{
Article: Screen Shuffling with Delphi
http://delphi.about.com/library/weekly/aa082801a.htm
Delphi code that divides the current desktop into blocks
and then swaps the blocks. It includes an option that lets
you adjust the shuffling speed, and the size of the blocks.
Great intro to sliding puzzle game or to screen saver development.
For the .zip file of this project click here.
}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls;
type
TShuffler = class(TForm)
Image1: TImage;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Shuffler: TShuffler;
DesktopBitmap : TBitmap;
gx, gy : Integer;
redRect : TBitmap;
rW, rH : Integer; //witdh and height of the shuffling rectangle
const
DELTA = 4; //shoul be 2^n -> makes the Screen to be matrix DELTA x DELTA
implementation
{$R *.DFM}
procedure InitScreen;
var i,j: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);
Shuffler.Image1.Picture.Bitmap := DesktopBitmap;
Randomize;
gx := Trunc(Random * DELTA);
gy := Trunc(Random * DELTA);
Shuffler.Image1.Canvas.CopyRect(Rect(rW * gx, rH * gy, rW * gx + rW, rH * gy + rH),redRect.Canvas,Rect(0,0,rW,rH));
//draw matrix
for i:=0 to DELTA-1 do begin
Shuffler.Image1.Canvas.MoveTo(rW * i,0);
Shuffler.Image1.Canvas.LineTo(rW * i,Screen.Height);
Shuffler.Image1.Canvas.MoveTo(0, rH * i);
Shuffler.Image1.Canvas.LineTo(Screen.Width, rH * i);
end;
{
**add cell numbers (row; column)**
Shuffler.Image1.Canvas.Font.Size:=30;
for i := 0 to DELTA-1 do begin
for j := 0 to DELTA-1 do begin
Shuffler.Image1.Canvas.TextOut(rw * i, rh * j, IntToStr(i+1)+';'+ IntToStr(j+1));
end; //for j
end; //for i
}
end;
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); //right
1: gx := Abs((gx - 1) MOD DELTA); //left
2: gy := Abs((gy + 1) MOD DELTA); //down
3: gy := Abs((gy - 1) MOD DELTA); //up
end; //case
r2 := Rect(rW * gx , rH * gy, rW * gx + rW , rH * gy + rH);
with Shuffler.Image1.Canvas do begin
CopyRect(r1, Shuffler.Image1.Canvas, r2);
CopyRect(r2, redRect.Canvas, redRect.Canvas.ClipRect);
end;
end;
procedure TShuffler.FormCreate(Sender: TObject);
begin
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;
// SetWindowPos(Handle,HWND_TOPMOST,0,0,0,0,SWP_NOSIZE + SWP_NOMOVE);
Visible := True;
Timer1.Interval := 10; // smaller := faster
Timer1.Enabled := True; // start calling DrawScreen
end;
procedure TShuffler.Timer1Timer(Sender: TObject);
begin
DrawScreen;
end;
procedure TShuffler.FormDestroy(Sender: TObject);
begin
DesktopBitmap.Free;
redRect.Free;
end;
end.
UNIT1.DFM
object Shuffler: TShuffler
Left = 368
Top = 331
Width = 209
Height = 123
Caption = 'Shuffler'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object Image1: TImage
Left = 48
Top = 16
Width = 113
Height = 65
end
object Timer1: TTimer
OnTimer = Timer1Timer
Left = 8
Top = 8
end
end
{
********************************************
Zarko Gajic
About.com Guide to Delphi Programming
http://delphi.about.com
email: delphi.guide@about.com
free newsletter: http://delphi.about.com/library/blnewsletter.htm
forum: http://forums.about.com/ab-delphi/start/
********************************************
}