Текст программы

Главное окно программы

unit Pre;

interface

uses

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

Dialogs, ExtCtrls, StdCtrls;

type

TIntro = class (TForm)

Start: TImage;

Exit: TImage;

Background: TImage;

PStart: TImage;

PExit: TImage;

PStart01: TImage;

Start01: TImage;

procedure FormCreate (Sender: TObject);

procedure StartMouseDown (Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure StartMouseUp (Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure ExitMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

procedure ExitMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

procedure Start01MouseDown (Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure Start01MouseUp (Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Intro: TIntro;

WinText,WholestepsText,playkeyb,playmouse: string;

implementation

uses Unit1,Unit2;

{$R *. dfm}

procedure Play;

begin

begin

WinText: ='Вы выиграли! ';

WholestepsText: ='Всего ходов: ';

end;

main. showmodal;

end;

procedure Play2;

begin

begin

WinText: ='Вы выиграли! ';

WholestepsText: ='Всего ходов: ';

end;

main1. showmodal;

end;

procedure TIntro. FormCreate (Sender: TObject);

begin

Intro. left: = (screen. Width-Intro. Width) div 2;

Intro. top: = (screen. Height-Intro. Height) div 2;

end;

procedure TIntro. StartMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

Start. Visible: =False;

PStart. Visible: =True;

end;

procedure TIntro. StartMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

Start. Visible: =True;

PStart. Visible: =False;

Play;

end;

procedure TIntro. ExitMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

Exit. Visible: =False;

PExit. Visible: =True;

end;

procedure TIntro. ExitMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

Exit. Visible: =True;

PExit. Visible: =False;

Halt;

end;

procedure TIntro. Start01MouseDown (Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

Start01. Visible: =False;

PStart01. Visible: =True;

end;

procedure TIntro. Start01MouseUp (Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

Start01. Visible: =True;

PStart01. Visible: =False;

Play2;

end;

end.

Окно с числовым игровым полем

unit Unit1;

interface

uses

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

Dialogs, StdCtrls, ExtCtrls;

type

TMain = class (TForm)

Image1: TImage;

Label1: TLabel;

Label2: TLabel;

Switch: TImage;

Reset: TImage;

Exit: TImage;

Image5: TImage;

PExit: TImage;

PReset: TImage;

PSwitch: TImage;

procedure FormCreate (Sender: TObject);

procedure Image1Click (Sender: TObject);

procedure FormPaint (Sender: TObject);

procedure FormKeyDown (Sender: TObject; var Key: Word;

Shift: TShiftState);

procedure SwitchClick (Sender: TObject);

procedure ResetClick (Sender: TObject);

procedure ExitClick (Sender: TObject);

procedure SwitchMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

procedure SwitchMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

procedure ResetMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

procedure ResetMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

procedure ExitMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

procedure ExitMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Main: TMain;

Pjat: array [1.16] of integer;

steps, keybpos: integer;

keyb: string;

implementation

uses pre;

{$R *. dfm}

procedure startpjat ();

var

i,q,w,a: integer;

begin

steps: =0;

main. label2. caption: ='0';

randomize;

pjat [1]: =random (16);

for i: =2 to 16 do

begin

a: =1;

while (a=1) do

begin

w: =0;

pjat [i]: =random (16);

for q: =i-1 downto 1 do

if (pjat [i] =pjat [q]) then w: =w+1;

if (w=0) then a: =2;

end;

end;

end;

procedure ReloadPole (canvas: TCanvas);

var i,q,w,x,y: integer;

begin

canvas. Rectangle (0,0, 201, 201);

if keyb='yes' then

begin

canvas. Brush. Color: =clGradientInactiveCaption;

case keybpos of

1: begin x: =0; y: =0; end;

2: begin x: =50; y: =0; end;

3: begin x: =100; y: =0; end;

4: begin x: =150; y: =0; end;

5: begin x: =0; y: =50; end;

6: begin x: =50; y: =50; end;

7: begin x: =100; y: =50; end;

8: begin x: =150; y: =50; end;

9: begin x: =0; y: =100; end;

10: begin x: =50; y: =100; end;

11: begin x: =100; y: =100; end;

12: begin x: =150; y: =100; end;

13: begin x: =0; y: =150; end;

14: begin x: =50; y: =150; end;

15: begin x: =100; y: =150; end;

16: begin x: =150; y: =150; end;

end;

canvas. Rectangle (x,y,x+51,y+51);

canvas. Brush. Color: =clWhite;

end;

w: =3;

for q: =0 to w do

for i: =0 to w do

begin

canvas. MoveTo (i*50,q*50);

canvas. LineTo ( (i) *50, (w-q+1) *50);

canvas. MoveTo (i*50,q*50);

canvas. LineTo ( (w-i+1) *50, (q) *50);

end;

w: =1;

for q: =1 to 4 do

for i: =1 to 4 do

begin

if (pjat [w] <>0) then

if (keyb='yes') and (keybpos=w) then

begin

canvas. Brush. Color: =clGradientInactiveCaption;

canvas. TextOut (i*50-30,q*50-30, inttostr (pjat [w]));

canvas. Brush. Color: =clWhite;

end else

canvas. TextOut (i*50-30,q*50-30, inttostr (pjat [w]));

w: =w+1;

end;

end;

function CheckPole (): string;

var i: integer;

begin

result: ='yes';

for i: =1 to 15 do if (pjat [i] <>i) then result: ='no';

if (pjat [16] <>0) then result: ='no';

end;

procedure TMain. FormCreate (Sender: TObject);

begin

startpjat ();

reloadPole (image1. Canvas);

main. left: = (screen. Width-main. Width) div 2;

main. top: = (screen. Height-main. Height) div 2;

keyb: ='no';

keybpos: =1;

end;

procedure TMain. ResetClick (Sender: TObject);

begin

startpjat ();

reloadPole (image1. Canvas);

end;

procedure go (i,cell: integer);

begin

pjat [i]: =pjat [cell];

pjat [cell]: =0;

steps: =steps+1;

reloadPole (main. image1. Canvas);

main. label2. Caption: =inttostr (steps);

if CheckPole='yes' then showmessage (pre. wintext);

end;

procedure direction (dire: string);

var cell: integer;

begin

if dire='sdown' then if (keybpos<=12) then keybpos: =keybpos+4;

if dire='sleft' then if (keybpos<>1) and (keybpos<>5) and (keybpos<>9) and (keybpos<>13) then keybpos: =keybpos-1;

if dire='sup' then if (keybpos>=5) then keybpos: =keybpos-4;

if dire='sright'then if (keybpos<>4) and (keybpos<>8) and (keybpos<>12) and (keybpos<>16) then keybpos: =keybpos+1;

if dire='space' then begin

cell: =keybpos;

if (pjat [cell-1] =0) and (cell>=2) and (cell<=17) then

go (cell-1,cell);

if (pjat [cell+1] =0) and (cell>=0) and (cell<=15) then

go (cell+1,cell);

if (pjat [cell-4] =0) and (cell>=5) and (cell<=20) then

go (cell-4,cell);

if (pjat [cell+4] =0) and (cell>=-3) and (cell<=12) then

go (cell+4,cell);

end;

reloadPole (main. image1. Canvas);

end;

procedure TMain. Image1Click (Sender: TObject);

var

x,y,cell: integer;

begin

if keyb='no' then

begin

x: =mouse. CursorPos. x-image1. left-main. Left-4;

y: =mouse. CursorPos. y-image1. top-main. top-30;

x: =x div 50;

y: =y div 50;

cell: =x*1+y*4+1;

if (pjat [cell-1] =0) and (cell>=2) and (cell<=17) then

go (cell-1,cell);

if (pjat [cell+1] =0) and (cell>=0) and (cell<=15) then

go (cell+1,cell);

if (pjat [cell-4] =0) and (cell>=5) and (cell<=20) then

go (cell-4,cell);

if (pjat [cell+4] =0) and (cell>=-3) and (cell<=12) then

go (cell+4,cell);

end;

end;

procedure TMain. SwitchClick (Sender: TObject);

begin

if (keyb='yes')

then

begin

keyb: ='no';

reloadpole (image1. Canvas);

end

else

begin

keyb: ='yes';

reloadpole (image1. Canvas);

end;

end;

procedure TMain. ExitClick (Sender: TObject);

begin

halt;

end;

procedure TMain. FormPaint (Sender: TObject);

begin

label1. Caption: =pre. WholestepsText;

if keyb='no'

then

if keyb='yes'

then

end;

procedure TMain. FormKeyDown (Sender: TObject; var Key: Word;

Shift: TShiftState);

begin

if keyb='yes'

then

case Key of

vk_down: direction ('sdown');

vk_left: direction ('sleft');

vk_up: direction ('sup');

vk_right: direction ('sright');

vk_space: direction ('space');

VK_TAB: SwitchClick (Sender);

end

else

case key of

VK_TAB: SwitchClick (Sender);

end;

end;

procedure TMain. SwitchMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

Switch. Visible: =False;

PSwitch. Visible: =True;

end;

procedure TMain. SwitchMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

Switch. Visible: =True;

PSwitch. Visible: =False;

end;

procedure TMain. ResetMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

Reset. Visible: =False;

PReset. Visible: =True;

end;

procedure TMain. ResetMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

Reset. Visible: =True;

PReset. Visible: =False;

end;

procedure TMain. ExitMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

Exit. Visible: =False;

PExit. Visible: =True;

end;

procedure TMain. ExitMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

Exit. Visible: =True;

PExit. Visible: =False;

end;

end.

Окно с буквенным игровым полем

unit Unit2;

interface

uses

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

Dialogs, StdCtrls, ExtCtrls;

type

TMain1 = class (TForm)

Image1: TImage;

Label1: TLabel;

Label2: TLabel;

Switch: TImage;

Reset: TImage;

Exit: TImage;

Image5: TImage;

PExit: TImage;

PReset: TImage;

PSwitch: TImage;

procedure FormCreate (Sender: TObject);

procedure Image1Click (Sender: TObject);

procedure FormPaint (Sender: TObject);

procedure FormKeyDown (Sender: TObject; var Key: Word;

Shift: TShiftState);

procedure SwitchClick (Sender: TObject);

procedure ResetClick (Sender: TObject);

procedure ExitClick (Sender: TObject);

procedure SwitchMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

procedure SwitchMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

procedure ResetMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

procedure ResetMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

procedure ExitMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

procedure ExitMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Main1: TMain1;

Pjat: array [1.16] of integer;

steps, keybpos: integer;

keyb: string;

implementation

uses pre;

{$R *. dfm}

procedure startpjat ();

var

i,q,w,a: integer;

begin

steps: =0;

main1. label2. caption: ='0';

randomize;

pjat [1]: =random (16);

for i: =2 to 16 do

begin

a: =1;

while (a=1) do

begin

w: =0;

pjat [i]: =random (16);

for q: =i-1 downto 1 do

if (pjat [i] =pjat [q]) then w: =w+1;

if (w=0) then a: =2;

end;

end;

end;

procedure ReloadPole (canvas: TCanvas);

var i,q,w,x,y: integer;

mass58: array [1.15] of char;

begin

mass58 [1]: ='a';

mass58 [2]: ='b';

mass58 [3]: ='c';

mass58 [4]: ='d';

mass58 [5]: ='e';

mass58 [6]: ='f';

mass58 [7]: ='g';

mass58 [8]: ='h';

mass58 [9]: ='i';

mass58 [10]: ='j';

mass58 [11]: ='k';

mass58 [12]: ='l';

mass58 [13]: ='m';

mass58 [14]: ='n';

mass58 [15]: ='o';

canvas. Rectangle (0,0, 201, 201);

if keyb='yes' then

begin

canvas. Brush. Color: =clGradientInactiveCaption;

case keybpos of

1: begin x: =0; y: =0; end;

2: begin x: =50; y: =0; end;

3: begin x: =100; y: =0; end;

4: begin x: =150; y: =0; end;

5: begin x: =0; y: =50; end;

6: begin x: =50; y: =50; end;

7: begin x: =100; y: =50; end;

8: begin x: =150; y: =50; end;

9: begin x: =0; y: =100; end;

10: begin x: =50; y: =100; end;

11: begin x: =100; y: =100; end;

12: begin x: =150; y: =100; end;

13: begin x: =0; y: =150; end;

14: begin x: =50; y: =150; end;

15: begin x: =100; y: =150; end;

16: begin x: =150; y: =150; end;

end;

canvas. Rectangle (x,y,x+51,y+51);

canvas. Brush. Color: =clWhite;

end;

w: =3;

for q: =0 to w do

for i: =0 to w do

begin

canvas. MoveTo (i*50,q*50);

canvas. LineTo ( (i) *50, (w-q+1) *50);

canvas. MoveTo (i*50,q*50);

canvas. LineTo ( (w-i+1) *50, (q) *50);

end;

w: =1;

for q: =1 to 4 do

for i: =1 to 4 do

begin

if (pjat [w] <>0) then

if (keyb='yes') and (keybpos=w) then

begin

canvas. Brush. Color: =clGradientInactiveCaption;

canvas. TextOut (i*50-30,q*50-30,mass58 [Pjat [w]]);

canvas. Brush. Color: =clWhite;

end else

canvas. TextOut (i*50-30,q*50-30,mass58 [Pjat [w]]);

w: =w+1;

end;

end;

function CheckPole (): string;

var i: integer;

begin

result: ='yes';

for i: =1 to 15 do if (pjat [i] <>i) then result: ='no';

if (pjat [16] <>0) then result: ='no';

end;

procedure TMain1. FormCreate (Sender: TObject);

begin

startpjat ();

reloadPole (image1. Canvas);

main1. left: = (screen. Width-main1. Width) div 2;

main1. top: = (screen. Height-main1. Height) div 2;

keyb: ='no';

keybpos: =1;

end;

procedure TMain1. ResetClick (Sender: TObject);

begin

startpjat ();

reloadPole (image1. Canvas);

end;

procedure go (i,cell: integer);

begin

pjat [i]: =pjat [cell];

pjat [cell]: =0;

steps: =steps+1;

reloadPole (main1. image1. Canvas);

main1. label2. Caption: =inttostr (steps);

if CheckPole='yes' then showmessage (pre. wintext);

end;

procedure direction (dire: string);

var cell: integer;

begin

if dire='sdown' then if (keybpos<=12) then keybpos: =keybpos+4;

if dire='sleft' then if (keybpos<>1) and (keybpos<>5) and (keybpos<>9) and (keybpos<>13) then keybpos: =keybpos-1;

if dire='sup' then if (keybpos>=5) then keybpos: =keybpos-4;

if dire='sright'then if (keybpos<>4) and (keybpos<>8) and (keybpos<>12) and (keybpos<>16) then keybpos: =keybpos+1;

if dire='space' then begin

cell: =keybpos;

if (pjat [cell-1] =0) and (cell>=2) and (cell<=17) then

go (cell-1,cell);

if (pjat [cell+1] =0) and (cell>=0) and (cell<=15) then

go (cell+1,cell);

if (pjat [cell-4] =0) and (cell>=5) and (cell<=20) then

go (cell-4,cell);

if (pjat [cell+4] =0) and (cell>=-3) and (cell<=12) then

go (cell+4,cell);

end;

reloadPole (main1. image1. Canvas);

end;

procedure TMain1. Image1Click (Sender: TObject);

var

x,y,cell: integer;

begin

if keyb='no' then

begin

x: =mouse. CursorPos. x-image1. left-main1. Left-4;

y: =mouse. CursorPos. y-image1. top-main1. top-30;

x: =x div 50;

y: =y div 50;

cell: =x*1+y*4+1;

if (pjat [cell-1] =0) and (cell>=2) and (cell<=17) then

go (cell-1,cell);

if (pjat [cell+1] =0) and (cell>=0) and (cell<=15) then

go (cell+1,cell);

if (pjat [cell-4] =0) and (cell>=5) and (cell<=20) then

go (cell-4,cell);

if (pjat [cell+4] =0) and (cell>=-3) and (cell<=12) then

go (cell+4,cell);

end;

end;

procedure TMain1. SwitchClick (Sender: TObject);

begin

if (keyb='yes')

then

begin

keyb: ='no';

reloadpole (image1. Canvas);

end

else

begin

keyb: ='yes';

reloadpole (image1. Canvas);

end;

end;

procedure TMain1. ExitClick (Sender: TObject);

begin

halt;

end;

procedure TMain1. FormPaint (Sender: TObject);

begin

label1. Caption: =pre. WholestepsText;

if keyb='no'

then

if keyb='yes'

then

end;

procedure TMain1. FormKeyDown (Sender: TObject; var Key: Word;

Shift: TShiftState);

begin

if keyb='yes'

then

case Key of

vk_down: direction ('sdown');

vk_left: direction ('sleft');

vk_up: direction ('sup');

vk_right: direction ('sright');

vk_space: direction ('space');

VK_TAB: SwitchClick (Sender);

end

else

case key of

VK_TAB: SwitchClick (Sender);

end;

end;

procedure TMain1. SwitchMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

Switch. Visible: =False;

PSwitch. Visible: =True;

end;

procedure TMain1. SwitchMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

Switch. Visible: =True;

PSwitch. Visible: =False;

end;

procedure TMain1. ResetMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

Reset. Visible: =False;

PReset. Visible: =True;

end;

procedure TMain1. ResetMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

Reset. Visible: =True;

PReset. Visible: =False;

end;

procedure TMain1. ExitMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

Exit. Visible: =False;

PExit. Visible: =True;

end;

procedure TMain1. ExitMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

Exit. Visible: =True;

PExit. Visible: =False;

end;

end.

Размещено на Allbest.ru