Dibujando con Canvas

[[cHackAll]]

Código Delphi [-]
unit Unit1; // Ejemplo de buffer doble programada, no interesa el valor de la propiedad...
 
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); // Double buffered !
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.