Problème de délai dans l'événement OnPaint

**mtloper** · 03/02/2008, 01h23

Salut,

J'ai un probleme avec le paint event de TPaintBox.
Premierement lorsque je maximise ou j'appel la procedure refresh du paintbox tous va bien, le paint se fait normalement

Le probleme est lorsqu'il y a une autre fenetre devant mon PaintBox et que je click sur la surface de mon PaintBox alors le event paint est appeler mais il garde des trace indesirable !!! La meme chose se produit lorsque je ferme une application qui se trouve devant.

La seul facon que j'ai trouve pour resoudre le probleme a ete de demarrer un timer a toute les fois qu'un event paint etait declancher

Mais y-a-t-il une methode plus armonieuse ?

Voici mon code

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
 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls ;
 
type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    Panel1: TPanel;
    Memo1: TMemo;
    bRefresh: TButton;
    bOnPaint: TButton;
    Timer1: TTimer;
    bDessin: TButton;
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure PaintBox1Paint(Sender: TObject);
    procedure PaintBox1MouseLeave(Sender: TObject);
    procedure PaintBox1MouseEnter(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure bRefreshClick(Sender: TObject);
    procedure bOnPaintClick(Sender: TObject);
    procedure bDessinClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    procedure Clear;
    procedure CrossCursor(X, Y: Integer);
    procedure Log(S: String);
    procedure Dessin;
  public
    Lx,Ly:integer;
    CrossCursorEnable: Boolean;
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.bOnPaintClick(Sender: TObject);
begin
  PaintBox1Paint(sender);
end;
 
procedure TForm1.bRefreshClick(Sender: TObject);
begin
  paintbox1.Refresh;
end;
 
procedure TForm1.bDessinClick(Sender: TObject);
begin
  with paintbox1.Canvas do begin
    pen.Mode:=pmCopy;
    pen.Color:= clred;
    moveto(30,50);LineTo(paintbox1.width-100,paintbox1.Height-50);
  end;
end;
 
Procedure TForm1.Clear;
Begin
  with PaintBox1.canvas do begin
    Pen.mode:=pmCopy;
    brush.Style := bssolid;
    brush.color:=clWhite;
    pen.color:=clwhite;
    rectangle(0,0,paintbox1.width,paintbox1.height);
  end;
End;
 
Procedure TForm1.CrossCursor(X,Y:Integer);
Begin
 If CrossCursorEnable then begin
  with paintbox1.Canvas do begin
    pen.Mode:=pmnotxor;
    pen.Color:= clblack;
 
    moveto(0,LY);LineTo(paintbox1.width,Ly);
    moveto(Lx,0);LineTo(Lx,paintbox1.Height);
 
    moveto(0,Y);LineTo(paintbox1.width,y);
    moveto(X,0);LineTo(x,paintbox1.Height);
  end;
  Lx:=x;
  Ly:=Y;
 end;
End;
 
Procedure TForm1.Dessin;            //Dessin bidon pour fin de test
Begin
  with paintbox1.Canvas do begin
    pen.Mode:=pmCopy;
    pen.Color:= clblue;
    moveto(0,0);LineTo(paintbox1.width,paintbox1.Height);
    moveto(paintbox1.width,0);LineTo(0,paintbox1.Height);
  end;
End;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  CrossCursorEnable:=true;
end;
 
Procedure TForm1.Log(S:String);
Begin
  Memo1.lines.add(FormatDateTime('HH:NN:SS:ZZZ',now) + ',' + s);
End;
 
procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  CrossCursor(-10,-10);
  //...code
  log('MouseDown');
  CrossCursor(x,y);
end;
 
procedure TForm1.PaintBox1MouseEnter(Sender: TObject);
begin
  Log('MouseEnter');
  CrossCursor(-10,-10);
end;
 
procedure TForm1.PaintBox1MouseLeave(Sender: TObject);
begin
  Log('MouseLeave');
  CrossCursor(-10,-10);
end;
 
procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
begin
  Log('MouseMove');
  caption := inttostr(x)+','+inttostr(y);
  CrossCursor(x,y);
end;
 
procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  CrossCursor(-10,-10);
    //...
  log('MouseUp');
  CrossCursor(x,y);
end;
 
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
 
  Log('Paint');
  Timer1.Enabled := true;   //  <--S'EST ICI QUE DEVRAIT REDESSINER
  Timer1.Interval := 1;       //  <-- AU LIEU JE DOIT APPELER UN TIMER POUR  
                                      //<--  POUR QU'IL LE FASSE.
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
 
Timer1.Enabled := false;
Timer1.Interval := 0;
  Log('Paint dans timer');
  Clear;                   //Efface l'espace de travail
  Dessin;                  //<-dessin bidon pour fin de test
  lx:=-10;ly:=-10;
end;

end.

**DarkChamallo** · 18/02/2008, 17h44

est-ce que DoubleBuffer ne serait pas une piste ?

**ShaiLeTroll** · 18/02/2008, 18h37

Si tu veux que ton dessin soit permanent, utilise un TImage, par contre, cela sera plus lent à chaque modification du dessin ...

Moi, j'ai fait ceci dans mon PaintBox, et j'ai aucune trace génante ...

Code :

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

1
2
3
4
procedure TFrmTestDivers.PaintBoxPaintToPaint(Sender: TObject);
begin
  Application.MainForm.PaintTo(PaintBoxPaintTo.Canvas.Handle, 0, 0);
end;

Mais ensuite, j'ai compliqué l'affaire, et effectivement, il a bcp plus de mal a tout afficher correctement

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
procedure TFrmTestDivers.PaintBoxPaintToPaint(Sender: TObject);
var
  X, Y: Integer;
begin
  Application.MainForm.PaintTo(PaintBoxPaintTo.Canvas.Handle, 0, 0);
  PaintBoxPaintTo.Canvas.Pen.Color := clRed;
  X := 0;
  Y := 0;
  PaintBoxPaintTo.Canvas.MoveTo(X, Y);
  X := PaintBoxPaintTo.Width;
  Y := PaintBoxPaintTo.Height;
  PaintBoxPaintTo.Canvas.LineTo(X, Y);
  X := RandomRange(0, PaintBoxPaintTo.Width);
  Y := RandomRange(0, PaintBoxPaintTo.Height);
  PaintBoxPaintTo.Canvas.MoveTo(X, Y);
  X := RandomRange(0, PaintBoxPaintTo.Width);
  Y := RandomRange(0, PaintBoxPaintTo.Height);
  PaintBoxPaintTo.Canvas.LineTo(X, Y);
end;

En fait, la ligne diagonale s'affiche très bien, mais les aléatoires et bien il laisse effectivement des traces alors que PaintTo devrait tout effacer ... et j'ai testé avec DoubleBuffered aussi

**LadyWasky** · 19/02/2008, 11h51

rhoooolala...

Attend voir un peu.

Je réécris ce que j'ai déjà écris ici :
http://www.developpez.net/forums/sho...2&postcount=22

Envoyé par waskol

DUCROS s'est déjà décarcassé à expliquer tout ça en long en large et en travers sur le forum.

Donc, tu cherches sur le forum :
Mot-clé : TPaintBox
Auteur : Waskol
Rubrique du forum : Delphi

Si tu ne trouve rien, c'est vraiment parce que tu as mal cherché

Bon courage hombre.

En résumé :
- Avec ton TPaintBox, il te faut un TBitmap. Tu le crées dans le OnCreate de ta fiche, tu lui donne les dimensions de la PaintBox, et tu le détruit dans le OnDestroy de la fiche.

- Pour mettre à jour ton dessin, tu écris une procédure pour ça dans laquelle
a) tu dessines dans le bitmap
b) tu appelle PaintBox1.Repaint;

- Dans le OnPaint du TPaintBox tu dessine le contenu du bitmap sur la paintbox

Ce qui donne le schéma suivant :

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
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;
 
type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
  private
    { Déclarations privées }
    TonBitmap:TBitmap;
  public
    { Déclarations publiques }
    Procedure MiseAJourDessin;
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  TonBitmap:=TBitmap.Create;
  TonBitmap.Width:=PaintBox1.ClientWidth;
  TonBitmap.Height:=PaintBox1.ClientHeight;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  TonBitmap.Free;
end;
 
procedure TForm1.MiseAJourDessin;
begin
  //Dessin dans le canvas du bitmap
  TonBitmap.Canvas.Draw();
  //Appel du OnPaint de la PaintBox
  PaintBox1.Repaint;
end;
 
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  PaintBox1.Canvas.Draw(0,0,TonBitmap);
end;
 
end.

Ca va l'faire ?

Donc appliqué à ton programme, ça devrait donner ceci :

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
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls ;
 
type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    Panel1: TPanel;
    Memo1: TMemo;
    bRefresh: TButton;
    bOnPaint: TButton;
    bDessin: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure PaintBox1Paint(Sender: TObject);
    procedure PaintBox1MouseLeave(Sender: TObject);
    procedure PaintBox1MouseEnter(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure bRefreshClick(Sender: TObject);
    procedure bOnPaintClick(Sender: TObject);
    procedure bDessinClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    TonBitmap:TBitmap;
    procedure Clear;
    procedure CrossCursor(X, Y: Integer);
    procedure Log(S: String);
    procedure Dessin;
  public
    Lx,Ly:integer;
    CrossCursorEnable: Boolean;
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  TonBitmap:=TBitmap.Create;
  TonBitmap.Width:=PaintBox1.ClientWidth;
  TonBitmap.Height:=PaintBox1.ClientHeight;
  DoubleBuffered:=true;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  TonBitmap.Free;
end;
 
procedure TForm1.bOnPaintClick(Sender: TObject);
begin
  PaintBox1.RePaint;
end;
 
procedure TForm1.bRefreshClick(Sender: TObject);
begin
  paintbox1.Refresh;
end;
 
procedure TForm1.bDessinClick(Sender: TObject);
begin
  with TonBitmap.Canvas do begin
    pen.Mode:=pmCopy;
    pen.Color:= clred;
    moveto(30,50);LineTo(TonBitmap.width-100,TonBitmap.Height-50);
  end;
  PaintBox1.Repaint;
end;
 
Procedure TForm1.Clear;
Begin
  with TonBitmap.canvas do begin
    Pen.mode:=pmCopy;
    brush.Style := bssolid;
    brush.color:=clWhite;
    pen.color:=clwhite;
    rectangle(0,0,TonBitmap.width,TonBitmap.height);
  end;
  PaintBox1.Repaint;
End;
 
Procedure TForm1.CrossCursor(X,Y:Integer);
Begin
 If CrossCursorEnable then begin
  with TonBitmap.Canvas do begin
    pen.Mode:=pmnotxor;
    pen.Color:= clblack;
 
    moveto(0,LY);LineTo(paintbox1.width,Ly);
    moveto(Lx,0);LineTo(Lx,paintbox1.Height);
 
    moveto(0,Y);LineTo(paintbox1.width,y);
    moveto(X,0);LineTo(x,paintbox1.Height);
  end;
  Lx:=x;
  Ly:=Y;
  PaintBox1.Repaint;
 end;
End;
 
Procedure TForm1.Dessin;            //Dessin bidon pour fin de test
Begin
  with TonBitmap.Canvas do begin
    pen.Mode:=pmCopy;
    pen.Color:= clblue;
    moveto(0,0);LineTo(TonBitmap.width,TonBitmap.Height);
    moveto(TonBitmap.width,0);LineTo(0,TonBitmap.Height);
  end;
  PaintBox1.Repaint;
End;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  CrossCursorEnable:=true;
end;
 
Procedure TForm1.Log(S:String);
Begin
  Memo1.lines.add(FormatDateTime('HH:NN:SS:ZZZ',now) + ',' + s);
End;
 
procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  CrossCursor(-10,-10);
  //...code
  log('MouseDown');
  CrossCursor(x,y);
end;
 
procedure TForm1.PaintBox1MouseEnter(Sender: TObject);
begin
  Log('MouseEnter');
  CrossCursor(-10,-10);
end;
 
procedure TForm1.PaintBox1MouseLeave(Sender: TObject);
begin
  Log('MouseLeave');
  CrossCursor(-10,-10);
end;
 
procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
begin
  Log('MouseMove');
  caption := inttostr(x)+','+inttostr(y);
  CrossCursor(x,y);
end;
 
procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  CrossCursor(-10,-10);
    //...
  log('MouseUp');
  CrossCursor(x,y);
end;
 
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  Log('Paint');
  PaintBox1.Canvas.Draw(0,0,TonBitmap);   
end;
 
end.

(J'ai viré le timer)

Comme j'ai pas Delphi sous la main, je n'ai pas pu tester, mais essaies...

**ShaiLeTroll** · 19/02/2008, 17h26

Euh, finalement, c'est un PaintBox avec Buffer donc plus très loin du TImage, en fait, du coup plus aucun intérêt de faire un TPaintBox (vérifier perf entre TImage et TPaintBox tous les deux utiliser en buffer, le TImage via Picture.Assign et le TPaintBox via Canvas.Draw) ... en fait ce qu'il manque c'est une sorte de BeginUpdate et EndUpdate sur le TImage, car lui dès que l'on modifie le bitmap\Picture, il se rafraichi, c'est ce qui coute en performance, le PaintBox ne le fait qu'à la demande ... et qui j'y pense, je n'ai jamais utilisé de PaintBox mais des TImage qui recoivent via un Bitmap généré par un Thread\OnIdle ou un Timer représentant en Temps Réel les états d'une machine ...

Problème de délai dans l'événement OnPaint

Composants VCL Delphi

Discussions similaires

Partager

Partager