unit Unit1;
interface
uses Windows, Messages, Classes, Graphics, Controls, Forms, ExtCtrls;
type
TForm1 = class(TForm) Timer: TTimer;
procedure FormCreate(Sender: TObject);
procedure TimerTimer(Sender: TObject);
procedure FormPaint(Sender: TObject);
end;
var Form1: TForm1;
implementation
{$r *.dfm}
var
Step: Double;
Bitmap: TBitmap;
Snake: array [0..255] of TPoint;
procedure TForm1.FormCreate(Sender: TObject);
begin
Bitmap := TBitmap.Create;
Bitmap.Width := ClientWidth;
Bitmap.Height := ClientHeight;
Bitmap.Canvas.Brush.Color := Color;
end;
procedure TForm1.TimerTimer(Sender: TObject);
var
Size: Double;
Value: TPoint;
Index, Border: Integer;
begin
Size := 360 / Length(Caption);
with Bitmap.Canvas do
begin
FillRect(Classes.Rect(0, 0, Bitmap.Width, Bitmap.Height));
for Index := 0 to ControlCount - 1 do
with TWinControl(Controls[Index]) do
if Visible then
begin
Repaint;
PaintTo(Bitmap.Canvas, Left, Top); Border := BorderWidth + 3;
BitBlt(Bitmap.Canvas.Handle, Left + Border, Top + Border, Width - Border * 2, Height - Border * 2, Canvas.Handle, Left + Border, Top + Border, SRCCOPY); end;
SetBkMode(Handle, TRANSPARENT);
for Index := 1 to Length(Caption) do
with Snake[Index] do
begin
if Index > 1 then
Value := Snake[Index - 1]
else
Value := ScreenToClient(Mouse.CursorPos);
Inc(X, Round((Value.X - X) * 0.6));
Inc(Y, Round((Value.Y - Y) * 0.6));
TextOut(X + Round(66 * Cos(Step + Index * Size * (Pi / 180))),
Y + Round(66 * Sin(Step + Index * Size * (Pi / 180))),
Caption[Index]);
end;
end;
FormPaint(nil);
Step := Step - 0.06;
end;
procedure TForm1.FormPaint(Sender: TObject);
var DestDC: Cardinal;
begin
DestDC := GetWindowDC(Handle);
BitBlt(DestDC, ClientOrigin.X - Left, ClientOrigin.Y - Top, Bitmap.Width, Bitmap.Height, Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
ReleaseDC(Handle, DestDC);
end;
end.