unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Buttons,commctrl;
var
  Window:HWND;
  DC:Hdc;
  DCCanv:TCanvas;
const
  SnowCount=2000;
type
  TSnow=class
    dc:Integer;
    col:Tcolor;
    cnv:Tcanvas;
    X,Y:Integer;
    Dx:Integer;
    dy:Integer;
    widht,Height:Integer;
    Constructor Create;
    Procedure Draw;
  end;
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
    f:Boolean;
    Snows:array of TSnow;
    col:Tcolor;
    dc:Integer;
    buf:TBitmap;
    x:Integer;
    dx:integer;
    Function Rct:Trect;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  i:integer;
  fx:byte;
begin
  x:=5;
  dx:=5;
  dc:=1;
  ShowCursor(false);
  buf:=TBitmap.Create;
  SetLength(snows,snowcount);
  for i:=0 to snowcount -1 do
  begin
    Snows[i]:=TSnow.Create;
    with Snows[i] do
    begin
      Dx:=random(3)-random(3);
      dy:=random(3)+1;
      widht:=Screen.Width;
      Height:=Screen.Height;
      X:=random(Screen.Width);
      Y:=random(Screen.Height);
      cnv:=buf.Canvas;
      fx:=random(256);
      col:=rgb(fx,fx,fx);
    end;
  end;
  Left:=0;
  Top:=0;
  Width:=Screen.Width;
  Height:=Screen.Height;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  buf.Width:=PaintBox1.Width;
  buf.Height:=PaintBox1.Height;
end;

function TForm1.Rct: Trect;
begin
  Result:=PaintBox1.ClientRect;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  i:integer;
begin
  col:=rgb(GetrValue(col)+dc,GetgValue(col)+dc,GetBValue(col)+dc);
  if (col=$00FFFFff)or(col=0) then dc:=-dc;
  with buf.Canvas do
  begin
    Brush.Color:=clBlack;
    FillRect(Rct);
    Font.Color:=COL;
    Font.Name:='Courier New';
    font.Size:=70;
    x:=x+dx;
    if (x>460)or(x=5) then dx:=-dx;
    TextOut(x,600,'© By Snake');
    font.Size:=50;
    TextOut(x+120,700,timetostr(now));
  end;
  for i:=0 to SnowCount-1 do
    Snows[i].Draw;
  PaintBox1.Canvas.CopyRect(rct,buf.Canvas,rct);
end;

constructor TSnow.Create;
begin
  dc:=1;
end;

procedure TSnow.Draw;
var
  fx:byte;
begin
  col:=rgb(GetrValue(col)+dc,GetgValue(col)+dc,GetBValue(col)+dc);
  if (col=$00ffffff)or(col=0) then dc:=-dc;
  x:=x+dx+random(3)-random(3);
  y:=y+dy;
  if (x>=widht)or(x<0)or(y>=Height) then
  begin
    dx:=random(3)-random(3);
    dy:=random(3)+1;
    y:=0;
    x:=random(screen.Width);
    fx:=random(256);
    col:=rgb(fx,fx,fx);
  end;
  cnv.Pixels[x,y]:=col;
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if not f then
  begin
    f:=true;
    exit;
  end;

end;

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
  close;
end;

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  close;
end;

end.

frm

object Form1: TForm1
  Left = 215
  Top = 132
  BorderStyle = bsNone
  Caption = 'Form1'
  ClientHeight = 447
  ClientWidth = 644
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  KeyPreview = True
  OldCreateOrder = False
  Position = poDefault
  Visible = True
  OnCreate = FormCreate
  OnKeyPress = FormKeyPress
  OnResize = FormResize
  PixelsPerInch = 96
  TextHeight = 13
  object PaintBox1: TPaintBox
    Left = 0
    Top = 0
    Width = 644
    Height = 447
    Align = alClient
    OnMouseDown = PaintBox1MouseDown
  end
  object Timer1: TTimer
    Interval = 1
    OnTimer = Timer1Timer
    Left = 8
    Top = 8
  end
end

...
uses graphics //! переопределяется класс TBitmap
...
var
  bmBackBuff:TBitmap//Задний буфер. В роли видеопямяти у нас будет канвас нашей формы.
...
Procedure TForm1.formCreate(sender:TObject);
begin
  ...
  bmBackBuff:=TBitmap.Create;//Создаем задний буфер и выделяем под него пямять в озу
  bmBackBuff.width:=self.width; //задаем размер
  bmBackBuff.height:=self.height;//нашему заднему буферу, иначе мы будем рисовать в пространстве 0х0 пикселей :)
  ...
end;

Procedure Flip;//Смена страниц :)
begin
  BitBlt(form1.canvas.handle,//Куда копируем изображение
        0,0,//С какого пикселя начать
        bmBackBuff.width,bmBackBuff.width,//размер копируемого изображения
        bmBackBuff.canvas.handle,//откуда копируем
        SRCCOPY);//тип копирования (SRCCOPY/SRCPAINT/SRCINVERT/SRCCLEAR/SRCAND)
end;

Procedure Draw;//здесь мы будем рисовать
begin
   //Производим рисование на задний буффер
  with bmBackBuff.canvas do
  begin
    brush.color:=clblack;
    fillrect(0,0,bmbackbuff.width,bmbackbuff.height);
    font.size:=72;
    font.name:='Courier New';
    textout(10,10,timetostr(NOW));
    //и т.д.
  end;
end;

Procedure Render;//Как звучит! :)
begin
  Draw;
  Flip;
end;

procedure tform1.formshow(sender:TObject);
begin
  render;
end;