[VCL][D6]Tracé de lignes ds un PaintBox

Version imprimable

Bonjour à tous,

voilà j'ai un problème j'écris un programme pour tracer une ligne en maintenant le bouton de la souris enfonce et en la déplacant. j'utilise une procédure qui efface le PaintBox à chaque mouvement avec bouton enfoncé pour éviter de faire des miliers de lignes. Le problème, c'est que quand je fais une ligne ca va mais qd j'en fait une autre, la précédente est effacé ce qui est normal mais je sais pas comment faire pour pouvoir en tracer plusieurs sans quelles soient effacées. :(

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;
 
type
  TDessinForm = class(TForm)
    PaintBox1: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
var
  DessinForm: TDessinForm;
  Enfonce : Boolean;
  DepartPosition, FinPosition: TPoint;
 
implementation
 
{$R *.dfm}
 
procedure TDessinForm.FormCreate(Sender: TObject);
begin
  Enfonce:=false;
end;
 
procedure TDessinForm.PaintBox1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Enfonce:=true;
  DepartPosition.X:=X;
  DepartPosition.Y:=Y;
end;
 
procedure TDessinForm.PaintBox1MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
  procedure ViderCanvas;
  begin
    PaintBox1.Canvas.Brush.Color:=RGB(255,255,255);
    PaintBox1.Canvas.FillRect(Canvas.ClipRect);
  end;
begin
  if (Enfonce) then
  begin
    ViderCanvas;
    PaintBox1.Canvas.MoveTo(DepartPosition.X, DepartPosition.Y);
    PaintBox1.Canvas.LineTo(X, Y);
  end;
end;
 
procedure TDessinForm.PaintBox1MouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Enfonce:=false;
end;
 
end.

Si vous avez une alternative, je suis ouvert à toute propositions :mrgreen:

Merci d'avance

Salut,

Conserve les cordonnées de te précédentes lignes dans un tableau.
Ca pourrait donner un truc dans ce genre:

Code:

1
2
TableauLigne : array of array of TPoint
nbreLigne:integer

.....

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
procedure TDessinForm.PaintBox1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Enfonce:=true;
  DepartPosition.X:=X;
  DepartPosition.Y:=Y;
  nbreLigne = nbreLigne+1;
  setlength(tableauLigne,2,nbreLigne)
  tableauLigne(0,nbreLigne-1)=DepartPosition
end;
 
procedure TDessinForm.PaintBox1MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var pointFinal:Tpoint
begin
  if (Enfonce) then
  begin
    ViderCanvas;
    pointFinal.X=X;
    pointFinal.Y=Y;
    tableauLigne(1,nbreLigne-1)=PointFinal;
 
For i=0 to length (tableauLigne) do
begin
    PaintBox1.Canvas.MoveTo(tableauLigne[0][i].X, tableauLigne[0][i].Y);
    PaintBox1.Canvas.LineTo(tableauLigne[1][i].X,tableauLigne[1][i].Y);
end;
  end;
end;

@+.

Jai ce code là en te basant sur ce que t'a fait mais C pas bon, je résultat est tout pas bo. pouvez m'aidez ??? :arf:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
unit UWindowLine;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;
 
type
  TCoordLigne = record
    Depart, Fin : TPoint;
  end;
  TDessinForm = class(TForm)
    PaintBox1: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
var
  DessinForm: TDessinForm;
  Enfonce : Boolean;
  DepartPosition: TPoint;
 
  TableauLignes : array of TCoordLigne;
  NombreLigne:Integer;
 
implementation
 
{$R *.dfm}
 
procedure TDessinForm.FormCreate(Sender: TObject);
begin
  Enfonce:=false;
  NombreLigne:=0;
end;
 
procedure TDessinForm.PaintBox1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Enfonce:=true;
  DepartPosition.X:=X;
  DepartPosition.Y:=Y;
 
  Inc(NombreLigne);
  SetLength(TableauLignes, NombreLigne);
  TableauLignes[NombreLigne].Depart:=DepartPosition;
end;
 
procedure TDessinForm.PaintBox1MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
  procedure ViderCanvas;
  var
    Index: Integer;
  begin
    PaintBox1.Canvas.Brush.Color:=RGB(255,255,255);
    PaintBox1.Canvas.FillRect(Canvas.ClipRect);
    for Index:=0 to Length(TableauLignes) do
    begin
      PaintBox1.Canvas.MoveTo(TableauLignes[NombreLigne-1].Depart.X,
                              TableauLignes[NombreLigne-1].Depart.Y);
      PaintBox1.Canvas.LineTo(TableauLignes[NombreLigne-1].Fin.X,
                              TableauLignes[NombreLigne-1].Fin.Y);
    end;
  end;
  var
    FinPosition: TPoint;
begin
  if (Enfonce) then
  begin
    ViderCanvas;
    PaintBox1.Canvas.MoveTo(DepartPosition.X, DepartPosition.Y);
    PaintBox1.Canvas.LineTo(X, Y);
 
    TableauLignes[NombreLigne-1].Depart:=DepartPosition;
    TableauLignes[NombreLigne-1].Fin:=FinPosition;
 
  end;
end;
 
procedure TDessinForm.PaintBox1MouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Enfonce:=false;
end;
 
end.

Ou alors j'ai fait ce code mais ca règle pas lep roblème de la ligne superflu
dans le coin gauche haut je sais pas pourquoi elle est là

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
unit UWindowLine;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;
 
type
  TCoordLigne = record
    Depart, Fin : TPoint;
  end;
  TDessinForm = class(TForm)
    PaintBox1: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
var
  DessinForm: TDessinForm;
  Enfonce : Boolean;
  DepartPosition: TPoint;
 
  TableauLignes : array of TCoordLigne;
  NombreLigne:Integer;
 
implementation
 
{$R *.dfm}
 
procedure TDessinForm.FormCreate(Sender: TObject);
begin
  Enfonce:=false;
  NombreLigne:=0;
end;
 
procedure TDessinForm.PaintBox1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Enfonce:=true;
  DepartPosition.X:=X;
  DepartPosition.Y:=Y;
 
  Inc(NombreLigne);
  SetLength(TableauLignes, NombreLigne);
  TableauLignes[NombreLigne-1].Depart:=DepartPosition;
end;
 
procedure TDessinForm.PaintBox1MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
  procedure ViderCanvas;
  var
    Index: Integer;
  begin
    PaintBox1.Canvas.Brush.Color:=RGB(255,255,255);
    PaintBox1.Canvas.FillRect(Canvas.ClipRect);
    for Index:=0 to Length(TableauLignes) do
    begin
      PaintBox1.Canvas.MoveTo(TableauLignes[Index].Depart.X,
                              TableauLignes[Index].Depart.Y);
      PaintBox1.Canvas.LineTo(TableauLignes[Index].Fin.X,
                              TableauLignes[Index].Fin.Y)
    end;
  end;
  var
    FinPosition: TPoint;
begin
  if (Enfonce) then
  begin
    ViderCanvas;
    PaintBox1.Canvas.MoveTo(DepartPosition.X, DepartPosition.Y);
    PaintBox1.Canvas.LineTo(X, Y);
  end;
end;
 
procedure TDessinForm.PaintBox1MouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  TableauLignes[NombreLigne-1].Fin.X:=X;
  TableauLignes[NombreLigne-1].Fin.Y:=Y;
  Enfonce:=false;
end;
 
end.

Si vous avez des idées.

Salut

Essaie comme ça

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
procedure TForm1.PaintBox1MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
  procedure ViderCanvas;
  var
    Index: Integer;
  begin
    PaintBox1.Canvas.Brush.Color:=RGB(255,255,255);
    PaintBox1.Canvas.FillRect(Canvas.ClipRect);
    for Index:=0 to Length(TableauLignes)-2 do
    begin
      //showmessage(inttostr(index)+' '+inttostr(TableauLignes[Index].Depart.y));
      PaintBox1.Canvas.MoveTo(TableauLignes[Index].Depart.X,
                              TableauLignes[Index].Depart.Y);
      PaintBox1.Canvas.LineTo(TableauLignes[Index].Fin.X,
                              TableauLignes[Index].Fin.Y)
    end;
  end;
  var
    FinPosition: TPoint;
begin
  if (Enfonce) then
  begin
    ViderCanvas;
    PaintBox1.Canvas.MoveTo(DepartPosition.X, DepartPosition.Y);
    PaintBox1.Canvas.LineTo(X, Y);
  end;
end;

fin.x et fin.y de la ligne en cours lors du mousemove ne sont pas encore déterminés. Ils le seront lors du mouseup. Ces valeurs sont par défaut à zéro ;)

05/12/2006, 19h45
edam

autre solu , remplace painbox par Timage (pas bon non??? :lol: )