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

Utilisateur anonyme - 6 déc. 2007 à 10:14 - Dernière réponse :  Utilisateur anonyme
- 9 déc. 2007 à 02:31
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
Afficher la suite 

Votre réponse

15 réponses

Meilleure réponse
cs_Kenavo 759 Messages postés vendredi 21 mars 2003Date d'inscription 1 octobre 2009 Dernière intervention - 6 déc. 2007 à 19:44
3
Merci
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 !
<

Merci cs_Kenavo 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 94 internautes ce mois-ci

Commenter la réponse de cs_Kenavo
Meilleure réponse
Cirec 4231 Messages postés vendredi 23 juillet 2004Date d'inscription 3 août 2018 Dernière intervention - 6 déc. 2007 à 20:52
3
Merci
Regarde ceci pour mieux comprendre la différence entre Invalidate et Repaint

 
@+
Cirec

<hr siz="" />

Merci Cirec 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 94 internautes ce mois-ci

Commenter la réponse de Cirec
Meilleure réponse
cs_Kenavo 759 Messages postés vendredi 21 mars 2003Date d'inscription 1 octobre 2009 Dernière intervention - 7 déc. 2007 à 18:30
3
Merci
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 !

Merci cs_Kenavo 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 94 internautes ce mois-ci

Commenter la réponse de cs_Kenavo
Cirec 4231 Messages postés vendredi 23 juillet 2004Date d'inscription 3 août 2018 Dernière intervention - 6 déc. 2007 à 10:55
0
Merci
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="" />
Commenter la réponse de Cirec
Utilisateur anonyme - 6 déc. 2007 à 11:24
0
Merci
Salut,

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

Merci
Commenter la réponse de Utilisateur anonyme
Cirec 4231 Messages postés vendredi 23 juillet 2004Date d'inscription 3 août 2018 Dernière intervention - 6 déc. 2007 à 11:37
0
Merci
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="" />
Commenter la réponse de Cirec
Utilisateur anonyme - 6 déc. 2007 à 13:36
0
Merci
Ah tu as raison : Apres modification ca scintille toujours .

C'est un truc de malade lol.

Merci.
Commenter la réponse de Utilisateur anonyme
cs_MAURICIO 2233 Messages postés mardi 10 décembre 2002Date d'inscription 15 décembre 2014 Dernière intervention - 6 déc. 2007 à 19:01
0
Merci
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+
Commenter la réponse de cs_MAURICIO
Cirec 4231 Messages postés vendredi 23 juillet 2004Date d'inscription 3 août 2018 Dernière intervention - 6 déc. 2007 à 19:10
0
Merci
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="" />
Commenter la réponse de Cirec
Commenter la réponse de Utilisateur anonyme
cs_Kenavo 759 Messages postés vendredi 21 mars 2003Date d'inscription 1 octobre 2009 Dernière intervention - 6 déc. 2007 à 19:42
0
Merci
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 !
Commenter la réponse de cs_Kenavo
Utilisateur anonyme - 6 déc. 2007 à 19:57
0
Merci
Merci à tous les 3.

Kenavo tu pourrais m'en dire un petit peu plus sur ce phénomène ?
Commenter la réponse de Utilisateur anonyme
Commenter la réponse de Utilisateur anonyme
Utilisateur anonyme - 7 déc. 2007 à 20:27
0
Merci
Merci pour les explications
Commenter la réponse de Utilisateur anonyme
Utilisateur anonyme - 9 déc. 2007 à 02:31
0
Merci
Hey les gars oubliez pas c'est bientot l'anniv de Delphiprog
Commenter la réponse de Utilisateur anonyme

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.