Solved

Getting rid of the flickering

Posted on 1998-08-05
8
484 Views
Last Modified: 2010-04-04
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
Comment
Question by:moonrise
8 Comments
 
LVL 10

Expert Comment

by:viktornet
Comment Utility
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
 
LVL 10

Expert Comment

by:viktornet
Comment Utility
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
 
LVL 10

Expert Comment

by:viktornet
Comment Utility
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
 

Author Comment

by:moonrise
Comment Utility
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
Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

 
LVL 10

Expert Comment

by:viktornet
Comment Utility
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
 
LVL 4

Accepted Solution

by:
erajoj earned 40 total points
Comment Utility
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
 

Author Comment

by:moonrise
Comment Utility
Thank you John. It works great.
0
 

Expert Comment

by:bobspencerr
Comment Utility
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

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
Sending a Secure fax is easy with eFax Corporate (http://www.enterprise.efax.com). First, Just open a new email message.  In the To field, type your recipient's fax number @efaxsend.com. You can even send a secure international fax — just include t…
Get a first impression of how PRTG looks and learn how it works.   This video is a short introduction to PRTG, as an initial overview or as a quick start for new PRTG users.

771 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now