Sujet Précédent Sujet Suivant

Problème de scintillement malgré le DoubleBuffered

Résolu
Utilisateur anonyme - 6 déc. 2007 à 10:14
 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

15 réponses

Réponse 1 / 15
cs_Kenavo Messages postés 702 Date d'inscription vendredi 21 mars 2003 Statut Membre Dernière intervention 1 octobre 2009 5
6 déc. 2007 à 19:44
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 !
<
3
Réponse 2 / 15
Cirec Messages postés 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
6 déc. 2007 à 20:52
Regarde ceci pour mieux comprendre la différence entre Invalidate et Repaint

 
@+
Cirec

<hr siz="" />
3
Réponse 3 / 15
cs_Kenavo Messages postés 702 Date d'inscription vendredi 21 mars 2003 Statut Membre Dernière intervention 1 octobre 2009 5
7 déc. 2007 à 18:30
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 !
3
Réponse 4 / 15
Cirec Messages postés 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
6 déc. 2007 à 10:55
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="" />
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 15
Utilisateur anonyme
6 déc. 2007 à 11:24
Salut,

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

Merci
0
Réponse 6 / 15
Cirec Messages postés 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
6 déc. 2007 à 11:37
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="" />
0
Réponse 7 / 15
Utilisateur anonyme
6 déc. 2007 à 13:36
Ah tu as raison : Apres modification ca scintille toujours .

C'est un truc de malade lol.

Merci.
0
Réponse 8 / 15
cs_MAURICIO Messages postés 2106 Date d'inscription mardi 10 décembre 2002 Statut Modérateur Dernière intervention 15 décembre 2014 5
6 déc. 2007 à 19:01
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+
0
Réponse 9 / 15
Cirec Messages postés 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
6 déc. 2007 à 19:10
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="" />
0
Réponse 10 / 15
Utilisateur anonyme
6 déc. 2007 à 19:39
Merci à vous
0
Réponse 11 / 15
cs_Kenavo Messages postés 702 Date d'inscription vendredi 21 mars 2003 Statut Membre Dernière intervention 1 octobre 2009 5
6 déc. 2007 à 19:42
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 !
0
Réponse 12 / 15
Utilisateur anonyme
6 déc. 2007 à 19:57
Merci à tous les 3.

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

Discussions similaires

Parametre de ShellExecute
armetiz -
armetiz -

28 réponses
Fonction Pos().
Becracker -
ni69 -

7 réponses
Convertir un png en jpeg Delphi XE
l0lwut -
l0lwut -

5 réponses
Décompiler un EXE Delphi
guy jeuniaux -
Oniria -

6 réponses
StringReplace ?
finipe -
finipe -

2 réponses
Rejoignez-nous