Dessiner mes lignes à partir d'une liste d'objets

**Cpt Anderson** · 13/11/2009, 18h40

Bonjour à tous,

Voici mon problème: j'ai une liste d'objet dans laquelle j'ai plusieurs objets du style:

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
 
 
TLigne=class
      private
         FStartX : integer ;
         FStartY : integer ;
         FEndX : integer ;
         FEndY : integer ;
         FColor : TColor;
         FEpaisseur : integer ;
      public
      //   Constructor Create ;
         property StartX : integer Read FStartX Write FStartX ;
         property StartY : integer Read FStartY Write FStartY ;
         property EndX : integer Read FEndX Write FEndX ;
         property EndY : integer Read FEndY Write FEndY ;
         property Color : TColor Read FColor Write FColor ;
         property Epaisseur : integer Read FEpaisseur Write FEpaisseur ;
   end ;

Les propriétés de ces objets sont bien sur renseignés et je désirerais maintenant tracer toutes les lignes que représentent un objet dans un TPaintBox. J'imagine qu'il faut utiliser les methodes PaintBox.Canvas.LineTo(x,y) et PaintBox.Canvas.MoveTo(x,y).
Imaginons que j'ai un simple bouton sur une form qui declanche le dessin et ma TPaintBox, comment dois-je procéder ?

Merci d'avance.

**edam** · 14/11/2009, 00h33

l'un des meilleur exemple qui m'a bien aidé pour utilisé TPainBox

**Dr.Who** · 14/11/2009, 05h49

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
unit GxObj;
 
interface
 
uses
  Windows, SysUtils, Classes, Controls, Graphics;
 
type
  TGraphObjectType = (
    gotGround,
    gotLine,
    gotRectangle,
    gotEllipse
  );
 
  TGraphObjectNeed = (
    gonPen,
    gonBrush,
    gonFont
  );
  TGraphObjectNeeds = set of TGraphObjectNeed;
 
  { Classe de base des GraphObject }
  TGraphObjectBase = class
  private
    fType     : TGraphObjectType;
    fNeeds    : TGRaphObjectNeeds;
    fLocation : TPoint;
    fPen      : TPen;
    fFont     : TFont;
    fBrush    : TBrush;
    fSize     : TSize;
 
    procedure SetBrush(const Value: TBrush);
    procedure SetFont(const Value: TFont);
    procedure SetPen(const Value: TPen);
 
  protected
    property Location : TPoint read fLocation write fLocation;
    property Size     : TSize  read fSize     write fSize;
    property Pen      : TPen   read fPen      write SetPen;
    property Brush    : TBrush read fBrush    write SetBrush;
    property Font     : TFont  read fFont     write SetFont;
 
    constructor Create(const aType: TGraphObjectType; const aNeeds: TGraphObjectNeeds); virtual;
 
  public
    property ObjType  : TGraphObjectType  read fType;
    property ObjNeeds : TGraphObjectNeeds read fNeeds;
 
    destructor Destroy; override;
 
  end;
 
  { Objet pour le fond du canvas
    note : doit être le premier objet assigné au GraphObjectDrawer
  }
  TGraphGround = class(TGraphObjectBase)
    property Brush;
 
    constructor Create; reintroduce;
  end;
 
  { Objet ligne }
  TGraphLine = class(TGraphObjectBase)
  public
    property Location;
    property Size;
    property Pen;
 
    constructor Create; reintroduce;
  end;
 
  { Object rectangle }
  TGraphRect = class(TGraphObjectBase)
  public
    property Location;
    property Size;
    property Pen;
    property Brush;
 
    constructor Create; reintroduce;
  end;
 
  { Object ellipse }
  TGraphEllipse = class(TGraphObjectBase)
  public
    property Location;
    property Size;
    property Pen;
    property Brush;
 
    constructor Create; reintroduce;
  end;
 
  { Objet qui permet de dessiner les GraphObjects
    note : tout objet assigné (addObject) seront automatiquement
           libérés à la destruction (Free) du GraphObjectDrawer.
  }
  TGraphObjectsDrawer = class(TGraphicControl)
  private
    fBuffer : TBitmap;    // Back buffer
    fObjects: TList;      // Liste des objets
    fUpdate : integer;    // Compteur de mise à jours
 
    fOnBeforeRender : TNotifyEvent; // Evenement avant rendu (MakeBuffer)
    fOnAfterRender  : TNotifyEvent; // Evenement aprés rendu (MakeBuffer)
 
  protected
    procedure MakeBuffer; virtual;
    procedure Change; virtual;
    procedure Paint; override;
    procedure Resize; override;
 
  public
    property OnAfterRender  : TNotifyEvent read fOnAfterRender write fOnAfterRender;
    property OnBeforeRender : TNotifyEvent read fOnBeforeRender write fOnBeforeRender;
    function CountObjects   : integer;
 
    procedure AddObject(Obj: TGraphObjectBase);
    procedure RemoveObject(Obj: TGraphObjectBase);
 
    procedure BeginUpdate;
    procedure EndUpdate;
 
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
 
  end;
 
 
 
implementation
 
 
{ TObjectsDrawer }
 
procedure TGraphObjectsDrawer.AddObject(Obj: TGraphObjectBase);
begin
  fObjects.Add(Pointer(Obj));
  if fUpdate = 0 then
    Change;
end;
 
procedure TGraphObjectsDrawer.BeginUpdate;
begin
  inc(fUpdate);
end;
 
procedure TGraphObjectsDrawer.Change;
begin
  if fUpdate <> 0 then
    exit;
  MakeBuffer;
  Invalidate;
end;
 
function TGraphObjectsDrawer.CountObjects: integer;
begin
  result := fObjects.Count;
end;
 
constructor TGraphObjectsDrawer.Create(AOwner: TComponent);
begin
  inherited;
  fBuffer := TBitmap.Create;
  fBuffer.Width := Width;
  fBuffer.Height := Height;
  fBuffer.PixelFormat := pf32bit;
 
  fObjects := TList.Create;
 
  fUpdate := 0;
end;
 
destructor TGraphObjectsDrawer.Destroy;
begin
  while fObjects.Count > 0 do
  begin
    TGraphObjectBase(fObjects.Items[ fObjects.Count-1 ]).Free;
    fObjects.Delete(fObjects.Count-1);
  end;
 
  fObjects.Free;
  fBuffer.Free;
  inherited;
end;
 
procedure TGraphObjectsDrawer.EndUpdate;
begin
  dec(fUpdate);
  if fUpdate = 0 then
    Change;
end;
 
procedure TGraphObjectsDrawer.MakeBuffer;
var N : integer;
    I : TGraphObjectBase;
begin
  if assigned(fOnBeforeRender) then
    fOnBeforeRender(Self);
 
  for N := 0 to fObjects.Count-1 do
  begin
    I := nil;
    { recuperation du GraphObject en cours }
    I := TGraphObjectBase(fObjects.Items[N]);
 
    if assigned(I) then
    begin
      { chargement des besoins du GraphObject }
      if gonPen in I.ObjNeeds then
        fBuffer.Canvas.Pen.Assign(I.Pen);
 
      if gonBrush in I.ObjNeeds then
        fBuffer.Canvas.Brush.Assign(I.Brush);
 
      if gonFont in I.ObjNeeds then
        fBuffer.Canvas.Font.Assign(I.Font);
 
      { méthode de dessin de chaque GraphObject }
      case I.ObjType of
        gotGround    : begin
          fBuffer.Canvas.FillRect(fBuffer.Canvas.ClipRect);
        end;
 
        gotLine      : begin
          fBuffer.Canvas.MoveTo(I.Location.X, I.Location.Y);
          fBuffer.Canvas.LineTo(I.Location.X+I.Size.cx, I.Location.Y+I.Size.cy);
        end;
 
        gotRectangle : begin
          fBuffer.Canvas.Rectangle(I.Location.X, I.Location.Y, I.Location.X+I.Size.cx, I.Location.Y+I.Size.cy);
        end;
 
        gotEllipse   : begin
          fBuffer.Canvas.Ellipse(I.Location.X, I.Location.Y, I.Location.X+I.Size.cx, I.Location.Y+I.Size.cy);
        end;
      end;
    end;
  end;
 
  if assigned(fOnAfterRender) then
    fOnAfterRender(Self);
end;
 
procedure TGraphObjectsDrawer.Paint;
begin
  if not fBuffer.Empty then
    Canvas.Draw(0, 0, fBuffer);
end;
 
procedure TGraphObjectsDrawer.RemoveObject(Obj: TGraphObjectBase);
begin
  fObjects.Delete(fObjects.IndexOf(pointer(obj)));
  Obj.Free;
  if fUpdate = 0 then
    Change;
end;
 
procedure TGraphObjectsDrawer.Resize;
begin
  inherited;
  fBuffer.Width  := Width;
  fBuffer.Height := Height;
  if fUpdate = 0 then
    Change;
end;
 
{ TGraphObject }
 
constructor TGraphObjectBase.Create(const aType: TGraphObjectType; const aNeeds: TGraphObjectNeeds);
begin
  fType := aType;
  fNeeds:= aNeeds;
  fLocation.X := random(320);
  fLocation.Y := random(240);
  fSize.cx    := random(640);
  fSize.cy    := random(480);
 
 
  if gonPen in aNeeds then
  begin
    fPen := TPen.Create;
    fPen.Width := 1;
    fPen.Color := random(255) * random(255) * random(255);
  end;
 
  if gonBrush in aNeeds then
  begin
    fBrush := TBrush.Create;
    fBrush.Color := random(255) * random(255) * random(255);
  end;
 
  if gonFont in aNeeds then
  begin
    fFont := TFont.Create;
    fFont.Size := 9;
    fFont.Name := 'arial';
  end;
end;
 
destructor TGraphObjectBase.Destroy;
begin
  if assigned(fFont) then
    fFont.Free;
 
  if assigned(fBrush) then
    fBrush.Free;
 
  if assigned(fPen) then
    fPen.Free;
 
  inherited;
end;
 
procedure TGraphObjectBase.SetBrush(const Value: TBrush);
begin
  fBrush.Assign(Value);
end;
 
procedure TGraphObjectBase.SetFont(const Value: TFont);
begin
  fFont.Assign(Value);
end;
 
procedure TGraphObjectBase.SetPen(const Value: TPen);
begin
  fPen.Assign(Value);
end;
 
{ TGraphLine }
 
constructor TGraphLine.Create;
begin
  inherited Create(gotLine, [gonPen]);
end;
 
{ TGraphRect }
 
constructor TGraphRect.Create;
begin
  inherited Create(gotRectangle, [gonPen, gonBrush]);
  fBrush.Color := fPen.Color;
end;
 
{ TGraphEllipse }
 
constructor TGraphEllipse.Create;
begin
  inherited Create(gotEllipse, [gonPen, gonBrush]);
  fBrush.Color := fPen.Color;
end;
 
{ TGraphGround }
 
constructor TGraphGround.Create;
begin
  inherited Create(gotGround, [gonBrush]);
end;
 
end.

utilisation :

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
unit Unit24;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;
 
type
  TForm24 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Déclarations privées }
  public
 
  end;
 
var
  Form24: TForm24;
 
implementation
 
{$R *.dfm}
 
uses GxObj;
 
var
  OD : TGraphObjectsDrawer;
 
procedure TForm24.FormCreate(Sender: TObject);
var T : TGraphObjectBase;
    N : integer;
begin
  Randomize;
 
  OD := TGraphObjectsDrawer.Create(Self);
  OD.Parent := Self;
  OD.Align  := alClient;
 
  OD.BeginUpdate;
  try
    T := TGraphGround.Create;
    TGraphGround(T).Brush.Color := $404040;
    OD.AddObject(T);
 
    for N := 0 to 69 do
    begin
      case N of
         0..19 : T := TGraphEllipse.Create;
        20..39 : T := TGraphRect.Create;
        40..69 : T := TGraphLine.Create;
      end;
      OD.AddObject(T);
    end;
  finally
    OD.EndUpdate;
  end;
end;
 
procedure TForm24.FormDestroy(Sender: TObject);
begin
  OD.Free;
end;
 
end.

**Cpt Anderson** · 14/11/2009, 11h51

Merci les gars...

Dessiner mes lignes à partir d'une liste d'objets

Delphi

Discussions similaires

Partager

Partager