unit Unit1;
interface
uses Windows, Classes, Graphics, Controls, Forms, ExtCtrls;
type
TForm1 = class(TForm)
Timer: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure TimerTimer(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure FormDestroy(Sender: TObject);
end;
var Form1: TForm1;
implementation
{$r *.dfm}
var
Bitmap: TBitmap;
Value: Integer;
Flag: Boolean;
procedure TForm1.FormCreate(Sender: TObject);
begin
Bitmap := TBitmap.Create;
Bitmap.Width := ClientWidth;
Bitmap.Height := ClientHeight;
Bitmap.Canvas.Pen.Color := clRed;
Timer.Interval := 20;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
BitBlt(Canvas.Handle, 0, 0, ClientWidth, ClientHeight, Bitmap.Canvas.Handle, 0, 0, SRCCOPY); end;
procedure TForm1.TimerTimer(Sender: TObject);
begin
if not Flag then
if Value = 120 then
Flag := not Flag
else
Inc(Value, 6)
else
if Value = 0 then
Flag := not Flag
else
Dec(Value, 6);
FormMouseMove(nil, [], 0, 0);
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
Point: TPoint;
Size: Integer;
begin
with Bitmap.Canvas do
begin
Lock;
Size := Value - 100;
GetCursorPos(Point);
if Size < 0 then Size := 0;
Y := Point.Y - Top - (66 * 2) + (Value - Size);
X := Point.X - Left;
Brush.Color := clBlack;
FillRect(ClientRect);
Pen.Color := clRed;
Brush.Color := Pen.Color;
Ellipse(X - 66, Y - (66 * 2) + Size, X + 66, Y);
Y := Point.Y - ClientOrigin.Y;
Pen.Color := 150 + Size * 5;
Rectangle(X - 66, Y, X + 66, Y + 2);
FormPaint(nil);
Unlock;
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Bitmap.Destroy;
end;
end.