How can I avoid flickering when my component repaints?

just write whatever you want
Post Reply
Claes
Posts: 52
Joined: Thu Apr 22, 2004 10:52 pm
Location: Denmark

How can I avoid flickering when my component repaints?

Post by Claes »

The Firefox browser has a cool animation displayed when a page is loading. It's just a circle made up of 8 smaller circles each with scaled color. Hopefully you all know Firefox? Otherwise you can take a look here: http://www.getfirefox.com.

I've made that animation into a Delphi component. It works, but the screen flickers everytime a new image is loaded. Can anyone here tell me how to avoid this flickering?

When the timerevent occurs, I call Invalidate, that calls Paint. In the Paint procedure, I build a temporary Bitmap with the entire image, and then draws that bitmap onto the Controls Canvas in the end. Here is the full code:

Code: Select all

unit FirefoxLoading;

interface

uses
  Windows,
  SysUtils,
  Classes,
  Controls,
  ExtCtrls,
  Graphics;

type
  TFirefoxLoading = class(TGraphicControl)
  private
    { Private declarations }
    FColor: TColor;
    FDotOffset: Byte;
    FEnabled: Boolean;
    FRect: TRect;
    FTimer: TTimer;
    FTimerInterval: Word;
    procedure DoTimer(Sender: TObject);
    procedure SetColor(Value: TColor);
    procedure SetTimerInterval(Value: Word);
  protected
    { Protected declarations }
    procedure SetEnabled(Value: Boolean); override;
    procedure Paint; override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    property Align;
    property Anchors;
    property Color: TColor read FColor write SetColor;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled: Boolean read FEnabled write SetEnabled;
    property ParentShowHint;
    property ShowHint;
    property TimerInterval: Word read FTimerInterval write SetTimerInterval;
    property Visible;
    property OnContextPopup;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
  end;

procedure Register;

implementation

uses
	Math,
  Types;

procedure TFirefoxLoading.Paint;
const
	N = 26;
  M = 255;
var
	Bitmap: TBitmap;
  DotColor: TColor;
	DotSize, Size, Margin, I, J: Integer;
	R, G, B: Byte;
  Dots: array[1..8] of TRect;
	D: TRect;
	C: TPoint;
begin
	Bitmap := TBitmap.Create;

  try
	  Bitmap.Height := Height;
  	Bitmap.Width := Width;

	  with Bitmap.Canvas do
  	begin
		  Brush.Color := Parent.Brush.Color;
 			FillRect(ClientRect);
			Size := Min(Height, Width);
	    DotSize := (Size div 4);
			Margin := Size div 8;

  	  FRect.Left := (Width - (DotSize * 4)) div 2;
    	FRect.Top := (Height - (DotSize * 4)) div 2;
	    FRect.Right := FRect.Left + Size;
  	  FRect.Bottom := FRect.Top + Size;
	    C := CenterPoint(FRect);

			D := Rect((C.X - DotSize div 2), FRect.Top, (C.X + DotSize div 2), FRect.Top + DotSize);
			Dots[1] := D;
	    OffsetRect(D, Margin * 2, Margin);
  	  Dots[2] := D;
    	OffsetRect(D, Margin, Margin * 2);
		Dots[3] := D;
  	  OffsetRect(D, Margin * -1, Margin * 2);
		Dots[4] := D;
	    OffsetRect(D, Margin * -2, Margin);
		Dots[5] := D;
    	OffsetRect(D, Margin * -2, Margin * -1);
		Dots[6] := D;
  	  OffsetRect(D, Margin * -1, Margin * -2);
		Dots[7] := D;
	    OffsetRect(D, Margin, Margin * -2);
		Dots[8] := D;

	    R := GetRValue(FColor);
  		G := GetGValue(FColor);
  		B := GetBValue(FColor);
			J := FDotOffset;

  	  for I := 1 to 8 do
    	begin
	      if R + N <= M then Inc(R, N);
  	    if G + N <= M then Inc(G, N);
    	  if B + N <= M then Inc(B, N);

				DotColor := RGB(R, G, B);
		    Pen.Color := DotColor;
				Brush.Color := DotColor;
	      Inc(J);
  	    if J > 8 then J := 1;
				Ellipse(Dots[J]);
	    end;
  	end;
  finally
  	Canvas.CopyMode := cmSrcCopy;
  	Canvas.CopyRect(ClientRect,Bitmap.Canvas,ClientRect);
  	Bitmap.Free;
  end;
end;

constructor TFirefoxLoading.Create(AOwner: TComponent);
begin
	inherited Create(AOwner);
	Height := 16;
  Width := 16;
  FEnabled := True;
	FTimerInterval := 125;
	FRect := ClientRect;
  
  FTimer := TTimer.Create(Self);
  FTimer.Interval := FTimerInterval;
  FTimer.Enabled := FEnabled and not (csDesigning in ComponentState);
	FTimer.OnTimer := DoTimer;
	FDotOffset := 0;
end;

destructor TFirefoxLoading.Destroy;
begin
	FTimer.Free;
	inherited;
end;

procedure TFirefoxLoading.DoTimer(Sender: TObject);
begin
	Inc(FDotOffset);
  if FDotOffset > 8 then FDotOffset := 1;
  Invalidate;
//	Repaint;
//	Windows.InvalidateRect(Self.Canvas.Handle, @FRect, False);
end;

procedure TFirefoxLoading.SetColor(Value: TColor);
var
	R, G, B: Byte;
begin
	if Value <> FColor then
  begin
  	R := GetRValue(Value);
  	G := GetGValue(Value);
  	B := GetBValue(Value);
    if (R = 0) or (G = 0) or (B = 0) then
    begin
    	FColor := Value;
      Repaint;
    end else
    	raise Exception.Create('The color must have at least one R, G or B value of zero.');
  end;
end;

procedure TFirefoxLoading.SetEnabled(Value: Boolean);
begin
	if Value <> FEnabled then
  begin
  	FEnabled := Value;
		FTimer.Enabled := FEnabled and not (csDesigning in ComponentState);

    inherited SetEnabled(Value);
  end;
end;

procedure TFirefoxLoading.SetTimerInterval(Value: Word);
begin
	if Value <> FTimerInterval then
  begin
		FTimerInterval := Value;
    FTimer.Interval := FTimerInterval;
	end;
end;

procedure Register;
begin
  RegisterComponents('My Components', [TFirefoxLoading]);
end;

end.
madshi
Site Admin
Posts: 10754
Joined: Sun Mar 21, 2004 5:25 pm

Post by madshi »

Use InvalidateRect like you've tried (but commented out), but on the window handle, not on the canvas handle.
Claes
Posts: 52
Joined: Thu Apr 22, 2004 10:52 pm
Location: Denmark

Post by Claes »

Thanks for your reply! I've modified the source a great deal now. First, to use InvalidateRect/InvalidateRgn, the component had to decent from TCustomControl. I made it decent from TCustomPanel in order to take advantage of some of this components properties. Secondly, I'm trying to use InvalidateRgn, so I build up a region (FRegion) that holds all the 8 dots in response to when the Height/Width changes. The code needs some beutification here and there, but I've now encountered this problem:

The Ellipses in the Region made up from calls to CreateEllipticRgnIndirect
DOES NOT match with the Ellipses draw in the Paint function..?!? Although they are all made up from the same Rects. They differ one or two pixels (see enclosed image). How can that be? Made this is the reason the image still flickers (not as much as before, though)?

Btw anyone here able to help is welcome. Not just Mathias... ;)
Image

Code: Select all

unit FirefoxLoading;

interface

uses
  Windows,
  Messages,
  SysUtils,
  Classes,
  Controls,
  Graphics,
  Forms,
  ExtCtrls;

type
  TFirefoxLoading = class(TCustomPanel)
  private
    { Private declarations }
    FDotOffset: Byte;
    FDots: array[1..8] of TRect;
    FHeight: Integer;
    FRegion: HRGN;
    FTimer: TTimer;
    FTimerInterval: Word;
    FWidth: Integer;
    procedure DoTimer(Sender: TObject);
    procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED;
  protected
    { Protected declarations }
    procedure CreateWnd; override;
    procedure Paint; override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    property Align;
    property Anchors;
    property BevelInner;
    property BevelOuter;
    property BiDiMode;
    property BorderStyle;
    property BorderWidth;
    property Caption;
    property Color;
    property Constraints;
    property Ctl3D;
    property DockSite;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property Locked;
    property ParentBackground;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property UseDockManager;
    property Visible;
  end;

function Min(const A, B: Integer): Integer;
procedure Register;

implementation

uses
  Types,
  Themes;

function Min(const A, B: Integer): Integer;
begin
  if A < B then Result := A else Result := B;
end;

constructor TFirefoxLoading.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
//  Width := 96;
//  Height := 16;
//  Alignment := taRightJustify;
  BevelOuter := bvNone;
  BevelWidth := 1;
  BorderStyle := bsNone;
  Caption := 'Loading... ';
  Color := clBtnFace;
  Font.Name := 'Arial';
  Font.Size := 8;
  Font.Style := [fsBold];
  FullRepaint := True;

  FTimerInterval := 125;
  Randomize;
end;

procedure TFirefoxLoading.CreateWnd;
begin
  inherited CreateWnd;
  FRegion := CreateRectRgn(0, 0, 0, 0);

  FTimer := TTimer.Create(Self);
  FTimer.Interval := FTimerInterval;
  FTimer.Enabled := Enabled and not (csDesigning in ComponentState);
  FTimer.OnTimer := DoTimer;
end;

destructor TFirefoxLoading.Destroy;
begin
  FTimer.Free;
  inherited Destroy;
end;

procedure TFirefoxLoading.WMWindowPosChanged(var Message: TWMWindowPosChanged);
var
  ARect: TRect;
  DotSize, Size, Margin: Integer;
  D: TRect;
  C: TPoint;
  RT, R2, R3: HRGN;
begin
  //Take note of the previous Height/Width
  FHeight := Height;
  FWidth := Width;
  inherited;

  // New Height/Width adjusted. Calculate the dots and combined region:
  ARect := GetClientRect;
  if BevelOuter <> bvNone then
    InflateRect(ARect, BevelWidth * -1, BevelWidth * -1);
  if BevelInner <> bvNone then
    InflateRect(ARect, BevelWidth * -1, BevelWidth * -1);
  if BorderWidth <> 0 then
    InflateRect(ARect, BorderWidth * -1, BorderWidth * -1);
  InflateRect(ARect, -2, -2);

  Size := Min(ARect.Bottom - ARect.Top, ARect.Right - ARect.Left);
  DotSize := Size div 4;
  Margin := Size div 8;

  C := CenterPoint(ARect);
  D := Rect((C.X - DotSize div 2), ARect.Top, (C.X + DotSize div 2), ARect.Top + DotSize);
  FDots[1] := D;
  OffsetRect(D, Margin * 2, Margin);
  FDots[2] := D;
   OffsetRect(D, Margin, Margin * 2);
  FDots[3] := D;
  OffsetRect(D, Margin * -1, Margin * 2);
  FDots[4] := D;
  OffsetRect(D, Margin * -2, Margin);
  FDots[5] := D;
   OffsetRect(D, Margin * -2, Margin * -1);
  FDots[6] := D;
  OffsetRect(D, Margin * -1, Margin * -2);
  FDots[7] := D;
  OffsetRect(D, Margin, Margin * -2);
  FDots[8] := D;

  if (GetRgnBox(FRegion, D) <= NULLREGION) or (FHeight <> Height) or (FWidth <> Width) then
  begin
    FRegion := CreateRectRgn(0, 0, 0, 0);
    RT := CreateRectRgn(0, 0, 0, 0);

    R2 := CreateEllipticRgnIndirect(FDots[1]);
    R3 := CreateEllipticRgnIndirect(FDots[2]);
    CombineRgn(RT, R2, R3, RGN_OR);

    R2 := CreateEllipticRgnIndirect(FDots[3]);
    CombineRgn(RT, RT, R2, RGN_OR);
    R2 := CreateEllipticRgnIndirect(FDots[4]);
    CombineRgn(RT, RT, R2, RGN_OR);
    R2 := CreateEllipticRgnIndirect(FDots[5]);
    CombineRgn(RT, RT, R2, RGN_OR);
    R2 := CreateEllipticRgnIndirect(FDots[6]);
    CombineRgn(RT, RT, R2, RGN_OR);
    R2 := CreateEllipticRgnIndirect(FDots[7]);
    CombineRgn(RT, RT, R2, RGN_OR);
    R2 := CreateEllipticRgnIndirect(FDots[8]);
    CombineRgn(FRegion, RT, R2, RGN_OR);
  end;
end;

procedure TFirefoxLoading.Paint;
const
  Alignments: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);
  N = 13;
  M = 255;
  H = 100;
var
  ARect: TRect;
  TopColor, BottomColor: TColor;
  R, G, B: Byte;
  I, J: Integer;
//  FontHeight: Integer;
//  Flags: Longint;

  procedure AdjustColors(Bevel: TPanelBevel);
  begin
    TopColor := clBtnHighlight;
    if Bevel = bvLowered then TopColor := clBtnShadow;
    BottomColor := clBtnShadow;
    if Bevel = bvLowered then BottomColor := clBtnHighlight;
  end;

begin
  ARect := GetClientRect;
  if BevelOuter <> bvNone then
  begin
    AdjustColors(BevelOuter);
    Frame3D(Canvas, ARect, TopColor, BottomColor, BevelWidth);
  end;
  Frame3D(Canvas, ARect, Color, Color, BorderWidth);
  if BevelInner <> bvNone then
  begin
    AdjustColors(BevelInner);
    Frame3D(Canvas, ARect, TopColor, BottomColor, BevelWidth);
  end;

  with Canvas do
  begin
    if not ThemeServices.ThemesEnabled or not ParentBackground then
    begin
      Brush.Color := Color;
//canvas.Brush.Color:=RGB(Random(255),Random(255),Random(255));
      FillRect(ARect);
//canvas.Brush.Color:=RGB(Random(255),Random(255),Random(255));
//  canvas.Ellipse(ARect);
    end;

      R := GetRValue(Color);
      G := GetGValue(Color);
      B := GetBValue(Color);
      J := FDotOffset;

      for I := 1 to 8 do
      begin
        if R + N <= M then Inc(R, N);
        if G + N <= M then Inc(G, N);
        if B + N <= M then Inc(B, N);
        if R < H then R := H;
        if G < H then G := H;
        if B < H then B := H;

        Pen.Width := 1;
        Pen.Color := RGB(R, G, B);
        Brush.Color := Pen.Color;
        Inc(J);
        if J > 8 then J := 1;
        Ellipse(FDots[J]);
      end;

{    Brush.Style := bsClear;
    Font := Self.Font;
    FontHeight := TextHeight('W');
    with Rect do
    begin
      Top := ((Bottom + Top) - FontHeight) div 2;
      Bottom := Top + FontHeight;
    end;
    Flags := DT_EXPANDTABS or DT_VCENTER or Alignments[Alignment];
    Flags := DrawTextBiDiModeFlags(Flags);
    DrawText(Handle, PChar(Caption), -1, Rect, Flags);}
  end;
end;

procedure TFirefoxLoading.DoTimer(Sender: TObject);
begin
  Inc(FDotOffset);
  if FDotOffset > 8 then FDotOffset := 1;

  InvalidateRgn(Handle, FRegion, True);
end;

procedure Register;
begin
  RegisterComponents('My Components', [TFirefoxLoading]);
end;

end.
madshi
Site Admin
Posts: 10754
Joined: Sun Mar 21, 2004 5:25 pm

Post by madshi »

I find that InvalidateRgn stuff much too complicated. As I said before, I recommend to use InvalidateRect. Then when invalidating, set the "erase background" parameter/flag to false.
Claes
Posts: 52
Joined: Thu Apr 22, 2004 10:52 pm
Location: Denmark

Post by Claes »

Ok, but since I have 8 rects, I'd have to invalidate 8 rects resulting in 8 calls to Paint. And since I have shift the color of all the rects in one process, I don't think it'll work. Isn't this true? Or maybe I have misunderstood something? That's why I tried the Region-approach... :crazy:

Can you explain why the Ellipse of the CreateEllipticRgn does not cover the same area as the Ellipse method of the Canvas object?
madshi
Site Admin
Posts: 10754
Joined: Sun Mar 21, 2004 5:25 pm

Post by madshi »

I'd invalidate the whole rect where all those 8 ellipses are.

Don't know about the covering problem.
Post Reply