{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
I have taken two tipps from this site to work together:
1. to draw a gradient from David Johannes Rieger
2. the unit anithread form P. Below
what's coming out is a animated gradient. You know it maybe from
programms like VCDEasy.
There is nothing from me - all from this site!
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Ich habe zwei Tipps von dieser Seite zusammengefügt:
1. to draw a gradient from David Johannes Rieger
2. the unit anithread form P. Below
Dadurch erhält man einen animierten Gradienten wie Bsp. in VCDEasy zu sehen.
Der Quelltext ist nicht von mir, alles ist von dieser Seite!
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
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.');
In diesem Fallnicht mehr als zwei Farben!
Here not more than two colors!
}
end;
end.
{Usage:
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;