Problème de scintillement malgré le DoubleBuffered [Résolu]

Signaler
-
 Utilisateur anonyme -
Salut à tous,

Voila je suis entrain de développer un composant de type potentiomètre. Tout fonctionne enfin presque . Ca scintille à mort et quand je met un doublebuffered ca change rien.

Je vous lache le code :

unit Potentio;

interface

uses
  SysUtils, Classes,Controls, Forms, Graphics,Messages,Windows, ExtCtrls,dialogs,Math;
  
type
  TPotentio = class(TGraphicControl)
  private
    fCanvas: TControlCanvas;
    fBorderColor:TColor;
    fButtonColor:TColor;
    fStickColor:TColor;
    fMin : Integer;
    fMax : Integer;
    fPos:Integer;
    fDelta:Extended;
    Procedure SetMin(Value:Integer);
    Procedure SetMax(Value:Integer);
    Procedure SetPos(Value:Integer);
    Procedure SetButtonColor(Value:TColor);
    Procedure SetStickColor(Value:TColor);
    Procedure SetBorderColor(Value:TColor);
    procedure Paint(var Message: TWMPaint); message WM_PAINT;
    Procedure Resize; Override;
    procedure MouseDown(Button: TMouseButton;Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
    procedure MouseUp(Button: TMouseButton;Shift: TShiftState; X, Y: Integer); override;   
  protected
  public
   constructor Create(AOwner:TComponent); override;
   destructor Destroy; override;
  published
    Property ButtonColor : TColor Read fButtonColor Write SetButtonColor;
    Property StickColor : TColor Read fStickColor Write SetStickColor;
    Property BorderColor : TColor Read fBorderColor Write SetBorderColor;
    Property Min : Integer Read fMin Write SetMin Default 0;
    Property Max : Integer Read fMax Write SetMax Default 100;
    Property Pos : Integer Read fPos Write SetPos Default 10;
    property OnDblClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;   
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('MUSIC_PRO', [TPotentio]);
end;

Procedure TPotentio.SetStickColor(Value:TColor);
Begin
  fStickColor:=Value;
  Self.Repaint;
End;

Procedure TPotentio.SetButtonColor(Value:TColor);
Begin
  fButtonColor:=Value;
  Self.Repaint;
End;

Procedure TPotentio.SetBorderColor(Value:TColor);
Begin
  fBorderColor:=Value;
  Self.Repaint;
End;

Procedure TPotentio.Resize;
Begin
  Self.Height:=Self.Width;
  Self.Repaint;
End;

Procedure TPotentio.SetMin(Value:Integer);
Begin
  If (Value<fMax) and (Value<=fPos) Then
  fMin:=Value;
  fDelta:=(270*(fMin-fPos)/(fMin-fMax)-45)*PI/180;
  Self.Repaint;
End;

Procedure TPotentio.SetMax(Value:Integer);
Begin
  If (Value>fMin) and (Value>=fPos) Then
  fMax:=Value;
  fDelta:=(270*(fMin-fPos)/(fMin-fMax)-45)*PI/180;
  fPos:=Round(fMin-(fMin-fMax)*((180*fDelta/PI)+45)/270);
  Self.Repaint;
End;

Procedure TPotentio.SetPos(Value:Integer);
Begin
  If (Value<=fMin) Then fPos:=fMin;
  If (Value>=fMax) Then fPos:=FMax;
  fPos:=Value;
  fDelta:=(270*(fMin-fPos)/(fMin-fMax)-45)*PI/180;
  fPos:=Round(fMin-(fMin-fMax)*((180*fDelta/PI)+45)/270);
  Self.Repaint;
End;

constructor TPotentio.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  Parent := TWinControl(AOwner);
  fcanvas:=TControlCanvas.Create;
  fCanvas.Control:=Self;
  fMin:=0;
  fMax:=100;
  fPos:=0;
  Self.fButtonColor:=$002E2E2E;
  Self.fBorderColor:=$004B4B4B;
  Self.fStickColor:=ClWhite;
end;

Procedure TPotentio.Paint(var Message: TWMPaint);
var
  Rect:TRect;
  R:Extended;
  Index:Integer;
begin
  if not assigned(Parent) then exit;
  with fCanvas Do
  begin
    Brush.Color := self.Color;
    Brush.Style := bsSolid;
    FillRect(Self.ClientRect);
    control:=self;
    Brush.Style:=BsSolid;
    Pen.Width:=1;

    Pen.Color:=ClBlack;
    Brush.Color:=fBorderColor;
    With Rect Do
      Begin
        Left:=(Self.Width Div 7);
        Right:=(6*Self.Width Div 7);
        Top:=(Self.Height Div 7);
        Bottom:=(6*Self.Height Div 7);
      End;
    Ellipse(Rect);

    Brush.Color:=fButtonColor;
    With Rect Do
      Begin
        Left:=Round(2*Self.Width / 7);
        Right:=Round(5*Self.Width / 7);
        Top:=Round(2*Self.Height / 7);
        Bottom:=Round(5*Self.Height / 7);
      End;
    Ellipse(Rect);

    Pen.Color:=Self.fStickColor;
    Brush.Color:=Self.fStickColor;
    For Index:=-1 To 5 Do
      Begin
        R:=Round(2*Self.Width / 7);
        Rect.Left:=Round(Self.Width Div 2-Round(R*Cos((45*Index)*PI/180))-Self.Width/25);
        REct.Top:=Round(Self.Width Div 2-R*Sin((45*Index)*PI/180)-Self.Width/25);
        Rect.Right:=Round(Rect.Left+2*Self.Width/25);
        Rect.Bottom:=Round(Rect.Top+2*Self.Width/25);
        Ellipse(Rect);
      End;

    R:=(3*Width DIV 14);
      With Rect Do
        Begin
          MoveTo(Width Div 2, Height Div 2);
          LineTo(Self.Width Div 2-Round(R*Cos(fDelta)),Round(Self.Width Div 2-R*Sin(fDelta)));
        End;
     Refresh;
  end;
end;

destructor TPotentio.Destroy;
begin
  FreeAndNil(fCanvas);
  inherited;
end;

procedure TPotentio.MouseDown(Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
Var
 I : Extended;
Begin
  Inherited;
  If Shift=[SSLeft] Then
    Begin
      If X<>Self.Width Div 2 Then
        Begin
          I:=(Y-Self.Width Div 2)/(X-Self.Width Div 2);
          fDelta:=ArcTan(I);
          If x>Self.Width Div 2 Then fDelta:=FDelta+PI;
          If fDelta>=(225*PI/180) then fDelta:=(225*PI/180);
          If fDelta<=(-45*PI/180) then fDelta:=(-45*PI/180);
          fPos:=Round(fMin+(fMax-fMin)*(fDelta*180/PI+45) / 270);
          Self.Repaint;
        End;
    End;
End;

procedure TPotentio.MouseMove(Shift: TShiftState; X,Y: Integer);
Var
 I : Extended;
Begin
  Inherited;
  If Shift=[SSLeft] Then
    Begin
      If X<>Self.Width Div 2 Then
        Begin
          I:=(Y-Self.Width Div 2)/(X-Self.Width Div 2);
          fDelta:=ArcTan(I);
          If x>Self.Width Div 2 Then fDelta:=FDelta+PI;
          If fDelta>=(225*PI/180) then fDelta:=(225*PI/180);
          If fDelta<=(-45*PI/180) then fDelta:=(-45*PI/180);
          fPos:=Round(fMin+(fMax-fMin)*(fDelta*180/PI+45) / 270);
          Self.Repaint;
        End;
    End;
End;

procedure TPotentio.MouseUp(Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
Begin
  Inherited;
End;

end.

Si il y en a un qui me dit qu'il y a trop de refresh par seconde, il se prend une fessée directe

15 réponses

Messages postés
702
Date d'inscription
vendredi 21 mars 2003
Statut
Membre
Dernière intervention
1 octobre 2009
3
Tiens, je suis bon ! juste un copier coller :



unit potentio;

interface

uses
  SysUtils, Classes,Controls, Forms, Graphics,Messages,Windows, ExtCtrls,dialogs,Math;
 
type
  TPotentio = class(TCustomControl)
  private
    fBorderColor:TColor;
    fButtonColor:TColor;
    fStickColor:TColor;
    fMin : Integer;
    fMax : Integer;
    fPos:Integer;
    fDelta:Extended;
    Procedure SetMin(Value:Integer);
    Procedure SetMax(Value:Integer);
    Procedure SetPos(Value:Integer);
    Procedure SetButtonColor(Value:TColor);
    Procedure SetStickColor(Value:TColor);
    Procedure SetBorderColor(Value:TColor);
//    procedure Paint(var Message: TWMPaint);//message WM_PAINT;
    procedure Paint; override; //message WM_PAINT;
    Procedure Resize; Override;
    procedure MouseDown(Button: TMouseButton;Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
    procedure MouseUp(Button: TMouseButton;Shift: TShiftState; X, Y: Integer); override;  
  protected
  public
   constructor Create(AOwner:TComponent); override;
   destructor Destroy; override;
  published
    Property ButtonColor : TColor Read fButtonColor Write SetButtonColor;
    Property StickColor : TColor Read fStickColor Write SetStickColor;
    Property BorderColor : TColor Read fBorderColor Write SetBorderColor;
    Property Min : Integer Read fMin Write SetMin Default 0;
    Property Max : Integer Read fMax Write SetMax Default 100;
    Property Pos : Integer Read fPos Write SetPos Default 10;
    property OnDblClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;  
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('MUSIC_PRO', [TPotentio]);
end;

Procedure TPotentio.SetStickColor(Value:TColor);
Begin
  if fStickColor=Value then exit;
  fStickColor:=Value;
  Self.Repaint;
End;

Procedure TPotentio.SetButtonColor(Value:TColor);
Begin
  if fButtonColor=Value then exit;
  fButtonColor:=Value;
  Self.Repaint;
End;

Procedure TPotentio.SetBorderColor(Value:TColor);
Begin
  if fBorderColor=Value then exit;
  fBorderColor:=Value;
  Self.Repaint;
End;

Procedure TPotentio.Resize;
Begin
  Self.Height:=Self.Width;
  Self.Repaint;
End;

Procedure TPotentio.SetMin(Value:Integer);
Begin
  If (Value<fMax) and (Value<=fPos) Then
  fMin:=Value;
  fDelta:=(270*(fMin-fPos)/(fMin-fMax)-45)*PI/180;
  Self.Repaint;
End;

Procedure TPotentio.SetMax(Value:Integer);
Begin
  If (Value>fMin) and (Value>=fPos) Then
  fMax:=Value;
  fDelta:=(270*(fMin-fPos)/(fMin-fMax)-45)*PI/180;
  fPos:=Round(fMin-(fMin-fMax)*((180*fDelta/PI)+45)/270);
  Self.Repaint;
End;

Procedure TPotentio.SetPos(Value:Integer);
Begin
  If (Value<=fMin) Then fPos:=fMin;
  If (Value>=fMax) Then fPos:=FMax;
  fPos:=Value;
  fDelta:=(270*(fMin-fPos)/(fMin-fMax)-45)*PI/180;
  fPos:=Round(fMin-(fMin-fMax)*((180*fDelta/PI)+45)/270);
  Self.Repaint;
End;

constructor TPotentio.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  Parent := TWinControl(AOwner);
  fMin:=0;
  fMax:=100;
  fPos:=0;
  Self.fButtonColor:=$002E2E2E;
  Self.fBorderColor:=$004B4B4B;
  Self.fStickColor:=ClWhite;
  doublebuffered  := True;
end;

Procedure TPotentio.Paint;
var
  Rect:TRect;
  R:Extended;
  Index:Integer;
begin
  if not assigned(Parent) then exit;
  with Canvas Do
  begin
    Brush.Color := self.Color;
    Brush.Style := bsSolid;
    FillRect(Self.ClientRect);
//    control:=self;
    Brush.Style:=BsSolid;
    Pen.Width:=1;

    Pen.Color:=ClBlack;
    Brush.Color:=fBorderColor;
    With Rect Do
      Begin
        Left:=(Self.Width Div 7);
        Right:=(6*Self.Width Div 7);
        Top:=(Self.Height Div 7);
        Bottom:=(6*Self.Height Div 7);
      End;
    Ellipse(Rect);

    Brush.Color:=fButtonColor;
    With Rect Do
      Begin
        Left:=Round(2*Self.Width / 7);
        Right:=Round(5*Self.Width / 7);
        Top:=Round(2*Self.Height / 7);
        Bottom:=Round(5*Self.Height / 7);
      End;
    Ellipse(Rect);

    Pen.Color:=Self.fStickColor;
    Brush.Color:=Self.fStickColor;
    For Index:=-1 To 5 Do
      Begin
        R:=Round(2*Self.Width / 7);
        Rect.Left:=Round(Self.Width Div 2-Round(R*Cos((45*Index)*PI/180))-Self.Width/25);
        REct.Top:=Round(Self.Width Div 2-R*Sin((45*Index)*PI/180)-Self.Width/25);
        Rect.Right:=Round(Rect.Left+2*Self.Width/25);
        Rect.Bottom:=Round(Rect.Top+2*Self.Width/25);
        Ellipse(Rect);
      End;

    R:=(3*Width DIV 14);
      With Rect Do
        Begin
          MoveTo(Width Div 2, Height Div 2);
          LineTo(Self.Width Div 2-Round(R*Cos(fDelta)),Round(Self.Width Div 2-R*Sin(fDelta)));
        End;
  end;
end;

destructor TPotentio.Destroy;
begin
  inherited;
end;

procedure TPotentio.MouseDown(Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
Var
 I : Extended;
Begin
  Inherited;
  If Shift=[SSLeft] Then
    Begin
      If X<>Self.Width Div 2 Then
        Begin
          I:=(Y-Self.Width Div 2)/(X-Self.Width Div 2);
          fDelta:=ArcTan(I);
          If x>Self.Width Div 2 Then fDelta:=FDelta+PI;
          If fDelta>=(225*PI/180) then fDelta:=(225*PI/180);
          If fDelta<=(-45*PI/180) then fDelta:=(-45*PI/180);
          fPos:=Round(fMin+(fMax-fMin)*(fDelta*180/PI+45) / 270);
          Self.Repaint;
        End;
    End;
End;

procedure TPotentio.MouseMove(Shift: TShiftState; X,Y: Integer);
Var
 I : Extended;
Begin
  Inherited;
  If Shift=[SSLeft] Then
    Begin
      If X<>Self.Width Div 2 Then
        Begin
          I:=(Y-Self.Width Div 2)/(X-Self.Width Div 2);
          fDelta:=ArcTan(I);
          If x>Self.Width Div 2 Then fDelta:=FDelta+PI;
          If fDelta>=(225*PI/180) then fDelta:=(225*PI/180);
          If fDelta<=(-45*PI/180) then fDelta:=(-45*PI/180);
          fPos:=Round(fMin+(fMax-fMin)*(fDelta*180/PI+45) / 270);
          Self.Repaint;
        End;
    End;
End;

procedure TPotentio.MouseUp(Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
Begin
  Inherited;
End;

end.








Ken@vo








Code, Code, Codec !
<
Messages postés
3818
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
18 septembre 2020
34
Regarde ceci pour mieux comprendre la différence entre Invalidate et Repaint

 
@+
Cirec

<hr siz="" />
Messages postés
702
Date d'inscription
vendredi 21 mars 2003
Statut
Membre
Dernière intervention
1 octobre 2009
3
Francky,

Pour ce que j'ai compris de la différence entre TGraphicControl et TCustomControl, c'est que ce dernier est fenêtré. C'est à dire qu'il dérive de TWinControl.
Ce qui lui donne, outre une certaine lourdeur qu'il ne doit pas à un abus de Kinder-suicide, des fonctions et comportements d'une fenêtre. C'est là qu'il peut, tout seul, profiter de la propriété DoubleBuffered ou gérer le clavier.

Il est toutefois possible, avec un TGraphicControl, d'obtenir un affichage fluide en faisant ainsi :

- Dessiner dans le canvas d'un bitmap
- Copier le bitmap dans le canvas du controle
- Mettre la propriété DoubleBuffered de la fiche à vrai

La procédure Paint est déclarée ainsi (voire Aide : rubrique "Dessin de l'image du composant"):   
 procedure Paint; override;

et peut être écrite ainsi :
procedure TPotentio.Paint;
var
  Rect: TRect;
  R: Extended;
  Index: Integer;
  Bitmap: TBitmap;  // déclaration d'un TBitmap pour le dessin
begin
  if not assigned(Parent) then
    exit;
  // création du bitmap
  Bitmap := TBitmap.Create;
  Bitmap.Width := Width;
  Bitmap.Height := Height;
  //utilisation du canvas du bitmap pour dessiner
  with Bitmap.Canvas do
  begin
    Brush.Color : = self.Color;
    Brush.Style := bsSolid;
    FillRect(Self.ClientRect);
//    control:=self; 
    Brush.Style : = BsSolid;
    Pen.Width := 1;
    //....
    // code pour dessiner sur le canvas du bitmap
    //....  
  end ;
  Canvas.Draw(0, 0, Bitmap);   // copie dans le canvas du controle
  Bitmap.Free  // Libération du Bitmap
end;

Voilà !

Ken@vo



<hr size ="2" width="100%" />



Code, Code, Codec !
Messages postés
3818
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
18 septembre 2020
34
Salut,

pour commencer je retirerai dans le OnPaint le Refresh (il n'a rien à faire ici) il y a des chances que ce soit lui qui mette l'affichage en boucle.

Et Remplace aussi tous les Self.Repaint par Invalidate

Et teste à nouveau

 
@+
Cirec

<hr siz="" />

Salut,

Je viens de tester mais ca change rien :  ca scintille toujours.

Merci
Messages postés
3818
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
18 septembre 2020
34
J'ai vu autre chose qui me "choque" dans ta conception

pourquoi avoir recrée un Canvas alors que GraphicControl en possède un ?

Ensuite il en va de même pour la procedure Paint elle existe aussi il fallait juste faire :
  protected
    { Déclarations protégées }
    Procedure Paint; Override;

 
@+
Cirec

<hr siz="" />

Ah tu as raison : Apres modification ca scintille toujours .

C'est un truc de malade lol.

Merci.
Messages postés
2106
Date d'inscription
mardi 10 décembre 2002
Statut
Modérateur
Dernière intervention
15 décembre 2014
5
Salut Francky,

je me suis penché 2 secondes sur ton code (je verrai mieux demain)
mais quelques chose a appelé mon attention:      Refresh; dans le Paint du compo !!!

A+
Messages postés
3818
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
18 septembre 2020
34
Salut Mauricio,

ça faisait longtemps ...

"mais quelques chose a appelé mon attention:      Refresh; dans le Paint du compo !!!"
Déjà signalé et corrigé ... mais ne résoud pas le problème

 
@+
Cirec

<hr siz="" />

Merci à vous
Messages postés
702
Date d'inscription
vendredi 21 mars 2003
Statut
Membre
Dernière intervention
1 octobre 2009
3
Salut Francky

Le DoubleBuffered doit être défini au niveau du composant. J'avais remarqué ça en écrivant des composants comme TGraphXY.

Je te propose une solution.

1 - Faire hériter ton compo de TCustomControl
    TPotentio = class(TCustomControl)


2 - Ajouter DoubleBuffered dans le constructeur Create

    DoubleBuffered  := True;


3 - Définir la procédure Paint ainsi :
    procedure Paint; override;

Après, ça gaze !




Ken@vo








Code, Code, Codec !

Merci à tous les 3.

Kenavo tu pourrais m'en dire un petit peu plus sur ce phénomène ?

Merci

Merci pour les explications

Hey les gars oubliez pas c'est bientot l'anniv de Delphiprog