Author: Bertrand Goetzmann
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.
1 unit ControlHandler;
2
3 // Written by Bertrand Goetzmann (http://www.object-everywhere.com)
4
5 interface
6
7 uses
8 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
9 StdCtrls, ExtCtrls, ComCtrls;
10
11 type
12 TControlPoint = (pcTopLeft, pcTopRight, pcBottomLeft, pcBottomRight, pcOther);
13
14 TControlHandler = class(TCustomControl)
15 private
16 Rgn: HRGN;
17 R, R1: TRect;
18 Pos: TPoint;
19 Pt: TControlPoint;
20 bDrag: Boolean;
21 protected
22 FControl: TControl;
23 procedure SetRegion;
24 function GetControlPoint(const Point: TPoint): TControlPoint;
25 procedure Paint; override;
26 procedure MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
27 X,
28 Y: Integer);
29 procedure MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X,
30 Y:
31 Integer);
32 procedure MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
33 public
34 constructor Create(AOwner: TComponent); override;
35 destructor Destroy; override;
36 procedure SetControl(Control: TControl);
37 published
38 property Control: TControl read FControl write SetControl;
39 end;
40
41 implementation
42
43 const
44 LARGEUR = 5;
45
46 // Méthodes de TControlHandler
47
48 constructor TControlHandler.Create(AOwner: TComponent);
49 begin
50 inherited Create(AOwner);
51 Parent := AOwner as TWinControl;
52
53 Rgn := 0;
54 bDrag := False;
55
56 OnMouseDown := MouseDown;
57 OnMouseMove := MouseMove;
58 OnMouseUp := MouseUp;
59 end;
60
61 destructor TControlHandler.Destroy;
62 begin
63 if Rgn <> 0 then
64 DeleteObject(Rgn);
65 inherited Destroy;
66 end;
67
68 function TControlHandler.GetControlPoint(const Point: TPoint): TControlPoint;
69 begin
70 Result := pcOther;
71 if PtInRect(Rect(0, 0, LARGEUR, LARGEUR), Point) then
72 Result := pcTopLeft
73 else if PtInRect(Rect(Width - LARGEUR, 0, Width, LARGEUR), Point) then
74 Result := pcTopRight
75 else if PtInRect(Rect(0, Height - LARGEUR, LARGEUR, Height), Point) then
76 Result := pcBottomLeft
77 else if PtInRect(Rect(Width - LARGEUR, Height - LARGEUR, Width, Height), Point)
78 then
79 Result := pcBottomRight;
80 end;
81
82 procedure TControlHandler.MouseDown(Sender: TObject; Button: TMouseButton; Shift:
83 TShiftState; X, Y: Integer);
84 begin
85 Pos.x := X;
86 Pos.y := Y;
87 bDrag := True;
88
89 R := Rect(FControl.Left, FControl.Top, FControl.Left + FControl.Width,
90 FControl.top
91 + FControl.Height);
92 R1 := Rect(FControl.Left, FControl.Top, FControl.Left + FControl.Width,
93 FControl.top
94 + FControl.Height);
95
96 Pt := GetControlPoint(Pos);
97
98 Visible := False;
99 end;
100
101 procedure TControlHandler.MouseUp(Sender: TObject; Button: TMouseButton; Shift:
102 TShiftState; X, Y: Integer);
103 begin
104 Screen.Cursor := crDefault;
105 bDrag := False;
106
107 Control.Left := R.Left;
108 Control.Top := R.Top;
109 Control.Width := R.Right - R.Left;
110 Control.Height := R.Bottom - R.Top;
111
112 SetRegion;
113
114 Visible := True;
115 end;
116
117 procedure TControlHandler.MouseMove(Sender: TObject; Shift: TShiftState; X, Y:
118 Integer);
119 begin
120 case GetControlPoint(Point(X, Y)) of
121 pcTopLeft:
122 Cursor := crSizeNWSE;
123 pcTopRight:
124 Cursor := crSizeNESW;
125 pcBottomLeft:
126 Cursor := crSizeNESW;
127 pcBottomRight:
128 Cursor := crSizeNWSE;
129 pcOther:
130 Cursor := crDrag;
131 end;
132
133 if not bDrag then
134 Exit;
135
136 case Pt of
137 pcTopLeft:
138 begin
139 R.Left := R1.Left + X - Pos.x;
140 R.Top := R1.Top + Y - Pos.y;
141 end;
142 pcTopRight:
143 begin
144 R.Right := R1.Right + X - Pos.x;
145 R.Top := R1.Top + Y - Pos.y;
146 end;
147 pcBottomLeft:
148 begin
149 R.Left := R1.Left + X - Pos.x;
150 R.Bottom := R1.Bottom + Y - Pos.y;
151 end;
152 pcBottomRight:
153 begin
154 R.Right := R1.Right + X - Pos.x;
155 R.Bottom := R1.Bottom + Y - Pos.y;
156 end;
157 pcOther:
158 begin
159 R.Left := R1.Left + X - Pos.x;
160 R.Top := R1.Top + Y - Pos.y;
161 R.Right := R1.Right + X - Pos.x;
162 R.Bottom := R1.Bottom + Y - Pos.y;
163 end;
164 end;
165
166 with FControl do
167 begin
168 Left := R.Left;
169 Top := R.Top;
170 Width := R.Right - R.Left;
171 Height := R.Bottom - R.Top;
172 end;
173 end;
174
175 procedure TControlHandler.SetRegion;
176 var
177 Rgn1, Rgn2: HRGN;
178 begin
179 if Rgn <> 0 then
180 DeleteObject(Rgn);
181 Visible := False;
182
183 Left := Control.Left - LARGEUR;
184 Top := Control.Top - LARGEUR;
185 Width := Control.Width + 2 * LARGEUR;
186 Height := Control.Height + 2 * LARGEUR;
187
188 Rgn := CreateRectRgn(0, 0, Width, Height);
189 Rgn1 := CreateRectRgn(0, 0, Width, Height);
190 Rgn2 := CreateRectRgn(LARGEUR, LARGEUR, Control.Width + LARGEUR, Control.Height +
191 LARGEUR);
192 CombineRgn(Rgn, Rgn1, Rgn2, RGN_DIFF);
193 DeleteObject(Rgn1);
194 DeleteObject(Rgn2);
195 SetWindowRgn(Handle, Rgn, True);
196
197 Visible := True;
198 end;
199
200 procedure TControlHandler.SetControl(Control: TControl);
201 begin
202 FControl := Control;
203 SetRegion;
204 end;
205
206 procedure TControlHandler.Paint;
207 begin
208 with Canvas do
209 begin
210 Brush.Color := clBlack;
211 Brush.Style := bsBDiagonal;
212 Rectangle(0, 0, Width, Height);
213
214 // Dessiner les poignets
215 Brush.Style := bsSolid;
216 FillRect(Rect(0, 0, LARGEUR, LARGEUR));
217 FillRect(Rect(Width - LARGEUR, 0, Width, LARGEUR));
218 FillRect(Rect(0, Height - LARGEUR, LARGEUR, Height));
219 FillRect(Rect(Width - LARGEUR, Height - LARGEUR, Width, Height));
220 end;
221 end;
222
223 end.
Component Download: http://perso.worldonline.fr/objecteverywhere/control.zip
|
