Discussion :

[Gilbert Geyer]

Re-bonjour,

Bigre t'as été rapide pour tester le code.

pourrait on faire de la même manière pour un polygone quelquonque, du genre array[1..7] of TDroite;

... certainement, sauf que ce sera un peu plus compliqué qu'avec un rectangle qui n'a que 4 bords
... il faut d'abord identifier parmi tous les polygones l'indice de celui situé sous la souris ainsi que l'indice du bord situé sous la souris et ensuite si on a agrippé le polygone à plus de 15% d'un angle on le rippe parallèlement à lui-même (relativement facile puisqu'il s'agit d'une simple translation sans modif de dimensions ni changements d'inclinaison des bords).
Par contre reste à savoir ce que tu veux faire si on agrippe un bord à moins de 15% d'un angle :
- étirement des bords contigüs à l'angle le reste étant inchangé ?(relativement facile également)
- rotation simple autour du centre du polygone en conservant les dimensions ? (là c'est un peu plus la galère : j'ai pas mal galéré avec la rotation du rectangle mais c'est qu'une question de géométrie et de calculs avec des sinus et des cosinus un peu plus compliqués dans le cas de polygones à "n" côtés).

A+

[petitcoucou31]

Salut ,

Dans mon cas, je gère les déplacements de polygone ou polyline comme une ligne simple avec la méthode décrite ci-dessus.

Je détecte un segment de polygone ou polyline et identifie qui il appartient.
Connaissant toute ces coordonnées ( array of Tpoint du polygone), je travaille sur les coordonnées de tout ces segments avant de le redessiner complètement.

Par contre mon application avait pas besoin de rotation !!

[Gilbert Geyer]

Bonjour,

Voiçi la première moitié du code auquel j'ai ajouté le traitement des polygones réguliers non étoilés :

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
 
unit uImgD;
 
// 1 ) Pour détection de Droites épaisses d'1 seul à plusieurs pixel(s)
//     détection par calcul tenant compte de l'épaisseur du trait
//     permet d'identifier une droite parmi d'autres de même couleur le cas échéant,
//     et même de détecter une droite invisible à l'écran du tye limite de zone.
// 2 ) Pour déplacement de la Droite par agrippage de la droite à la souris :
//     - à moins de 15% d'une extrémité : déplacement par étirage-rotation
//     - à plus de 15% d'une extrémité  : déplacement parallèlement à elle-même
// 3) Idem pour Rectangles et rotation par agrippage à mois de 15% d'un angle.
// 4) Cercles : déplacement par aggrippage n'importe où sauf dans la zone située
//    à l'extrême droite du cercle où l'agrippage provoque la variation du rayon
// 5) Polygones réguliers non étoilés : Déplacement et rotation comme avec les rectangles,
//    et variation de rayon par agrippage n'importe-où combiné avec la touche Maj (Shift).
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, Buttons, StdCtrls, Math, ComCtrls, Menus;
 
type
  TfrmImgD = class(TForm)
    btnTracerDroites: TSpeedButton;
    Image1: TImage;
    labelTemoin: TLabel;
    btnFondNoir: TSpeedButton;
    btnFondBlanc: TSpeedButton;
    btnTracerRectangles: TSpeedButton;
    Label1: TLabel;
    btnTracerCercles: TSpeedButton;
    bTracerPolygones: TSpeedButton;
    procedure FormShow(Sender: TObject);
    procedure btnTracerDroitesClick(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure btnFondNoirClick(Sender: TObject);
    procedure btnFondBlancClick(Sender: TObject);
    procedure btnTracerRectanglesClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure btnTracerCerclesClick(Sender: TObject);
    procedure bTracerPolygonesClick(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
var
  frmImgD: TfrmImgD;
 
implementation
 
{$R *.DFM}
 
// Droites ---------------------------------------------------------------------
 
type TDroiteA = record // Droites avec attributs
                  xo,yo,                 // coordonnées d'origine
                  xe,ye : integer;       // coordonnées d'extrémité
                  coulTrait : TColor;    // couleur du tracé
                  epTrait   : Integer;   // épaisseur du tracé
                  stylTrait : TPenStyle; // style du tracé si droite d'1 seul pixel
                end;
 
     TDroitesA = array [0..9] of TDroiteA;
 
var  MesDroitesA  : TDroitesA;
     iDroiteSelectionnee, xMp,yMp : integer;
     rOrigine    : Extended; // ratio d'éloignement du point d'agripage par rapport à l'origine de la droite
     pm          : TPenMode;
 
procedure TraceDroiteA( C : tCanvas; D : TDroiteA; mode : TPenMode);
begin     with C do
          begin pen.width := D.epTrait;
                pen.color := D.coulTrait;
                pen.Style := D.stylTrait;
                pen.mode  := mode;
                moveto(D.xo, D.yo);
                lineto(D.xe, D.ye);
                pen.mode := pmCopy;
          end;
end;
 
function PointDansTronconDroiteA(xs,ys : integer; Droite : TDroiteA) : Extended;
//@param Result renvoie :
//       -1 si le point xs,ys est en-dehors de la droite
//        5 si ce point est pile celui d'une doite réduite à un point
//       et si xs,ys est situé sur le tronçon de la droite, renvoie une valeur
//       comprise entre 0..1 et proportionnelle à l'éloignement de ce point
//       par rapport à l'origine de la droite.
var      a, b, miEp, lg : Extended; dx,dy,yc : integer; okx,oky : boolean;
begin    Result:=-1;
         miEp:=Droite.epTrait/2;
         dx:=Droite.xe - Droite.xo;
         dy:=Droite.ye - Droite.yo;
         if (dx=0) and (dy=0) then // Droite réduite à 1 seul point
         begin if (xs - miEp <=Droite.xo) and (Droite.xo <= xs + miEp)
               and (ys - miEp <=Droite.yo) and (Droite.yo <= ys + miEp)
               then Result:=5;
               EXIT;
         end;
         okx:=False; oky:=False;
         // okx et oky ne servent qu''à tester si le point-cible est situé entre
         // l'origine et l'extrémité du tronçon et non sur ses prolongements
         if ((dy<0) and (ys<=Droite.yo) and (ys>=Droite.ye))
         or ((dy>0) and (ys<=Droite.ye) and (ys>=Droite.yo)) then oky:=True;
         if ((dx>0) and (xs<=Droite.xe) and (xs>=Droite.xo))
         or ((dx<0) and (xs<=Droite.xo) and (xs>=Droite.xe)) then okx:=True;
 
         if (dx=0) then // Droite verticale
         begin if (xs - miEp <=Droite.xo) and (Droite.xo <= xs + miEp)
               and oky then Result:=(ys - Droite.yo)/dy;
               EXIT;
         end else
         if (dy=0) then // Droite horizontale
         begin if (ys - miEp <=Droite.yo) and (Droite.yo <= ys + miEp)
               and okx then Result:=(xs - Droite.xo)/dx;
               EXIT;
         end else // Droite inclinée "y = a.x + b"
         begin a:=dy/dx; // pente
               b:=Droite.yo - a*Droite.xo;
               yc:=round(a*xs + b);     // y-calculé(xs)
               lg:=sqrt(dx*dx + dy*dy); // longueur tronçon de droite
               miEp:=abs(miEp*lg/dx);   // projection de miEp sur la verticale yc-ys en xs
               if (yc + miEp >= ys) and (yc - miEp <= ys)
               and okx and oky then Result:=(xs - Droite.xo)/dx;
         end;
end;
 
// Rectangles-------------------------------------------------------------------
 
type TDroite = record // Droites sans attributs
                  xo,yo,                 // coordonnées d'origine
                  xe,ye : integer;       // coordonnées d'extrémité
                end;
 
type TRectangle = record
                     xo,yo,w,h : integer;
                     xc,yc     : integer;
                     Bords : array[1..4] of TDroite;
                     coulTrait : TColor;    // couleur du tracé
                     epTrait   : Integer;   // épaisseur du tracé
                     stylTrait : TPenStyle; // style du tracé si droite d'1 seul pixel
                  end;
 
     TRectangles = array of TRectangle;
 
var  MesRectangles   : TRectangles;
     iRectSelectionne,
     iBord : integer;
 
function CreeRect( ixo,iyo,iw,ih : integer; icoulTrait : TColor;
                   iepTrait : byte; istylTrait : TPenStyle) : TRectangle;
begin    with Result do
         begin xo:=ixo; yo:=iyo; w:=iw; h:=ih; coulTrait:=icoulTrait;
               epTrait:=iepTrait; stylTrait:=istylTrait;
               // 1 = bord gauche
               Bords[1].xo:=xo; Bords[1].yo:=yo;
               Bords[1].xe:=xo; Bords[1].ye:=yo+h;
               // 2 = bord inf
               Bords[2].xo:=xo;   Bords[2].yo:=yo+h;
               Bords[2].xe:=xo+w; Bords[2].ye:=yo+h;
               // 3 = bord droite
               Bords[3].xo:=xo+w; Bords[3].yo:=yo+h;
               Bords[3].xe:=xo+w; Bords[3].ye:=yo;
               // 4 = bord sup
               Bords[4].xo:=xo+w; Bords[4].yo:=yo;
               Bords[4].xe:=xo;   Bords[4].ye:=yo;
               xc:=xo + (w div 2);
               yc:=yo + (h div 2);
         end;
end;
 
procedure TraceRect(C : tCanvas; Rectangle : TRectangle; mode : TPenMode);
var       i : integer; al : Extended; D : TDroite;
begin     with C.pen do
          begin color := Rectangle.coulTrait;
                Style := Rectangle.stylTrait;
                width := Rectangle.epTrait;
          end;
          for i:=1 to 4 do
          begin D:=Rectangle.Bords[i];
                with C do
                begin pen.mode  := mode;
                      moveto(D.xo, D.yo); lineto(D.xe, D.ye);
                      moveto(D.xo, D.yo); lineto(D.xo, D.yo);
                end;
          end;
          with Rectangle do
          begin al:=arcTan2(Bords[1].yo - Bords[4].yo, Bords[4].xo - Bords[1].xo);
                frmImgD.label1.caption:='al°='+FloatToStr(round(al*180/Pi));
          end;
end;
 
procedure TraceRectBis(C : tCanvas; Rectangle : TRectangle; mode : TPenMode);
//        Rectangle dédoublé
var       et,etcos,etsin : integer; al : Extended; p14,p12,p23,p34 : TPoint;
begin     with Rectangle do
          begin p14.x:=Bords[1].xo; p14.y:=Bords[1].yo;
                p12.x:=Bords[2].xo; p12.y:=Bords[2].yo;
                p23.x:=Bords[3].xo; p23.y:=Bords[3].yo;
                p34.x:=Bords[4].xo; p34.y:=Bords[4].yo;
                C.pen.color := coulTrait;
                C.pen.Style := stylTrait;
                C.pen.mode  := mode;
                et:=epTrait;
                al:=arcTan2(p14.y-p34.y, p34.x-p14.x);
                frmImgD.label1.caption:='al°='+FloatToStr(round(al*180/Pi));
          end;
          with C do
          begin pen.width := 1;
                pen.mode  := mode;
                moveTo(p14.x,p14.y); lineTo(p12.x,p12.y);
                lineTo(p23.x,p23.y); lineTo(p34.x,p34.y); lineTo(p14.x,p14.y);
 
                etcos:=round(et*cos(al)); etsin:=round(et*sin(al));
 
                p14.x:=p14.x + etcos + etsin;    
                p14.y:=p14.y + etcos - etsin;
 
                p12.x:=p12.x + etcos - etsin;
                p12.y:=p12.y - etcos - etsin;
 
                p23.x:=p23.x - etcos - etsin;
                p23.y:=p23.y - etcos + etsin;
 
                p34.x:=p34.x - etcos + etsin;
                p34.y:=p34.y + etcos + etsin;
 
                moveTo(p14.x,p14.y); lineTo(p12.x,p12.y);
                lineTo(p23.x,p23.y); lineTo(p34.x,p34.y); lineTo(p14.x,p14.y);
          end;
end;
 
function PointDansTronconDroite(xs,ys : integer; Droite : TDroite; epDroite : byte) : Extended;
//@param Result renvoie :
//       -1 si le point xs,ys est en-dehors de la droite
//        5 si ce point est pile celui d'une doite réduite à un point
//       et si xs,ys est situé sur le tronçon de la droite, renvoie une valeur
//       comprise entre 0..1 et proportionnelle à l'éloignement de ce point
//       par rapport à l'origine de la droite.
var      a, b, miEp, lg : Extended; dx,dy,yc : integer; okx,oky : boolean;
begin    Result:=-1;
         miEp:=epDroite/2;
         dx:=Droite.xe - Droite.xo;
         dy:=Droite.ye - Droite.yo;
         if (dx=0) and (dy=0) then // Droite réduite à 1 seul point
         begin if (xs - miEp <=Droite.xo) and (Droite.xo <= xs + miEp)
               and (ys - miEp <=Droite.yo) and (Droite.yo <= ys + miEp)
               then Result:=5;
               EXIT;
         end;
         okx:=False; oky:=False;
         // okx et oky ne servent qu''à tester si le point-cible est situé entre
         // l'origine et l'extrémité du tronçon et non sur ses prolongements
         if ((dy<0) and (ys<=Droite.yo) and (ys>=Droite.ye))
         or ((dy>0) and (ys<=Droite.ye) and (ys>=Droite.yo)) then oky:=True;
         if ((dx>0) and (xs<=Droite.xe) and (xs>=Droite.xo))
         or ((dx<0) and (xs<=Droite.xo) and (xs>=Droite.xe)) then okx:=True;
 
         if (dx=0) then // Droite verticale
         begin if (xs - miEp <=Droite.xo) and (Droite.xo <= xs + miEp)
               and oky then Result:=(ys - Droite.yo)/dy;
               EXIT;
         end else
         if (dy=0) then // Droite horizontale
         begin if (ys - miEp <=Droite.yo) and (Droite.yo <= ys + miEp)
               and okx then Result:=(xs - Droite.xo)/dx;
               EXIT;
         end else // Droite inclinée "y = a.x + b"
         begin a:=dy/dx; // pente
               b:=Droite.yo - a*Droite.xo;
               yc:=round(a*xs + b);     // y-calculé(xs)
               lg:=sqrt(dx*dx + dy*dy); // longueur tronçon de droite
               miEp:=abs(miEp*lg/dx);   // projection de miEp sur la verticale yc-ys en xs
               if (yc + miEp >= ys) and (yc - miEp <= ys)
               and okx and oky then Result:=(xs - Droite.xo)/dx;
         end;
end;
 
function PointSurBordRect(xs,ys : integer; Rectangle : TRectangle) : Extended;
var      i : byte;
begin    i:=0;
         repeat inc(i);
                Result:=PointDansTronconDroite(xs,ys, Rectangle.Bords[i], Rectangle.epTrait);
                iBord:=i;
         until (Result>=0) or (i=4);
end;
 
function  DistancePtDroite(xp,yp : integer; D : TDroite) : Extended;
var       al, a, b : Extended;
begin     with D do
          begin if xo=xe then Result:=xp-xo // D verticale
                else if yo=ye then Result:=yp-yo // D horizontale
                else begin // D inclinée
                     al:=arcTan2(ye - yo, xo - xe);
                     a:=(ye - yo)/(xe - xo);
                     b:=yo - a*xo;
                     Result:=(yp - a*xp - b)*cos(al);
                end;
          end;
end;
 
procedure TranslatRect(var Rectangle : TRectangle; dx,dy : integer);
var       j : byte;
begin     with Rectangle do
          begin for j:=1 to 4 do
                begin Bords[j].xo:=Bords[j].xo+dx;
                      Bords[j].yo:=Bords[j].yo+dy;
                      Bords[j].xe:=Bords[j].xe+dx;
                      Bords[j].ye:=Bords[j].ye+dy;
                end;
                xc:=xc+dx; yc:=yc+dy;
          end;
end;
 
procedure EtireRect(var Rectangle : TRectangle; xs,ys, Bord : integer);
var       dx,dy : integer; al,d : Extended;
 
          procedure DecaleBord(j : byte);
          begin     with Rectangle do
                    begin Bords[j].xo:=Bords[j].xo+dx;
                          Bords[j].yo:=Bords[j].yo+dy;
                          Bords[j].xe:=Bords[j].xe+dx;
                          Bords[j].ye:=Bords[j].ye+dy;
                    end;
          end;
 
          procedure DecaleExtrem;
          begin     with Rectangle do
                    begin case Bord of
                      1 : begin Bords[2].xo:=Bords[2].xo+dx; Bords[2].yo:=Bords[2].yo+dy;
                                Bords[4].xe:=Bords[4].xe+dx; Bords[4].ye:=Bords[4].ye+dy; end;
                      2 : begin Bords[3].xo:=Bords[3].xo+dx; Bords[3].yo:=Bords[3].yo+dy;
                                Bords[1].xe:=Bords[1].xe+dx; Bords[1].ye:=Bords[1].ye+dy; end;
                      3 : begin Bords[4].xo:=Bords[4].xo+dx; Bords[4].yo:=Bords[4].yo+dy;
                                Bords[2].xe:=Bords[2].xe+dx; Bords[2].ye:=Bords[2].ye+dy; end;
                      4 : begin Bords[1].xo:=Bords[1].xo+dx; Bords[1].yo:=Bords[1].yo+dy;
                                Bords[3].xe:=Bords[3].xe+dx; Bords[3].ye:=Bords[3].ye+dy; end;
                      end;
                    end;
          end;
 
begin     with Rectangle do
          begin if Bords[Bord].xo - Bords[Bord].xe = 0  // bord vertical
                then begin dx:=xs - Bords[Bord].xo; dy:=0; end
                else begin
                       d:=DistancePtDroite(xs,ys, Bords[Bord]);
                       al:=arcTan2(Bords[Bord].ye - Bords[Bord].yo, Bords[Bord].xo - Bords[Bord].xe);
                       dy:=round(d*cos(al));
                       dx:=round(d*sin(al));
                end;
                DecaleBord(Bord); DecaleExtrem;
                xc:=Bords[1].xo + ((Bords[2].xe - Bords[1].xo) div 2);
                yc:=Bords[1].yo + ((Bords[2].ye - Bords[1].yo) div 2);
                xo:=Bords[1].xo; yo:=Bords[1].yo;
                w:=round(sqrt(sqr(Bords[2].xe - Bords[2].xo) + sqr(Bords[2].ye - Bords[2].yo)));
                h:=round(sqrt(sqr(Bords[1].xe - Bords[1].xo) + sqr(Bords[1].ye - Bords[1].yo)));
          end;
end;
 
procedure RotatRect(var Rectangle : TRectangle; xs,ys : integer);
var       al,be,R : Extended;
begin     with Rectangle do
          begin R:= sqrt(w*w + h*h)/2;
                al:=ArcTan2(yc - ys, xs - xc);
                be:=al - ArcTan(h/w);
                Bords[4].xo:=xc + round(R*cos(al));
                Bords[4].yo:=yc - round(R*sin(al));
                Bords[4].xe:=Bords[4].xo - trunc(w*cos(be));
                Bords[4].ye:=Bords[4].yo + trunc(w*sin(be));
 
                Bords[1].xo:=Bords[4].xe;
                Bords[1].yo:=Bords[4].ye;
                xo:=Bords[1].xo;
                yo:=Bords[1].yo;
                Bords[1].xe:=Bords[1].xo + trunc(h*sin(be));
                Bords[1].ye:=Bords[1].yo + trunc(h*cos(be));
 
                Bords[2].xo:=Bords[1].xe;
                Bords[2].yo:=Bords[1].ye;
                Bords[2].xe:=Bords[2].xo + trunc(w*cos(be));
                Bords[2].ye:=Bords[2].yo - trunc(w*sin(be));
 
                Bords[3].xo:=Bords[2].xe;
                Bords[3].yo:=Bords[2].ye;
                Bords[3].xe:=Bords[3].xo - trunc(h*sin(be));
                Bords[3].ye:=Bords[3].yo - trunc(h*cos(be));
          end;
end; // RotatRect
 
// Cercles ---------------------------------------------------------------------
 
type TCercle = record
                     xc,yc,R   : integer;
                     coulTrait : TColor;
                     epTrait   : Integer;
                     stylTrait : TPenStyle;
                  end;
 
     TCercles = array of TCercle;
 
var  MesCercles : TCercles;
     iCercleSelectionne : integer;
 
function CreeCercle( ixc,iyc,iR: integer; iCoulTrait : TColor;
                     iEpTrait : byte; iStylTrait : TPenStyle) : TCercle;
begin    with Result do
         begin xc:=ixc; yc:=iyc; R:=iR;
               coulTrait:=iCoulTrait; epTrait:=iEpTrait; stylTrait:=iStylTrait;
         end;
end;
 
procedure TraceCercle( C : tCanvas; Cercle : TCercle; mode : TPenMode);
var       Re : TRect;
begin     with C do
          begin pen.width := Cercle.epTrait;
                pen.color := Cercle.coulTrait;
                pen.Style := Cercle.stylTrait;
                pen.mode  := mode;
                Re:=Rect( Cercle.xc-Cercle.R, Cercle.yc-Cercle.R,
                          Cercle.xc+Cercle.R, Cercle.yc+Cercle.R);
                C.Ellipse(Re);
          end;
end;
 
function PointSurCercle(xs,ys : integer; Cercle : TCercle) : Extended;
//@param Result : sera compris entre -Pi et +Pi radians si le point xs,ys est sur le cercle
//       et - 5 radians si le point est ailleurs.
var      d : Extended;
begin    Result:=-5;
         with Cercle do
         begin d:=sqrt((xs-xc)*(xs-xc) + (ys-yc)*(ys-yc));
               if (d >= R - (epTrait/2)) and (d <= R + (epTrait/2)) then
               begin if xs = xc then Result:=Pi/2
                     else Result:=arcTan2(ys-yc, xs-xc);
               end;
         end;
end;
 
procedure TranslatCercle(var Cercle : TCercle; dx,dy : integer);
begin     with Cercle do begin xc:=xc+dx; yc:=yc+dy; end;
end;
 
// Polygones réguliers non étoilés ---------------------------------------------
// triangles, carrés, pentagones, etc
 
type TPolygone = record
                     nbCotes,             // nb de côtés >=3
                     xc,yc,R   : integer; // posit du centre et rayon
                     incli     : Extended;// inclinaison en rotation en radians
                     Bords : array of TDroite;
                     coulTrait : TColor;    // couleur du tracé
                     epTrait   : Integer;   // épaisseur du tracé
                     stylTrait : TPenStyle; // style du tracé si droite d'1 seul pixel
                  end;
 
     TPolygones = array of TPolygone;
 
var  MesPolygones   : TPolygones;
     iPolygoneSelectionne : integer;
 
function CreePolygone( inbCotes,ixc,iyc,iR : integer; eIncli : Extended;
                       icoulTrait : TColor; iepTrait : byte; istylTrait : TPenStyle) : TPolygone;
var      i : byte; Theta : Extended; xs,ys : integer;
begin    if inbCotes<=2 then inbCotes:=3;
         with Result do
         begin nbCotes:=inbCotes; xc:=ixc; yc:=iyc; R:=iR; coulTrait:=icoulTrait;
               epTrait:=iepTrait; stylTrait:=istylTrait;
               Incli:=eIncli;
               SetLength(Bords, nbCotes+1);
               for i:=1 to nbCotes do
               begin Theta:=eIncli + ((i-1)*2*Pi/nbCotes);
                     xs:=xc+round(R*cos(Theta));
                     ys:=yc+round(R*sin(Theta));
                     Bords[i].xo:=xs;
                     Bords[i].yo:=ys;
               end;
               for i:=1 to nbCotes do
               begin if i<=nbCotes-1 then
                     begin Bords[i].xe:=Bords[i+1].xo;
                           Bords[i].ye:=Bords[i+1].yo;
                     end else
                     begin Bords[i].xe:=Bords[1].xo;
                           Bords[i].ye:=Bords[1].yo;
                     end;
               end;
         end;
end;
 
procedure TracePolygone(C : tCanvas; Polygone : TPolygone; mode : TPenMode);
var       i : integer; D : TDroite;
begin     with C do
          begin pen.mode  := mode;
                pen.color := Polygone.coulTrait;
                pen.Style := Polygone.stylTrait;
                pen.width := Polygone.epTrait;
                for i:=1 to Polygone.nbCotes do
                begin D:=Polygone.Bords[i];
                      moveto(D.xo, D.yo); lineto(D.xe, D.ye);
                      moveto(D.xo, D.yo); lineto(D.xo, D.yo);
                end;
          end;
end;
 
function PointSurBordPolygone(xs,ys : integer; Polygone : TPolygone) : Extended;
var      i : integer;
begin    i:=0;
         repeat inc(i);
                Result:=PointDansTronconDroite(xs,ys, Polygone.Bords[i], Polygone.epTrait);
                iBord:=i;
         until (Result>=0) or (i=Polygone.nbCotes);
end;
 
procedure TranslatPolygone(var Polygone : TPolygone; dx,dy : integer);
var       i : integer;
begin     with Polygone do
          begin for i:=1 to Polygone.nbCotes do
                begin Bords[i].xo:=Bords[i].xo+dx;
                      Bords[i].yo:=Bords[i].yo+dy;
                      Bords[i].xe:=Bords[i].xe+dx;
                      Bords[i].ye:=Bords[i].ye+dy;
                end;
                xc:=xc+dx; yc:=yc+dy;
          end;
end;
 
procedure RotatPolygone(var Polygone : TPolygone; X,Y,dx,dy : integer);
var       i : integer; xp,yp,xs,ys : integer; Theta,ThetaX,ThetaP, dTheta : Extended;
begin     xp:=X + dx; yp:=Y + dy;
          with Polygone do
          begin ThetaX:=arctan2(yc - Y, X - xc); ThetaP:=arctan2(yc - yp, xp - xc);
                dTheta:=ThetaX - ThetaP;
                Incli:=Incli + dTheta;
                for i:=1 to nbCotes do
                begin Theta:=Incli + ((i-1)*2*Pi/nbCotes);
                      xs:=xc+round(R*cos(Theta));
                      ys:=yc+round(R*sin(Theta));
                      Bords[i].xo:=xs;
                      Bords[i].yo:=ys;
                end;
                for i:=1 to nbCotes do
                begin if i<=nbCotes-1 then
                      begin Bords[i].xe:=Bords[i+1].xo;
                            Bords[i].ye:=Bords[i+1].yo;
                      end else
                      begin Bords[i].xe:=Bords[1].xo;
                            Bords[i].ye:=Bords[1].yo;
                      end;
                end;
         end;
end;
 
procedure DimPolygone(var Polygone : TPolygone; iR : integer);
var       i : integer; xs,ys : integer; Theta : Extended;
begin     with Polygone do
          begin R:=iR;
                for i:=1 to nbCotes do
                begin Theta:=Incli + ((i-1)*2*Pi/nbCotes);
                      xs:=xc+round(R*cos(Theta));
                      ys:=yc+round(R*sin(Theta));
                      Bords[i].xo:=xs;
                      Bords[i].yo:=ys;
                end;
                for i:=1 to nbCotes do
                begin if i<=nbCotes-1 then
                      begin Bords[i].xe:=Bords[i+1].xo;
                            Bords[i].ye:=Bords[i+1].yo;
                      end else
                      begin Bords[i].xe:=Bords[1].xo;
                            Bords[i].ye:=Bords[1].yo;
                      end;
                end;
         end;
end;
 
// Utilisation -----------------------------------------------------------------

A+ : suite et fin du code dans message suivant.

[Gilbert Geyer]

Suite et fin du code de mon message précédent :

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
 
// Utilisation -----------------------------------------------------------------
 
procedure TfrmImgD.FormShow(Sender: TObject);
var       ep : byte;
begin     //color:=clWhite; //<pour tracés avec pmNotXor sur canvas Form
          iDroiteSelectionnee:=-1;
          pm:=pmNotXor;
          // 1) série de droites fines
          ep:=1; // un seul pixel
          with MesDroitesA[0] do
          begin xo:=50; yo:=50; xe:=200; ye:=100;
                coulTrait:=clRed; epTrait:=ep; stylTrait:=psSolid;
          end;
          with MesDroitesA[1] do // parallèle à la précédente et en contact avec celle-ci
          begin xo:=50; yo:=51; xe:=200; ye:=101;
                coulTrait:=clLime; epTrait:=ep; stylTrait:=psDash;
          end;
          with MesDroitesA[2] do
          begin xo:=50; yo:=100; xe:=200; ye:=50;
                coulTrait:=clNavy; epTrait:=ep; stylTrait:=psDot;
          end;
          with MesDroitesA[3] do // verticale
          begin xo:=100; yo:=110; xe:=100; ye:=150;
                coulTrait:=clGreen; epTrait:=ep; stylTrait:=psDashDot;
          end;
          with MesDroitesA[4] do // horizontale
          begin xo:=100; yo:=110; xe:=50; ye:=110;
                coulTrait:=clYellow; epTrait:=ep; stylTrait:=psDashDotDot;
          end; 
          // 2) série de droites épaisses
          ep:=10; // 10 pixels
          with MesDroitesA[5] do
          begin xo:=50; yo:=150; xe:=200; ye:=200;
                coulTrait:=clRed; epTrait:=ep; stylTrait:=psSolid;
          end;
          with MesDroitesA[6] do // parallèle à la précédente et en contact avec celle-ci
          begin xo:=50; yo:=161; xe:=200; ye:=211;
                coulTrait:=clLime; epTrait:=ep; stylTrait:=psSolid;
          end;
          with MesDroitesA[7] do
          begin xo:=50; yo:=200; xe:=200; ye:=150;
                coulTrait:=clNavy; epTrait:=ep; stylTrait:=psSolid;
          end;
          with MesDroitesA[8] do // verticale
          begin xo:=100; yo:=210; xe:=100; ye:=250;
                coulTrait:=clGreen; epTrait:=ep; stylTrait:=psSolid;
          end;
          with MesDroitesA[9] do // horizontale
          begin xo:=100; yo:=210; xe:=50; ye:=210;
                coulTrait:=clYellow; epTrait:=ep; stylTrait:=psSolid;
          end;
          // 3) Rectangles
          iRectSelectionne:=-1;
          SetLength(MesRectangles,2);
          MesRectangles[0]:=CreeRect( 250,50,100,30, clNavy, 10, psSolid);
          MesRectangles[1]:=CreeRect( 250,100,100,30, clGreen, 8, psSolid);
          // 4) Cercles
          iCercleSelectionne:=-1;
          SetLength(MesCercles,2);
          MesCercles[0]:=CreeCercle( 250,250,40, clRed, 5, psSolid);
          MesCercles[1]:=CreeCercle( 350,250,40, clFuchsia, 2, psSolid);
          // 3) Polygones
          iPolygoneSelectionne:=-1;
          SetLength(MesPolygones,5);
          MesPolygones[0]:=CreePolygone( 3,150,350,30, 0, clRed,  4 , psSolid);
          MesPolygones[1]:=CreePolygone( 4,250,350,30, 0, clLime, 4 , psSolid);
          MesPolygones[2]:=CreePolygone( 5,350,350,30, 0, clBlue, 4 , psSolid);
          MesPolygones[3]:=CreePolygone( 6,450,350,30, 0, clNavy, 4 , psSolid);
          MesPolygones[4]:=CreePolygone( 7,550,350,30, 0, clFuchsia, 4 , psSolid);
          WindowState:=wsMaximized;
end;
 
procedure TfrmImgD.btnTracerDroitesClick(Sender: TObject);
var       i : integer;
begin     for i:=Low(MesDroitesA) to High(MesDroitesA)
          do TraceDroiteA(Image1.Canvas, MesDroitesA[i], pm);
end;
 
procedure TfrmImgD.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var       i : integer;
begin     labelTemoin.color:=clBtnFace;
          labelTemoin.caption:=FloatToStr(rOrigine);
          //1 ) Tests sur droites
          i:=-1; iDroiteSelectionnee:=-1;
          repeat inc(i); rOrigine:=PointDansTronconDroiteA(X,Y, MesDroitesA[i])
          until (rOrigine>=0) or (i=High(MesDroitesA));
          // ici on quitte la boucle dès qu'on a détecté le tracé sur lequel on a cliqué
          if rOrigine>=0
          then begin labelTemoin.caption:=FloatToStr(rOrigine);
                     labelTemoin.color:=MesDroitesA[i].coulTrait;
                     iDroiteSelectionnee:=i;
                     Screen.Cursor := crHandPoint;
                     xMp:=X; yMp:=Y;  EXIT;
          end;
          //2 ) Tests sur rectangles
          i:=-1; iRectSelectionne:=-1;
          repeat inc(i); rOrigine:=PointSurBordRect(X,Y, MesRectangles[i]);
          until (rOrigine>=0) or (i=High(MesRectangles));
          if rOrigine>=0
          then begin labelTemoin.caption:=FloatToStr(rOrigine);
                     labelTemoin.color:=MesRectangles[i].coulTrait;
                     iRectSelectionne:=i;
                     Screen.Cursor := crHandPoint;
                     xMp:=X; yMp:=Y; EXIT;
          end;
          //3) Tests sur Cercles
          i:=-1; iCercleSelectionne:=-1;
          repeat inc(i); rOrigine:=PointSurCercle(X,Y, MesCercles[i]);
          until (rOrigine<>-5) or (i=High(MesCercles));
          if rOrigine<>-5
          then begin labelTemoin.caption:=intToStr(trunc(rOrigine*180/Pi))+'°';
                     labelTemoin.color:=MesCercles[i].coulTrait;
                     iCercleSelectionne:=i;
                     Screen.Cursor := crHandPoint;
                     xMp:=X; yMp:=Y; EXIT;
          end;
          //3) Tests sur Polygones
          i:=-1; iPolygoneSelectionne:=-1;
          repeat inc(i); rOrigine:=PointSurBordPolygone(X,Y, MesPolygones[i]);
          until (rOrigine>=0) or (i=High(MesPolygones));
          if rOrigine>=0
          then begin labelTemoin.caption:=intToStr(trunc(rOrigine*180/Pi))+'°';
                     labelTemoin.color:=MesPolygones[i].coulTrait;
                     iPolygoneSelectionne:=i;
                     Screen.Cursor := crHandPoint;
                     xMp:=X; yMp:=Y; EXIT;
          end;
end;
 
procedure TfrmImgD.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
var       i,dxs,dys : integer;
begin     //1) Droites
          i:=iDroiteSelectionnee;
          if i>=0 then
          begin dxs:=X - xMp; dys:=Y - yMp;
                with MesDroitesA[i] do
                begin TraceDroiteA(Image1.Canvas, MesDroitesA[i], pm);
                      if rOrigine<=0.15 then // Etirage droite par agrippage près de l''origine
                      begin xo:=xo+dxs; yo:=yo+dys; end else
                      if rOrigine>=0.85 then // Etirage droite par agrippage près de l''extrémité
                      begin xe:=xe+dxs; ye:=ye+dys; end
                      else // Déplacement droite parallèle à elle-même
                      begin xo:=xo+dxs; yo:=yo+dys; xe:=xe+dxs; ye:=ye+dys; end;
                      TraceDroiteA(Image1.Canvas, MesDroitesA[i], pm);
                end;
                xMp:=X; yMp:=Y;
          end;
          //2) Rectangles
          i:=iRectSelectionne;
          if i>=0 then
          begin dxs:=X - xMp; dys:=Y - yMp;
                if not odd(i)
                then TraceRect(Image1.Canvas, MesRectangles[i], pm)
                else TraceRectBis(Image1.Canvas, MesRectangles[i], pm);
 
                if (rOrigine<=0.15) or (rOrigine>=0.85)
                then RotatRect(MesRectangles[i], X, Y) else
                begin case iBord of
                        4 : TranslatRect(MesRectangles[i], dxs, dys); // Déplacement parallèle à lui-même
                        else EtireRect(MesRectangles[i], X, Y, iBord);
                      end;
                end;
 
                if not odd(i)
                then TraceRect(Image1.Canvas, MesRectangles[i], pm)
                else TraceRectBis(Image1.Canvas, MesRectangles[i], pm);
                xMp:=X; yMp:=Y;
          end;
          //3) Cercles
          i:=iCercleSelectionne;
          if i>=0 then
          begin dxs:=X - xMp; dys:=Y - yMp;
                TraceCercle(Image1.Canvas, MesCercles[i], pm);
                if (rOrigine>=-0.15) and (rOrigine<=0.15)
                then MesCercles[i].R:=MesCercles[i].R+dxs    // variation Rayon
                else TranslatCercle(MesCercles[i], dxs,dys); // translation
                TraceCercle(Image1.Canvas, MesCercles[i], pm);
                xMp:=X; yMp:=Y;
          end;
          //4) Polygones
          i:=iPolygoneSelectionne;
          if i>=0 then
          begin dxs:=X - xMp; dys:=Y - yMp;
                TracePolygone(Image1.Canvas, MesPolygones[i], pm);
                if ssShift in Shift
                then DimPolygone(MesPolygones[i], MesPolygones[i].R + dxs) // variation Rayon
                else
                if (rOrigine>0.15) and (rOrigine<0.85)
                then TranslatPolygone(MesPolygones[i], dxs,dys)   // translation
                else RotatPolygone(MesPolygones[i], X,Y, dxs,dys);// rotation
                TracePolygone(Image1.Canvas, MesPolygones[i], pm);
                xMp:=X; yMp:=Y;
          end;
end;
 
procedure TfrmImgD.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin     iDroiteSelectionnee:=-1;
          iRectSelectionne:=-1;
          iCercleSelectionne:=-1;
          iPolygoneSelectionne:=-1;
          Screen.Cursor := crDefault;
end;
 
procedure TfrmImgD.btnFondNoirClick(Sender: TObject);
begin     with Image1.Canvas do
          begin brush.color:=clBlack;
                FillRect(Rect(0,0,image1.width,image1.height));
          end;
end;
 
procedure TfrmImgD.btnFondBlancClick(Sender: TObject);
begin     with Image1.Canvas do //< superflu si Image1 est vide
          begin brush.color:=clWhite;
                FillRect(Rect(0,0,image1.width,image1.height));
          end;
end;
 
procedure TfrmImgD.btnTracerRectanglesClick(Sender: TObject);
var       i : integer;
begin     for i:=Low(MesRectangles) to High(MesRectangles)
           do if not odd(i)
              then TraceRect(Image1.Canvas, MesRectangles[i], pm)
              else TraceRectBis(Image1.Canvas, MesRectangles[i], pm);
end;
 
procedure TfrmImgD.FormResize(Sender: TObject);
begin     image1.left:=120;
          image1.width:=clientWidth-image1.left;
          image1.height:=clientHeight;
end;
 
procedure TfrmImgD.btnTracerCerclesClick(Sender: TObject);
var       i : integer;
begin     for i:=Low(MesCercles) to High(MesCercles)
          do TraceCercle(Image1.Canvas, MesCercles[i], pm);
end;
 
procedure TfrmImgD.bTracerPolygonesClick(Sender: TObject);
var       i : integer;
begin     for i:=Low(MesPolygones) to High(MesPolygones)
           do TracePolygone(Image1.Canvas, MesPolygones[i], pm);
end;
 
end.

A+

[stfanny31]

salut à tous
je trouve formidable ce que vous faites (merci c'est génial)
moi je ne suis pas aussi pro que vous mais j'arrive à comprendre le code
est ce que SVP vous pouvez m'expliquer comment marche "le canvas" ?
merci

[Gilbert Geyer]

Bonjour,

SVP vous pouvé m'expliqué comment marche 'le canvas"

Le canvas est un objet qui contient lui-même des objets graphiques à utiliser pour dessiner ou écrire sur un dessin : le crayon (Pen), une brosse (Brush), la police de caractères (Font) , un tableau de pixels (Pixels[x,y]), et la possibilité de charger un BitMap dans sa proriété Picture.

Et comme dans Delphi il y a plein d'objets qui possèdent un canvas ça permet de dessiner en plein d'endroits : TForm, TLabel, TListBox, PaintBox, TImage et j'en passe...

C'est la bonne utilisation des propriétés et des méthodes associées au canvas et aux objets graphiques qu'il contient qui fait marcher le canvas.

Les méthodes associées au canvas permettent de tracer :
- des lignes droites( MoveTo(x,y) + LineTo(x,y) ),
- des ellipses ou des cercles ( Ellipse(X1, Y1, X2, Y2); ),
- des rectangles ( Rectangle(X1, Y1, X2, Y2); ),
- des lignes brisées ( Polyline( [Point1, Point2, ... PointN]); ),
- des courbes de Bézier (PolyBezier([Point1, Point2, ... PointN]);
- pour le reste voir l'aide de Delphi.

A+

[stfanny31]

merci beaucoup pour votre réponse
je viens de commencer mon travaille ,je suis très optimiste
merci

[stfanny31]

salut merci bcp pr votre diffinition cela ma bcp aidé
voici ce que j'ai fé pr désiné des ligne :

procedure Tf1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin f1.Canvas.LineTo(x,y); end;//F1:name de la forme1

procedure Tf1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin f1.Canvas.MoveTo(x,y); end;

ce programe désine bien les ligne
mais: :le probléme et que quant l'utilisateur clique la premiére fois il ne vois pâs le trais avant de enlevé sa main de la Souri
moi je ve que l'utilisateur puisse voir le trait avant de le désiné
j'éspére que j'ai été clair
si vous pouvé m'aidé cela seré bien merci
amicalemnt votre stfanny31

[Gilbert Geyer]

Bonjour,

le probléme et que quant l'utilisateur clique la premiére fois il ne vois pâs le trais avant de enlevé sa main de la Souri
moi je ve que l'utilisateur puisse voir le trait avant de le désiné

... bigre! pour "voir le trait avant de le dessiner" il faut bien le dessiner sinon il est invisible.

Pour voir le tracé pendant qu'on le dessine :

Code :

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

1
2
3
4
5
6
7
8
 
procedure Tf1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin f1.Canvas.MoveTo(x,y); end;
 
procedure Tf1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin   f1.Canvas.LineTo(x,y); end;

... Par contre ceci trace le trait au fur et à mesure que l'utilisateur fait ses zig-zag avec la souris et pour pouvoir effacer puis déplacer le tracé par la suite il faut mémoriser, lors du mouseMove, dans un tableau de Points, les coordonnées x,y de la tajectoire de la souris et redessiner par-dessus le tracé initial avec pen.mode:=pmNotXor guidé par ce tableau. C'est l'inconvénient des tracés effectués à la main (tremblante, ou hésitante) avec la souris, alors qu'en créant des objets "Droite", "Cercle", "Rectangle" l'utilisateur n'utilise la souris que pour positionner l'objet sur le Canvas et c'est le logiciel qui effectue le tracé sans trembler.

A+

[stfanny31]

merci Mr 'Gilbert Geyer' pour votre aide mais c'est pas cela que je voulé ,je voulé une ligne bien stable pas faite a la main
j'ai trouvé dans notre bibliothéque un bon livre de delphi7 que j'ai pris un énorme plaisir a lire et qui ma donné des idé pour avancé dans mon traville
j'ai lu et relu votre explication de déplacement mais y'a bcp de commantaire qui manque si vous pouvé l'écrire on plus explicite cela seré bien (merci d'avance)
et j'ai des idé a vous proposé pr réglé notre probléme de déplacement :
1- esque on pe pas utilisé une API pr réglé notre programme de déplacemment (comme si on déplacé une fenétre windws)
2-esque la méthode 'DragMode'pe nous aidé !!!j'ai trouvé un example sur le net mais je l'ai pas comprise
http://delphipage.free.fr/glissdepl.html
merci bcp Mr 'Gilbert Geyer' é a tt les monbre

[petitcoucou31]

hello stfanny31

Pour trace une ligne comme je pense que tu le voudrais , tu as un exemple dans la fac "http://mdelannoy.developpez.com/ligne/",
qui te permet de cliquer a un endroit, avoir l'autre extrémité de ta ligne au bout de ton curseur et enfin la terminer en cliquant ou tu veux.

Bye ..

[Gilbert Geyer]

Bonjour,

j'ai lu et relu votre explication de déplacement mais y'a bcp de commantaire qui manque si vous pouvé l'écrire on plus explicite cela seré bien (merci d'avance)

... je pourrais être plus explicite si tu me dis ce que tu n'as pas pigé dans mon explication.

et j'ai des idé a vous proposé pr réglé notre probléme de déplacement :
1- esque on pe pas utilisé une API pr réglé notre programme de déplacemment (comme si on déplacé une fenétre windws)
2-esque la méthode 'DragMode'pe nous aidé !!!j'ai trouvé un example sur le net mais je l'ai pas comprise
http://delphipage.free.fr/glissdepl.html

... non pour les deux questions. (Le Drag c'est fait pour glisser-déplacer par exemple un fichier depuis l'Explorateur de Windows vers une appli qui veut ulitiliser ce fichier).

Question 1: Est-ce-que tu veux uniquement tracer des lignes droites suivant le scénario suivant :
- on clique à un endroit et pendant qu'on déplace la souris il s'étire une ligne droite entre le point du click-de-MouseDown et la pointe du curseur-souris,
- et lorsqu'on lâche la souris la ligne droite reste tracée à son dernier emplacement ?

Question 2: Est-ce-que tu veux en plus qu'une ligne tracée comme ci-dessus puisse ensuite être agrippée à la souris pour être déplacée avec la souris dans un autre endroit du canvas ?

A+

[stfanny31]

merci beaucoup
vous avez tout compris
1-MouseDown :on commence à dessiner notre ligne
2-MouseMove:on voit le trait que l'on veut,une ligne droite et stable
3-MouseUp :on a notre ligne bien tracée

et puis je la prend et je la déplace dans ma fenêtre

Note:on peut avoir plusieurs lignes dans la fiche

merci pour toute votre attention

[Gilbert Geyer]

Salut,

Voiçi un bout de code qui permet de créer des lignes droites élastiques et déplaçables à la souris :

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
 
unit uLignes;
 
//     Tracer une ligne élastique et déplaçable par agrippage avec la souris
//     Utilisation :
//     - Pour créer une nouvelle ligne : Appui simultané de la touche Ctrl
//       et d'un bouton-souris au moins lors du MouseDown.
//     - Pour étirer une ligne existante : Agripper la ligne avec la souris
//       à moins de 15% d''une de ses extrémités et l''étirer.
//     - Pour la déplacer parallèlement à elle-même : l''agripper à plus de 15%
//       de ses extrémités.
//     (Les lignes ne comportent pas de poignées vu que le curseur-souris change
//      de forme lors du survol d'une ligne)
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, Math;
 
type
  TForm1 = class(TForm)
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormShow(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.DFM}
 
type TDroiteA = record // Droites avec attributs
                  visible : boolean;
                  xo,yo,                 // coordonnées d'origine
                  xe,ye : integer;       // coordonnées d'extrémité
                  incli : Extended;      // inclinaison radians
                  coulTrait : TColor;    // couleur du tracé
                  epTrait   : Integer;   // épaisseur du tracé
                  stylTrait : TPenStyle; // style du tracé si droite d'1 seul pixel
                end;
 
     TDroitesA = array of TDroiteA;
 
var  MesDroitesA  : TDroitesA;
     iDroiteSelectionnee,iBord : integer;
     rOrigine : Extended;
     pm : TPenMode;
 
procedure TraceDroiteA( C : tCanvas; D : TDroiteA; mode : TPenMode);
begin     with C do
          begin pen.width := D.epTrait;
                pen.mode  := mode;
                Pen.Color := D.coulTrait;
                pen.Style := D.stylTrait;
                moveto(D.xo, D.yo);
                lineto(D.xe, D.ye);
          end;
end;
 
function PointDansTronconDroiteA(xs,ys : integer; Droite : TDroiteA) : Extended;
//@param Result renvoie :
//       -1 : si le point xs,ys est en-dehors de la droite,
//       -maxInt : si ce point est pile celui d'une doite réduite à un point,
//       et si xs,ys est situé sur le tronçon de la droite, renvoie une valeur
//       comprise entre 0..1 et proportionnelle à l'éloignement de ce point
//       par rapport à l'origine de la droite.
var      a, b, miEp, lg : Extended; dx,dy,yc : integer; okx,oky : boolean;
begin    Result:=-1;
         miEp:=Droite.epTrait/2;
         dx:=Droite.xe - Droite.xo;
         dy:=Droite.ye - Droite.yo;
         if (dx=0) and (dy=0) then // Droite réduite à 1 seul point
         begin if (xs - miEp <=Droite.xo) and (Droite.xo <= xs + miEp)
               and (ys - miEp <=Droite.yo) and (Droite.yo <= ys + miEp)
               then Result:=-maxInt;
               EXIT;
         end;
         okx:=False; oky:=False;
         // okx et oky ne servent qu''à tester si le point-cible est situé entre
         // l'origine et l'extrémité du tronçon et non sur ses prolongements
         if ((dy<0) and (ys<=Droite.yo) and (ys>=Droite.ye))
         or ((dy>0) and (ys<=Droite.ye) and (ys>=Droite.yo)) then oky:=True;
         if ((dx>0) and (xs<=Droite.xe) and (xs>=Droite.xo))
         or ((dx<0) and (xs<=Droite.xo) and (xs>=Droite.xe)) then okx:=True;
 
         if (dx=0) then // Droite verticale
         begin if (xs - miEp <=Droite.xo) and (Droite.xo <= xs + miEp)
               and oky then Result:=(ys - Droite.yo)/dy;
               EXIT;
         end else
         if (dy=0) then // Droite horizontale
         begin if (ys - miEp <=Droite.yo) and (Droite.yo <= ys + miEp)
               and okx then Result:=(xs - Droite.xo)/dx;
               EXIT;
         end else // Droite inclinée "y = a.x + b"
         begin a:=dy/dx; // pente
               b:=Droite.yo - a*Droite.xo;
               yc:=round(a*xs + b);     // y-calculé(xs)
               lg:=sqrt(dx*dx + dy*dy); // longueur tronçon de droite
               miEp:=abs(miEp*lg/dx);   // projection de miEp sur la verticale yc-ys en xs
               if (yc + miEp >= ys) and (yc - miEp <= ys)
               and okx and oky then Result:=(xs - Droite.xo)/dx;
         end;
end; // PointDansTronconDroiteA(...
 
function  CreerNouvelleDroite( Po,Pe : TPoint; Coul : TColor; eTrait : integer;
                               styTrait : TPenStyle) : integer;
var       count,i : integer;
begin     count:=length(MesDroitesA); inc(count);
          SetLength(MesDroitesA,count);
          i:=count-1;
          with MesDroitesA[i] do
          begin xo:=Po.x; yo:=Po.y;
                xe:=Pe.x; ye:=Pe.y;
                if (xo-xe)<>0 then incli:=arctan2(ye - yo, xo-xe) // en Radians
                              else incli:=Pi/2;
                coulTrait:=Coul;
                epTrait:=eTrait; stylTrait:=styTrait;
          end;
          TraceDroiteA(Form1.Canvas, MesDroitesA[i], pm);
          MesDroitesA[i].visible:=true;
          Result:=i;
end;
 
// Utilisation :
 
procedure TForm1.FormShow(Sender: TObject);
begin     color:=clWhite; pm:=pmNotXor; //ou bien color:=clBlack; pm:=pmXor;
          setLength(MesDroitesA,0);
          iDroiteSelectionnee:=-1;
end;
 
var       xMp,yMp : integer;
 
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var       i : integer; P1,P2 : TPoint;
begin     iBord:=-1; rOrigine:=-10;
          //1 ) Droites
          i:=-1; iDroiteSelectionnee:=-1;
          if length(MesDroitesA)>0 then
          begin repeat inc(i);
                       if MesDroitesA[i].visible
                       then rOrigine:=PointDansTronconDroiteA(X,Y, MesDroitesA[i]);
                until (rOrigine>=0) or (i=High(MesDroitesA));
                // ici on quitte la boucle dès qu'on a détecté le tracé sur lequel on a cliqué
                if (rOrigine>=0) and (MesDroitesA[i].visible)
                then begin iDroiteSelectionnee:=i;
                           Screen.Cursor := crHandPoint;
                           xMp:=X; yMp:=Y;
                end;
          end;
          if iDroiteSelectionnee<0 then
          // on a cliqué à coté d'une droite préexistante, ou bien il n''en existe
          // aucune, donc on peut en créer une nouvelle mais avec appui simultané
          // de la Touche Ctrl et d'un bouton-souris
          begin if ssCtrl in Shift then
                begin P1.x:=X; P1.y:=Y; P2.x:=X; P2.y:=Y;
                      iDroiteSelectionnee:=CreerNouvelleDroite(P1,P2,clRed, 2, psSolid);
                      xMp:=X; yMp:=Y;
                end;
          end;
end;
 
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
var       i,dxs,dys : integer; Bmp : TBitMap;
          cl : TColor; scl : String; R,G,B : byte; Gomme : TRect;
begin     //1) Droites
          i:=iDroiteSelectionnee;
          if i>=0 then
          begin Screen.Cursor := crHandPoint;
                dxs:=X - xMp; dys:=Y - yMp;
                with MesDroitesA[i] do
                begin TraceDroiteA(Canvas, MesDroitesA[i], pm);
                      if rOrigine<=0.15 then // Etirage droite par agrippage près de l''origine
                      begin xo:=xo+dxs; yo:=yo+dys; end else
                      if rOrigine>=0.85 then // Etirage droite par agrippage près de l''extrémité
                      begin xe:=xe+dxs; ye:=ye+dys; end
                      else // Déplacement droite parallèlement à elle-même
                      begin xo:=xo+dxs; yo:=yo+dys; xe:=xe+dxs; ye:=ye+dys; end;
                      TraceDroiteA(Canvas, MesDroitesA[i], pm);
                end;
                xMp:=X; yMp:=Y;
          end else // Pas de droite sélectionnée : on détecte leur survol pour le changement de curseur
          begin if length(MesDroitesA)>0 then
                begin i:=-1;
                      repeat inc(i);
                             if MesDroitesA[i].visible
                             then rOrigine:=PointDansTronconDroiteA(X,Y, MesDroitesA[i]);
                      until (rOrigine>=0) or (i=High(MesDroitesA));
                      if rOrigine>=0 then Screen.Cursor := crHandPoint
                                     else Screen.Cursor := crDefault;
                end;
          end;
end;
 
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin     iDroiteSelectionnee:=-1;
          Screen.Cursor := crDefault;
end;
 
end.

... ici le tracé s'effectue en mode pmNotXor directement sur le canvas de la Form de couleur blanche mais c'est facilement modifiable pour effectuer les tracés sur le canvas d'un TImage placé sur la Form.

A+

[stfanny31]

salut
merci beaucoup Mr :Gilbert Geyer vous m'avez beaucoup aidé
et merci beaucoup à vous Mr:petitcoucou31 la page dont vous m'avez si bien envoyé le lien est
il me reste le problème de déplacement si vous pouviez m'aider cela serait très gentil, j'ai fait des recherche et j'ai trouvé un truc :
http://www.phidels.com/php/index.php...zip.php3&id=46
j'ai bien compris le principe mais cela ne marche pas ?
pour tout vous dire je n'ai pas compris à quoi sert cette instruction :

program Pdraw;
uses
Forms,
Udraw in 'Udraw.pas' {Form1};

{$R *.RES}

begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

c'est une méthode pour déplacer un rectangle mais si elle marche je pense que je pourrais l'utiliser pour ma ligne
si vous pouviez me dire qu'es ce qui cloche!!
merci encore

[Gilbert Geyer]

Salut,

il me reste le probléme de déplacement si vous pouvé m'aidé

... quel problème de déplacement vu que le code que j'ai posté Hier 13h18 permet d'effectuer le déplacement d'une ligne en l'agrippant à la souris à plus de 15% des extrémités et c'est dit explicitement en commentaire au début du code ?

a quoi sére c'est instruction :

Citation:
program Pdraw;
uses
Forms,
Udraw in 'Udraw.pas' {Form1};

{$R *.RES}

begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

c'est une méthode pr déplacer un rectangle mais si elle marche je pence que je pourais l'utiliser pr ma ligne

... les instructions de cette citation servent uniquement à initialiser le lancement du programme et ne sont pas une méthode pour déplacer un rectangle.

A+

[stfanny31]

salut Mr:Gilbert Geyer
oups j'ai pas bien compris votre code
mais je suis déçu ,j'ai bien l'intention de déplacer cette ligne
mais quant vous dite un bout cela veut dire quoi
il n'est pas complet !!
déjà que comme il est difficile, alors si vous me donnez un bout..........
j'ai quelques questions :
1-est ce que vous pouvez m'expliquer comme cela marche pen.mode??
le help delphi n'explique pas vraiment comment cela marche
2-pourquoi vous faite

if (xs - miEp <=Droite.xo) and (Droite.xo <= xs + miEp)

c'est pas la même chose?

Note :je comprend la difficulté que avez mes prof à lire mes programmes de 1000lignes avec 10boucle et 10else chevauchés
c'est plus facile de crée un programme que de comprendre un qui n'est pas a soi
merci encore

[Gilbert Geyer]

Salut,

mais je ss decu ,j'ai bien l'intention de déplacer c'est ligne
mais quant vous dite un bout cela ve dire quoi
il n'est pas complet !!

... je n'ai nulle part parlé de "bout" et qu'est-ce qui n'est pas "complet" puisque le code permet de déplacer les lignes ... prière de dire clairement ce qu'est le problème.

1-esque vous pouvé m'expliqué comme cela marche pen.mode??
le help delphi n'explique pas vrément comment cela marche

... pen.mode s'utilise pour dire à Delphi comment doit fonctionner le pen (crayon). Par exemple lorsqu'on on fait :
- pen.color:=maCouleur et pen.mode:=pmCopy le tracé qu'on fait avec s'effectue avec la couleur maCouleur quelle que soit la couleur de l'écran,
- pen.color:=maCouleur et pen.mode:=pmNotCopy le tracé s'effectue avec la couleur inverse de maCouleur quelle que soit la couleur de l'écran,
- pen.color:=maCouleur et pen.mode:=pmMergePenNot le tracé s'effectue dans une couleur qui est une combinaison de maCouleur et l'inverse de la couleur de l'écran à l'mplacement du tracé,
- etc, il y a ainsi 16 modes possibles pour pen.mode.

Avec pen.mode:=pmNotXor et un écran blanc (utilisé dans le code) lorsqu'on trace la ligne la première fois le tracé s'effectue avec pen.color=maCouleur ... et lorsqu'on re-trace la même ligne par-dessus la première toujours avec pen.mode:=pmNotXor le tracé s'effectue en blanc et du blanc sur un écran blanc revient à effacer la ligne.... Donc pour déplacer une ligne on commence par l'effacer d'abord ainsi puis on la retrace en visible juste à côté en fonction du Delta-X et du Delta-Y (dxs et dys dans le code du MouseMove) provenant du déplacement de la souris. Pigé ?

2-pourquoi vous faite

Citation:
if (xs - miEp <=Droite.xo) and (Droite.xo <= xs + miEp)

c'est pas la méme chose?

... non ce n'est pas la même chose puisque ça s'écrit également if (Droite.xo >= xs-miEp) and (Droite.xo <= xs + miEp) et ça permet de vérifier dans le cas d'une droite verticale si "xs" qui correspond à la position de la souris se trouve ou ne se trouve pas quelque part à l'intérieur du tracé à plus ou moins la valeur de miEp qui est la moitié de l'épaisseur du trait (ça facilite la visée avec la souris lorsque le trait a une épaisseur supérieure à 1 pixel).

c'est plus facil de crée un programme que de comprendre un qui n'est pas a soi

... absolument d'accord ... mais quand on pose une question sur un forum faut s'attendre à recevoir du code qui n'est pas de soi.

A+

[stfanny31]

salut Mr Gilbert Geyer
merci pour votre explication
mais dites moi ,
j'ai voulu exécuter votre code
mais a je vois rien ,
il n'y a qu'une fenêtre blanche ,rien ne se dessine
pourquoi ?

merci encore

[Gilbert Geyer]

Salut,

j voulu excuter votre code
mais a je vois rien ,
y'a que une fenétre blache ,rien ne ce décine
pourkoi ?

... ça ne dessine que si on lui commande de dessiner une ligne comme expliqué tout au début du code :

// - Pour créer une nouvelle ligne : Appui simultané de la touche Ctrl
et d'un bouton-souris au moins lors du MouseDown.
// - Pour étirer une ligne existante : Agripper la ligne avec la souris
// à moins de 15% d''une de ses extrémités et l''étirer.
// - Pour la déplacer parallèlement à elle-même : l''agripper à plus de 15%
// de ses extrémités.
// (Les lignes ne comportent pas de poignées vu que le curseur-souris change
// de forme lors du survol d'une ligne)

A+