Created
January 13, 2013 12:19
-
-
Save jermenkoo/4523808 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
unit Unit1; | |
interface | |
uses | |
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, | |
Dialogs, ExtCtrls, StdCtrls; | |
type | |
TForm1 = class(TForm) | |
Image1: TImage; | |
procedure FormCreate(Sender: TObject); | |
procedure FormResize(Sender: TObject); | |
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton; | |
Shift: TShiftState; X, Y: Integer); | |
private | |
{ Private declarations } | |
public | |
{ Public declarations } | |
end; | |
var | |
Form1: TForm1; | |
SizeX : integer = 4; | |
SizeY : integer = 4; | |
numbers : array of array of integer; //pole s cislami | |
sorted : boolean; | |
implementation | |
{$R *.dfm} | |
procedure Shuffle; forward; | |
function Wincheck : boolean; forward; | |
//nakresli kocku | |
procedure Box(var x, y : integer); | |
var w, h : integer; | |
begin | |
w := Form1.Image1.Width div SizeX; | |
h := Form1.Image1.Height div SizeY; | |
Form1.Image1.Canvas.Rectangle(w * x, h * y, w * x + w, h * y + h); | |
//vypis cisla | |
if numbers[x][y] <> 0 then | |
Form1.Image1.Canvas.TextOut(w*x+(w div 2), h*y+(h div 2), IntToStr(numbers[x, y])); | |
end; | |
//nakresli pole stvorcov | |
procedure DrawField; | |
var i, j : integer; | |
begin | |
for i := 0 to SizeX - 1 do begin | |
for j := 0 to SizeY - 1 do begin | |
Box(i, j); | |
end; | |
end; | |
end; | |
//posunie kocku | |
procedure MoveBox(var x, y: integer); | |
var width, height: integer; | |
begin | |
if (y+1 < SizeY) and (numbers[x][y+1] = 0) then begin | |
numbers[x][y+1] := numbers[x][y]; | |
numbers[x][y] := 0; | |
end; | |
if (y-1 >= 0) and (numbers[x][y-1] = 0) then begin | |
numbers[x][y-1] := numbers[x][y]; | |
numbers[x][y] := 0; | |
end; | |
if (x+1 < SizeX) and (numbers[x+1][y] = 0) then begin | |
numbers[x+1][y] := numbers[x][y]; | |
numbers[x][y] := 0; | |
end; | |
if (x-1 >= 0) and (numbers[x-1][y] = 0) then begin | |
numbers[x-1][y] := numbers[x][y]; | |
numbers[x][y] := 0; | |
end; | |
DrawField; | |
if Wincheck then Application.MessageBox('You win!', 'Victory!', 0); | |
end; | |
procedure TForm1.FormCreate(Sender: TObject); | |
var i, j, value : integer; | |
begin | |
DoubleBuffered := true; | |
Image1.Width := Form1.ClientWidth; | |
Image1.Height := Form1.ClientHeight; | |
Image1.Canvas.Rectangle(0, 0, Form1.ClientWidth, Form1.ClientHeight); | |
value := 1; | |
SetLength(Numbers, SizeX); | |
for i := 0 to SizeX-1 do | |
SetLength(Numbers[i], SizeY); | |
for j := 0 to SizeX - 1 do begin | |
for i := 0 to SizeY - 1 do begin | |
numbers[i][j] := value; | |
value := value + 1; | |
end; | |
end; | |
numbers[SizeX - 1][SizeY - 1] := 0; | |
Randomize; | |
Shuffle; | |
DrawField; | |
end; | |
//vymeni hodnotu | |
//no XOR quick-hack | |
procedure Swap(var x, y : integer); | |
var temp : integer; | |
begin | |
temp := x; | |
x := y; | |
y := temp; | |
end; | |
//zamiesa pole | |
procedure Shuffle; | |
var i, j, k : integer; | |
begin; | |
for i := 0 to SizeX - 1 do begin | |
for j := 0 to SizeY - 1 do begin | |
for k := SizeY - 1 downto 0 do Swap(numbers[i][j], numbers[i][Succ(Random(k))]); | |
end; | |
end; | |
end; | |
//skontroluje ci sme hru vyhrali | |
//reverzny algoritmus podla plnenia pola | |
function Wincheck; | |
var i, j, val : integer; | |
begin | |
sorted := true; | |
val := 1; | |
for j := 0 to SizeX - 1 do begin | |
for i := 0 to SizeY - 1 do begin | |
if (i = 3) and (j = 3) then sorted := sorted and (numbers[i][j] = 0) | |
else begin | |
sorted := sorted and (numbers[i][j] = val); | |
inc(val); | |
end; | |
end; | |
end; | |
result := sorted; | |
end; | |
procedure TForm1.FormResize(Sender: TObject); | |
begin | |
//priradenie po resize | |
Image1.ClientWidth := Form1.ClientWidth; | |
Image1.ClientHeight := Form1.ClientHeight; | |
Image1.Canvas.Rectangle(0, 0, Image1.ClientHeight, Image1.ClientWidth); | |
DrawField; | |
end; | |
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; | |
Shift: TShiftState; X, Y: Integer); | |
var BoxX, BoxY: integer; | |
var width, height: integer; | |
begin | |
width := Form1.Image1.Width div SizeX; | |
height := Form1.Image1.Height div SizeY; | |
BoxX := X div width; | |
BoxY := Y div height; | |
MoveBox(BoxX, BoxY); | |
end; | |
end. |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment