Solved

Getting rid of the flickering

Posted on 1998-08-05
8
527 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
8 Comments
 
LVL 10

Expert Comment

by:viktornet
ID: 1359948
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
ID: 1359949
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
ID: 1359950
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
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:moonrise
ID: 1359951
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
 
LVL 10

Expert Comment

by:viktornet
ID: 1359952
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
ID: 1359953
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
ID: 1359954
Thank you John. It works great.
0
 

Expert Comment

by:bobspencerr
ID: 6939896
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.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
NetCrunch network monitor is a highly extensive platform for network monitoring and alert generation. In this video you'll see a live demo of NetCrunch with most notable features explained in a walk-through manner. You'll also get to know the philos…
Do you want to know how to make a graph with Microsoft Access? First, create a query with the data for the chart. Then make a blank form and add a chart control. This video also shows how to change what data is displayed on the graph as well as form…
Suggested Courses
Course of the Month6 days, 7 hours left to enroll

636 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