44945 (664042), страница 2

Просмтор этого файла доступен только зарегистрированным пользователям. Но у нас супер быстрая регистрация: достаточно только электронной почты!

Текст из файла (страница 2)

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, Menus, ExtDlgs;

type

TForm1 = class(TForm)

MainMenu1: TMainMenu;

N1: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

N4: TMenuItem;

N5: TMenuItem;

N6: TMenuItem;

N7: TMenuItem;

N8: TMenuItem;

N9: TMenuItem;

N10: TMenuItem;

N11: TMenuItem;

OpenPictureDialog1: TOpenPictureDialog;

procedure FormCreate(Sender: TObject);

procedure FormMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure FormPaint(Sender: TObject);

procedure ShowPole;

procedure Mixer;

procedure NewGame;

procedure Formmas;

procedure N11Click(Sender: TObject);

procedure N7Click(Sender: TObject);

procedure N2Click(Sender: TObject);

procedure N3Click(Sender: TObject);

procedure N6Click(Sender: TObject);

procedure N8Click(Sender: TObject);

procedure N9Click(Sender: TObject);

procedure N10Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

uses Progr, Unit3;

{$R *.dfm}

var wc,hc,h,w: integer;fname: string;

pole: array of array of byte;

ex, ey:integer;

stp: array of array of byte;

{(1, 2, 3, 4),(5, 6, 7, 8), (9, 10, 11, 12), (13, 14, 15, 0)}

pic: TBitmap;

procedure TForm1.NewGame;

var

i, j:integer;

begin

try

pic.LoadFromFile(fname);

except

on EFopenError do

begin

ShowMessage('Ошибка обращения к файлу' + fname);

Form1.Close;

end;

end;

hc:=Pic.Height div H;

wc:=Pic.Width div W;

ClientWidth:= wc * W;

ClientHeight:= hc * H;

for i:=1 to H do

for j:=1 to W do

pole[i,j]:= stp[i,j];

Form1.Mixer;

Form1.ShowPole;

end;

function Finish: boolean;

var

row,col: integer;

i: integer;

begin

row:=1; col:=1;

Finish:= True;

for i:=1 to 15 do

begin

if pole[row,col] <> i then

begin

Finish:=False;

break;

end;

if col < 4 then inc(col) else begin

col :=1;

inc(row);

end;

end;

end;

procedure TForm1.Formmas;

var

i,j:integer;

begin

SetLength(stp,H+1,W+1);

SetLength(pole,H+1,W+1);

for i:=1 to H do

for j:=1 to W do

stp[i,j]:=h*(i-1)+j;

stp[H,W]:=0

end;

procedure Move(cx, cy:integer);

var

r:integer;

begin

if not (( abs(cx-ex)=1) and (cy-ey=0) or

( abs(cy-ey)=1) and (cx-ex=0)) then exit;

Pole[ey,ex]:=Pole[cy,cx];

Pole[cy,cx]:=0;

ex:=cx;

ey:=cy;

Form1.ShowPole;

if Finish then

begin

pole[H,W]:=H*W;

Form1.ShowPole;

r:=MessageDlg('Цель достигнута!'+ #13+

'Еще раз?', mtInformation, [mbYes, mbNo], 0);

if r = mrNo then Form1.Close;

Form1.NewGame;

end;

end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

var

cx,cy:integer;

begin

cx:= Trunc(X / wc) + 1;

cy:= Trunc(Y / hc) +1;

Move(cx, cy);

end;

procedure TForm1.ShowPole;

var

Source, Dest: Trect;

sx, sy: integer;

i,j: integer;

begin

for i:=1 to W do

for j:=1 to H do

begin

sy:=((pole[i,j]-1) div W)*hc;

sx:=((pole[i,j]-1) mod W)*wc;

Source:=Bounds(sx,sy,wc,hc);

Dest:=Bounds((j-1)*wc,(i-1)*hc,wc,hc);

if pole[i,j] <> 0 then Canvas.CopyRect(Dest,pic.Canvas,Source)

else Canvas.Rectangle((j-1)*wc,(i-1)*hc,j*wc,i*hc);

end;

end;

procedure TForm1.Mixer;

var

x1,y1: integer;

x2,y2: integer;

d: integer;

i: integer;

begin

x1:=H; y1:=W;

randomize;

for i:=1 to 150 do

begin

repeat

x2:=x1;

y2:=y1;

d:=random(4)+1;

case d of

1: dec(x2);

2: inc(x2);

3: dec(y2);

4: inc(y2);

end;

until (x2>=1) and (x2=1) and (y2<=w);

Pole[y1,x1]:= Pole[y2,x2];

Pole[y2,x2]:=0;

x1:=x2;

y1:=y2;

end;

ex:=x1;

ey:=y1;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

pic:= TBitMap.Create;fname:= 'pic_1.bmp';

H:=4;W:=4;

Formmas;

NewGame;

end;

procedure TForm1.FormPaint(Sender: TObject);

begin

Form1.ShowPole;

end;

procedure TForm1.N11Click(Sender: TObject);

begin

close;

end;

procedure TForm1.N7Click(Sender: TObject);

begin

Form2.ShowModal

end;

procedure TForm1.N2Click(Sender: TObject);

Var i,j:integer;

begin

for i:=1 to H do

for j:=1 to W do

pole[i,j]:= stp[i,j];

Form1.Mixer;

Form1.ShowPole;

end;

procedure TForm1.N3Click(Sender: TObject);

begin

if OpenPictureDialog1.Execute

then fname:=OpenPictureDialog1.FileName;

NewGame;

end;

procedure TForm1.N6Click(Sender: TObject);

begin

Form3.RichEdit1.Lines.LoadFromFile('Правила.rtf');

Form3.ShowModal;

end;

procedure TForm1.N8Click(Sender: TObject);

var

i,j:integer;

begin

H:=4;W:=4;

Formmas;

NewGame;

N2Click(Sender);

end;

procedure TForm1.N9Click(Sender: TObject);

var

i,j:integer;

begin

h:=5;w:=5;

Formmas;

NewGame;

N2Click(Sender);

end;

procedure TForm1.N10Click(Sender: TObject);

var

i,j:integer;

begin

h:=6;w:=6;

Formmas;

NewGame;

N2Click(Sender);

end;

end.

24

Характеристики

Список файлов реферата