Приложение а Исходный текст программного средства

unit Unit1;

interface

uses

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

Dialogs, ExtCtrls, Menus, StdCtrls, Buttons, XPMan, ExtDlgs, ShellAPI;

type

mas = array[-1..10,-1..10]of integer;

rmas = array[0..9,0..9]of real;

TfmBattle = class(TForm)

pnFields: TPanel;

myField: TImage;

cField: TImage;

MainMenu1: TMainMenu;

N1: TMenuItem;

Panel1: TPanel;

Panel2: TPanel;

N2: TMenuItem;

N3: TMenuItem;

N4: TMenuItem;

Panel3: TPanel;

N5: TMenuItem;

N6: TMenuItem;

N7: TMenuItem;

N8: TMenuItem;

Label1: TLabel;

rb4: TRadioButton;

rb3: TRadioButton;

rb2: TRadioButton;

rb1: TRadioButton;

lbName: TLabel;

Label3: TLabel;

N9: TMenuItem;

XPManifest1: TXPManifest;

pnLegend: TPanel;

Shape3: TShape;

Shape4: TShape;

Shape5: TShape;

Shape6: TShape;

StaticText1: TStaticText;

StaticText2: TStaticText;

StaticText3: TStaticText;

Memo1: TMemo;

OpenDialog1: TOpenDialog;

SaveDialog1: TSaveDialog;

Button1: TButton;

Button2: TButton;

Button3: TButton;

Button4: TButton;

Panel4: TPanel;

Shape1: TShape;

Shape2: TShape;

rbV: TRadioButton;

rbG: TRadioButton;

procedure FormActivate(Sender: TObject);

procedure myFieldMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure bbReClick(Sender: TObject);

procedure cFieldMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure N8Click(Sender: TObject);

procedure N2Click(Sender: TObject);

procedure N9Click(Sender: TObject);

procedure N6Click(Sender: TObject);

procedure N3Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure Button4Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

fmBattle: TfmBattle;

A,B,C:mas;

D:rmas;

Sh,Ch,ds:array[1..4]of integer;

p,strg:integer;

flag,nol:boolean;

ds1,ds2:integer;

State:integer;

y,z,napr,o,pp,kp:integer;

S:Set of byte;

stt:File of rmas;

implementation

uses Unit3;

{$R *.dfm}

procedure InitMas(var A,B,C:mas);

var i,j:integer;

begin

for i:=-1 to 10 do

for j:=-1 to 10 do

begin

A[i,j]:=0;

B[i,j]:=0;

C[i,j]:=0;

end;

for i:=1 to 4 do

begin

Sh[i]:=5-i;

Ch[i]:=5-i;

Ds[i]:=5-i;

end;

p:=0;

For j:=-1 to 10 do

begin

C[-1,j]:=-5;

C[j,-1]:=-5;

end;

end;

function check1(k,l,d,b:integer;A:mas):boolean;

var f:boolean;

i,j:integer;

begin

f:=TRUE;

Case b of

1:begin

f:=True;

i:=k-1;

while f and (i<=k+d+1) do

begin

j:=l-1;

while f and (j<=l+1) do

begin

f:=(A[j,i]=0);

j:=j+1;

end;

i:=i+1;

end;

end;

2:begin

f:=True;

j:=l-1;

while f and (j<=l+d+1) do

begin

i:=k-1;

while f and (i<=k+1) do

begin

f:=(A[j,i]=0);

i:=i+1;

end;

j:=j+1;

end;

end;

end;

check1:=f;

end;

function check2(k,l,d,b:integer):boolean;

var f:boolean;

begin

f:=TRUE;

Case b of

1:f:=(k+d<=9);

2:f:=(l+d<=9);

end;

check2:=f;

end;

function check3(d:integer):boolean;

begin

check3:=(Sh[d+1]>0);

end;

procedure GetB(var B:mas);

var k,l,i,j,t,p:integer;

f1,f2,f3,f4:boolean;

begin

Randomize;

f1:=False;

f2:=False;

f3:=False;

f4:=False;

repeat

k:=Random(10);

l:=Random(10);

p:=Random(2)+1;

if check1(k,l,3,p,B)and check2(k,l,3,p)

then

begin

Case p of

1: for t:=k to k+3 do

B[l,t]:=4;

2: for t:=l to l+3 do

B[t,k]:=4;

end;

dec(Ch[4]);

f4:=True;

end;

until f4;

for i:=1 to 2 do

begin

f3:=False;

Repeat

k:=Random(10);

l:=Random(10);

p:=Random(2)+1;

if check1(k,l,2,p,B)and check2(k,l,2,p)

then

begin

Case p of

1: for t:=k to k+2 do

B[l,t]:=3;

2: for t:=l to l+2 do

B[t,k]:=3;

end;

dec(Ch[3]);

f3:=True;

end;

until f3;

end;

for i:=1 to 3 do

begin

f2:=False;

Repeat

k:=Random(10);

l:=Random(10);

p:=Random(2)+1;

if check1(k,l,1,p,B)and check2(k,l,1,p)

then

begin

Case p of

1: for t:=k to k+1 do

B[l,t]:=2;

2: for t:=l to l+1 do

B[t,k]:=2;

end;

dec(Ch[2]);

f2:=True;

end;

until f2;

end;

for i:=1 to 4 do

begin

f1:=False;

Repeat

k:=Random(10);

l:=Random(10);

p:=Random(2)+1;

if check1(k,l,0,p,B)and check2(k,l,0,p)

then

begin

Case p of

1: B[l,k]:=1;

2: B[l,k]:=1;

end;

dec(Ch[1]);

f1:=True;

end;

until f1;

end;

end;

function mru(k,l:integer;B:mas):integer;

begin

if (B[l,k]<=0)

then

mru:=0;

if (B[l,k]>0)

then

mru:=1;

end;

procedure TfmBattle.FormActivate(Sender: TObject);

var i,j:integer;

begin

if Fileexists('f1.stt')

then

begin

AssignFile(stt,'f1.stt');

Reset(stt);

Read(stt,D);

CloseFile(stt);

end

else

for i:=0 to 9 do

for j:=0 to 9 do

D[i,j]:=0;

nol:=true;

shape5.Brush.Color:=rgb(238,180,34);

shape6.Brush.Color:=rgb(205,38,38);

for i:=0 to 210 do

for j:=0 to 210 do

begin

myField.Canvas.Pixels[i,j]:=clAqua;

cField.Canvas.Pixels[i,j]:=clAqua;

end;

for j:=0 to 210 do

begin

myField.Canvas.Pixels[j,0]:=clNavy;

myField.Canvas.Pixels[0,j]:=clNavy;

cField.Canvas.Pixels[j,0]:=clNavy;

cField.Canvas.Pixels[0,j]:=clNavy;

myField.Canvas.Pixels[j,209]:=clNavy;

myField.Canvas.Pixels[209,j]:=clNavy;

cField.Canvas.Pixels[j,209]:=clNavy;

cField.Canvas.Pixels[209,j]:=clNavy;

end;

i:=21;

While i<=210 do

begin

For j:=1 to 210 do

begin

myField.Canvas.Pixels[i,j]:=clNavy;

cField.Canvas.Pixels[i,j]:=clNavy;

myField.Canvas.Pixels[j,i]:=clNavy;

cField.Canvas.Pixels[j,i]:=clNavy;

end;

i:=i+21;

end;

InitMas(A,B,C);

GetB(B);

ds1:=0;

ds2:=0;

S:=[];

o:=1;

pp:=2;

end;

procedure TfmBattle.myFieldMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

var i,j,k,l,t,d:integer;

begin

k:=X div 21;

l:=Y div 21;

d:=3;

If rb4.Checked

then

d:=3;

If rb3.Checked

then

d:=2;

If rb2.Checked

then

d:=1;

If rb1.Checked

then

d:=0;

If rbG.Checked

then

begin

if check1(k,l,d,1,A)and check2(k,l,d,1)and check3(d)

then

begin

for i:=k*21+1 to (k+d)*21+20 do

for j:=l*21+1 to l*21+20 do

if myField.Canvas.Pixels[i,j]<>clNavy

then

myField.Canvas.Pixels[i,j]:=clTeal;

for t:=k to k+d do

A[l,t]:=d+1;

p:=p+1;

dec(Sh[d+1]);

if Sh[d+1]=0

then

Case d of

0:rb1.Enabled:=False;

1:rb2.Enabled:=False;

2:rb3.Enabled:=False;

3:rb4.Enabled:=False;

end;

end;

end

else

begin

if check1(k,l,d,2,A)and check2(k,l,d,2)and check3(d)

then

begin

for i:=k*21+1 to k*21+20 do

for j:=l*21+1 to (l+d)*21+20 do

if myField.Canvas.Pixels[i,j]<>clNavy

then

myField.Canvas.Pixels[i,j]:=clTeal;

for t:=l to l+d do

A[t,k]:=d+1;

p:=p+1;

dec(Sh[d+1]);

if Sh[d+1]=0

then

Case d of

0:rb1.Enabled:=False;

1:rb2.Enabled:=False;

2:rb3.Enabled:=False;

3:rb4.Enabled:=False;

end;

end;

end;

If p=10

then

Button4.Enabled:=True;

end;

procedure TfmBattle.bbReClick(Sender: TObject);

var i,j:integer;

begin

for i:=0 to 210 do

for j:=0 to 210 do

begin

myField.Canvas.Pixels[i,j]:=clAqua;

cField.Canvas.Pixels[i,j]:=clAqua;

end;

for j:=0 to 210 do

begin

myField.Canvas.Pixels[j,0]:=clNavy;

myField.Canvas.Pixels[0,j]:=clNavy;

cField.Canvas.Pixels[j,0]:=clNavy;

cField.Canvas.Pixels[0,j]:=clNavy;

myField.Canvas.Pixels[j,209]:=clNavy;

myField.Canvas.Pixels[209,j]:=clNavy;

cField.Canvas.Pixels[j,209]:=clNavy;

cField.Canvas.Pixels[209,j]:=clNavy;

end;

i:=21;

While i<=210 do

begin

For j:=1 to 210 do

begin

myField.Canvas.Pixels[i,j]:=clNavy;

cField.Canvas.Pixels[i,j]:=clNavy;

myField.Canvas.Pixels[j,i]:=clNavy;

cField.Canvas.Pixels[j,i]:=clNavy;

end;

i:=i+21;

end;

InitMas(A,A,C);

rb1.Enabled:=True;

rb2.Enabled:=True;

rb3.Enabled:=True;

rb4.Enabled:=True;

rb4.Checked:=True;

Button4.Enabled:=False;

//Auto.Enabled:=True;

end;

procedure FindDead(d:integer;B:mas;cField:TImage);

var i,j,k,l,t,p:integer;

f1,f:boolean;

begin

f1:=True;

for l:=0 to 9 do

begin

for k:=0 to 9-d+1 do

begin

if (B[l,k]=-d-1)

then

begin

f:=True;

for t:=k+1 to k+d do

if B[l,t]<>-d-1

then

f:=False;

f1:=f;

if f1

then

begin

for i:=k*21+1 to (k+d)*21+20 do

for j:=l*21+1 to l*21+20 do

if cField.Canvas.Pixels[i,j]<>clNavy

then

cField.Canvas.Pixels[i,j]:=rgb(205,38,38);

for t:=k to k+d do

B[l,t]:=0;

t:=k-1;

for i:=(((t*21+1)+(t*21+20))div 2)-2 to(((t*21+1)+(t*21+20))div 2)+2 do

for j:=(((l*21+1)+(l*21+20))div 2)-2 to(((l*21+1)+(l*21+20))div 2)+2 do

cField.Canvas.Pixels[i,j]:=clTeal;

B[l,t]:=-5;

t:=k+d+1;

for i:=(((t*21+1)+(t*21+20))div 2)-2 to(((t*21+1)+(t*21+20))div 2)+2 do

for j:=(((l*21+1)+(l*21+20))div 2)-2 to(((l*21+1)+(l*21+20))div 2)+2 do

cField.Canvas.Pixels[i,j]:=clTeal;

B[l,t]:=-5;

for t:=k-1 to k+1+d do

begin

p:=l-1;

for i:=(((t*21+1)+(t*21+20))div 2)-2 to(((t*21+1)+(t*21+20))div 2)+2 do

for j:=(((p*21+1)+(p*21+20))div 2)-2 to(((p*21+1)+(p*21+20))div 2)+2 do

cField.Canvas.Pixels[i,j]:=clTeal;

B[p,t]:=-5;

p:=l+1;

for i:=(((t*21+1)+(t*21+20))div 2)-2 to(((t*21+1)+(t*21+20))div 2)+2 do

for j:=(((p*21+1)+(p*21+20))div 2)-2 to(((p*21+1)+(p*21+20))div 2)+2 do

cField.Canvas.Pixels[i,j]:=clTeal;

B[p,t]:=-5;

end;

end;

end;

end;

end;

f1:=True;

for l:=0 to 9 do

begin

for k:=0 to 9-d+1 do

begin

if (B[k,l]=-d-1)

then

begin

f:=True;

for t:=k+1 to k+d do

if B[t,l]<>-d-1

then

f:=False;

f1:=f;

if f1

then

begin

for i:=k*21+1 to (k+d)*21+20 do

for j:=l*21+1 to l*21+20 do

if cField.Canvas.Pixels[j,i]<>clNavy

then

cField.Canvas.Pixels[j,i]:=rgb(205,38,38);

for t:=k to k+d do

B[t,l]:=0;

t:=k-1;

for i:=(((t*21+1)+(t*21+20))div 2)-2 to(((t*21+1)+(t*21+20))div 2)+2 do

for j:=(((l*21+1)+(l*21+20))div 2)-2 to(((l*21+1)+(l*21+20))div 2)+2 do

cField.Canvas.Pixels[j,i]:=clTeal;

B[l,t]:=-5;

t:=k+d+1;

for i:=(((t*21+1)+(t*21+20))div 2)-2 to(((t*21+1)+(t*21+20))div 2)+2 do

for j:=(((l*21+1)+(l*21+20))div 2)-2 to(((l*21+1)+(l*21+20))div 2)+2 do

cField.Canvas.Pixels[j,i]:=clTeal;

B[l,t]:=-5;

for t:=k-1 to k+1+d do

begin

p:=l-1;

for i:=(((t*21+1)+(t*21+20))div 2)-2 to(((t*21+1)+(t*21+20))div 2)+2 do

for j:=(((p*21+1)+(p*21+20))div 2)-2 to(((p*21+1)+(p*21+20))div 2)+2 do

cField.Canvas.Pixels[j,i]:=clTeal;

B[p,t]:=-5;

p:=l+1;

for i:=(((t*21+1)+(t*21+20))div 2)-2 to(((t*21+1)+(t*21+20))div 2)+2 do

for j:=(((p*21+1)+(p*21+20))div 2)-2 to(((p*21+1)+(p*21+20))div 2)+2 do

cField.Canvas.Pixels[j,i]:=clTeal;

B[p,t]:=-5;

end;

end;

end;

end;

end;

end;