{
Исходник к статье: Перетасовка экрана в Delphi
http://delphi.about.com/
Пример, который позволяет
разделить экран на блоки, а затем поменять эти
блоки местами. Так же можно менять размеры блоков
и скрость их перемещения. На мой взгляд неплохое
начало для создания логической игрушки либо
экранной заставки..
.zip файл данного проекта можно взять здесь.
}
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/
********************************************
}
|