Mega Code Archive
Move or resize a TControl object graphically
<![CDATA[
Title: Move or resize a TControl object graphically
Question: Move or resize graphically a TControl object by using another objet that has all the necessary code.
Answer:
The unit showed bellow is for the TControlHandler class.
TControlHandler can manipulate graphically any descendant of the TControl class. A TControl objet can be selected by the TControlHandler Control property : a border appears surrounding the control passed to this method as reference. At run-time, you can then change its location or change its size with the mouse.
For example, in an application, create a TControlHandler at startup :
FControlHandler := TControlHandler.Create(Self);
To manipulate a Button1 objet placed on the form, write the following instruction :
FControlHandler.Control := Button1;
You can choose another control by assigning a new TControl's reference ; the previous one is deselected.
unit ControlHandler;
// Written by Bertrand Goetzmann (http://www.object-everywhere.com)
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, ComCtrls;
type
TControlPoint = (pcTopLeft, pcTopRight, pcBottomLeft, pcBottomRight, pcOther);
TControlHandler = class(TCustomControl)
private
Rgn: HRGN;
R, R1: TRect;
Pos: TPoint;
Pt: TControlPoint;
bDrag: Boolean;
protected
FControl: TControl;
procedure SetRegion;
function GetControlPoint(const Point: TPoint): TControlPoint;
procedure Paint; override;
procedure MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SetControl(Control: TControl);
published
property Control: TControl read FControl write SetControl;
end;
implementation
const
LARGEUR = 5;
// Mthodes de TControlHandler
constructor TControlHandler.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Parent := AOwner as TWinControl;
Rgn := 0;
bDrag := False;
OnMouseDown := MouseDown;
OnMouseMove := MouseMove;
OnMouseUp := MouseUp;
end;
destructor TControlHandler.Destroy;
begin
if Rgn 0 then
DeleteObject(Rgn);
inherited Destroy;
end;
function TControlHandler.GetControlPoint(const Point: TPoint): TControlPoint;
begin
Result := pcOther;
if PtInRect(Rect(0, 0, LARGEUR, LARGEUR), Point) then
Result := pcTopLeft
else if PtInRect(Rect(Width-LARGEUR, 0, Width, LARGEUR), Point) then
Result := pcTopRight
else if PtInRect(Rect(0, Height-LARGEUR, LARGEUR, Height), Point) then
Result := pcBottomLeft
else if PtInRect(Rect(Width-LARGEUR, Height-LARGEUR, Width, Height), Point) then
Result := pcBottomRight;
end;
procedure TControlHandler.MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Pos.x := X;
Pos.y := Y;
bDrag := True;
R := Rect(FControl.Left, FControl.Top, FControl.Left + FControl.Width, FControl.Top + FControl.Height);
R1 := Rect(FControl.Left, FControl.Top, FControl.Left + FControl.Width, FControl.Top + FControl.Height);
Pt := GetControlPoint(Pos);
Visible := False;
end;
procedure TControlHandler.MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Screen.Cursor := crDefault;
bDrag := False;
Control.Left := R.Left;
Control.Top := R.Top;
Control.Width := R.Right - R.Left;
Control.Height := R.Bottom - R.Top;
SetRegion;
Visible := True;
end;
procedure TControlHandler.MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
case GetControlPoint(Point(X, Y)) of
pcTopLeft :
Cursor := crSizeNWSE;
pcTopRight :
Cursor := crSizeNESW;
pcBottomLeft :
Cursor := crSizeNESW;
pcBottomRight :
Cursor := crSizeNWSE;
pcOther :
Cursor := crDrag;
end;
if not bDrag then Exit;
case Pt of
pcTopLeft : begin
R.Left := R1.Left + X - Pos.x;
R.Top := R1.Top + Y - Pos.y;
end;
pcTopRight : begin
R.Right := R1.Right + X - Pos.x;
R.Top := R1.Top + Y - Pos.y;
end;
pcBottomLeft : begin
R.Left := R1.Left + X - Pos.x;
R.Bottom := R1.Bottom + Y - Pos.y;
end;
pcBottomRight : begin
R.Right := R1.Right + X - Pos.x;
R.Bottom := R1.Bottom + Y - Pos.y;
end;
pcOther : begin
R.Left := R1.Left + X - Pos.x;
R.Top := R1.Top + Y - Pos.y;
R.Right := R1.Right + X - Pos.x;
R.Bottom := R1.Bottom + Y - Pos.y;
end;
end;
with FControl do
begin
Left := R.Left;
Top := R.Top;
Width := R.Right - R.Left;
Height := R.Bottom - R.Top;
end;
end;
procedure TControlHandler.SetRegion;
var
Rgn1, Rgn2: HRGN;
begin
if Rgn 0 then DeleteObject(Rgn);
Visible := False;
Left := Control.Left - LARGEUR;
Top := Control.Top - LARGEUR;
Width := Control.Width + 2*LARGEUR;
Height := Control.Height + 2*LARGEUR;
Rgn := CreateRectRgn(0, 0, Width, Height);
Rgn1 := CreateRectRgn(0, 0, Width, Height);
Rgn2 := CreateRectRgn(LARGEUR, LARGEUR, Control.Width + LARGEUR, Control.Height + LARGEUR);
CombineRgn(Rgn, Rgn1, Rgn2, RGN_DIFF);
DeleteObject(Rgn1);
DeleteObject(Rgn2);
SetWindowRgn(Handle, Rgn, True);
Visible := True;
end;
procedure TControlHandler.SetControl(Control: TControl);
begin
FControl := Control;
SetRegion;
end;
procedure TControlHandler.Paint;
begin
with Canvas do
begin
Brush.Color := clBlack;
Brush.Style := bsBDiagonal;
Rectangle(0, 0, Width, Height);
// Dessiner les poignets
Brush.Style := bsSolid;
FillRect(Rect(0, 0, LARGEUR, LARGEUR));
FillRect(Rect(Width-LARGEUR, 0, Width, LARGEUR));
FillRect(Rect(0, Height-LARGEUR, LARGEUR, Height));
FillRect(Rect(Width-LARGEUR, Height-LARGEUR, Width, Height));
end;
end;
end.
]]>