Chop up the Desktop

Der folgende Code ist eine schöne Spielerei, die man auch als Screensaver nutzen kann. Hier wird der Desktop in Kacheln geschnitten und die Blöcke werden wie in einem Spiel hin und her geschoben.

var
  Form1: TForm1;
  DesktopBitmap   : TBitmap;
  gx, gy          : Integer;
  redRect         : TBitmap;
  rW, rH          : Integer;

const
  Delta=8;
  
//

procedure TForm1.FormCreate(Sender: TObject);
procedure InitScreen;
var
 i:integer;
begin
 DesktopBitmap:=TBitmap.Create;
 with DesktopBitmap do
  begin
   Width:=Screen.Width;
   Height:=Screen.Height;
  end;
 BitBlt(DesktopBitmap.Canvas.Handle,
        0,
        0,
        Screen.Width,
        Screen.Height,
        GetDC(GetDesktopWindow),
        0,
        0,
        SrcCopy);

 Form1.Image1.Picture.Bitmap:=DesktopBitmap;
 Randomize;
 gx:=Trunc(Random*Delta);
 gy:=Trunc(Random*Delta);
 Form1.Image1.Canvas.CopyRect(Rect(rW*gx, rH*gy, rW*gx+rW, rH*gy+rH),
                              redRect.Canvas,
                              Rect(0,0,rW,rH));

 for i:=0 to DELTA-1 do
  begin
   Form1.Image1.Canvas.MoveTo(rW*i,0);
   Form1.Image1.Canvas.LineTo(rW*i,Screen.Height);
   Form1.Image1.Canvas.MoveTo(0, rH*i);
   Form1.Image1.Canvas.LineTo(Screen.Width, rH*i);
  end;
end;
begin
 ShowCursor(False);
 SystemParametersInfo(SPI_SCREENSAVERRUNNING,1,0,0);
 Button1.Cancel:=true;
 rW := Screen.Width div Delta;
 rH := Screen.Height div Delta;
 redRect := TBitmap.Create;
 with redRect do
  begin
   Width:=rW;
   Height:=rH;
   Canvas.Brush.Color:=clRed;
   Canvas.Brush.Style:=bssolid;
   Canvas.Rectangle(0,0,rW,rH);
   Canvas.Font.Color:=clNavy;
   Canvas.Font.Style:=Canvas.Font.Style+[fsBold];
   Canvas.TextOut(2,2,'About');
   Canvas.Font.Style:=Canvas.Font.Style-[fsBold];
   Canvas.TextOut(2,17,'Delphi');
   Canvas.TextOut(2,32,'Programming');
  end;

 Timer1.Enabled:=False;
 Image1.Align:=alClient;
 Visible:=False;
 BorderStyle:=bsNone;
 Top:=0;
 Left:=0;
 Width:=Screen.Width;
 Height:=Screen.Height;
 InitScreen;
 Visible:=True;
 Timer1.Interval:=10;
 Timer1.Enabled:=True; 
end;

procedure TForm1.Timer1Timer(Sender: TObject);
procedure DrawScreen;
var
 r1,r2:TRect;
 Direction:integer;
begin
 r1:=Rect(rW*gx , rH*gy,  rW*gx+rW  , rH*gy+rH);
 Direction:=Trunc(Random*4);
  case Direction of
   0: gx:=Abs((gx+1) mod Delta);
   1: gx:=Abs((gx-1) mod Delta);    
   2: gy:=Abs((gy+1) mod Delta);    
   3: gy:=Abs((gy-1) mod Delta);    
  end; 
 r2:=Rect(rW*gx , rH*gy,  rW*gx+rW  , rH*gy+rH);
 with Form1.Image1.Canvas do
  begin
   CopyRect(r1, Form1.Image1.Canvas, r2);
   CopyRect(r2, redRect.Canvas, redRect.Canvas.ClipRect);
  end;
end;
begin
 DrawScreen;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 ShowCursor(True);
 Close;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 SystemParametersInfo(SPI_SCREENSAVERRUNNING,0,0,0);
end;