15 мая 2023 года "Исходники.РУ" отмечают своё 23-летие!
Поздравляем всех причастных и неравнодушных с этим событием!
И огромное спасибо всем, кто был и остаётся с нами все эти годы!

Главная Форум Журнал Wiki DRKB Discuz!ML Помощь проекту




{
Исходник к статье: Перетасовка экрана в 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/
********************************************
}