Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people, just like you, are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
Solved

Resizing and moving TQRRichText

Posted on 2001-07-06
1
799 Views
Last Modified: 2007-11-27
Resizing and moving TQRRichText

This is source code (component) for resizing and moving TQRRichText.
Problem is that I can not resize and move it or it is very hard.
The same problem is appearing in Designer from Devexpress.



unit SizeQRRichText;

interface

uses Windows, Messages, Classes, Controls, ExtCtrls, Forms, QRCTRLS;

// declare the record types to translate mouse messages...
type
 TCMMouseEnter = record
                   Msg : Cardinal;
                   Unused : Integer;
                   Sender : TControl;
                   Result : LongInt;
                 end;

type
 TCMMouseLeave = TCMMouseEnter;


 TSizeQRRichText = class(TQRRichText)
 private
   // variable to hold the value passed to WM_SYSCOMMAND...
   fSysCmd:integer;
   // variable to hold the "default" cursor, just in case it isn't "crDefault"
   fSavedCursor:TCursor;
   FEnableMoving: Boolean;
   FEnableSizing: Boolean;

   // -> Bug fix (explained below)
   fClientControl:TWinControl;
   fClientMouseMove:TMouseMoveEvent;
   procedure ClientMouseMove(Sender:TObject; Shift: TShiftState; X, Y: Integer);
   // <-

   // Custom events to trap the MouseEnter and mouse leave messages...
   // note the  CM_  prefix - these are custom Windows messages
   // similar to standard  WM_ messages, but used internally by Delphi applications...
   procedure CMMouseEnter(var Msg : TCMMouseEnter); message CM_MouseEnter;
   procedure CMMouseLeave(var Msg : TCMMouseLeave); message CM_MouseLeave;

 public
   CONSTRUCTOR Create(AOwner:TComponent); override;
 protected
   // override these default mouse events
   procedure MouseMove(Shift: TShiftState; X, Y: Integer);  override;
   procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
 published
   property OnClientMouseMove:TMouseMoveEvent read fClientMouseMove write fClientMouseMove;
   property EnableMoving: Boolean read FEnableMoving write FEnableMoving;
   property EnableSizing: Boolean read FEnableSizing write FEnableSizing;
 end;

procedure Register;

implementation

// Added this procedure to install the component on the pallette...
procedure Register;
begin
 RegisterComponents('Samples', [TSizeQRRichText]);
end;


// constants passed to WM_SYSCOMMAND
// For some reason, these are not listed in the help file,
// I had to play around a bit to find them...
const
 SizeE  = $F002; // east
 SizeW  = $F001; // west
 SizeN  = $F003; // north
 SizeS  = $F006; // south
 SizeNW = $F004; // northwest
 SizeNE = $F005; // northeast
 SizeSW = $F007; // southwest
 SizeSE = $F008; // southeast

// Drags the entire QRRichText ...
 MoveIt = $F012;


(*
 begin bug fix -
 For some reason, the CMouseLeave event isn't always called.
 Windows seems to drop the ball if the mouse leaves the control too quickly.
 So we need to jump through some hoops here to be sure the cursor gets restored
*)

// Declare a "dummy" class
// this "trick" just exposes the protected methods of TWinControl...
type
 DummyClass=class(TWinControl);

// the constructor is only needed here for the bug fix,
// but you might need it later if you decide to enhance the control...
CONSTRUCTOR TSizeQRRichText.Create(AOwner:TComponent);
begin
 inherited Create(AOwner);
 FEnableMoving := true;
 FEnableSizing := true;
 // I assume that the Parent control will be the same as AOwner...
 fClientControl:=TWinControl(AOwner);
 // Save the defined Client MouseMove event (if there is one)...
 fClientMouseMove:=DummyClass(fClientControl).OnMouseMove;
 // and assign the new one...
 DummyClass(fClientControl).OnMouseMove:=ClientMouseMove;
 // save the default screen cursor...
 fSavedCursor:=Screen.Cursor;
end;

procedure TSizeQRRichText.ClientMouseMove(Sender:TObject; Shift: TShiftState; X, Y: Integer);
begin
 inherited;
 // restore the cursor...
 Screen.Cursor:=crDefault;
 // call any other code that is attached to this event...
 if assigned(fClientMouseMove) then fClientMouseMove(Sender,Shift,X,Y);
end;

(* end bug fix *)

// save the value of the screen cursor when we enter the QRRichText...
procedure TSizeQRRichText.CMMouseEnter(var Msg : TCMMouseEnter);
begin
 inherited;
 fSavedCursor:=Screen.Cursor;
end;

// and restore it when we leave...
procedure TSizeQRRichText.CMMouseLeave(var Msg : TCMMouseLeave);
begin
 inherited;
 Screen.Cursor:=fSavedCursor;
end;


// Note that nothing is really "happening" here as far as sizing the QRRichText-
// we are just setting things up in case MouseDown gets called...
procedure TSizeQRRichText.MouseMove(Shift: TShiftState; X, Y: Integer);
const
 Edge=10; // how close to the edge do we get before saying we're "on" it? (in  pixels)
 Corner=20; // the corners are a bit harder to detect, so we add some tolerance
var
 P:TPoint;
begin
 // Create a TPoint from from the mouse coordinates passed to the function...
 P:=point(X,Y);

 // All this if-then-else stuff decides which constant will be passed to WM_SYSCOMMAND
 // Here we just use some math to create a small square at each corner,
 // then check to see if the mouse is within any them...
 if FEnableSizing then
 begin
   if ptInRect(Rect(0,0,Corner,Corner),P) then fSysCmd:=SizeNW
   else if ptInRect(Rect(0,Height-Corner,Corner,Height),P) then fSysCmd:=SizeSW
   else if ptInRect(Rect(Width-Corner,Height-Corner,Width,Height),P) then fSysCmd:=SizeSE
   else if ptInRect(Rect(Width-Corner,0,Width,Corner),P) then fSysCmd:=SizeNE

   // if it's not in a corner, then is it near an edge?
   else if (X < Edge) then fSysCmd:=SizeW
   else if ( X > (Width-Edge) ) then fSysCmd:=SizeE
   else if (Y < Edge) then fSysCmd:=SizeN
   else if ( Y > (Height-3) ) then fSysCmd:=SizeS

   // if it's none of the above, then MouseDown should drag the whole QRRichText...
   else
     if FEnableMoving then fSysCmd:=MoveIt
     else fSysCmd := 0;
 end
   else
     if FEnableMoving then fSysCmd:=MoveIt
     else fSysCmd := 0;

 // Now that we have the correct system command, we can use its
 // value to determine which screen cursor to display...
 with Screen do case fSysCmd of
   SizeE,SizeW:Cursor:=crSizeWE;
   SizeN,SizeS:Cursor:=crSizeNS;
   SizeNE,SizeSW:Cursor:=crSizeNESW;
   SizeNW,SizeSE:Cursor:=crSizeNWSE;
   else Cursor:=crDefault;
 end;
end;

procedure TSizeQRRichText.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
// Give the new cursor a unique integer constant...
const crMove=-5;

// I declared a variable to hold the value of the "Align" property
// this is more-or-less "reserved for future enhancements" ...
var realign:TAlign;

begin
 // the four-sided arrow (move) cursor is not available in Delphi 2,
 // so I borrow this one from Windows...
 Screen.Cursors[crMove]:=LoadCursor(0,IDC_SIZEALL);
 // make sure the default MouseMove stuff gets executed...
 inherited MouseDown(Button,Shift,X,Y);
 // We don't drag with the right button, so bail out if it's down...
 if Button=mbRight then EXIT;
 // if the Left button is down, and we're not on an edge, then we must be moving...
 if (ssLeft in Shift) and (Screen.Cursor=crDefault) then Screen.Cursor:=crMove;
 // save the setting of the Align property...
 // this really isn't needed here, but I had hoped to adapt this code
 // to create something like a "dockable" QRRichText...
 realign:=Align;
 Align:=alNone;
 // Let go of the mouse capture...
 // not sure about this, but I read somewhere that it's a good idea...
 ReleaseCapture;
 // "Perform" tells the component to execute an API call on itself...
 Perform(WM_SysCommand,fSysCmd,0); //<- And here's the heart of the whole component!
 // Restore the settings, and we're done!
 Screen.Cursor:=crDefault;
 Align:=realign;
end;

END.
0
Comment
Question by:gfdas
1 Comment
 
LVL 2

Accepted Solution

by:
vbmn earned 200 total points
ID: 6281785
Use Runtime Design System.

Author's home page:

 Written in English

  http://www.geocities.com/ResearchTriangle/Thinktank/5653/

 Written in Japanese

  http://hp.vector.co.jp/authors/VA005818/
0

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Two types of users will appreciate AOMEI Backupper Pro: 1 - Those with PCIe drives (and haven't found cloning software that works on them). 2 - Those who want a fast clone of their boot drive (no re-boots needed) and it can clone your drive wh…
Established in 1997, Technology Architects has become one of the most reputable technology solutions companies in the country. TA have been providing businesses with cost effective state-of-the-art solutions and unparalleled service that is designed…

809 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question