gfdas
asked on
Resizing and moving TQRRichText
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:TMouseMov eEvent;
procedure ClientMouseMove(Sender:TOb ject; 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:TMouseMo veEvent 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('Sample s', [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(TWinContr ol);
// 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(AOw ner:TCompo nent);
begin
inherited Create(AOwner);
FEnableMoving := true;
FEnableSizing := true;
// I assume that the Parent control will be the same as AOwner...
fClientControl:=TWinContro l(AOwner);
// Save the defined Client MouseMove event (if there is one)...
fClientMouseMove:=DummyCla ss(fClient Control).O nMouseMove ;
// and assign the new one...
DummyClass(fClientControl) .OnMouseMo ve:=Client MouseMove;
// save the default screen cursor...
fSavedCursor:=Screen.Curso r;
end;
procedure TSizeQRRichText.ClientMous eMove(Send er: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,Sh ift,X,Y);
end;
(* end bug fix *)
// save the value of the screen cursor when we enter the QRRichText...
procedure TSizeQRRichText.CMMouseEnt er(var Msg : TCMMouseEnter);
begin
inherited;
fSavedCursor:=Screen.Curso r;
end;
// and restore it when we leave...
procedure TSizeQRRichText.CMMouseLea ve(var Msg : TCMMouseLeave);
begin
inherited;
Screen.Cursor:=fSavedCurso r;
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,C orner),P) then fSysCmd:=SizeNW
else if ptInRect(Rect(0,Height-Cor ner,Corner ,Height),P ) then fSysCmd:=SizeSW
else if ptInRect(Rect(Width-Corner ,Height-Co rner,Width ,Height),P ) then fSysCmd:=SizeSE
else if ptInRect(Rect(Width-Corner ,0,Width,C orner),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:=crSize WE;
SizeN,SizeS:Cursor:=crSize NS;
SizeNE,SizeSW:Cursor:=crSi zeNESW;
SizeNW,SizeSE:Cursor:=crSi zeNWSE;
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]:=Lo adCursor(0 ,IDC_SIZEA LL);
// 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,fSys Cmd,0); //<- And here's the heart of the whole component!
// Restore the settings, and we're done!
Screen.Cursor:=crDefault;
Align:=realign;
end;
END.
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:TMouseMov
procedure ClientMouseMove(Sender:TOb
// <-
// 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);
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:TMouseMo
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('Sample
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(TWinContr
// 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(AOw
begin
inherited Create(AOwner);
FEnableMoving := true;
FEnableSizing := true;
// I assume that the Parent control will be the same as AOwner...
fClientControl:=TWinContro
// Save the defined Client MouseMove event (if there is one)...
fClientMouseMove:=DummyCla
// and assign the new one...
DummyClass(fClientControl)
// save the default screen cursor...
fSavedCursor:=Screen.Curso
end;
procedure TSizeQRRichText.ClientMous
begin
inherited;
// restore the cursor...
Screen.Cursor:=crDefault;
// call any other code that is attached to this event...
if assigned(fClientMouseMove)
end;
(* end bug fix *)
// save the value of the screen cursor when we enter the QRRichText...
procedure TSizeQRRichText.CMMouseEnt
begin
inherited;
fSavedCursor:=Screen.Curso
end;
// and restore it when we leave...
procedure TSizeQRRichText.CMMouseLea
begin
inherited;
Screen.Cursor:=fSavedCurso
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(
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,C
else if ptInRect(Rect(0,Height-Cor
else if ptInRect(Rect(Width-Corner
else if ptInRect(Rect(Width-Corner
// 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:=crSize
SizeN,SizeS:Cursor:=crSize
SizeNE,SizeSW:Cursor:=crSi
SizeNW,SizeSE:Cursor:=crSi
else Cursor:=crDefault;
end;
end;
procedure TSizeQRRichText.MouseDown(
// 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]:=Lo
// 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,fSys
// Restore the settings, and we're done!
Screen.Cursor:=crDefault;
Align:=realign;
end;
END.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.