unit anithread;
interface
uses
Classes, Windows, Controls, Graphics, SysUtils;
type
TAnimationThread =
class(TThread)
private
{ Private declarations }
FWnd: HWND;
FPaintRect: TRect;
FbkColor, FfgColor: TColor;
FInterval: Integer;
FMaxPos : Integer;
FUseColors :
Array of TColor;
image: TBitmap;
imrect: TRect;
procedure DrawGradient(ACanvas: TCanvas; Rect: TRect; Horicontal: Boolean;
Colors:
array of TColor);
procedure PaintText(ACanvas: TCanvas; PaintRect: TRect; fProzent: Integer);
procedure ShowCaption;
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}
maxpos: Integer);
overload;
constructor Create(paintsurface: TWinControl;
{Control to paint on }
paintrect: TRect;
{area for animation bar }
bkColor: TColor; bColors:
array of TColor;
{colors to use }
interval: Integer;
{wait in msecs between paints}
maxpos: Integer);
overload;
end;
implementation
uses animprog_main;
constructor TAnimationThread.Create(paintsurface: TWinControl;
paintrect: TRect; bkColor, barcolor: TColor; interval: Integer; maxpos: Integer);
begin
inherited Create(True);
FWnd := paintsurface.Handle;
FPaintRect := paintrect;
FbkColor := bkColor;
FfgColor := barColor;
FInterval := interval;
FreeOnterminate := True;
FMaxPos := maxpos;
SetLength(FUseColors, 1);
FUseColors[0] := FfgColor;
Image := TBitmap.Create;
Resume;
end;
{ TAnimationThread.Create }
procedure TAnimationThread.Execute;
var
Left, Right: Integer;
increment: Integer;
state: (incRight, decRight);
po : Integer;
proz : Integer;
begin
try
with Image
do
begin
Width := FPaintRect.Right - FPaintRect.Left;
Height := FPaintRect.Bottom - FPaintRect.Top;
imrect := Rect(0, 0, Width, Height);
end;
{ with }
Left := 0;
Right := 0;
increment := imrect.Right
div 50;
state := Low(State);
while not Terminated
do
begin
with Image.Canvas
do
begin
Brush.Color := FbkColor;
FillRect(imrect);
// original!
Brush.Color := FfgColor;
po := Form1.posi;
if (po>FMaxPos)
then
po := FMaxPos;
proz := Round(100.0/FMaxPos*po);
Right := Round((imrect.Right-imrect.Left+1)*1.0/FMaxPos*po);
DrawGradient(Image.Canvas, Rect(Left, imrect.Top, Right, imrect.Bottom),
True, FUseColors);
PaintText(Image.Canvas, imrect, proz);
end;
{ with }
Synchronize(ShowCaption);
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
begin
merkp := ACanvas.Brush.Color;
ACanvas.Brush.Color := Colors[0];
ACanvas.FillRect(Rect);
ACanvas.Brush.Color := merkp;
end;
end;
constructor TAnimationThread.Create(paintsurface: TWinControl;
paintrect: TRect; bkColor: TColor; bColors:
array of TColor; interval,
maxpos: Integer);
var
i : Integer;
begin
inherited Create(true);
FWnd := paintsurface.Handle;
FPaintRect := paintrect;
FbkColor := bkColor;
if (Length(bColors)=0)
then
begin
SetLength(FUseColors, 1);
FUseColors[0] :=
RGB(255-GetRValue(ColorToRGB(bkColor)),255-GetGValue(ColorToRGB(bkColor)),255-GetBValue(ColorToRGB(bkColor)));
end
else
begin
SetLength(FUseColors, Length(bColors));
for i := 0
to High(bColors)
do
FUseColors[i] := bColors[i];
end;
FfgColor := FUseColors[0];
FInterval := interval;
FreeOnterminate := True;
FMaxPos := maxpos;
Image := TBitmap.Create;
Resume;
end;
procedure TAnimationThread.PaintText(ACanvas: TCanvas; PaintRect: TRect; fProzent: Integer);
var
Ima2 : TBitmap;
s :
String;
X : Integer;
Y : Integer;
Width : Integer;
Height : Integer;
begin
if true
then
begin
Width := PaintRect.Right-PaintRect.Left+1;
Height := PaintRect.Bottom-PaintRect.Top+1;
Ima2 := TBitmap.Create;
Ima2.Width := Width;
Ima2.Height := Height;
with Ima2.Canvas
do
begin
CopyMode := cmBlackness;
CopyRect(Rect(0, 0, Width, Height), Ima2.Canvas, Rect(0, 0, Width, Height));
CopyMode := cmSrcCopy;
end;
with Ima2.Canvas
do
begin
Brush.Style := bsClear;
Font.Color := clWhite;
s := Format('
%d%%', [fProzent]);
with PaintRect
do
begin
X := (Right - Left + 1 - TextWidth(S))
div 2;
Y := (Bottom - Top + 1 - TextHeight(S))
div 2;
end;
// with
TextRect(PaintRect, X, Y, s);
end;
// with Ima2.Canvas
ACanvas.CopyMode := cmSrcInvert;
ACanvas.Draw(0, 0, Ima2);
FreeAndNil(Ima2);
end;
end;
procedure TAnimationThread.ShowCaption;
var
DC: HDC;
begin
DC := GetDC(FWnd);
if DC <> 0
then
try
BitBlt(
DC,
FPaintRect.Left,
FPaintRect.Top,
imrect.Right,
imrect.Bottom,
Image.Canvas.Handle,
0, 0,
SRCCOPY);
finally
ReleaseDC(FWnd,
DC);
end;
end;
end.