• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 537
  • Last Modified:

Getting rid of the flickering

I am using a descendent of TSpeedButton which adds gradient.  I added a OnMouseEnter and OnMouseLeave to it so that the bevel appears when the mouse enters and disapears when it leaves.  When moving the mouse around fast enough, this creates some flickering.  How can I get rid of that ?


Component:

unit Gradbtn;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, Buttons, ExtCtrls;

type

  TGradBtn = class(TSpeedButton)
  private
    { Private Declarations }
    BackGround: TBitmap;
    fGradColor: TColor; {clBlue}
    fFaceColor: TColor; {clBlack}
    fHighlightColor: TColor; {clWhite}
    fBottomColor: TColor; {clBlack}
    fBevWidth: integer;   {1}
    fRectWidth: integer;  {1}
    FOnMouseEnter: TNotifyEvent;  //Make the Mouse Enter and Leave available
    FOnMouseLeave: TNotifyEvent;
    procedure GradFill(Clr1, Clr2: TColor; TheBitmap: TBitmap);
    procedure SetGradColor(AColor: TColor);
    procedure SetFaceColor(AColor: TColor);
    procedure SetHighlightColor(AColor: TColor);
    procedure SetBottomColor(AColor: TColor);
    procedure SetBevWidth(ANumber: integer);
    procedure SetRectWidth(ANumber: integer);
  protected
    { Protected Declarations }
    procedure CMMouseEnter(var Msg:TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Msg:TMessage); message CM_MOUSELEAVE;
    procedure Paint; override;
    destructor Destroy;
  public
    { Public Declarations }
    constructor Create(AOwner: TComponent); override;
  published
    { Published Declarations }
    property GradColor: TColor read fGradcolor
     write SetGradColor default clBlue;
    property FaceColor: TColor read fFacecolor
     write SetFaceColor default clBlack;
    property HighlightColor: TColor read fHighlightColor
     write SetHighlightColor default clWhite;
    property ShadowColor: TColor read fBottomColor
     write SetBottomColor default clBlack;
    property BevelWidth: integer read fBevWidth
     write SetBevWidth default 1;
    property BorderWidth: integer read fRectWidth
     write SetRectWidth default 1;
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter
        write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave
        write FOnMouseLeave;
  end;

procedure Register;

implementation

{The "Set..." procedures redraw the button after a property is changed}
procedure TGradBtn.SetGradColor(AColor: TColor);
begin
    if AColor <> fGradcolor then begin
        fGradColor:= AColor;
        GradFill(fGradColor, fFaceColor, BackGround);
        Paint;
    end;
end;

procedure TGradBtn.SetFaceColor(AColor: TColor);
begin
    if AColor <> fFacecolor then begin
        fFaceColor:= AColor;
        GradFill(fGradColor, fFaceColor, BackGround);
        Paint;
    end;
end;

procedure TGradBtn.SetHighlightColor(AColor: TColor);
begin
    if AColor <> fHighlightcolor then begin
        fHighlightColor:= AColor;
        Paint;
    end;
end;

procedure TGradBtn.SetBottomColor(AColor: TColor);
begin
    if AColor <> fBottomcolor then begin
        fBottomColor:= AColor;
        Paint;
    end;
end;

procedure TGradBtn.SetBevWidth(ANumber: integer);
begin
    if ANumber <> fBevWidth then begin
        fBevWidth:= ANumber;
        Paint;
    end;
end;

procedure TGradBtn.SetRectWidth(ANumber: integer);
begin
    if ANumber <> fRectWidth then begin
        fRectWidth:= ANumber;
        Paint;
    end;
end;

{This procedure draws the gradient colors onto the bitmap}
procedure TGradBtn.GradFill(Clr1, Clr2: TColor; TheBitmap: TBitmap);
var
  RGBFrom: array[0..2] of Byte;    { from RGB values                     }
  RGBDiff: array[0..2] of integer; { difference of from/to RGB values    }
  ColorBand: TRect;                  { color band rectangular coordinates  }
  I: Integer;                { color band index                    }
  R: Byte;                   { a color band's R value              }
  G: Byte;                   { a color band's G value              }
  B: Byte;                   { a color band's B value              }
begin
   { extract from RGB values}
   RGBFrom[0] := GetRValue(ColorToRGB(Clr1));
   RGBFrom[1] := GetGValue(ColorToRGB(Clr1));
   RGBFrom[2] := GetBValue(ColorToRGB(Clr1));
   { calculate difference of from and to RGB values}
   RGBDiff[0] := GetRValue(ColorToRGB(Clr2)) - RGBFrom[0];
   RGBDiff[1] := GetGValue(ColorToRGB(Clr2)) - RGBFrom[1];
   RGBDiff[2] := GetBValue(ColorToRGB(Clr2)) - RGBFrom[2];
   { set pen sytle and mode}
   TheBitmap.Canvas.Pen.Style:= psSolid;
   TheBitmap.Canvas.Pen.Mode:= pmCopy;
   { set color band's left and right coordinates}
   ColorBand.Top:= 0;
   ColorBand.Bottom := Height;
   for I := 0 to 255 do
   begin
       { calculate color band's top and bottom coordinates}
       ColorBand.Left:= MulDiv (I, TheBitmap.Width, 256);
       ColorBand.Right:= MulDiv (I + 1, TheBitmap.Width, 256);
       { calculate color band color}
       R := RGBFrom[0] + MulDiv(I, RGBDiff[0], $ff);
       G := RGBFrom[1] + MulDiv(I, RGBDiff[1], $ff);
       B := RGBFrom[2] + MulDiv(I, RGBDiff[2], $ff);
       { select brush and paint color band}
       TheBitmap.Canvas.Brush.Color := RGB(R, G, B);
       TheBitmap.Canvas.FillRect(ColorBand);
   end;
end;

{This procedure draws the button onto the form}
procedure TGradBtn.Paint;
var
  x, y, W, H: integer;
  R, InnerRect: TRect;
begin
   {Get button's total rectangle area}
   R:=ClientRect;
   {Get the part we'll draw the gradient color to.  It's the total rectangle }
   {area minus the border width                                              }
   with InnerRect do begin
      Top:=R.Top + fRectWidth;
      Left:=R.Left + fRectWidth;
      Right:=R.Right - fRectWidth;
      Bottom:=R.Bottom - fRectWidth;
   end;
   {Set the font}
   canvas.font.assign(font);
   {Get coordinates for centering the caption onto the button}
   x:=(width - canvas.textwidth(caption)) div 2;
   y:=(height - canvas.textheight(caption)) div 2;
   {Test to see if the size has changed.  If so, we need to redraw }
   {the gradient colors onto the background bitmap.  If not, we    }
   {won't redraw because doing it is slow...                       }
   W:=Width - (2 * fRectWidth);
   H:=Height - (2 * fRectWidth);
   if (W <> BackGround.Width) or (H <> BackGround.Height) then begin
       BackGround.Width:= W;
       BackGround.Height:= H;
       GradFill(fGradColor, fFaceColor, BackGround);
   end;
   {We draw the button differently depending on if it is pressed or not}
   if fState = bsDown then with canvas do begin
      {If button is pressed...}
      Brush.Color:=clBlack;        {Set border color}
      FillRect(R);                 {Draw border     }
      Brush.Color:=fFaceColor;     {Set face color  }
      {Draw the gradient colors, but offset to simulate that the button}
      {is pressed }
      Draw(fRectWidth + 1, fRectWidth + 1, BackGround);
      Frame3D(Canvas, InnerRect, fBottomColor, fFaceColor, fBevWidth);
                                   {Draw a 3D frame like a normal button, but pressed}
      SetBKMode(canvas.handle, 1);
                                   {Set transparency mode for text output}
      Textout(x + 1, y + 1, caption);   {Draw the caption }
   end
   else with canvas do begin
      {If button not pressed...}
      Brush.Color:=clBlack;
      FillRect(R);
      Brush.Color:=fFaceColor;
      Draw(fRectWidth, fRectWidth, BackGround);
      Frame3D(Canvas, InnerRect, fHighlightColor, fBottomcolor, fBevWidth);
      SetBKMode(canvas.handle, 1);
      textout(x,y,caption);
   end;
   {Reset the background mode}
   SetBKMode(canvas.handle,2);
end;

{Create the button}
constructor TGradBtn.Create(AOwner: TComponent);
begin
   {Get all methods of ancestor (TSpeedButton) }
   inherited Create(AOwner);
   ControlStyle := ControlStyle + [csOpaque];
   {Set the default properties.  This is the way the button appears     }
   {when you first place it on a form or create it at runtime.  You can }
   {change these if you don't like the default properties!              }
   Width:=100;
   Height:=30;
   fGradColor:= clBlue;
   fFaceColor:= clBlack;
   fHighlightColor:= clWhite;
   fBottomColor:= clBlack;
   fBevWidth:= 1;
   fRectWidth:= 1;
   {Create the background bitmap.  It is freed in the "destroy" procedure}
   BackGround:=TBitmap.Create;
   BackGround.Width:=Width;
   BackGround.Height:=Height;
   {Draw the gradient colors to the background bitmap for future painting}
   GradFill(fGradColor, fFaceColor, BackGround);
   Font.Color:=clWhite;
   Caption:='TGradBtn';
end;

destructor TGradBtn.Destroy;
begin
  inherited;
   {Free the bitmap because Windows can't do it on it's own...}
   Background.Free;
end;

procedure TGradBtn.CMMouseEnter(var Msg:TMessage);
begin
  inherited;
  if Assigned (FOnMouseEnter) then FOnMouseEnter(Self);
end;

procedure TGradBtn.CMMouseLeave(var Msg:TMessage);
begin
  inherited;
  if Assigned (FonMouseLeave) then FOnMouseLeave(Self);
end;

procedure Register;
begin
   {Write component to Component Palette if installing}
   RegisterComponents('Samples', [TGradBtn]);
end;

end.
0
moonrise
Asked:
moonrise
1 Solution
 
viktornetCommented:
In the Paint() procedure try to enter "Invalidate;" right before the end like this

   textout(x,y,caption);
      end;
      {Reset the background mode}
      SetBKMode(canvas.handle,2);
     Invalidate;
   end;

Try that and if it still flickers then let me know...

Regards,
Viktor Ivanov
0
 
viktornetCommented:
One more thing! You might wanna try this....
  type
    TGradBtn = class(TSpeedButton)
    protected
      procedure WMEraseBkgnd(var Message: WMEraseBkgnd);
                message WM_ERASEBKGND;
    end;
  procedure  TGradBtn.WMEraseBkgnd(var Message: TWMEraseBkgnd);
  begin
    Message.Result := 0
  end;
----------------
I think this will solve your problem but I'm not sure, so try it and see what happens... Talk to you later :)

Regards,
Viktor Ivanov
0
 
viktornetCommented:
uhhh, I have a mistake over there...
this -> protected
         procedure WMEraseBkgnd(var Message: WMEraseBkgnd); //I've missed the T
                   message WM_ERASEBKGND;
       end;
is supose to be like this->protected
         procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); //Now it's corrected
                   message WM_ERASEBKGND;
       end;
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
moonriseAuthor Commented:
Thank you for your response. I tried both suggestions:

The one with the invalidate just makes it flicker all the time.

The second one (procedure WMEraseBkgnd(var Message: WMEraseBkgnd)) does not seem to make a difference.
0
 
viktornetCommented:
oh, well, I'm sure there is a way to do that... It's just that I don't know of it,,,, If you get any suggestions to fix this please let me know..thanx

Regards,
Viktor Ivanov
0
 
erajojCommented:
Here's a patch that uses another intermediate bitmap.
It could use improvements but it doesn't flicker, at least not on my machine:

unit Gradbtn;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, Buttons, ExtCtrls;

type

  TGradBtn = class(TSpeedButton)
  private
    { Private Declarations }
    BackGround, Intermediary: TBitmap; // <<<<
    fGradColor: TColor; {clBlue}
    fFaceColor: TColor; {clBlack}
    fHighlightColor: TColor; {clWhite}
    fBottomColor: TColor; {clBlack}
    fBevWidth: integer;   {1}
    fRectWidth: integer;  {1}
    FOnMouseEnter: TNotifyEvent;  //Make the Mouse Enter and Leave available
    FOnMouseLeave: TNotifyEvent;
    procedure GradFill(Clr1, Clr2: TColor; TheBitmap: TBitmap);
    procedure SetGradColor(AColor: TColor);
    procedure SetFaceColor(AColor: TColor);
    procedure SetHighlightColor(AColor: TColor);
    procedure SetBottomColor(AColor: TColor);
    procedure SetBevWidth(ANumber: integer);
    procedure SetRectWidth(ANumber: integer);
  protected
    { Protected Declarations }
    procedure CMMouseEnter(var Msg:TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Msg:TMessage); message CM_MOUSELEAVE;
    procedure Paint; override;
    destructor Destroy;
  public
    { Public Declarations }
    constructor Create(AOwner: TComponent); override;
  published
    { Published Declarations }
    property GradColor: TColor read fGradcolor
     write SetGradColor default clBlue;
    property FaceColor: TColor read fFacecolor
     write SetFaceColor default clBlack;
    property HighlightColor: TColor read fHighlightColor
     write SetHighlightColor default clWhite;
    property ShadowColor: TColor read fBottomColor
     write SetBottomColor default clBlack;
    property BevelWidth: integer read fBevWidth
     write SetBevWidth default 1;
    property BorderWidth: integer read fRectWidth
     write SetRectWidth default 1;
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter
        write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave
        write FOnMouseLeave;
  end;

procedure Register;

implementation

{The "Set..." procedures redraw the button after a property is changed}
procedure TGradBtn.SetGradColor(AColor: TColor);
begin
    if AColor <> fGradcolor then begin
        fGradColor:= AColor;
        GradFill(fGradColor, fFaceColor, BackGround);
        Paint;
    end;
end;

procedure TGradBtn.SetFaceColor(AColor: TColor);
begin
    if AColor <> fFacecolor then begin
        fFaceColor:= AColor;
        GradFill(fGradColor, fFaceColor, BackGround);
        Paint;
    end;
end;

procedure TGradBtn.SetHighlightColor(AColor: TColor);
begin
    if AColor <> fHighlightcolor then begin
        fHighlightColor:= AColor;
        Paint;
    end;
end;

procedure TGradBtn.SetBottomColor(AColor: TColor);
begin
    if AColor <> fBottomcolor then begin
        fBottomColor:= AColor;
        Paint;
    end;
end;

procedure TGradBtn.SetBevWidth(ANumber: integer);
begin
    if ANumber <> fBevWidth then begin
        fBevWidth:= ANumber;
        Paint;
    end;
end;

procedure TGradBtn.SetRectWidth(ANumber: integer);
begin
    if ANumber <> fRectWidth then begin
        fRectWidth:= ANumber;
        Paint;
    end;
end;

{This procedure draws the gradient colors onto the bitmap}
procedure TGradBtn.GradFill(Clr1, Clr2: TColor; TheBitmap: TBitmap);
var
  RGBFrom: array[0..2] of Byte;    { from RGB values                     }
  RGBDiff: array[0..2] of integer; { difference of from/to RGB values    }
  ColorBand: TRect;                  { color band rectangular coordinates  }
  I: Integer;                { color band index                    }
  R: Byte;                   { a color band's R value              }
  G: Byte;                   { a color band's G value              }
  B: Byte;                   { a color band's B value              }
begin
   { extract from RGB values}
   RGBFrom[0] := GetRValue(ColorToRGB(Clr1));
   RGBFrom[1] := GetGValue(ColorToRGB(Clr1));
   RGBFrom[2] := GetBValue(ColorToRGB(Clr1));
   { calculate difference of from and to RGB values}
   RGBDiff[0] := GetRValue(ColorToRGB(Clr2)) - RGBFrom[0];
   RGBDiff[1] := GetGValue(ColorToRGB(Clr2)) - RGBFrom[1];
   RGBDiff[2] := GetBValue(ColorToRGB(Clr2)) - RGBFrom[2];
   { set pen sytle and mode}
   TheBitmap.Canvas.Pen.Style:= psSolid;
   TheBitmap.Canvas.Pen.Mode:= pmCopy;
   { set color band's left and right coordinates}
   ColorBand.Top:= 0;
   ColorBand.Bottom := Height;
   for I := 0 to 255 do
   begin
       { calculate color band's top and bottom coordinates}
       ColorBand.Left:= MulDiv (I, TheBitmap.Width, 256);
       ColorBand.Right:= MulDiv (I + 1, TheBitmap.Width, 256);
       { calculate color band color}
       R := RGBFrom[0] + MulDiv(I, RGBDiff[0], $ff);
       G := RGBFrom[1] + MulDiv(I, RGBDiff[1], $ff);
       B := RGBFrom[2] + MulDiv(I, RGBDiff[2], $ff);
       { select brush and paint color band}
       TheBitmap.Canvas.Brush.Color := RGB(R, G, B);
       TheBitmap.Canvas.FillRect(ColorBand);
   end;
end;

{This procedure draws the button onto the form}
procedure TGradBtn.Paint;
var
  x, y, W, H: integer;
  R, InnerRect: TRect;
begin
   {Get button's total rectangle area}
   R:=ClientRect;
   {Get the part we'll draw the gradient color to.  It's the total rectangle }
   {area minus the border width                                              }
   with InnerRect do begin
      Top:=R.Top + fRectWidth;
      Left:=R.Left + fRectWidth;
      Right:=R.Right - fRectWidth;
      Bottom:=R.Bottom - fRectWidth;
   end;
   Intermediary.Width  := Width;  // <<<<  Added
   Intermediary.Height := Height; // <<<<  Added
   {Set the font}
   Intermediary.canvas.font.assign(font); // <<<< Changed
   {Get coordinates for centering the caption onto the button}
   x:=(width - Intermediary.canvas.textwidth(caption)) div 2; // <<<< Changed
   y:=(height - Intermediary.canvas.textheight(caption)) div 2; // <<<< Changed
   {Test to see if the size has changed.  If so, we need to redraw }
   {the gradient colors onto the background bitmap.  If not, we    }
   {won't redraw because doing it is slow...                       }
   W:=Width - (2 * fRectWidth);
   H:=Height - (2 * fRectWidth);
   if (W <> BackGround.Width) or (H <> BackGround.Height) then begin
       BackGround.Width:= W;
       BackGround.Height:= H;
       GradFill(fGradColor, fFaceColor, BackGround);
   end;
   {We draw the button differently depending on if it is pressed or not}
   if fState = bsDown then with Intermediary.canvas do begin // <<<< Changed
      {If button is pressed...}
      Brush.Color:=clBlack;        {Set border color}
      FillRect(R);                {Draw border     }
      Brush.Color:=fFaceColor;     {Set face color  }
      {Draw the gradient colors, but offset to simulate that the button}
      {is pressed }
      Draw(fRectWidth + 1, fRectWidth + 1, BackGround);
      Frame3D(Intermediary.Canvas, InnerRect, fBottomColor, fFaceColor, fBevWidth); // <<<< Changed
                                   {Draw a 3D frame like a normal button, but pressed}
      SetBKMode(Intermediary.canvas.handle, 1); // <<<< Changed
                                   {Set transparency mode for text output}
      Textout(x + 1, y + 1, caption);   {Draw the caption }
   end
   else with Intermediary.canvas do begin // <<<< Changed
      {If button not pressed...}
      Brush.Color:=clBlack;
      FillRect(R);
      Brush.Color:=fFaceColor;
      Draw(fRectWidth, fRectWidth, BackGround);
      Frame3D(Intermediary.Canvas, InnerRect, fHighlightColor, fBottomcolor, fBevWidth); // <<<< Changed
      SetBKMode(Intermediary.canvas.handle, 1); // <<<< Changed
      textout(x,y,caption);
   end;
   {Reset the background mode}
   SetBKMode(Intermediary.canvas.handle,2); // <<<< Changed
   Canvas.Draw( 0, 0, Intermediary ); // <<<< Added
end;

{Create the button}
constructor TGradBtn.Create(AOwner: TComponent);
begin
   {Get all methods of ancestor (TSpeedButton) }
   inherited Create(AOwner);
   ControlStyle := ControlStyle + [csOpaque];
   {Set the default properties.  This is the way the button appears     }
   {when you first place it on a form or create it at runtime.  You can }
   {change these if you don't like the default properties!              }
   Width:=100;
   Height:=30;
   fGradColor:= clBlue;
   fFaceColor:= clBlack;
   fHighlightColor:= clWhite;
   fBottomColor:= clBlack;
   fBevWidth:= 1;
   fRectWidth:= 1;
   {Create the background bitmap.  It is freed in the "destroy" procedure}
   BackGround:=TBitmap.Create;
   BackGround.Width:=Width;
   BackGround.Height:=Height;
   Intermediary := TBitmap.Create; // <<<< Added
   Intermediary.Width:=Width;      // <<<< Added
   Intermediary.Height:=Height;    // <<<< Added
   {Draw the gradient colors to the background bitmap for future painting}
   GradFill(fGradColor, fFaceColor, BackGround);
   Font.Color:=clWhite;
   Caption:='TGradBtn';
end;

destructor TGradBtn.Destroy;
begin
  inherited;
   {Free the bitmap because Windows can't do it on it's own...}
   Background.Free;
end;

procedure TGradBtn.CMMouseEnter(var Msg:TMessage);
begin
  inherited;
  if Assigned (FOnMouseEnter) then FOnMouseEnter(Self);
end;

procedure TGradBtn.CMMouseLeave(var Msg:TMessage);
begin
  inherited;
  if Assigned (FonMouseLeave) then FOnMouseLeave(Self);
end;

procedure Register;
begin
   {Write component to Component Palette if installing}
   RegisterComponents('Samples', [TGradBtn]);
end;

end.

/// John
0
 
moonriseAuthor Commented:
Thank you John. It works great.
0
 
bobspencerrCommented:
Have you thought of using the invalidaterect function as this limits the refresh paint of the form tyo the area specified in the function. I have writtena  component which flickered like mad until I set (owner as tform).doublebuffered:=true; and used the invalidaterect facility. Flicker reduced to nil

Best of luck...
0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now