Déplacement dynamique de composants à l'exécution

Version imprimable

02/07/2005, 18h32
tekilx

Déplacement dynamique de composants à l'exécution
Bonjour,

je cherche une méthode pour pouvoir déplacer et retailler des composants (Edits, combobox, images, checkbox, ...) dynamiquement à l'exécution.

pour l'instant, j'utilise l'évenement OnMouseDown des composants, et j'envoie un message SC_DRAGMOVE ou SC_Size, selon ce que je veux faire :
Code:

1 2 (sender as tcontrol).perform(WM_SysCommand, SC_DragMove, 0);
pour le déplacement
et
Code:

1 2 (sender as tcontrol).perform(WM_SysCommand, SC_Size or 8,0);
pour le retaillage.

Ca fonctionne a peu près bien, mais ça ne marche pas pour les ComboBox ( la combo s'ouvre)
Ca ne fonctionne pas non plus pour les Timages (je dois déplacer le composant conteneur de l'image -un TPanel en l'occurence- pour que ca marche :
Code:

1 2 (sender as TImage).Parent.Perform(WM_SysCommand, SC_DragMove, 0);
Ca ne fonctionne pas non plus, évidemment, pour les composants qui n'implémentent pas de gestionnaire pour l'evenement OnMouseDown ( en gros pour les compos ne descendant pas de TWinControl)

Un autre problème est que ca ne marche que pour les composants pris individuellement. je ne peux pas sélectionner plusieurs composants et les déplacer simultanément avec cette méthode.

Note : SC_Size est définie dans Windows.pas. Par contre SC_DragMove n'est pas définie dans Windows.pas . Il faut rajouter
Code:

1 2 const SC_DragMove = $F012; // 61458 en décimal
au code

Je sais qu'il existe des composants pour faire cela très simplement ... mais
je n'arrive pas à mettre la main dessus
Si quelqu'un pouvait me renseigner à ce sujet...

merci d'avance

PS j'utilise Delphi6 Pro + JVCL 3 + Firebird 1.5
04/07/2005, 10h23
Clorish

Je m'excuse mais qque chose me choffonne quand meme vraiement :

Pourquoi ne pas passer par les proprietee "Top/Left/Height/Width" d'es composant ?!?
Combiné a un Timer et un "pas" les deplacements se font tout seuls ....

Maintenant vu la "complexite" du code je ne pense pas a avoir affaire a un debutant, d'ou mon interrogation ...

Tiens moi au courant ;)
04/07/2005, 13h18
rsc

Un composant qui rend déplacables et dimensionnables les contrôles :

http://www.phidels.com/php/index.php...ip.php3&id=250

La méthode de base est la même que la tienne, avec des perfectionnements.

Concernant tes envies de fonctionnalités supplémentaires :
- pour les "composants ne descendant pas TWinControl", ce sont en principe des composants non fenêtrés (sans Handle de fenêtre), donc ça risque d'être difficile.
- pour la question de déplacer plusieurs composants en même temps, "yaka" implémenter un mécansime de groupage (sélection multiple de composants) et ensuite, en en déplaçant un avec la méthode base, ça ne doit pas être trop difficile de "faire suivre" les autres en jouant sur les Left et Top. Je ne connais pas de code tout fait à ce propos, à toi le flambeau ;)

Roland

Roland

Plus simplement, dans l'evenement OnMouseDown du controle à deplacer :

Pour un panel :

Code:

1
2
3
4
5
procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;  Shift: TShiftState; X, Y: Integer);
begin
 ReleaseCapture;
Panel1.Perform(WM_SYSCOMMAND, $F012, 0);
end;

Pour un bouton :

Code:

1
2
3
4
5
6
procedure TForm1.Button1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
Button1.Perform(WM_SYSCOMMAND, $F012, 0);
end;

:lol:

04/07/2005, 14h34
tekilx
Bonjour
Pour répondre à Clorish, je dirai que que ce que je souhaite, c'est pouvoir déplacer/redimensionner des composants à l'execution grace à la souris, en gros, comme on peut le faire dans l'EDI de Delphi.

Pour répondre à Ilyes, je dirai que j'ai besoin d'un gestionnaire d'événement générique, car je ne sais pas, à priori quel sont les composants qui vont être déplacés, d'ou la syntaxe :
Code:

1 2 3 4 5 if (sender is TPanel) then (sender as TPanel).Perform .... if (sender is TEdit) then (Sender as TEdit).perform ....
je n'ai donc qu'un gestionnaire unique qui se charge de déplacer / retailler les composants. En testant le Type du Sender, je peux ainsi n'avoir qu'une méthode qui traite tous les cas ( et je me serts de ShifState pour savoir si je dois déplacer ou retailler )

Et pour répondre à rsc, je vais de ce pas aller voir le composant dont tu parles.
Quand à déplacer des composants non fen^trés, je ne désespere pas : puisque qu'on peut le faire dans l'EDI Delphi, on doit bien pouvoir le faire au runtime !

Merci à tous les 3 pour réponses

Amicalement,

voici le source d'un composant (TResizer) qui permet de resizer un controle (descendant de TControl) à l'execution. il simule le comportement d'un disigner d'interface comme celui de VB ou Delphi

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
unit Resizer;
 
interface
 
uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  Forms, Dialogs;
 
type
  TResizer = class (TCustomControl)
  private
    FOldRgn:HRGN;
    FHandledControl: TControl;
    FBorderColor: TColor;
    FResizePointColor: TColor;
    FBorderWidth: Integer;
    FBitmap:TBitmap;
    procedure SetHandledControl(const Value: TControl);
    procedure SetBorderColor(const Value: TColor);
    procedure SetResizePointColor(const Value: TColor);
    procedure SetBorderWidth(const Value: Integer);
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
    procedure WMMove(var Message: TWMMove); message WM_MOVE;
    procedure DefineBitmap(Bitmap:TBitMap);
  protected
    function InnerRect:TRect;
    procedure Resize; override;
 
    procedure AjustResizer;
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X: Integer; Y: Integer); override;
  public
    property BorderWidth:Integer read FBorderWidth write SetBorderWidth default 6;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property HandledControl: TControl read FHandledControl write SetHandledControl;
    property BorderColor:TColor read FBorderColor write SetBorderColor;
    property ResizePointColor:TColor read FResizePointColor write SetResizePointColor;    
  end;
 
const
  crDeplacer=1;
 
implementation
 
{$R *.res}
 
{
*********************************** TResizer ***********************************
}
procedure TResizer.AjustResizer;
var
  R:TRect;
begin
  Visible:=False;
  if Assigned(HandledControl) then
  begin
    Parent:=HandledControl.Parent;
      R:=HandledControl.BoundsRect;
      Dec(R.Left,BorderWidth);
      Dec(R.Top,BorderWidth);
      Inc(R.Right,BorderWidth);
      Inc(R.Bottom,BorderWidth);
    BoundsRect:=R;
    Visible:=True;
  end;
end;
 
constructor TResizer.Create(AOwner: TComponent);
begin
  inherited;
  FBorderWidth:=6;
  FOldRgn:=Integer(nil);
  Cursor:=crDeplacer;
  FResizePointColor:=clNavy;
  FBorderColor:=clWhite;
  FBitmap:=TBitmap.Create;
  DefineBitmap(FBitmap);
end;
 
procedure TResizer.DefineBitmap(Bitmap:TBitMap);
var
  I,J:Integer;
begin
  with Bitmap do
  begin
    Width:=8;
    Height:=8;
    PixelFormat:=pf24bit;
    if BorderColor<0 then
      Bitmap.Canvas.Brush.Color:=ColorToRGB(BorderColor)
    else
      Canvas.Brush.Color:=BorderColor;
    Canvas.FillRect(Rect(0,0,8,8));
    I:=1;
    while I<8 do
    begin
      J:=0;
      while J<7 do
      begin
        if (((I div 2)+ (J div 2)) mod 2)<>0 then
          Canvas.Pixels[J,I]:=ResizePointColor;
        Inc(J,2);
      end;
      Inc(I,2);
    end;
  end;
end;
 
destructor TResizer.Destroy;
begin
  HandledControl:=nil;
  FBitmap.Destroy;
  DeleteObject(FOldRgn);
  inherited;
end;
 
procedure TResizer.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited;
  if ssLeft in Shift then
  begin
    ReleaseCapture;
    Perform(WM_SYSCOMMAND,$f012,0);
  end;
end;
 
procedure TResizer.Paint;
var
  R:TRect;
begin
  Canvas.Brush.Color:=BorderColor;
  Canvas.Brush.Bitmap:=FBitmap;
  Canvas.FillRect(ClientRect);
  Canvas.Brush.Bitmap:=nil;
  Canvas.Brush.Color:=ResizePointColor;
  Canvas.FillRect(Rect(0,0,BorderWidth,BorderWidth));
  Canvas.FillRect(Rect((Width-BorderWidth) div 2,0,(Width+BorderWidth)div 2,BorderWidth) );
  Canvas.FillRect(Rect(Width-BorderWidth-1,0,Width,BorderWidth) );
  Canvas.FillRect(Rect(Width-BorderWidth-1,(Height-BorderWidth)div 2,Width,(Height+BorderWidth)div 2) );
  Canvas.FillRect(Rect(Width-BorderWidth-1, Height-BorderWidth-1,Width,Height) );
  Canvas.FillRect(Rect((Width-BorderWidth)div 2, Height-BorderWidth-1,(Width+BorderWidth)div 2, Height) );
  Canvas.FillRect(Rect(0, Height-BorderWidth-1, BorderWidth, Height) );
  Canvas.FillRect(Rect(0,(Height-BorderWidth)div 2, BorderWidth, (Height+BorderWidth)div 2));
end;
 
procedure TResizer.SetBorderWidth(const Value: Integer);
begin
  FBorderWidth := Value;
  AjustResizer;
end;
 
procedure TResizer.SetHandledControl(const Value: TControl);
begin
  if FHandledControl <> Value then
  begin
    FHandledControl := Value;
    if Assigned(FHandledControl) then
      AjustResizer
    else
    begin
      visible:=false;
      Parent:=nil;
    end;
  end;
end;
 
procedure TResizer.SetBorderColor(const Value: TColor);
begin
  if FBorderColor<>Value then
  begin
    FBorderColor := Value;
    DefineBitmap(FBitmap);
    Invalidate;
  end;
end;
 
procedure TResizer.SetResizePointColor(const Value: TColor);
begin
  if FResizePointColor<>Value then
  begin
    FResizePointColor := Value;
    DefineBitmap(FBitmap);
    Invalidate;
  end;
end;
 
procedure TResizer.WMNCHitTest(var Message: TWMNCHitTest);
var
  P:TPoint;
begin
  // Tester si l'evenement de la souris est definit pour nous
  Message.Result:=HTTRANSPARENT;
  P:=ScreenToClient(Point(Message.XPos,Message.YPos));
  if P.X<10 then
  begin
    // On est dans la partie gauche du control
    if P.Y<10 then
      Message.Result:=HTTOPLEFT // Le coin superieur gauche
    else
    begin
      if Height-P.Y<10 then
        Message.Result:=HTBOTTOMLEFT // Le coin inferieur gauche
      else
      begin
        if Abs(P.Y - (Height div 2))<5 then
          Message.Result:=HTLEFT
        else
          Message.Result:=HTCLIENT;
      end;
    end;
  end
  else
    if (Width-P.X)<10 then
    begin
      // On est dans la partie droite du controle
      if P.Y<10 then
        Message.Result:=HTTOPRIGHT // Le coin superieur droit
      else
      begin
        if Height-P.Y<10 then
          Message.Result:=HTBOTTOMRIGHT // Le coin inferieur droit
        else
        begin
          if Abs(P.Y - (Height div 2))<5 then
            Message.Result:=HTRIGHT
          else
            Message.Result:=HTCLIENT;
        end;
      end;
    end
    else
    begin
      if P.Y<10 then
      begin
        // On est dans le haut du controle
        if Abs(P.X-(Width div 2))<5 then
          Message.Result:=HTTOP
        else
          Message.Result:=HTCLIENT;
      end
      else
        if (Height-P.Y<10) then
        begin
          // On est dans le bat du controle
          if Abs(P.X-(Width div 2))<5 then
            Message.Result:=HTBOTTOM
          else
            Message.Result:=HTCLIENT;
        end
    end;
end;
 
function TResizer.InnerRect: TRect;
begin
  Result:=BoundsRect;
  Inc(Result.Left,BorderWidth);
  Inc(Result.Top,BorderWidth);
  Dec(Result.Right,BorderWidth);
  Dec(Result.Bottom,BorderWidth);
end;
 
procedure TResizer.WMMove(var Message: TWMMove);
begin
  inherited;
  if Assigned(HandledControl) then
  begin
    HandledControl.BoundsRect:=InnerRect;
  end;
end;
 
procedure TResizer.Resize;
var
  rgn, rgn2:HRGN;
begin
  // creer une region de clipping
  rgn :=CreateRectRgn(0,0,Width-1,Height-1);
  rgn2:=CreateRectRgn(BorderWidth,BorderWidth,Width-(BorderWidth+1),Height-(BorderWidth+1));
  CombineRgn(rgn,rgn,rgn2,RGN_DIFF);
  SetWindowRgn(Handle,rgn,Visible);
 
  DeleteObject(rgn2);
  DeleteObject(FOldRgn);
  FOldRgn:=rgn;
 
  if Assigned(HandledControl) then
  begin
    HandledControl.BoundsRect:=InnerRect;
  end;
  inherited;
end;
 
initialization
   Screen.Cursors[crDeplacer]:=LoadCursor(HInstance,IDC_HAND); {'CR_DEPLACER'}
end.

il faut juste copier ce code dans un fichier "Resizer.pas";
le composant TResizer a une propriété HandledControl de type TControl. utiliser cette prop pour manipuler le controle souhaité.

petit exemple d'utilisation :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
// variable globale
Resizer : TResizer; // a initialiser qq part dans le code
Boutton: TButton;
 
// Evenement OnClick du Boutton
procedure Form1.BouttonClick(Sender : TObject);
begin
  Resizer.HandledControl:= Boutton;
end;
 
// Evenement OnClick de la Form
procedure Form1.FormClick(Sender : TObject);
begin
  Resizer.HandledControl:= nil;
end;

04/07/2005, 17h13
tekilx

Merci beaucoup pour ce code.
J'ai aussi trouvé sur Borland Code Central un composant qui permet de redimmensionner dynamiquement des composants

Pour ceux que ça interresse c'est ici :

http://cc.borland.com/Item.aspx?id=14689

Je crois que je commence à tenir le début d'une solution à mon problème. !
:D
05/07/2005, 10h16
rsc

Par hasard je tombe ici :
http://romuald.raffin.free.fr/composants.htm

sur :

Citation:

RaGroupe V2.0 : Composant non visuel permettant de regrouper plusieurs contrôles permettant des actions groupées sur ceux-ci.

Je n'ai pas le temps de regarder ça pour l'instant, mais j'ai pensé à ton désir de déplacer +eurs composants à la fois

Roland
05/07/2005, 10h46
tekilx

Merci bcp pour ce lien .
En fait, le composant proposé ne permet que de modifier certaines propriétés d'un ensemble de composants. Ca ne colle pas avec mon besoin.

Je vais faire une synthèse de ce que j'ai pu trouver suite à ce post, et je vous tiendrai informé.