Discussion :

[Charly910]

Bonjour,

j'essaye de dessiner un rectangle de sélection sur une image contenant un Bmp (le Timage est dans un TPanel). Le problème c'est que j'ai un très gros Flickering dans le mousemove. J'ai essayer de mettre Doublebuffered à True pour la fenêtre sans succès. Pour un autre projet de trackbar, j'avais aussi ce problème et Andornor m'avais indiqué d'utiliser WMERASEBKGND. Mais ça ne marche pas ici !

j'ai refait un projet minimal (l'image bitmap est dans le dfm) :

TestWinScan.zip

et pour ceux qui ne veulent par ouvrir le zip, je mets aussi le code de la fenêtre :

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
unit Princ;
 
{   Test de scintillement  }
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Dialogs, ExtCtrls, StdCtrls ;
 
type
  TF_Princ = class(TForm)
    PnlTop: TPanel;
    ImgPanel: TPanel;
    ImgHolder: TImage;
    Btn_Afficher: TButton;
    OpenDialog1: TOpenDialog;
    procedure FormCreate(Sender: TObject);
    procedure TraceCacheRecSel1(Can : TCanvas; xoSel,yoSel,xeSel,yeSel : Integer );
    procedure ImgHolderMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ImgHolderMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure ImgHolderMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Btn_AfficherClick(Sender: TObject);
 
    procedure WMERASEBKGND(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
{ ==================================================================== }
  private
  protected
  public
end;
 
var
  F_Princ : TF_Princ;
  AnchorX, AnchorY,
  CurX, CurY : Integer;
  Bounding : Boolean;
 
  X0Pix, Y0Pix, X1Pix, Y1Pix : Integer ;
  X0cm, Y0cm, X1cm, Y1cm : Extended ;
 
  CadreVisible : Boolean ;
 
  xoSel, yoSel, xeSel, yeSel : integer; // Coordonn es d'origine et d'extr mit  du rectangle de s lection
  SelVisible, FinSel : boolean;       // Suivi de l' volution de la s lection
 
  Coef : Extended ;
  epTrait : integer;
  clTrait : TColor ;
 
implementation
 
Uses   TypInfo ;
{$R *.dfm}
 
{ ==================================================================== }
procedure TF_Princ.WMERASEBKGND(var Message: TWMEraseBkgnd);
begin
  Message.Result := 1;
end;      
{ ==================================================================== }
procedure TF_Princ.FormCreate(Sender: TObject);
begin
//  F_Princ.DoubleBuffered := True ;
  epTrait := 3 ;
  clTrait := clRed ;
  xoSel := -1 ;
  FinSel := True ;
  SelVisible := False ;
end;
{ ========================================================================== }
procedure TF_Princ.TraceCacheRecSel1(Can : TCanvas; xoSel,yoSel,xeSel,yeSel : Integer );
//        Trace le motif de s lection lors d'un 1er appel, et l'efface lors
//        de l'appel suivant avec les m mes param tres
Var
  XX, YY : Integer ;
  XX1, YY1 : Integer ;
begin
  // Correction pour Stretch de l'image
  Coef  := ImgHolder.Picture.Bitmap.Height / ImgHolder.Height ;
  XX :=  Round(xoSel*Coef) ;
  YY :=  Round(yoSel*Coef) ;
  XX1 :=  Round(xeSel*Coef) ;
  YY1 :=  Round(yeSel*Coef) ;
  Can.pen.mode  := pmNotXor;
  Can.pen.width := epTrait;
  Can.pen.color := clTrait;
  Can.Rectangle(XX,YY,XX1,YY1); // s lection Rectangulaire
end;
{ ====================================================================== }
procedure TF_Princ.ImgHolderMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if FinSel and SelVisible then // Effacement d'une s lection pr  xistante par click
    begin
      TraceCacheRecSel1(ImgHolder.Canvas, xoSel,yoSel,xeSel,yeSel);
      SelVisible:=False;
      FinSel:=False;
      xoSel:=-1;
      Exit;
    end;
  FinSel:=False;
  xoSel:=X;
  yoSel:=Y;
end;
{ ====================================================================== }
procedure TF_Princ.ImgHolderMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
 if (xoSel>=0) and (Not FinSel) then
   begin
     if SelVisible Then // alors on l'efface avant de la re-tracer dans la nouvelle position
       TraceCacheRecSel1(ImgHolder.Canvas, xoSel,yoSel,xeSel,yeSel);
     xeSel:=X;
     yeSel:=Y;
     TraceCacheRecSel1(ImgHolder.Canvas, xoSel,yoSel,xeSel,yeSel);
     SelVisible:=true;
   end;
end;
{ ====================================================================== }
procedure TF_Princ.ImgHolderMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FinSel:=True; // Fin de s lection
end;
{ ====================================================================== }
procedure TF_Princ.Btn_AfficherClick(Sender: TObject);
// Affichage de l'image
begin
  If OpenDialog1.Execute Then
    Begin
      ImgHolder.Picture.LoadFromFile(Opendialog1.Filename);
      epTrait := ImgHolder.Picture.Bitmap.width  div 140 ;
    End ;
end;
{ ====================================================================== }
 
End.

Sauriez vous comment éviter ou limiter ce scintillement ?

Merci
A+
Charly

[Andnotor]

Un rectangle de sélection est généralement fait à l'aide de DrawFocusRect.

C'est une fonction XOR, tu l'appelles une première fois pour dessiner et une deuxième fois avec les mêmes coordonnées pour effacer.
De plus ça évite de se poser la question quelle couleur est la plus adaptée puisque XOR = inverse vidéo, le trait est toujours visible.

[Charly910]

Merci Andornot, j'avais pris cet exemple sur le net, je vais remplacer par DrawFocusRect

A+
Charly

[Charly910]

Bonjour Andnotor,
J'ai essayé, mais le trait est peu visible : très fin et pointillés très espacés. D'autre part, j'ai toujours le scintillement !

Est ce que je ne devrais pas envoyer le WMERASEBKGND au TPanel (ou au TImage) plutot qu'à la Form ?

A+
Charly

[Charly910]

J'ai fait un test en mettant l'image directement sur la form, au lieu de la mettre dans un TPanel. Miracle, je n'ai plus de scintillement !

ça m'ennuie un peu, car j'aurais bien aimé conservé mon Panel pour marquer l'emplacement de l'image, comme un cadre.

Pourquoi ce scintillement avec le Panel ?

A+
Charly

[Charly910]

Par contre si j'enlève la procédure WMERASEBKGND j'ai à nouveau le scintillement.

Si je la laisse, quand je redimensionne la fenêtre à la souris, les parties agrandies ne se redessinent pas et apparaissent en noir !

Je suis donc un peu coincé, sauf à mettre Borderstyle en bsDialog

A+
Charly

[Charly910]

Bon, j'ai enlevé la procedure WMERASEBKGND et rajouté DoubleBuffered à True et tout se passe bien, plus de scintillement.

Mais j'aurai bien aimé conserver mon TPanel. Si quelqu'un a une solution ...

A+
Charly