1. Home
  2. Computing & Technology
  3. Delphi Programming

{
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/
********************************************
}
Explore Delphi Programming
About.com Special Features

Stay connected and entertained with reviews on tips on the latest HDTVs, cellphones and more. More >

Easy ways to connect two computers for networking purposes. More >

  1. Home
  2. Computing & Technology
  3. Delphi Programming

©2009 About.com, a part of The New York Times Company.

All rights reserved.