,,,
: <15>
2008
.
1.
2.
3.
4.
4.1
4.2
4.3 <15>
5.
5.1
5.2 , , .
5.3
5.4
5.5
6.
7.
8.
9.
.
.
.
, , , .
. , .
, .
. , c .
, , , , ..
.
. , , 1968 . , , /1, , .
80- MS PASCAL Turbo PASCAL . .
. , , , . ( ). , , - .
. , , , , , .
. 4*4. 15 , . .
, , . , , . , ( -, -), .
. , , , , . , () . , :1. 16 2. 1, 2, 3, 4, ... 15 ( , ) , 3. 4. 5. .
6. , , 3
3 { }. . , , ( , ). , , - , . .
, 3:
1.
2.
3. . , . , 1
4. . : , , ,
5.
6. 1
, , . .
. , , , ( , ).
|
||||
, {E x i t}. , .
, ( ) , ( menu). , menu. , else . , - case, .
menu : 0, 1, 2, 3. case, : 0, 1, 2. 3 ( {Exit}), case , .
. , .
<15> . , 4-x . (up,down), , . . . , (up down), . , ( , ). . Enter, , . , , .
|
, , , - menu ., 0, .
, . , . , .
|
|
|
|
, n-1 , , n- . , n- .
, .
, . , 16 .
, , , . UP, DOWN, LEFT,
RIGHT. , , . , .
( ), . , , , . .
, ( ).
, . , . . , , . , , , .
, . , Esc. . . , . , . Esc.
, .
, , . , , .
, , .
24 . , Esc. , Enter, , Esc. <15>.
<15>
. petnash.pas- , . petnash1.pas- , , .
program petnash;
uses
crt,graph,
petnash1;{, }
Var
grDriver,grMode,ErrCode,men:integer;
Begin(*petnash*)
{ }
grDriver:=Detect;
InitGraph(grDriver, grMode,'');
ErrCode := GraphResult;
if ErrCode <> grOk
then
begin
Writeln('Graphics error:',GraphErrorMsg(ErrCode));
Writeln('Press - <ENTER>');
Readln;
Halt;
end;
{ }
setcolor( 6);
setlinestyle(0,0,1);
recod; { }
repeat
menu(men);{, }
case men of
0:game; {}
1:best; { }
2:help; { }
end;(*case*)
until men=3; { }
closegraph { }
END.(*petnash*)
Unit petnash1;
(**************)Interface(*****************)
uses
crt,graph;
const
{ , }
Up=#72;
Down=#80;
Left=#75;
Right=#77;
Space=#32;
Esc=#27;
Enter=#13;
type
strok=string[10];
var
stroka:array[1..12] of strok;
f02,f03:text;
st02:string[10];
stl2:string[20];
a,b2,pl,kl,o:char;
st,st1:string[5];
step:string[5];
u,vict:boolean;
mas:array [1..16] of integer;
a02,b3,c02,b,b1,d,e,e02,i,i1,j,n,r,steps,x,
x1,y,y1,yme:integer;
grDriver,grMode:integer;
m,m1,m2,m3:integer;
p,p1,p2,p3:pointer;
procedure recod;
procedure buk(a,b,c:integer;s:char);
procedure victory;
procedure nomer(xp,yp,ip:integer);
procedure kv(xk,yk:integer);
procedure tabl(xv,yv:integer;klv:char;var xv1,yv1:integer);
procedure menu(var ym:integer);
procedure game;
procedure best;
procedure help;
(*************)Implementation(****************)
(* *)
(* 'rezult.dat'*)
procedure recod;
begin(*recod*)
assign(f02,'rezult.dat');
reset(f02);{ }
for i:=1 to 10 do { }
readln(f02,stroka[i]);
end;(*recod*)
(* *)
procedure buk(a,b,c:integer;s:char);
begin (*buk*)
for I:=a downto b do
begin
{ }
setcolor(1);
settextstyle(1,0,10);{ }
outtextxy(c,i,s);
{ ,
}
setcolor(14);
settextstyle(1,0,10);
outtextxy(c,i,s);
end;
{ }
setcolor(1);
settextstyle(1,0,10);
outtextxy(c,b,s);
end;(*buk*)
(* *)
procedure victory;
begin (*victory*)
{ Victoty}
setbkcolor(14);
buk(480,220,100,'V');
buk(480,220,170,'i');
buk(480,220,205,'c');
buk(480,220,255,'t');
buk(480,220,300,'o');
buk(480,220,359,'r');
buk(480,220,410,'y');
{ 2 }
setcolor(4);
setlinestyle(0,0,3);
for i:=115 to 405 do
begin
delay(3);
line(i,355,i+20,355);
line(i,240,i,240);
end;
for i:=455 to 470 do
begin
delay(3);
line(i,355,i+5,355)
end
end;(*victory*)
(* *)
procedure nomer(xp,yp,ip:integer);
begin (*nomer*)
{ mas[ip]
- }
str(mas[ip]:1,st);
{ - st}
outtextxy(175+xp*86,120+yp*86,st);
end;(*nomer*)
(* -*)
procedure kv(xk,yk:integer);
begin(*kv*)
bar3d(160+xk*86,100+yk*86,235+xk*86,
175+yk*86,7,true);
end;(*kv*)
(* *)
procedure tabl(xv,yv:integer;klv:char;var
xv1,yv1:integer);
begin(*tabl*)
{(),
,
}
setcolor(13);
kv(xv,yv);
{ }
if mas[4*yv+xv+1]<>0 then
nomer(xv,yv,4*yv+xv+1);
{ case
}
klv of
Down :if yv<3 then yv:=yv+1;
Up :if yv>0 then yv:=yv-1;
Left :if xv>0 then xv:=xv-1;
Right :if xv<3 then xv:=xv+1;
end;(*case*)
xv1:=xv;
yv1:=yv;
{, ,
}
setcolor(1);
kv(x,y);
{ }
if mas[4*yv+xv+1]<>0
then nomer(x,y,4*y+x+1);
end;(*tabl*)
(* *)
procedure menu(var ym:integer);
var
om:char;
begin(*menu*)
ym:=0;
cleardevice; { }
{ ,
}
setcolor(8);
setfillstyle(1,8);
bar(45,152,615,202);
bar(45,222,615,272);
bar(45,292,615,342);
bar(45,362,615,412);
fillellipse(304,62,210,35);
{ ,
}
setcolor(1);
setfillstyle(1,1);
bar(35,145,605,195);
bar(35,215,605,265);
bar(35,285,605,335);
bar(35,355,605,405);
{ ***MENU***}
fillellipse(298,57,210,35);
{ }
setcolor(12);
settextstyle(1,0,1);
outtextxy(20,430,'Copyright Software 1998');
outtextxy(20,450,'Written by Volkov
Konstantin');
{ ***MENU*** ,
}
setcolor(8);
settextstyle(1,0,6);
outtextxy(142,33,'*** MENU ***');
{ ***MENU*** }
setcolor(10);
outtextxy(140,30,'*** MENU ***');
setbkcolor(9); { }
repeat
setfillstyle(1,5); {
-}
{, }
bar(35,145+70*ym,605,195+70*ym);
{ }
outtextxy(50,135,'Game');
outtextxy(50,205,'Best players');
outtextxy(50,275,'About this game');
outtextxy(50,345,'Exit');
om:=readkey;
{ ,
}
setfillstyle(1,1);
bar(35,145+70*ym,605,195+70*ym);
{ ,
}
if om=up then ym:=ym-1;
if om=down then ym:=ym+1;
if ym=-1 then ym:=3;
if ym=4 then ym:=0;
setcolor(10); { }
{
}
sound(300);
for i:=-maxint to maxint do
j:=j;
nosound;
until om=Enter ;
end;(*menu*)
(* *)
procedure game;
begin(*game*)
cleardevice; { }
steps:=0;{ 0}
{ ,
- }
setfillstyle(1,3);
bar(10,90,130,155);
setfillstyle(1,7);
bar(30,120,80,145);
{ }
setlinestyle(0,0,1);
setcolor(1);
rectangle(10,90,130,155);
rectangle(29,119,81,146);
setlinestyle(0,0,1);
{ - ,
0}
setcolor(4);
settextstyle(0,0,1);
outtextxy(20,100,'Number steps ');
outtextxy(40,130,'0');
setcolor(13);
vict:=false; { }
setfillstyle(1,14); {
}
bar3d(152,86,509,445,10,true);{
}
{
}
bar(0,0,639,50);
settextstyle(7,0,5);
outtextxy(125,2,'* 15 *');
{
}
bar(0,450,639,480);
settextstyle(7,0,3);
outtextxy(80,450,'Press Esc for quit to
main menu');
{ }
settextstyle(7,0,5);
setfillstyle(1,11);
{ }
randomize;
{
1 15}
mas[16]:=0;
mas[1]:=random(14)+1;
n:=2;
repeat
u:=true;
while u do
begin{ }
j:=random(15)+1;
u:=false;
for i:=1 to n-1 do
{
}
if mas[i]=j then u:=true;
end;{ }
mas[n]:=j;
n:=n+1;
until n=16;{
}
{ ()}
for j:=0 to 3 do
for i:=0 to 3 do
kv(i,j);
{
}
setbkcolor(7);
{ }
setfillstyle(1,8);
floodfill(157,90,13);
setfillstyle(1,3);
floodfill(168,82,13);
floodfill(513,90,13);
setfillstyle(1,11);
{ }
n:=1;
for j:=0 to 3 do
for i:=0 to 3 do
if (i<>3) or (j<>3) then
begin
nomer(i,j,n);
n:=n+1;
end;
x1:=3;
y1:=3;
x:=3;
y:=3;
{
, }
setcolor(1);
setfillstyle(1,11);
bar3d(418,358,493,433,7,true);
repeat
kl:=readkey;
tabl(x,y,kl,x,y); {C
}
{ }
if kl=Space then
begin(*if1*)
u:=(abs(x1-x)=1) and (abs(y1-y)=0) or
(abs(x-x1)=0) and (abs(y1-y)=1);
{
}
if u then
begin(*if2*)
{ ,
}
i:=4*y+x+1;
i1:=4*y1+x1+1;
setcolor(11);
nomer(x,y,i);
setcolor(13);
nomer(x1,y1,i);
n:=mas[i1]; {
}
mas[i1]:=mas[i];
mas[i]:=n;
x1:=x;
y1:=y;
steps:=steps+1; {
}
{ }
setfillstyle(1,7);
bar(30,120,80,145);{ .}
setcolor(4);
str(steps,st1);
settextstyle(0,0,1);
outtextxy(40,130,st1);
setcolor(13);
settextstyle(7,0,5);
setfillstyle(1,11);
{ }
u:=true;
j:=0;
n:=0;
repeat
j:=j+1;
n:=n+1;
if (n<>mas[j]) and (n<>12)
then u:=false;
if (n=11) and (mas[12]=0)
then j:=j+1;
until mas[j]=15;
if u and ((mas[15]=15) or
(mas[16]=15))
then
begin(*if3*)
pl:=Esc;{ }
vict:=true;{ }
end;(*if3*)
end;(*if2*)
end;(*if1*)
{ Esc}
if kl=Esc
then
begin (*if*)
{
4 }
m:=imagesize(0,0,320,240);
getmem(p,m);
getimage(0,0,320,240,p^);
m1:=imagesize(320,0,639,240);
getmem(p1,m1);
getimage(320,0,639,240,p1^);
m2:=imagesize(0,240,320,480);
getmem(p2,m2);
getimage(0,240,320,480,p2^);
m3:=imagesize(320,240,639,480);
getmem(p3,m3);
getimage(320,240,639,480,p3^);
{ ,
Esc}
cleardevice;
setbkcolor(0);
b3:=0;
repeat
{ }
setcolor(1);
setlinestyle(0,0,1);
rectangle(243,183,417,257);
rectangle(248,188,412,252);
setfillstyle(1,14);{
}
{- }
bar(250,190+30*b3,410,220+30*b3);
setcolor(13);
settextstyle(8,0,1);
outtextxy(275,195,'Continue . .
.');
outtextxy(275,220,'Exit ');
b2:=readkey;
setfillstyle(1,0);
bar(250,190+30*b3,410,220+30*b3);
{ }
if b2=up then b3:=0;
if b2=down then b3:=1;
if b3=0
then kl:='z'{
Continue}
else kl:=Esc{ Exit}
until b2=Enter;
end; (*if*)
{ Continue,
,
}
if kl='z'
then
begin
cleardevice;
setbkcolor(7);
putimage(0,0,p^,normalput);
freemem(p,m);
putimage(320,0,p1^,normalput);
freemem(p1,m1);
putimage(0,240,p2^,normalput);
freemem(p2,m2);
putimage(320,240,p3^,normalput);
freemem(p3,m3);
settextstyle(7,0,5);
setfillstyle(1,11)
end
until (kl=Esc) or (pl=Esc) ;
{ }
if vict then
begin(*vict*)
cleardevice;{ }
victory;{ }
{ ,
, }
setcolor(4);
settextstyle(7,0,5);
outtextxy(100,50,'You are win ! ! !');
str(steps,step);
outtextxy(100,100,'You made');
outtextxy(150,150,step);
outtextxy(250,150,'steps.');
repeat
until keypressed;
kl:=readkey;
i:=0;
{ }
repeat
i:=i+1;
val(stroka[i*2],b,x);
until (b>steps) or (i=6);
{
,
}
if i<6 then
begin(*
*)
for j:=5 downto i do
begin(* *)
stroka[j*2+1]:=stroka[j*2-1];
stroka[j*2+2]:=stroka[j*2];
end;(* *)
{ }
cleardevice;
setbkcolor(0);
outtextxy(10,130,'Please, enter your
name :');
{ }
setcolor(10);
rectangle(100,225,525,290);
rectangle(98,223,527,292);
{ }
kl:=readkey;
j:=1;
stroka[i*2-1]:='';
u:=not(kl=enter);
while u do
begin(* *)
u:=(kl>' ') and (kl<'z') and (j<11);
if u
then
begin(**)
stroka[i*2-1]:=stroka[i*2-1]+kl;
outtextxy(80+j*40,230,kl);{
}
j:=j+1;
end;(**)
kl:=readkey;
u:=not(kl=Enter);
end;(* *)
{ ,
Noname}
if length(stroka[i*2-1])=0
then stroka[i*2-1]:='Noname';
stroka[i*2]:=step;
(* *)
rewrite(f02);
for i:=1 to 10 do
writeln(f02,stroka[i]);
close(f02);
end;(*. . .*)
end;(*vict*)
end;(*game*)
(* *)
procedure best;
begin(*best*)
cleardevice; { }
{ }
setlinestyle(0,0,3);
setcolor(13);
rectangle(13,138,621,434);
rectangle(9,132,625,440);
setlinestyle(0,0,1);
{ }
setfillstyle(1,14);
floodfill(24,140,13);
{ }
setcolor(10);
settextstyle(7,0,7);
outtextxy(30,45,'Best players are:');
{ }
setcolor(13);
settextstyle(0,0,100);
for a02:=1 to 5 do
begin(*for a02*)
str(a02,stl2);{
-}
c02:=length(stroka[a02*2-1]);
stl2:=stl2+' '+stroka[a02*2-1];
for e02:=1 to 11-c02 do{
}
stl2:=stl2+'.';
for e02:=1 to 5-length(stroka[a02*2]) do
stl2:=stl2+'.';
stl2:=stl2+stroka[a02*2];
outtextxy(40,100+50*a02,stl2);
if a02<>0 then setcolor(9); {
}
end;(*for a02*)
repeat
until keypressed;
kl:=readkey;
setcolor(13);
end;(*best*)
(* *)
procedure help;
var
st3:string;
begin(*help*)
assign(f03,'pravila.dat');
reset(f03); { pravila.dat}
closegraph; { }
clrscr; { }
kl:='n';
while not(eof(f03)) { } and
(kl<>Esc) { . Esc} do
begin {1}
i:=1;
while (i<25) {} and not(eof(f03)) do
begin {2}
i:=i+1;
readln(f03,st3); {
st3}
writeln('',st3); {
st3 }
{ ,
Enter 2 }
if eof(f03)
then kl:=enter
else kl:=#10
end;{2}
gotoxy(12,25);
repeat { Enter
Esc}
if keypressed then kl:=readkey;
until (kl=enter) or (kl=esc);
end;{1}
clrscr;
gotoxy(21,12);
writeln('
');
repeat
until keypressed;
kl:=readkey;
kl:='n';
{
}
InitGraph(grDriver, grMode,'');
setbkcolor(11);
setcolor(13);
setlinestyle(0,0,3);
end;(*help*)
END.
, , .
<15> :
type
strok = string[10];
, .
<15> :
Stroka : array[1..12] of strok;
, , , .
f02,f03:text;
( rezult.dat,pravila.dat)
st02:string[10];
C 10 ,
stl2:string[20];
20 ,
a,b2,pl,kl,o:char;
,
st:string[5];
st1,step:string[5];
,
u:boolean;
, true false,
vict:boolean;
, vict=true
mas:array [1..16] of integer;
, 1 16
p,p1,p2,p3:pointer;
-,
m,m1,m2,m3:integer;
integer:
grDriver-
ErrCode- - graphresult
i,j,n-
i1-
grMode- .
steps- -
x,x1,y,y1-
st02- -
a02-
c02-
e02-
b- - .
men-
procedure recod;
,
procedure zz1(a,b,c:integer;s:char);
procedure victory;
. Victory.
procedure nomer(xp,yp,ip:integer);
,
procedure kv(xk,yk:integer);
Procedure tabl(xv,yv:integer;klv:char;var xv1,yv1:integer);
. , UP,DOWN,LEFT,RIGHT , , , , , .
procedure menu(var ym:integer);
<15> ( )
procedure game;
,
procedure best;-
procedure help;-
.
.
- , . freeware, as is.
.
- , UP, DOWN, LEFT, PIGHT, ESC ENTER.
- , , .
Pent 733/256/64mGF/40Gb WinXp.
<15> Microsoft Word 2002 WINDOWS XP.
Borland Pascal 7.0
. , .
, .
MS-DOS , :
petnash.exe -
rezult.dat - , .
pravila.dat- ,
tscr.chr, trip.chr, lcom.chr- ,
50 , .
, etnach.exe, .
, :
1 Game
2 Best players
3 About this game
4 Exit
:
Game -
Best players -
About this game - "15", ,
Exit - DOS
, Game Enter. 1 15 .
:
|
, , :
|
. . '' , .
:
UP
LEFTRIGHT
DOWN
,
.
Borland Pascal 7.0, , , , , , .
, Microsoft Word 2002 Borland Pascal 7.0.
1. , 2133 , , , 1993.
2. .. , .. , Turbo Pascal 7.0, , -, 1998
3. . ., . ., . ., ,
, , 1994
4. , , , , 1995
5. http://pascal.dax.ru/ - Turbo Pascal
6. http://borlpasc.narod.ru/ - Turbo Pascal
: <15>
Copyright (c) 2024 Stud-Baza.ru , , , .