Discussion :

[SergioMaster]

Je vois que mon programme sollicite beaucoup d'interrogations et je le comprend.

Non, pas des interrogations, des incompréhensions de votre manière de faire

sous forme de composant visuelle avec la photo associé sur l’écran

Je me souviens d'un webinaire dont le but était de créer un composant à partir d'un TFrame (annonce), la video est facile à retrouver grâce à en utilisant le titre "Créer des composants visuels sans faire de composant" comme recherche je suis "tomber" tout de suite dessus ( à pprem)

Mais je reste persuadé qu'il n'est pas nécessaire de créer un composant, juste un TFrame.

ainsi le positionner d'une manière à satisfaire des besoins internes à l'entreprise.

le Drag&Drop et le docking est certainement mieux que ce que vous essayez maladoitement de faire avec tout ce fatras de code

en 30mn voici qui indique la faisabilité (utilisation de frame, dragdrop et docking)

[chekkal]

FindComponent !
Vous devriez maintenir une liste interne pour éviter ce balayage lourd.

j'ai pas compris votre raisonnement

FindComponent !
plusieurs FindComponent pour le même controle à la suite, et vous vous demandez pourquoi c'est lent !

FindComponent ne cherche pas le même controle.

Le MouseMove est trop compliqué, en utilisant un Panel comme Parent, retrouver les controles groupés sera plus aisé pour déplacer l'ensemble et aussi séparer les TShape 900 dans une liste des control contenus

J'ai déjà testé le Tpanel est il est beaucoup plus lourd à la création, aussi l'avantage d'Utiliser le Tshape et que je peut simuler le déplacement d'un Employé entre les Chantier "Tshape".

Jetez ce code, recommencez !

A VOS ORDRES CHEF....

[ShaiLeTroll]

j'ai pas compris votre raisonnement

une TObjectList<TPanel> cela vous parle ?
J'en ferais deux, un liste de TChantier et une liste de TEmployee, j'utiliserais un ID numérique pour les recherches au lieu d'utilise le libellé, un ID qui vient par exemple de la DB

FindComponent ne cherche pas le même controle.

Ah oui ?
Pourtant c'est flagrant que l'utilisation de variable locale pour stocker le Component trouvé par FindComponent est un minimum d'optimisation :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
 
...
   if Tlabel(form1.FindComponent('mat'+Fdm.PER.fieldbyname('mat').asstring))<>nil then
      Tlabel(form1.FindComponent('mat'+Fdm.PER.fieldbyname('mat').asstring)).Destroy;
  ...
if TImage(form1.FindComponent('imat'+Fdm.PER.fieldbyname('mat').asstring))<>nil then
      TImage(form1.FindComponent('imat'+Fdm.PER.fieldbyname('mat').asstring)).Destroy;
...
             s:='m'+copy(Timage(Sender).name,3,length(Timage(Sender).name)-2);
             Tlabel(form1.FindComponent(s)).left:=Timage(Sender).left+Timage(Sender).width+5;i:=Tlabel(form1.FindComponent(s)).left;
             Tlabel(form1.FindComponent(s)).top:=Timage(Sender).top;///+Tlabel(form1.FindComponent(s)).height div 2;
 ...
 
             Tlabel(k.FindComponent(s)).left:=TLabel(Sender).left;
             Tlabel(k.FindComponent(s)).top:=TLabel(Sender).top+10;}
 
...
             Timage(form1.FindComponent(varglobal)).Left:=x;
             TImage(form1.FindComponent(varglobal)).top:=y+Tshape(sender).top;
             Timage(form1.FindComponent(varglobal)).tag:=1;
             pag2mousemove(Tlabel(form1.FindComponent(varglobal)),[SSShift],x,y);
             TImage(form1.FindComponent(varglobal)).tag:=0;
             varglobal:='';
      ...

J'ai déjà testé le Tpanel est il est beaucoup plus lourd à la création, aussi l'avantage d'Utiliser le Tshape et que je peut simuler le déplacement d'un Employé entre les Chantier "Tshape".

Le TPanel crée un Handle oui, on peut lui changer son parent et surtout possède la propriété DockSite + OnDockOver/OnDockDrop

[SergioMaster]

une TObjectList<TPanel>

Marrant, moi je suis parti sur des TFrames

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
    ListeChantiers : TObjectList<TChantier>;
    ListeOuvriers : TObjectList<TOuvrier>;

[ShaiLeTroll]

Les Frames, cela simplifie le truc et évite effectivement plein de code pour la compostion des controles imbriques

Sur ma pause dejeuner, j'ai trouvé cela amusant de faire ceci en D7 Perso, au moins on peut difficilement faire plus bas pour être compatible
EDIT : DropOnOver c'est plus visuel mais normalement cela ne se fait pas comme ça

DragDock_MainForm.pas

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
unit DragDock_MainForm;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls,
  DragDock_DataModel;
 
type
  TChantiersController = class;
  TChantierControl = class;
  TEmployeControl = class;
 
  TDragDockMainForm = class(TForm)
    grpEntities: TGroupBox;
    btnEntityAddChantier: TButton;
    btnEntityAddEmploye: TButton;
    sbChantiers: TScrollBox;
    ckbDragDropOnOver: TCheckBox;
    procedure btnEntityAddChantierClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnEntityAddEmployeClick(Sender: TObject);
    procedure ckbDragDropOnOverClick(Sender: TObject);
  private
    FChantiers: TChantiersController;
  public
    { Déclarations publiques }
  end;
 
  TChantiersController = class(TObject)
  private
    FContainer: TScrollBox;
    FChantiers: TChantierList;
    FDropOnOver: Boolean;
 
    procedure ShowChantiersEnterEventHandler(Sender: TObject);
    procedure ShowChantiersCloseUpEventHandler(Sender: TObject);
    procedure ShowChantiersExitEventHandler(Sender: TObject);
 
    procedure SetDropOnOver(const Value: Boolean);
  public
    constructor Create(AContainer: TScrollBox);
    destructor Destroy(); override;
 
    function AddChantier(AChantier: TChantierEntity): TChantierControl; overload;
    function AddChantier(const AChantierName: string): TChantierControl; overload;
    function AddEmployee(const AEmployeName: string): TEmployeControl;
    class function AddEmployeInChantier(AEmploye: TEmployeControl; AChantier: TChantierControl): TEmployeControl; overload;
    class function AddEmployeInChantier(const AEmployeName: string; AChantier: TChantierControl): TEmployeControl; overload;
 
    property DropOnOver: Boolean read FDropOnOver write SetDropOnOver;
  end;
 
  TChantierControl = class(TPanel)
  private
    FBorder: TShape;
    FTitle: TLabel;
    FEntity: TChantierEntity;
    FEmployes: TEmployeList;
    FDropOnOver: Boolean;
 
    function GetChantierID(): Integer;
    procedure SetChantierID(const Value: Integer);
    function GetChantierName(): string;
    procedure SetChantierName(const Value: string);
 
    procedure ToggleSizeableClickEventHandler(Sender: TObject);
    procedure ChantierDragOverEventHandler(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
    procedure ChantierDragDropEventHandler(Sender, Source: TObject; X, Y: Integer);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy(); override;
 
    property ChantierID: Integer read GetChantierID write SetChantierID;
    property ChantierName: string read GetChantierName write SetChantierName;
 
    property Entity: TChantierEntity read FEntity;
    property Employes: TEmployeList read FEmployes;
 
    property DropOnOver: Boolean read FDropOnOver write FDropOnOver;
  end;
 
 
  TEmployeControl = class(TPanel)
  private
    FBorder: TShape;
    FTitle: TLabel;
    FContrat: TLabel;
    FImage: TImage;
    FEntity: TEmployeEntity;
    FDragImageList: TDragImageList;
 
    function GetEmployeID(): Integer;
    procedure SetEmployeID(const Value: Integer);
    function GetEmployeName(): string;
    procedure SetEmployeName(const Value: string);
 
    procedure EmployeDragSubStartEventHandler(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy(); override;
 
    procedure ChangeChantier(ANewChantier: TChantierControl);
 
    property EmployeID: Integer read GetEmployeID write SetEmployeID;
    property EmployeName: string read GetEmployeName write SetEmployeName;
 
    property Entity: TEmployeEntity read FEntity;
  end;
 
 
var
  DragDockMainForm: TDragDockMainForm;
 
implementation
 
uses Math, StrUtils;
 
{$R *.dfm}
 
{ TChantierTDragDockMainFormsController }
 
procedure TDragDockMainForm.FormCreate(Sender: TObject);
begin
  FChantiers := TChantiersController.Create(sbChantiers);
  ckbDragDropOnOver.Checked := FChantiers.DropOnOver;
end;
 
procedure TDragDockMainForm.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FChantiers);
end;
 
procedure TDragDockMainForm.btnEntityAddChantierClick(Sender: TObject);
var
  S: string;
begin
  S := TimeToStr(Now());
  if InputQuery('Nouveau Chantier', 'Nom du nouveau chantier', S) then
    FChantiers.AddChantier(S);
end;
 
procedure TDragDockMainForm.btnEntityAddEmployeClick(Sender: TObject);
var
  S: string;
begin
  S := TimeToStr(Now());
  if InputQuery('Nouvel Employé', 'Nom du nouvel employé', S) then
    FChantiers.AddEmployee(S);
end;
 
procedure TDragDockMainForm.ckbDragDropOnOverClick(Sender: TObject);
begin
  FChantiers.DropOnOver := ckbDragDropOnOver.Checked;
end;
 
 
{ TChantiersController }
 
constructor TChantiersController.Create(AContainer: TScrollBox);
var
  I: Integer;
begin
  inherited Create();
 
  FDropOnOver := True;
 
  FContainer := AContainer;
 
  FChantiers := TChantierList.Create(False);
  FChantiers.Load();
 
  for I := 0 to FChantiers.Count - 1 do
    AddChantier(TChantierEntity(FChantiers[I]));
end;
 
destructor TChantiersController.Destroy();
begin
  if Assigned(FChantiers) then
    FChantiers.Save();
 
  FreeAndNil(FChantiers);
 
  inherited Destroy();
end;
 
function TChantiersController.AddChantier(AChantier: TChantierEntity): TChantierControl;
begin
  Result := AddChantier(AChantier.ChantierName);
  Result.ChantierID := AChantier.ChantierID;
end;
 
function TChantiersController.AddChantier(const AChantierName: string): TChantierControl;
begin
  Result := TChantierControl.Create(FContainer);
  Result.Left := 8 * FContainer.ControlCount + 300 * (FContainer.ControlCount - 1);
  Result.Width := 300;
  Result.Height := Max(Result.Height, FContainer.ClientHeight - 100);
  Result.ChantierName := AChantierName;
  Result.DropOnOver := Self.DropOnOver;
 
  FChantiers.Add(Result.Entity);
end;
 
function TChantiersController.AddEmployee(const AEmployeName: string): TEmployeControl;
 
  function SelectChantiers(): TChantierControl;
  var
    Form: TForm;
    Editor: TComboBox;
    I: Integer;
  begin
    Result := nil;
 
    Form := TForm.Create(nil);
    try
      Form.BorderStyle := bsNone;
      Form.AutoSize := True;
      Form.Position := poDesigned;
      Form.Left := Mouse.CursorPos.X;
      Form.Top := Mouse.CursorPos.Y;
 
      Editor := TComboBox.Create(Form);
      Editor.Style := csDropDownList;
      Editor.Parent := Form;
      Editor.OnEnter := ShowChantiersEnterEventHandler;
      Editor.OnExit := ShowChantiersExitEventHandler;
      Editor.OnCloseUp := ShowChantiersCloseUpEventHandler;
 
      for I := 0 to FContainer.ControlCount - 1 do
        Editor.Items.AddObject(TChantierControl(FContainer.Controls[I]).ChantierName, FContainer.Controls[I]);
      Editor.Items.Add('Cancel');
 
      Form.ShowModal();
 
      if Editor.ItemIndex >= 0 then
        Result := TChantierControl(Editor.Items.Objects[Editor.ItemIndex]);
    finally
      Form.Free();
    end;
  end;
 
var
  LChantier: TChantierControl;
begin
  LChantier := SelectChantiers();
  if Assigned(LChantier) then
    Result := AddEmployeInChantier(AEmployeName, LChantier)
  else
    Result := nil;
end;
 
class function TChantiersController.AddEmployeInChantier(AEmploye: TEmployeControl; AChantier: TChantierControl): TEmployeControl;
begin
  Result := AddEmployeInChantier(AEmploye.EmployeName, AChantier);
  Result.EmployeID := AEmploye.EmployeID;
end;
 
class function TChantiersController.AddEmployeInChantier(const AEmployeName: string; AChantier: TChantierControl): TEmployeControl;
begin
  Result := TEmployeControl.Create(AChantier);
  Result.Left := 8;
  Result.Top := 8 * AChantier.ControlCount + 50 * (AChantier.ControlCount - 3);
  Result.Width := 150;
  Result.EmployeName := AEmployeName;
 
  AChantier.Employes.Add(Result.Entity);
  AChantier.Height := Max(AChantier.Height, 50 * AChantier.Employes.Count);
end;
 
procedure TChantiersController.ShowChantiersEnterEventHandler(Sender: TObject);
begin
  TComboBox(Sender).DroppedDown := True;
end;
 
procedure TChantiersController.ShowChantiersCloseUpEventHandler(Sender: TObject);
begin
  TForm(TComboBox(Sender).Owner).ModalResult := mrOK;
end;
 
procedure TChantiersController.ShowChantiersExitEventHandler(Sender: TObject);
begin
  TForm(TComboBox(Sender).Owner).ModalResult := mrCancel;
end;
 
procedure TChantiersController.SetDropOnOver(const Value: Boolean);
var
  I: Integer;
  C: TControl;
begin
  for I := 0 to FContainer.ControlCount - 1 do
  begin
    C := FContainer.Controls[I];
    if C is TChantierControl then
      TChantierControl(C).DropOnOver := Value;
  end;
end;
 
 
 
{ TChantierControl }
 
constructor TChantierControl.Create(AOwner: TComponent);
var
  I: Integer;
begin
  inherited Create(AOwner);
 
  Parent := AOwner as TWinControl;
 
  BevelOuter := bvNone;
  OnDragOver := ChantierDragOverEventHandler;
  OnDragDrop := ChantierDragDropEventHandler;
 
  FEntity := TChantierEntity.Create();
 
  FEmployes := TEmployeList.Create(False);
 
  FBorder := TShape.Create(Self);
  FBorder.Parent := Self;
  FBorder.Top := 8;
  FBorder.Left := 0;
  FBorder.Width := Self.Width;
  FBorder.Height := Self.Height - 8;
  FBorder.Anchors := [akLeft, akTop, akRight, akBottom];
  FBorder.Pen.Color := Random($FFFFFF);
  FBorder.Enabled := False;
 
  FTitle := TLabel.Create(Self);
  FTitle.Parent := Self;
  FTitle.Left := 8;
  FTitle.OnDblClick := ToggleSizeableClickEventHandler;
 
  FEmployes.Load(FEntity);
  for I := 0 to FEmployes.Count - 1 do
    TChantiersController.AddEmployeInChantier(TEmployeEntity(FEmployes[I]).EmployeName, Self);
end;
 
destructor TChantierControl.Destroy();
begin
  if Assigned(FEmployes) then
    FEmployes.Save();
 
  FreeAndNil(FBorder);
  FreeAndNil(FEmployes);
  FreeAndNil(FEntity);
 
  inherited Destroy();
end;
 
procedure TChantierControl.ToggleSizeableClickEventHandler(Sender: TObject);
begin
  SetWindowLong(Self.Handle, GWL_STYLE, GetWindowLong(Self.Handle, GWL_STYLE) xor WS_SIZEBOX);
  Self.Width := Self.Width + IfThen(LongBool(GetWindowLong(Self.Handle, GWL_STYLE) and WS_SIZEBOX), +8, -8);
  Self.Height := Self.Height + IfThen(LongBool(GetWindowLong(Self.Handle, GWL_STYLE) and WS_SIZEBOX), +8, -8);
end;
 
procedure TChantierControl.ChantierDragOverEventHandler(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
begin
  Accept := (Sender is TChantierControl) and (Source is TEmployeControl) ;
  if Accept and TChantierControl(Sender).DropOnOver then
    ChantierDragDropEventHandler(Sender, Source, X, Y);
end;
 
procedure TChantierControl.ChantierDragDropEventHandler(Sender, Source: TObject; X, Y: Integer);
begin
  TEmployeControl(Source).ChangeChantier(TChantierControl(Sender));
  TEmployeControl(Source).Left := X;
  TEmployeControl(Source).Top := Y;
end;
 
function TChantierControl.GetChantierID(): Integer;
begin
  Result := FEntity.ChantierID;
end;
 
procedure TChantierControl.SetChantierID(const Value: Integer);
begin
  FEntity.ChantierID := Value;
end;
 
function TChantierControl.GetChantierName(): string;
begin
  Result := FEntity.ChantierName;
end;
 
procedure TChantierControl.SetChantierName(const Value: string);
begin
  FEntity.ChantierName := Value;
  FTitle.Caption := Value;
end;
 
{ TEmployeControl }
 
constructor TEmployeControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
 
  Height := 50;
  Parent := AOwner as TWinControl;
 
  BevelOuter := bvNone;
  DragMode := dmAutomatic;
 
  FEntity := TEmployeEntity.Create();
 
  FBorder := TShape.Create(Self);
  FBorder.Parent := Self;
  FBorder.Top := 0;
  FBorder.Left := 0;
  FBorder.Width := Self.Width;
  FBorder.Height := Self.Height - 8;
  FBorder.Anchors := [akLeft, akTop, akRight, akBottom];
  FBorder.Pen.Color := Random($FFFFFF);
  FBorder.Pen.Style := psDashDotDot;
  FBorder.Enabled := False; // IMPORTANT !
 
  FTitle := TLabel.Create(Self);
  FTitle.Parent := Self;
  FTitle.Top := 4;
  FTitle.Left := 48;
  FTitle.OnMouseDown := EmployeDragSubStartEventHandler; // IMPORTANT !
 
  FContrat := TLabel.Create(Self);
  FContrat.Parent := Self;
  FContrat.Top := 4 + FTitle.Top + FTitle.Height;
  FContrat.Left := 48;
  FContrat.OnMouseDown := EmployeDragSubStartEventHandler; // IMPORTANT !
 
  FImage := TImage.Create(Self);
  FImage.Parent := Self;
  FImage.Top := 6;
  FImage.Left := 8;
  FImage.Width := 32;
  FImage.Height := 32;
  FImage.Enabled := False; // IMPORTANT !
 
  with FImage.Picture.Bitmap do
  begin
    Width := 32;
    Height := 32;
    Canvas.Pen.Color := Random($FFFFFF);
    Canvas.Brush.Color := Random($FFFFFF);
    Canvas.Rectangle(0, 0, 31, 31);
  end;
end;
 
destructor TEmployeControl.Destroy();
begin
  FreeAndNil(FDragImageList);
 
  FreeAndNil(FBorder);
  FreeAndNil(FEntity);
 
  inherited Destroy();
end;
 
procedure TEmployeControl.ChangeChantier(ANewChantier: TChantierControl);
var
  LOldChantier: TChantierControl;
begin
  LOldChantier := TChantierControl(Self.Parent);
  LOldChantier.Employes.Extract(Self);
  ANewChantier.Employes.Add(Self);
  Self.Parent := ANewChantier;
end;
 
procedure TEmployeControl.EmployeDragSubStartEventHandler(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (Sender is TLabel) and (TLabel(Sender).Parent is TEmployeControl) then
    TLabel(Sender).Parent.BeginDrag(True);  // IMPORTANT !
end;
 
function TEmployeControl.GetEmployeID(): Integer;
begin
  Result := FEntity.EmployeID;
end;
 
procedure TEmployeControl.SetEmployeID(const Value: Integer);
begin
  FEntity.EmployeID := Value;
end;
 
function TEmployeControl.GetEmployeName(): string;
begin
  Result := FEntity.EmployeName;
end;
 
procedure TEmployeControl.SetEmployeName(const Value: string);
begin
  FEntity.EmployeName := Value;
  FTitle.Caption := Value;
  FContrat.Caption := IfThen(LongBool(Random(2)), 'Avec Contrat', 'Sans Contrat');
end;
 
 
 
end.

DragDock_MainForm.dfm

Code dfm :

Sélectionner tout - Visualiser dans une fenêtre à part

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
object DragDockMainForm: TDragDockMainForm
  Left = 289
  Top = 170
  Width = 1305
  Height = 675
  Caption = 'DragDockMainForm'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object grpEntities: TGroupBox
    Left = 0
    Top = 0
    Width = 1289
    Height = 65
    Align = alTop
    Caption = 'Entities'
    TabOrder = 0
    object btnEntityAddChantier: TButton
      Left = 16
      Top = 24
      Width = 75
      Height = 25
      Caption = '+ Chantier'
      TabOrder = 0
      OnClick = btnEntityAddChantierClick
    end
    object btnEntityAddEmploye: TButton
      Left = 104
      Top = 24
      Width = 75
      Height = 25
      Caption = '+ Employe'
      TabOrder = 1
      OnClick = btnEntityAddEmployeClick
    end
    object ckbDragDropOnOver: TCheckBox
      Left = 192
      Top = 24
      Width = 97
      Height = 17
      Caption = 'Drop On Over'
      TabOrder = 2
      OnClick = ckbDragDropOnOverClick
    end
  end
  object sbChantiers: TScrollBox
    Left = 0
    Top = 65
    Width = 1289
    Height = 571
    Align = alClient
    TabOrder = 1
  end
end

DragDock_DataModel.pas

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
unit DragDock_DataModel;
 
interface
 
uses Contnrs;
 
type
  TChantierEntity = class(TObject)
  private
    FChantierID: Integer;
    FChantierName: string;
  public
    property ChantierID: Integer read FChantierID write FChantierID;
    property ChantierName: string read FChantierName write FChantierName;
  end;
 
  TChantierList = class(TObjectList)
  private
 
  public
    procedure Load();
    procedure Save();
  end;
 
  TEmployeEntity = class(TObject)
  private
    FEmployeID: Integer;
    FEmployeName: string;
  public
    property EmployeID: Integer read FEmployeID write FEmployeID;
    property EmployeName: string read FEmployeName write FEmployeName;
  end;
 
  TEmployeList = class(TObjectList)
  private
 
  public
    procedure Load(AChantier: TChantierEntity);
    procedure Save();
  end;
 
 
implementation
 
uses SysUtils;
 
var
  DummyID: Integer;
 
{ TChantierList }
 
procedure TChantierList.Load();
var
  I: Integer;
  Entity: TChantierEntity;
begin
  // SELECT CHANTIER_ID, CHANTIER_NAME, ... FROM T_CHANTIER
  for I := 0 to 5 do
  begin
    Entity := TChantierEntity.Create();
    Add(Entity);
 
    Inc(DummyID);
    Entity.ChantierID := DummyID;
    Entity.ChantierName := FormatDateTime('hh:nn:ss:zzz.', Now()) + IntToStr(DummyID);
  end;
end;
 
procedure TChantierList.Save();
begin
  // for Items.Count
  //   if ID = 0
  //     INSERT INTO T_CHANTIER
  //   else
  //     UPDATE SET ... T_CHANTIER WHERE CHANTIER_ID = Items[I].ChantierID
end;
 
{ TEmployeList }
 
procedure TEmployeList.Load(AChantier: TChantierEntity);
var
  I: Integer;
  Entity: TEmployeEntity;
begin
  // SELECT EMPLOYE_ID, EMPLOYE_NAME ... FROM T_EMPLOYE WHERE CHANTIER_ID = AChantier.ChantierID
 
  for I := 0 to 20 do
  begin
    Entity := TEmployeEntity.Create();
    Add(Entity);
 
    Inc(DummyID);
    Entity.EmployeID := DummyID;
    Entity.EmployeName := FormatDateTime('hh:nn:ss:zzz.', Now()) + IntToStr(DummyID);
  end;
end;
 
procedure TEmployeList.Save();
begin
  // for Items.Count
  //   if ID = 0
  //     INSERT INTO T_EMPLOYE
  //   else
  //     UPDATE SET ... T_EMPLOYE WHERE EMPLOYE_ID = Items[I].EmployeID
end;
 
end.

[SergioMaster]

Les Frames, cela simplifie le truc et évite effectivement plein de code pour la composition des contrôles imbriqués

Effectivement et offre aussi la possiblité de certains trucs. J'ai pu ainsi codé très facilement les déplacements avec le DragDrop mais aussi le retaillage des frames en ajoutant une seule gestion de message (joli + qui mériterait presque une FAQ)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
  private
    { Déclarations privées }
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
procedure TChantier.WMNCHitTest(var Message: TWMNCHitTest);
var
  Point: TPoint;
begin
  Point := ScreenToClient(SmallPointToPoint(Message.Pos));
  // Resize (bottom right)
  if (Point.X >= (Width - 10)) and (Point.Y >= (Height - 10)) then
    Message.Result := HTBOTTOMRIGHT
  else
    inherited;
end;

j'ai trouvé cela amusant de faire cela

Moi aussi, mais pas au point de fournir les sources à Chekkal, ce qui m'a retenu :

1- ce petit projet suite à une demande de clients

2- ainsi que les informations parcellaires (il a fallu tant de posts pour obtenir enfin le code fautif ! Et, jusqu'à peu toujours pas de remise en question)

[chekkal]

J' ai essayer le code de @shaillletroll

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
 
unit Unit8;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls,
  Contnrs;
type
  TChantierEntity = class(TObject)
  private
    FChantierID: Integer;
    FChantierName: string;
  public
    property ChantierID: Integer read FChantierID write FChantierID;
    property ChantierName: string read FChantierName write FChantierName;
  end;
 
  TChantierList = class(TObjectList)
  private
 
  public
    procedure Load();
    procedure Save();
  end;
 
  TEmployeEntity = class(TObject)
  private
    FEmployeID: Integer;
    FEmployeName: string;
  public
    property EmployeID: Integer read FEmployeID write FEmployeID;
    property EmployeName: string read FEmployeName write FEmployeName;
  end;
 
  TEmployeList = class(TObjectList)
  private
 
  public
    procedure Load(AChantier: TChantierEntity);
    procedure Save();
  end;
type
  TChantiersController = class;
  TChantierControl = class;
  TEmployeControl = class;
 
  TDragDockMainForm = class(TForm)
    grpEntities: TGroupBox;
    btnEntityAddChantier: TButton;
    btnEntityAddEmploye: TButton;
    sbChantiers: TScrollBox;
    ckbDragDropOnOver: TCheckBox;
    procedure btnEntityAddChantierClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnEntityAddEmployeClick(Sender: TObject);
    procedure ckbDragDropOnOverClick(Sender: TObject);
  private
    FChantiers: TChantiersController;
  public
    { Déclarations publiques }
  end;
 
  TChantiersController = class(TObject)
  private
    FContainer: TScrollBox;
    FChantiers: TChantierList;
    FDropOnOver: Boolean;
 
    procedure ShowChantiersEnterEventHandler(Sender: TObject);
    procedure ShowChantiersCloseUpEventHandler(Sender: TObject);
    procedure ShowChantiersExitEventHandler(Sender: TObject);
 
    procedure SetDropOnOver(const Value: Boolean);
  public
    constructor Create(AContainer: TScrollBox);
    destructor Destroy(); override;
 
    function AddChantier(AChantier: TChantierEntity): TChantierControl; overload;
    function AddChantier(const AChantierName: string): TChantierControl; overload;
    function AddEmployee(const AEmployeName: string): TEmployeControl;
    class function AddEmployeInChantier(AEmploye: TEmployeControl; AChantier: TChantierControl): TEmployeControl; overload;
    class function AddEmployeInChantier(const AEmployeName: string; AChantier: TChantierControl): TEmployeControl; overload;
 
    property DropOnOver: Boolean read FDropOnOver write SetDropOnOver;
  end;
 
  TChantierControl = class(TPanel)
  private
    FBorder: TShape;
    FTitle: TLabel;
    FEntity: TChantierEntity;
    FEmployes: TEmployeList;
    FDropOnOver: Boolean;
 
    function GetChantierID(): Integer;
    procedure SetChantierID(const Value: Integer);
    function GetChantierName(): string;
    procedure SetChantierName(const Value: string);
 
    procedure ToggleSizeableClickEventHandler(Sender: TObject);
    procedure ChantierDragOverEventHandler(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
    procedure ChantierDragDropEventHandler(Sender, Source: TObject; X, Y: Integer);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy(); override;
 
    property ChantierID: Integer read GetChantierID write SetChantierID;
    property ChantierName: string read GetChantierName write SetChantierName;
 
    property Entity: TChantierEntity read FEntity;
    property Employes: TEmployeList read FEmployes;
 
    property DropOnOver: Boolean read FDropOnOver write FDropOnOver;
  end;
 
 
  TEmployeControl = class(TPanel)
  private
    FBorder: TShape;
    FTitle: TLabel;
    FContrat: TLabel;
    FImage: TImage;
    FEntity: TEmployeEntity;
    FDragImageList: TDragImageList;
 
    function GetEmployeID(): Integer;
    procedure SetEmployeID(const Value: Integer);
    function GetEmployeName(): string;
    procedure SetEmployeName(const Value: string);
 
    procedure EmployeDragSubStartEventHandler(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy(); override;
 
    procedure ChangeChantier(ANewChantier: TChantierControl);
 
    property EmployeID: Integer read GetEmployeID write SetEmployeID;
    property EmployeName: string read GetEmployeName write SetEmployeName;
 
    property Entity: TEmployeEntity read FEntity;
  end;
 
 
var
  DragDockMainForm: TDragDockMainForm;
 
  DummyID: Integer;
implementation
 
uses Math, StrUtils;
 
{$R *.dfm}
 
{ TChantierTDragDockMainFormsController }
 
procedure TDragDockMainForm.FormCreate(Sender: TObject);
begin
  FChantiers := TChantiersController.Create(sbChantiers);
  ckbDragDropOnOver.Checked := FChantiers.DropOnOver;
end;
 
procedure TDragDockMainForm.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FChantiers);
end;
 
procedure TDragDockMainForm.btnEntityAddChantierClick(Sender: TObject);
var
  S: string;
begin
  S := TimeToStr(Now());
  if InputQuery('Nouveau Chantier', 'Nom du nouveau chantier', S) then
    FChantiers.AddChantier(S);
end;
 
procedure TDragDockMainForm.btnEntityAddEmployeClick(Sender: TObject);
var
  S: string;
begin
  S := TimeToStr(Now());
  if InputQuery('Nouvel Employé', 'Nom du nouvel employé', S) then
    FChantiers.AddEmployee(S);
end;
 
procedure TDragDockMainForm.ckbDragDropOnOverClick(Sender: TObject);
begin
  FChantiers.DropOnOver := ckbDragDropOnOver.Checked;
end;
 
 
{ TChantiersController }
 
constructor TChantiersController.Create(AContainer: TScrollBox);
var
  I: Integer;
begin
  inherited Create();
 
  FDropOnOver := True;
 
  FContainer := AContainer;
 
  FChantiers := TChantierList.Create(False);
  FChantiers.Load();
 
  for I := 0 to FChantiers.Count - 1 do
    AddChantier(TChantierEntity(FChantiers[I]));
end;
 
destructor TChantiersController.Destroy();
begin
  if Assigned(FChantiers) then
    FChantiers.Save();
 
  FreeAndNil(FChantiers);
 
  inherited Destroy();
end;
 
function TChantiersController.AddChantier(AChantier: TChantierEntity): TChantierControl;
begin
  Result := AddChantier(AChantier.ChantierName);
  Result.ChantierID := AChantier.ChantierID;
end;
 
function TChantiersController.AddChantier(const AChantierName: string): TChantierControl;
begin
  Result := TChantierControl.Create(FContainer);
  Result.Left := 8 * FContainer.ControlCount + 300 * (FContainer.ControlCount - 1);
  Result.Width := 300;
  Result.Height := Max(Result.Height, FContainer.ClientHeight - 100);
  Result.ChantierName := AChantierName;
  Result.DropOnOver := Self.DropOnOver;
 
  FChantiers.Add(Result.Entity);
end;
 
function TChantiersController.AddEmployee(const AEmployeName: string): TEmployeControl;
 
  function SelectChantiers(): TChantierControl;
  var
    Form: TForm;
    Editor: TComboBox;
    I: Integer;
  begin
    Result := nil;
 
    Form := TForm.Create(nil);
    try
      Form.BorderStyle := bsNone;
      Form.AutoSize := True;
      Form.Position := poDesigned;
      Form.Left := Mouse.CursorPos.X;
      Form.Top := Mouse.CursorPos.Y;
 
      Editor := TComboBox.Create(Form);
      Editor.Style := csDropDownList;
      Editor.Parent := Form;
      Editor.OnEnter := ShowChantiersEnterEventHandler;
      Editor.OnExit := ShowChantiersExitEventHandler;
      Editor.OnCloseUp := ShowChantiersCloseUpEventHandler;
 
      for I := 0 to FContainer.ControlCount - 1 do
        Editor.Items.AddObject(TChantierControl(FContainer.Controls[I]).ChantierName, FContainer.Controls[I]);
      Editor.Items.Add('Cancel');
 
      Form.ShowModal();
 
      if Editor.ItemIndex >= 0 then
        Result := TChantierControl(Editor.Items.Objects[Editor.ItemIndex]);
    finally
      Form.Free();
    end;
  end;
 
var
  LChantier: TChantierControl;
begin
  LChantier := SelectChantiers();
  if Assigned(LChantier) then
    Result := AddEmployeInChantier(AEmployeName, LChantier)
  else
    Result := nil;
end;
 
class function TChantiersController.AddEmployeInChantier(AEmploye: TEmployeControl; AChantier: TChantierControl): TEmployeControl;
begin
  Result := AddEmployeInChantier(AEmploye.EmployeName, AChantier);
  Result.EmployeID := AEmploye.EmployeID;
end;
 
class function TChantiersController.AddEmployeInChantier(const AEmployeName: string; AChantier: TChantierControl): TEmployeControl;
begin
  Result := TEmployeControl.Create(AChantier);
  Result.Left := 8;
  Result.Top := 8 * AChantier.ControlCount + 50 * (AChantier.ControlCount - 3);
  Result.Width := 150;
  Result.EmployeName := AEmployeName;
 
  AChantier.Employes.Add(Result.Entity);
  AChantier.Height := Max(AChantier.Height, 50 * AChantier.Employes.Count);
end;
 
procedure TChantiersController.ShowChantiersEnterEventHandler(Sender: TObject);
begin
  TComboBox(Sender).DroppedDown := True;
end;
 
procedure TChantiersController.ShowChantiersCloseUpEventHandler(Sender: TObject);
begin
  TForm(TComboBox(Sender).Owner).ModalResult := mrOK;
end;
 
procedure TChantiersController.ShowChantiersExitEventHandler(Sender: TObject);
begin
  TForm(TComboBox(Sender).Owner).ModalResult := mrCancel;
end;
 
procedure TChantiersController.SetDropOnOver(const Value: Boolean);
var
  I: Integer;
  C: TControl;
begin
  for I := 0 to FContainer.ControlCount - 1 do
  begin
    C := FContainer.Controls[I];
    if C is TChantierControl then
      TChantierControl(C).DropOnOver := Value;
  end;
end;
 
 
 
{ TChantierControl }
 
constructor TChantierControl.Create(AOwner: TComponent);
var
  I: Integer;
begin
  inherited Create(AOwner);
 
  Parent := AOwner as TWinControl;
 
  BevelOuter := bvNone;
  OnDragOver := ChantierDragOverEventHandler;
  OnDragDrop := ChantierDragDropEventHandler;
 
  FEntity := TChantierEntity.Create();
 
  FEmployes := TEmployeList.Create(False);
 
  FBorder := TShape.Create(Self);
  FBorder.Parent := Self;
  FBorder.Top := 8;
  FBorder.Left := 0;
  FBorder.Width := Self.Width;
  FBorder.Height := Self.Height - 8;
  FBorder.Anchors := [akLeft, akTop, akRight, akBottom];
  FBorder.Pen.Color := Random($FFFFFF);
  FBorder.Enabled := False;
 
  FTitle := TLabel.Create(Self);
  FTitle.Parent := Self;
  FTitle.Left := 8;
  FTitle.OnDblClick := ToggleSizeableClickEventHandler;
 
  FEmployes.Load(FEntity);
  for I := 0 to FEmployes.Count - 1 do
    TChantiersController.AddEmployeInChantier(TEmployeEntity(FEmployes[I]).EmployeName, Self);
end;
 
destructor TChantierControl.Destroy();
begin
  if Assigned(FEmployes) then
    FEmployes.Save();
 
  FreeAndNil(FBorder);
  FreeAndNil(FEmployes);
  FreeAndNil(FEntity);
 
  inherited Destroy();
end;
 
procedure TChantierControl.ToggleSizeableClickEventHandler(Sender: TObject);
begin
  SetWindowLong(Self.Handle, GWL_STYLE, GetWindowLong(Self.Handle, GWL_STYLE) xor WS_SIZEBOX);
  Self.Width := Self.Width + IfThen(LongBool(GetWindowLong(Self.Handle, GWL_STYLE) and WS_SIZEBOX), +8, -8);
  Self.Height := Self.Height + IfThen(LongBool(GetWindowLong(Self.Handle, GWL_STYLE) and WS_SIZEBOX), +8, -8);
end;
 
procedure TChantierControl.ChantierDragOverEventHandler(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
begin
  Accept := (Sender is TChantierControl) and (Source is TEmployeControl) ;
  if Accept and TChantierControl(Sender).DropOnOver then
    ChantierDragDropEventHandler(Sender, Source, X, Y);
end;
 
procedure TChantierControl.ChantierDragDropEventHandler(Sender, Source: TObject; X, Y: Integer);
begin
  TEmployeControl(Source).ChangeChantier(TChantierControl(Sender));
  TEmployeControl(Source).Left := X;
  TEmployeControl(Source).Top := Y;
end;
 
function TChantierControl.GetChantierID(): Integer;
begin
  Result := FEntity.ChantierID;
end;
 
procedure TChantierControl.SetChantierID(const Value: Integer);
begin
  FEntity.ChantierID := Value;
end;
 
function TChantierControl.GetChantierName(): string;
begin
  Result := FEntity.ChantierName;
end;
 
procedure TChantierControl.SetChantierName(const Value: string);
begin
  FEntity.ChantierName := Value;
  FTitle.Caption := Value;
end;
 
{ TEmployeControl }
 
constructor TEmployeControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
 
  Height := 50;
  Parent := AOwner as TWinControl;
 
  BevelOuter := bvNone;
  DragMode := dmAutomatic;
 
  FEntity := TEmployeEntity.Create();
 
  FBorder := TShape.Create(Self);
  FBorder.Parent := Self;
  FBorder.Top := 0;
  FBorder.Left := 0;
  FBorder.Width := Self.Width;
  FBorder.Height := Self.Height - 8;
  FBorder.Anchors := [akLeft, akTop, akRight, akBottom];
  FBorder.Pen.Color := Random($FFFFFF);
  FBorder.Pen.Style := psDashDotDot;
  FBorder.Enabled := False; // IMPORTANT !
 
  FTitle := TLabel.Create(Self);
  FTitle.Parent := Self;
  FTitle.Top := 4;
  FTitle.Left := 48;
  FTitle.OnMouseDown := EmployeDragSubStartEventHandler; // IMPORTANT !
 
  FContrat := TLabel.Create(Self);
  FContrat.Parent := Self;
  FContrat.Top := 4 + FTitle.Top + FTitle.Height;
  FContrat.Left := 48;
  FContrat.OnMouseDown := EmployeDragSubStartEventHandler; // IMPORTANT !
 
  FImage := TImage.Create(Self);
  FImage.Parent := Self;
  FImage.Top := 6;
  FImage.Left := 8;
  FImage.Width := 32;
  FImage.Height := 32;
  FImage.Enabled := False; // IMPORTANT !
 
  with FImage.Picture.Bitmap do
  begin
    Width := 32;
    Height := 32;
    Canvas.Pen.Color := Random($FFFFFF);
    Canvas.Brush.Color := Random($FFFFFF);
    Canvas.Rectangle(0, 0, 31, 31);
  end;
end;
 
destructor TEmployeControl.Destroy();
begin
  FreeAndNil(FDragImageList);
 
  FreeAndNil(FBorder);
  FreeAndNil(FEntity);
 
  inherited Destroy();
end;
 
procedure TEmployeControl.ChangeChantier(ANewChantier: TChantierControl);
var
  LOldChantier: TChantierControl;
begin
  LOldChantier := TChantierControl(Self.Parent);
  LOldChantier.Employes.Extract(Self);
  ANewChantier.Employes.Add(Self);
  Self.Parent := ANewChantier;
end;
 
procedure TEmployeControl.EmployeDragSubStartEventHandler(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (Sender is TLabel) and (TLabel(Sender).Parent is TEmployeControl) then
    TLabel(Sender).Parent.BeginDrag(True);  // IMPORTANT !
end;
 
function TEmployeControl.GetEmployeID(): Integer;
begin
  Result := FEntity.EmployeID;
end;
 
procedure TEmployeControl.SetEmployeID(const Value: Integer);
begin
  FEntity.EmployeID := Value;
end;
 
function TEmployeControl.GetEmployeName(): string;
begin
  Result := FEntity.EmployeName;
end;
 
procedure TEmployeControl.SetEmployeName(const Value: string);
begin
  FEntity.EmployeName := Value;
  FTitle.Caption := Value;
  FContrat.Caption := IfThen(LongBool(Random(2)), 'Avec Contrat', 'Sans Contrat');
end;
procedure TChantierList.Load();
var
  I: Integer;
  Entity: TChantierEntity;
begin
  // SELECT CHANTIER_ID, CHANTIER_NAME, ... FROM T_CHANTIER
  for I := 0 to 5 do
  begin
    Entity := TChantierEntity.Create();
    Add(Entity);
 
    Inc(DummyID);
    Entity.ChantierID := DummyID;
    Entity.ChantierName := FormatDateTime('hh:nn:ss:zzz.', Now()) + IntToStr(DummyID);
  end;
end;
 
procedure TChantierList.Save();
begin
  // for Items.Count
  //   if ID = 0
  //     INSERT INTO T_CHANTIER
  //   else
  //     UPDATE SET ... T_CHANTIER WHERE CHANTIER_ID = Items[I].ChantierID
end;
 
{ TEmployeList }
 
procedure TEmployeList.Load(AChantier: TChantierEntity);
var
  I: Integer;
  Entity: TEmployeEntity;
begin
  // SELECT EMPLOYE_ID, EMPLOYE_NAME ... FROM T_EMPLOYE WHERE CHANTIER_ID = AChantier.ChantierID
 
  for I := 0 to 1000 do
  begin
    Entity := TEmployeEntity.Create();
    Add(Entity);
 
    Inc(DummyID);
    Entity.EmployeID := DummyID;
    Entity.EmployeName := FormatDateTime('hh:nn:ss:zzz.', Now()) + IntToStr(DummyID);
  end;
end;
 
procedure TEmployeList.Save();
begin
  // for Items.Count
  //   if ID = 0
  //     INSERT INTO T_EMPLOYE
  //   else
  //     UPDATE SET ... T_EMPLOYE WHERE EMPLOYE_ID = Items[I].EmployeID
end;
 
 
 
end.

j'ai juste modifié la procédure

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
procedure TEmployeList.Load(AChantier: TChantierEntity);
var
  I: Integer;
  Entity: TEmployeEntity;
begin
  // SELECT EMPLOYE_ID, EMPLOYE_NAME ... FROM T_EMPLOYE WHERE CHANTIER_ID = AChantier.ChantierID
 
  for I := 0 to 1000 do
  begin
    Entity := TEmployeEntity.Create();
    Add(Entity);
 
    Inc(DummyID);
    Entity.EmployeID := DummyID;
    Entity.EmployeName := FormatDateTime('hh:nn:ss:zzz.', Now()) + IntToStr(DummyID);
  end;
end;

avec la création de 1000 "TemployeEntity" sans même utiliser le chargement des données d'une base de données ,j'ai ça

[SergioMaster]

J' ai essayer le code de @shaillletroll
j'ai juste modifié la procédure

n'ayant fait preuve d'aucune originalité de votre part était-il nécessaire de nous en fournir le code ? Seul le second code était intéressant puisque responsable de l'erreur

sans même utiliser le chargement des données d'une base de données

1000 employés sur un même chantier, une fourmilière ?
Peu importe avec une BDD serait-il nécessaire de créer les objets Si en soit je ne conteste pas l'approche objet pour les tests de création dynamique avec une BDD j'écrirais quelque chose de plus simple

[Paul TOTH]

le code c'est bien, par contre sur un projet comme ça un ZIP c'est mieux car ça évite des copier coller...et aussi performant soit-il, mon cerveau repère les erreurs moins vite que Delphi

en fait ce qui bloque c'est la création de 1000 TBitmap tout bêtement...ce qui rejoint ce que je disais plus haut (si je ne me trompe pas de fil)

mais j'ai trouvé une parade un peu douteuse mais qui fonctionne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
  FImage := TPaintBox.Create(Self);
  FImage.Parent := Self;
  FImage.Top := 6;
  FImage.Left := 8;
  FImage.Width := 32;
  FImage.Height := 32;
  FImage.Enabled := False; // IMPORTANT !
  FImage.OnPaint := PaintImage;
 
  FImageIndex := GImageList.Count;
  var Bitmap := TBitmap.Create(32, 32);
  with Bitmap.Canvas do
  begin
    Pen.Color := Random($FFFFFF);
    Brush.Color := Random($FFFFFF);
    Rectangle(0, 0, 31, 31);
  end;
  GImageList.Add(Bitmap, nil);
  Bitmap.Free;
end;
 
procedure TEmployeControl.PaintImage(Sender: TObject);
begin
  GImageList.Draw(FImage.Canvas, 0, 0, FImageIndex);
end;

le TImage est remplacé par un TPaintBox, et au lieu de créer 1000 Bitmap, j'ajoute chaque bitmap dans un TListImage global, en ne gardant que son index, et dans le OnPaint je dessine l'image.

en interne Windows va conserver un seul bitmap de 32x32000 pixels qui prend beaucoup moins de ressources que 1000 bitmaps de 32x32

[pprem]

avec la création de 1000 "TemployeEntity" sans même utiliser le chargement des données d'une base de données ,j'ai ça

En fait c'est pas 1000 éléments qui ont été créés, c'est 1001 (de 0 à 1000 inclus), raccourci classique dans la formulation, mais ça peut générer des anomalies dans les programmes quand on ne fait pas attention.

Ceci dit, il me semble urgent de s'intéresser à des notions d'ORM et ne pas tout créer en mémoire quand ça n'est pas utilisé.

Il y a une base de données, les seules choses que l'on devrait avoir dans le code, c'est l'accès à ces informations uniquement lorsqu'on les demandes. SQL est un peu fait pour ça.

Concernant l'interface utilisateur, il y a vraiment 1000 employés affichés sur l'écran ? Il fait quelle taille ?

Franchement, j'veux bien qu'il y ait des raisons de faire tout ça parce qu'on trouve que c'est plus facile, mais il y a clairement quelque chose qui coince dans la conception de cette fonctionnalité.

[ShaiLeTroll]

avec la création de 1000 "TemployeEntity" sans même utiliser le chargement des données d'une base de données ,j'ai ça

Donc 6 Chantiers de 1001 employés, soit 6006 employés ?
Au départ, on nous montre un pauvre écran de 20 employés, avec un design qui peu en contenir difficilement plus de 200 (j'ai proposé un affichage de 6 x 21 soit 126 employés)
Maintenant, cela monte à 1000

Rappel, au départ, on voulait faire ceci, 20 employés !

Si au niveau objet, cela peut encore le supporter, en réalité mes collections d'objet étaient un DataSet et l'objet montrait uniquement le curseur actif, une encapsulation permettant de profiter des perfs du DataSet, ne pas faire des copies ...
J'ai proposé une approche simpliste de découpage Modèle - Vue, évidemment qu'il ne faut pas travailler comme ça sur des grands ensemble, et même un DataSet, à 2Go de mémoire, il explose.

Donc en revient à l'idée d'origine de faire un mode virtuel,
d'utiliser un objet comme la TListView en mode virtuel et OwnerDraw,
une PaintBox où tout est dessiné et tout est géré manuellement, j'ai des doutes mais lisez ce sujet Ajouter des poignées à un cadre de sélection sur Bitmap en D6 Win11 ?, cela reviendra à votre code original mais faudrait le repenser avec une logique de controle fait maison, pas à base de TComponent mais tout à la main en TObject, vous aviez que c'est ainsi que sont fait les jeux vidéos ? des milliers de struct et des liste double-chainées, des ring liste ou des bucket liste, vous entrez dans un niveau de code assez élevé, vous avez pensé à votre équilibre de rentabilité du projet entre le cout et son prix soumis au client ?)

La proposition de Paul Toth pour remplacer le TImage par un TPaintBox pour utiliser une image source, un peu ce que fait les styles, une grande image et des sprites décrit par leur position

Voici ce ce que cela donne avec 6 * 501, soit 3006 employés ... vous n'est pas réaliste dans votre exemple mais allons dans cette logique de pousser les limites au delà d'une réalité fonctionnelle.

Et en serrant, 2500 employés cela tient sur un écran classique 1080p





Je ne vois pas comment déjà on pourrait gérer le planning de plus de 40 salariés avec cet écran, je l'ai déjà écrit, une gestion de chantier implique aussi de gérer la disponibilité matériel, une planification anticipée sur plusieurs jours voire semaines.
Alors vouloir gérer 1000 employés avec en plus un problème de scrollbox pour tout afficher, il faudrait ajouter un champ de recherche pour retrouver le salarié et que le programme affiche et met en évidence sa vignette ...

Soyez réaliste dans vos projections de charge !

[pprem]

Je ne vois pas comment déjà on pourrait gérer le planning de plus de 40 salariés avec cet écran, je l'ai déjà écrit, une gestion de chantier implique aussi de gérer la disponibilité matériel, une planification anticipée sur plusieurs jours voire semaines.

[TrollDi On]Je sais bien qu'on parle de VCL depuis le début, mais j'aurais bien ajouter : dans les chantiers on travaille maintenant sur smartphones et tablettes... just for fun.[TrollDi Off]

[ShaiLeTroll]

Pour faire un planning en FMX, autant utiliser TTMSFNCPlanner ou l'on doit pouvoir facilement répartir le temps de travail de chaque employé sur un chantier

Suffit de chercher "logiciel planning chantier" sur Google, tous fournisse une vue sous la forme d'un calendrier défilant voire même sous la forme d'un GANTT (pour présenter la dépendance d'exécution des taches incluant le planning de livraison)

Je ne vais pas utiliser d'images de logiciel de BTP car cela ne serait pas convenable mais montrer ces concepts depuis des blogs informatiques, cela a un certain sens.
Avant l'informatique, on utilisant un panneau mural de type "Planning à Fiche", les calendriers actuels ne sont qu'une évolution virtuelle.

Issu du Blog TMS une représentation que l'on retrouve dans plusieurs logiciels de Planning en BTP.

Et pour le GANTT :

PlanMinder: un outil de planification de projet remarquable montre la flexibilité de Delphi sur le Blog Embarcadero

La réalisation de taches en BTP est modélisé ainsi dans des projets de grande taille car chaque tache, chaque métier à un ordre, on ne va pas construire le toit avant les murs ...

En tout cas, les Blogs sur le BTP montre qu'ils savent s'organiser : Planning de chantier : outils et logiciels gratuits

[chekkal]

1000 employés sur un même chantier, une fourmilière ?

MAIS J'AI JAMAIS DIT QU'UN CHANTIER CONTENEZ 1000 EMPLOYES!!!!

Présentation de l'entreprise:
- Activité: Entreprise de Batiment
- Nbre moyen d'Employés:2365
- Nbre moyen de Chantiers:25
-Moyenne d'Employés par chantier:90


Maintenant mon problème c'est comment gérer la mémoire , vu que je doit créer la liste des employés au préalable pour que l'utilisateur ait un accée direct ou trouvé un moyen de faire un create -destory des objets crées.


Tous les Exemples que vous m'avez fournie nécessite un respect d'un certain ordre de travail, et ce n'est pas ce que je veut faire. Dans Mon exple je donne la possibilité à l'utilisateur de modifier la taille visuelle et l'emplacement des chantier, aussi le positionnement visuelle des employés sur l'ecran dans le but de satisfaire une besoin interne de l'entreprise.

[ShaiLeTroll]

MAIS J'AI JAMAIS DIT QU'UN CHANTIER CONTENEZ 1000 EMPLOYES!!!!

Nous faisons la déduction avec les informations que nous avions puisque le programme d'exemple a été modifié avec la création de 1000 "TemployeEntity" pouvait indiquer cela, hors l'exemple créé à la base 6 x 21 employés que vous avez muté en 6 x 1001 employés.

- Activité: Entreprise de Batiment
- Nbre moyen d'Employés:2365
- Nbre moyen de Chantiers:25
-Moyenne d'Employés par chantier:90

Vous n'avez pas changé correctement les boucles
TChantierList for I := 1 to 25 do ... 25 chantiers
TEmployeList for I := 1 to 90 do ... 90 ouvriers

L'idée est de n'avoir dans un TEmployeList les employés d'un seul chantier, les chantiers sont listés dans TChantierList donc il y a une seule TChantierList et au plus 25 TEmployeList contenant chacune entre 1 et 180 TemployeEntity ...
En annexe, vous avez un DataSet de tous les employés de la société, inutile de créer les objets avant qu'ils soient utilisés

Rappel : le code fourni est pour jeu de test, c'est pour concevoir l'écran hors de la partie SGBD
Vous devinez que l'utilisation d'objet vous permettra de greffer très vite le SGBD par la suite et vous devrez surement ajouter des optimisations, par exemple un State Modified pour ne mettre à jour que les Employés qui ont bougé ... modifier la base de données à chaque glissement pourrait être lent ... une mise à jour groupée avec un bouton valider sera plus performante ... ou alors vous déporter la mise à jour dans un Thread pour conserver une IHM fluide et mémoriser en DB immédiatement en traitement de fond.

Difficile de présenter autant d'employés dans un seul écran comme le montre mon exemple avec 2650 visibles sur 6 chantiers
25 chantiers c'est même difficile à positionner

Maintenant mon problème c'est comment gérer la mémoire , vu que je doit créer la liste des employés au préalable pour que l'utilisateur ait un accée direct ou trouvé un moyen de faire un create -destory des objets crées.

Le problème n'est pas la mémoire, 2500 TemployeEntity ce n'est rien, le problème c'est 2500 Timage mais cela a déjà été résolu par Paul Toth, j'ai intégré d'ailleurs sa modification dans mon petit projet expérimental, je suis monté à 91 * 26 soit 2366 employés.
Même si a mon avis, vous devriez étudier les principes de Lazy Loading, vous mélanger les choses, un DataSet permet de très bien stocker les données et vous pouvez ajouter des objets qui font le lien entre la Vue et le Modèle.
J'ai crée ces objets à titre démonstratif de séparation.

Dans Mon exple je donne la possibilité à l'utilisateur de modifier la taille visuelle et l'emplacement des chantier, aussi le positionnement visuelle des employés sur l'ecran dans le but de satisfaire une besoin interne de l'entreprise.

Vous avez du louper quelque chose dans le projet que j'ai proposé, les chantiers sont redimensionnables via WS_SIZEBOX, c'est fixe par défaut et redimensionnable ponctuellement
Tout employé est glissable par Drag&Drop,
Tout chantier est redimensionnable par Double-Clic sur son nom, puis bordure de redimensionnement et remise en position fixe par Double-Clic sur son nom.
Notez ci-dessous l'aspect de bordure sur deux chantiers en mode redimensionnement.





Vous avez largement de quoi faire avec toutes les solutions fournies, continuez à étudier les codes et idées fournies, vous êtes passé à côté de nombreux concepts.

[SergioMaster]

MAIS J'AI JAMAIS DIT QU'UN CHANTIER CONTENEZ 1000 EMPLOYES!!!!

c'est pourtant ce que vous avez tenté de faire avec votre code 1000 employés par chantier

Tous les exemples que vous m'avez fournis nécessitent un respect d'un certain ordre de travail,

faux ce que j'ai proposé en image écran dans mon post #23 (fait en une 30 de minutes) donne toute latitude pour déplacer/retailler les chantiers et les employés, la retaille n'est pas faite pour les employés cela m'aurait demandé 5mn de plus .
De même j'aurais pu rajouter des post-it ( au post #12 de SaihLetroll)

@ShaiLeTroll nulle part je n'ai vu FMX, mais le que j'ai pondu aurait pu être migré (sauf que je me vois mal faire des déplacements sur un smartphone)

Présentation de l'entreprise:
- Activité: Entreprise de Batiment
- Nbre moyen d'Employés:2365
- Nbre moyen de Chantiers:25
-Moyenne d'Employés par chantier:90

Dans ce cas elle a les moyens de me payer mon expertise
Voilà le marché, l'entreprise m'envoie une tablette Android 11 pouces de bonne qualité et je propose les sources