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.