Mega Code Archive
How to implement an animated gradient
<![CDATA[
Title: How to implement an animated gradient
unit anithread;
interface
uses
Classes, Windows, Controls, Graphics;
type
TAnimationThread = class(TThread)
private
{ Private declarations }
FWnd: HWND;
FPaintRect: TRect;
FbkColor, FfgColor: TColor;
FInterval: Integer;
procedure DrawGradient(ACanvas: TCanvas; Rect: TRect; Horicontal: Boolean;
Colors: array of TColor);
protected
procedure Execute; override;
public
constructor Create(paintsurface: TWinControl; {Control to paint on }
paintrect: TRect; {area for animation bar }
bkColor, barcolor: TColor; {colors to use }
interval: Integer); {wait in msecs between
paints}
end;
implementation
constructor TAnimationThread.Create(paintsurface: TWinControl;
paintrect: TRect; bkColor, barcolor: TColor; interval: Integer);
begin
inherited Create(True);
FWnd := paintsurface.Handle;
FPaintRect := paintrect;
FbkColor := bkColor;
FfgColor := barColor;
FInterval := interval;
FreeOnterminate := True;
Resume;
end; { TAnimationThread.Create }
procedure TAnimationThread.Execute;
var
image: TBitmap;
DC: HDC;
Left, Right: Integer;
increment: Integer;
imagerect: TRect;
state: (incRight, decRight);
begin
Image := TBitmap.Create;
try
with Image do
begin
Width := FPaintRect.Right - FPaintRect.Left;
Height := FPaintRect.Bottom - FPaintRect.Top;
imagerect := Rect(0, 0, Width, Height);
end; { with }
Left := 0;
Right := 0;
increment := imagerect.Right div 50;
state := Low(State);
while not Terminated do
begin
with Image.Canvas do
begin
Brush.Color := FbkColor;
//FillRect(imagerect); original!
DrawGradient(Image.Canvas, imagerect, True, [clBtnShadow, clBtnFace]);
case state of
incRight:
begin
Inc(Right, increment);
if Right imagerect.Right then
begin
Right := imagerect.Right;
Inc(state);
end; // if
end; // Case incRight }
decRight:
begin
Dec(Right, increment);
if Right = 0 then
begin
Right := 0;
state := incRight;
end; // if
end; // Case decLeft
end; { Case }
Brush.Color := FfgColor;
//FillRect(Rect(left, imagerect.top, right, imagerect.bottom)); original!
DrawGradient(Image.Canvas, Rect(Left, imagerect.Top, Right, imagerect.Bottom),
True, [clBtnFace, clBtnShadow]);
end; { with }
DC := GetDC(FWnd);
if DC 0 then
try
BitBlt(DC,
FPaintRect.Left,
FPaintRect.Top,
imagerect.Right,
imagerect.Bottom,
Image.Canvas.Handle,
0, 0,
SRCCOPY);
finally
ReleaseDC(FWnd, DC);
end;
Sleep(FInterval);
end; { While }
finally
Image.Free;
end;
InvalidateRect(FWnd, nil, True);
end; { TAnimationThread.Execute }
procedure TAnimationThread.DrawGradient(ACanvas: TCanvas; Rect: TRect;
Horicontal: Boolean; Colors: array of TColor);
type
RGBArray = array[0..2] of Byte;
var
x, y, z, stelle, mx, bis, faColorsh, mass: Integer;
Faktor: Double;
A: RGBArray;
B: array of RGBArray;
merkw: Integer;
merks: TPenStyle;
merkp: TColor;
begin
mx := High(Colors);
if mx 0 then
begin
if Horicontal then
mass := Rect.Right - Rect.Left
else
mass := Rect.Bottom - Rect.Top;
SetLength(b, mx + 1);
for x := 0 to mx do
begin
Colors[x] := ColorToRGB(Colors[x]);
b[x][0] := GetRValue(Colors[x]);
b[x][1] := GetGValue(Colors[x]);
b[x][2] := GetBValue(Colors[x]);
end;
merkw := ACanvas.Pen.Width;
merks := ACanvas.Pen.Style;
merkp := ACanvas.Pen.Color;
ACanvas.Pen.Width := 1;
ACanvas.Pen.Style := psSolid;
faColorsh := Round(mass / mx);
for y := 0 to mx - 1 do
begin
if y = mx - 1 then
bis := mass - y * faColorsh - 1
else
bis := faColorsh;
for x := 0 to bis do
begin
Stelle := x + y * faColorsh;
faktor := x / bis;
for z := 0 to 2 do
a[z] := Trunc(b[y][z] + ((b[y + 1][z] - b[y][z]) * Faktor));
ACanvas.Pen.Color := RGB(a[0], a[1], a[2]);
if Horicontal then
begin
ACanvas.MoveTo(Rect.Left + Stelle, Rect.Top);
ACanvas.LineTo(Rect.Left + Stelle, Rect.Bottom);
end
else
begin
ACanvas.MoveTo(Rect.Left, Rect.Top + Stelle);
ACanvas.LineTo(Rect.Right, Rect.Top + Stelle);
end;
end;
end;
b := nil;
ACanvas.Pen.Width := merkw;
ACanvas.Pen.Style := merks;
ACanvas.Pen.Color := merkp;
end;
{else
// Please specify at least two colors
raise EMathError.Create('Es m¨¹ssen mindestens zwei Farben angegeben werden.');
Here not more than two colors!
}
end;
end.
Usage Example:
Place a TPanel on a form, size it as appropriate.Create an instance of the
TanimationThread call like this: procedure TForm1.Button1Click(Sender : TObject);
procedure TForm1.Button1Click(Sender: TObject);
var
ani: TAnimationThread;
r: TRect;
begin r := panel1.ClientRect;
InflateRect(r, - panel1.bevelwidth, - panel1.bevelwidth);
ani := TanimationThread.Create(panel1, r, panel1.Color, clBlue, 25);
Button1.Enabled := False;
Application.ProcessMessages;
Sleep(30000); // replace with query.Open or such
Button1.Enabled := True;
ani.Terminate;
ShowMessage('Done');
end;
]]>