Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
How to resize a TControl object graphically Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
17-Jun-03
Category
VCL-General
Language
Delphi 2.x
Views
102
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			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

			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC