Question

pascal游戏

谁有pascal游戏
给一个；过程

Answer 1

Fpc五子棋 功能强大（悔棋+存“棋谱”)
var pan:array[0..16,0..16] of string;
i,j,h1,h2,l1,l2,h,l,n,n1,n2,choose,z1,z2:integer;
ju1,ju2:array[0..10000] of string;
s1,s2,p1,p2:string;
hui1,hui2:boolean;
procedure juout;
begin
for i:=1 to z1 do
writeln(ju1[i],ju2[i]);
writeln('1 保存棋局');
writeln('2 退出');
read(choose);
case choose of
1:begin
assign(output,'五子棋棋局.txt');
rewrite(output);
for i:=1 to z1 do
writeln(ju1[i],ju2[i]);
close(output);
exit;
end;
2:exit;
end;
end;
procedure options;
begin
writeln('双方悔棋次数限定：');
writeln('（初始值为0）');
read(n);
n1:=n;
n2:=n;
end;
procedure out;
begin
write(' ');
for i:=1 to 15 do
write(i:2);
writeln;
for i:=1 to 15 do
begin
write(i:2);
for j:=1 to 15 do
write(pan[i,j]);
writeln;
end;
end;
function trytry1(h,l:integer):boolean;
var i,t:integer;
begin
trytry1:=false;
t:=0;
i:=0;
while pan[h-i,l]='○' do begin inc(i); inc(t); end;
i:=0;
while pan[h+i,l]='○' do begin inc(i); inc(t); end;
if t>=6 then begin trytry1:=true; exit; end;
t:=0;
i:=0;
while pan[h,l-i]='○' do begin inc(i); inc(t); end;
i:=0;
while pan[h,l+i]='○' do begin inc(i); inc(t); end;
if t>=6 then begin trytry1:=true; exit; end;
t:=0;
i:=0;
while pan[h-i,l-i]='○' do begin inc(i); inc(t); end;
i:=0;
while pan[h+i,l+i]='○' do begin inc(i); inc(t); end;
if t>=6 then begin trytry1:=true; exit; end;
t:=0;
i:=0;
while pan[h-i,l+i]='○' do begin inc(i); inc(t); end;
i:=0;
while pan[h+i,l-i]='○' do begin inc(i); inc(t); end;
if t>=6 then begin trytry1:=true; exit; end;
end;
function trytry2(h,l:integer):boolean;
var i,t:integer;
begin
trytry2:=false;
t:=0;
i:=0;
while pan[h-i,l]='●' do begin inc(i); inc(t); end;
i:=0;
while pan[h+i,l]='●' do begin inc(i); inc(t); end;
if t>=6 then begin trytry2:=true; exit; end;
t:=0;
i:=0;
while pan[h,l-i]='●' do begin inc(i); inc(t); end;
i:=0;
while pan[h,l+i]='●' do begin inc(i); inc(t); end;
if t>=6 then begin trytry2:=true; exit; end;
t:=0;
i:=0;
while pan[h-i,l-i]='●' do begin inc(i); inc(t); end;
i:=0;
while pan[h+i,l+i]='●' do begin inc(i); inc(t); end;
if t>=6 then begin trytry2:=true; exit; end;
t:=0;
i:=0;
while pan[h-i,l+i]='●' do begin inc(i); inc(t); end;
i:=0;
while pan[h+i,l-i]='●' do begin inc(i); inc(t); end;
if t>=6 then begin trytry2:=true; exit; end;
end;
procedure game;
begin
repeat
inc(z1);
writeln('黑棋走子 请输入落子坐标');
read(h,l);
while (h=0) and(l=0) and(hui1=false) do
begin
writeln('对不起，双方不能连续悔棋');
read(h1,l1);
h:=h1;l:=l1;
while (pan[h1,l1]='○') or (pan[h1,l1]='●') or (h1<1) or (h1>15) or(l1<1) or (l1>15) do
begin
writeln('对不起 该处不能落子');
writeln('黑棋走子 请输入落子坐标');
read(h1,l1);
h:=h1;l:=l1;
end;
end;
while (h=0) and(l=0) and(n1=0) do
begin
writeln('对不起，您的悔棋机会已用完');
writeln('黑棋走子 请输入落子坐标');
readln(h,l);
while (pan[h,l]='○')or(pan[h,l]='●')or((h=0) and (l<>0))or((l=0) and (h<>0))or(h1<0)or(h1>15)or(l1<0)or(l1>15) do
begin
writeln('对不起 该处不能落子');
writeln('黑棋走子 请输入落子坐标');
read(h,l);
end;
end;
if (h<>0)and(l<>0) then begin h1:=h; l1:=l; end;
while (pan[h,l]='○')or(pan[h,l]='●')or((h=0) and (l<>0))or((l=0) and (h<>0))or(h1<0)or(h1>15)or(l1<0)or(l1>15) do
begin
writeln('对不起 该处不能落子');
writeln('黑棋走子 请输入落子坐标');
read(h,l);
if (h<>0)and(l<>0) then begin h1:=h; l1:=l; end;
end;
if (h<>0) and(l<>0) then
begin
s1:=pan[h1,l1];

pan[h1,l1]:='○';
hui2:=true;
str(h1,p1);str(l1,p2);
ju1[z1]:='黑棋在'+p1+','+p2+'落子 ';
out;
end;
while (h=0) and (l=0) do
begin
pan[h1,l1]:=s1;
pan[h2,l2]:=s2;
out;
writeln('黑棋悔棋');
writeln('黑棋走子 请输入落子坐标');
hui2:=false;
dec(n1);
dec(z1);
dec(z2);
ju2[z2]:='';
ju1[z1]:='';
writeln('还可悔棋',n1,'次');
read(h1,l1);
h:=h1;
l:=l1;
while (pan[h1,l1]='○') or (pan[h1,l1]='●') or (h1<1) or (h1>15) or(l1<1) or (l1>15) do
begin
writeln('对不起 该处不能落子');
writeln('黑棋走子 请输入落子坐标');
read(h1,l1);
end;
s1:=pan[h1,l1];
pan[h1,l1]:='○';
hui2:=false;
str(h1,p1);str(l1,p2);
ju1[z1]:='黑棋在'+p1+','+p2+'落子 ';
out;
end;
if trytry1(h1,l1)=true then begin writeln('黑棋胜'); readln; juout; break; end;
inc(z2);
writeln('白棋走子 请输入落子坐标');
read(h,l);
while (h=0) and(l=0) and(hui2=false) do
begin
writeln('对不起，双方不能连续悔棋');
read(h2,l2); h:=h2;l:=l2;
while (pan[h2,l2]='○') or (pan[h2,l2]='●') or (h2<1) or (h2>15) or(l2<1) or (l2>15) do
begin
writeln('对不起 该处不能落子');
writeln('白棋走子 请输入落子坐标');
read(h2,l2);
h:=h2;l:=l2;
end;
end;
while (h=0) and(l=0) and(n2=0) do
begin
writeln('对不起，您的悔棋机会已用完');
writeln('白棋走子 请输入落子坐标');
readln(h,l);
while (pan[h,l]='○')or(pan[h,l]='●')or((h=0) and (l<>0))or((l=0) and (h<>0))or(h1<0)or(h1>15)or(l1<0)or(l1>15) do
begin
writeln('对不起 该处不能落子');
writeln('白棋走子 请输入落子坐标');
read(h,l);
end;
end;
if (h<>0)and(l<>0) then begin h2:=h; l2:=l; end;
while (pan[h,l]='○')or(pan[h,l]='●')or((h=0) and (l<>0))or((l=0)and (h<>0))or(h2<0)or(h2>15)or(l2<0)or(l2>15) do
begin
writeln('对不起 该处不能落子');
writeln('白棋走子 请输入落子坐标');
read(h,l);
if (h<>0)and(l<>0) then begin h2:=h; l2:=l; end;
end;
if (h<>0) and(l<>0) then
begin
s2:=pan[h2,l2];
pan[h2,l2]:='●';
hui1:=true;
str(h2,p1);str(l2,p2);
ju2[z2]:='白棋在'+p1+','+p2+'落子 ';
out;
end;
while (h=0) and (l=0) do
begin
pan[h1,l1]:=s1;
pan[h2,l2]:=s2;
out;
writeln('白棋悔棋');
writeln('白棋走子 请输入落子坐标');
hui1:=false;
dec(n2);
dec(n1);
ju1[z1]:='';
ju2[z2]:='';
writeln('还可悔棋',n2,'次');
read(h2,l2);
h:=h2;
l:=l2;
while (pan[h2,l2]='○') or (pan[h2,l2]='●') or (h2<1) or (h2>15) or(l2<1) or (l2>15) do
begin
writeln('对不起 该处不能落子');
writeln('白棋走子 请输入落子坐标');
read(h2,l2);
end;
s2:=pan[h2,l2];
str(h2,p1);str(l2,p2);
ju2[z2]:='白棋在'+p1+','+p2+'落子 ';

pan[h2,l2]:='●';
out;
end;
if trytry2(h2,l2)=true then begin writeln('白棋胜'); readln; juout; break; end;
until 1=2;
end;
begin
writeln('欢迎使用Free Pascal游戏程序');
readln;
writeln('作者：丁浩玙');
readln;
writeln('翻版必究');
readln;
writeln('QQ：541600517');
readln;
writeln;
writeln('游戏——五子棋');
readln;
n1:=0;
n2:=0;
while choose<>1 do
begin
writeln('1 开始游戏');
writeln('2 游戏说明');
writeln('3 设置');
writeln('4 退出');
readln(choose);
case choose of
1:;
2:begin
writeln('本游戏规则与传统五子棋规则相同，落子时需输入落子的行列；悔棋需在己方回合内输入“0 0”即可，双方不可连续悔棋');
readln;
end;
3:begin options; readln; end;
4:exit;
end;
end;
z1:=0;
z2:=0;
hui1:=false;
hui2:=false;
for i:=2 to 14 do
for j:=2 to 14 do
pan[i,j]:='╋';
for i:=1 to 15 do
begin
pan[1,i]:='┳';
pan[i,1]:='┣';
pan[15,i]:='┻';
pan[i,15]:='┫';
end;
pan[1,1]:='┏';
pan[1,15]:='┓';
pan[15,1]:='┗';
pan[15,15]:='┛';
out;
readln;
writeln('////游戏开始\\\\');
game;
readln;
readln;
end.

Answer 2

井字过三关：
program TicTacToe;
uses crt;
var
a:Array [1..3] of Array [1..3] of char;
b:Array [1..3] of Array [1..3] of integer;
i,n,g,e,p:integer;
t:text;
c:char;
o:integer;
r:integer;
s,h:integer;
ch,cal,ek,ck,hc:integer;
time:integer;
label xh,exit1;
begin
randomize;
clrscr;
writeln('1',chr(179),'2',chr(179),'3');
writeln(chr(196),chr(197),chr(196),chr(197),chr(196));
writeln('4',chr(179),'5',chr(179),'6');
writeln(chr(196),chr(197),chr(196),chr(197),chr(196));
writeln('7',chr(179),'8',chr(179),'9');
writeln('press enter');
readln;
xh:
ek:=0;
repeat
repeat
clrscr;
if ek=1 then writeln('wrong');
case b[1,1] of
0:a[1,1]:=' ';
1:a[1,1]:='o';
2:a[1,1]:='x';
end;
case b[1,2] of
0:a[1,2]:=' ';
1:a[1,2]:='o';
2:a[1,2]:='x';
end;
case b[1,3] of
0:a[1,3]:=' ';
1:a[1,3]:='o';
2:a[1,3]:='x';
end;
case b[2,1] of
0:a[2,1]:=' ';
1:a[2,1]:='o';
2:a[2,1]:='x';
end;
case b[2,2] of
0:a[2,2]:=' ';
1:a[2,2]:='o';
2:a[2,2]:='x';
end;
case b[2,3] of
0:a[2,3]:=' ';
1:a[2,3]:='o';
2:a[2,3]:='x';
end;
case b[3,1] of
0:a[3,1]:=' ';
1:a[3,1]:='o';
2:a[3,1]:='x';
end;
case b[3,2] of
0:a[3,2]:=' ';
1:a[3,2]:='o';
2:a[3,2]:='x';
end;
case b[3,3] of
0:a[3,3]:=' ';
1:a[3,3]:='o';
2:a[3,3]:='x';
end;
writeln(a[1,1],chr(179),a[1,2],chr(179),a[1,3]);
writeln(chr(196),chr(197),chr(196),chr(197),chr(196));
writeln(a[2,1],chr(179),a[2,2],chr(179),a[2,3]);
writeln(chr(196),chr(197),chr(196),chr(197),chr(196));
writeln(a[3,1],chr(179),a[3,2],chr(179),a[3,3]);
write('press location');
c:=readkey;
if c='e' then
begin
ch:=3;
goto exit1;
end;
o:=ord(c);
p:=o-48;
case p of
1,2,3:g:=1;
4,5,6:g:=2;
7,8,9:g:=3;
end;
e:=o mod 3;
if e=0 then e:=3;
writeln;
ek:=1;
until ((c='0') or (c='1') or (c='2') or (c='3') or (c='4')
or (c='5') or (c='6') or (c='7') or (c='8') or (c='9'));
until (a[g,e]<>'x') and (a[g,e]<>'o');
time:=time+1;
if c='1' then b[1,1]:=1;
if c='2' then b[1,2]:=1;
if c='3' then b[1,3]:=1;
if c='4' then b[2,1]:=1;
if c='5' then b[2,2]:=1;
if c='6' then b[2,3]:=1;
if c='7' then b[3,1]:=1;
if c='8' then b[3,2]:=1;
if c='9' then b[3,3]:=1;
clrscr;
for s:=1 to 3 do begin
for h:=1 to 3 do begin
if b[s,h]=1 then write('o');
if b[s,h]=2 then write('x');
if (b[s,h]<>1) and (b[s,h]<>2) then write(' ');
if h<>3 then write(chr(179));
end;
writeln;
if s<>3 then writeln(chr(196),chr(197),chr(196),chr(197),chr(196));
end;
if ((b[1,2]=1) and (b[2,2]=1) and (b[3,2]=1))
or ((b[1,1]=1) and (b[1,2]=1) and (b[1,3]=1))
or ((b[2,1]=1) and (b[2,2]=1) and (b[2,3]=1))
or ((b[3,1]=1) and (b[3,2]=1) and (b[3,3]=1))
or ((b[1,1]=1) and (b[2,1]=1) and (b[3,1]=1))
or ((b[1,3]=1) and (b[2,3]=1) and (b[3,3]=1))
or ((b[1,1]=1) and (b[2,2]=1) and (b[3,3]=1))
or ((b[1,3]=1) and (b[2,2]=1) and (b[3,1]=1))
then begin ch:=1; goto exit1; end;
cal:=0;
for s:=1 to 3 do begin
for h:=1 to 3 do begin
if (b[s,h]=1) or (b[s,h]=2) then cal:=cal+1;
end;
end;
if cal=9 then goto exit1;
writeln('press enter');
readln;

repeat
hc:=0;
ck:=0;
if (((b[1,2]=2) and (b[1,3]=2))
or ((b[2,1]=2) and (b[3,1]=2))
or ((b[2,2]=2) and (b[3,3]=2)))
and (b[1,1]<>1) then
begin
hc:=1;
ck:=ck+1;
r:=1;
end;
if (((b[1,1]=2) and (b[1,3]=2))
or ((b[2,2]=2) and (b[3,2]=2)))
and (b[1,2]<>1) then
begin
hc:=1;
ck:=ck+1;
r:=2;
end;
if (((b[1,1]=2) and (b[1,2]=2))
or ((b[2,3]=2) and (b[3,3]=2))
or ((b[2,2]=2) and (b[3,1]=2)))
and (b[1,3]<>1) then
begin
hc:=1;
ck:=ck+1;
r:=3;
end;
if (((b[1,1]=2) and (b[3,1]=2))
or ((b[2,2]=2) and (b[2,3]=2)))
and (b[2,1]<>1) then
begin
hc:=1;
ck:=ck+1;
r:=4;
end;
if (((b[1,1]=2) and (b[3,3]=2))
or ((b[1,3]=2) and (b[3,1]=2))
or ((b[1,2]=2) and (b[3,2]=2))
or ((b[2,1]=2) and (b[2,3]=2)))
and (b[2,2]<>1) then
begin
hc:=1;
ck:=ck+1;
r:=5;
end;
if (((b[2,1]=2) and (b[2,2]=2))
or ((b[1,3]=2) and (b[3,3]=2)))
and (b[2,3]<>1) then
begin
hc:=1;
ck:=ck+1;
r:=6;
end;
if (((b[1,1]=2) and (b[2,1]=2))
or ((b[3,2]=2) and (b[3,3]=2))
or ((b[1,3]=2) and (b[2,2]=2)))
and (b[3,1]<>1) then
begin
hc:=1;
ck:=ck+1;
r:=7;
end;
if (((b[1,2]=2) and (b[2,2]=2))
or ((b[3,1]=2) and (b[3,3]=2)))
and (b[3,2]<>1) then
begin
hc:=1;
ck:=ck+1;
r:=8;
end;
if (((b[1,1]=2) and (b[2,2]=2))
or ((b[1,3]=2) and (b[2,3]=2))
or ((b[1,1]=2) and (b[2,2]=2)))
and (b[3,3]<>1) then
begin
hc:=1;
ck:=ck+1;
r:=9;
end;
if hc=0 then begin
if time=1 then begin
if c='5' then r:=1;
if c<>'5' then r:=5;
end
else
begin
if (((b[1,2]=1) and (b[1,3]=1))
or ((b[2,1]=1) and (b[3,1]=1))
or ((b[2,2]=1) and (b[3,3]=1)))
and (b[1,1]<>2) then
begin
ck:=ck+1;
r:=1;
hc:=3;
end;
if (((b[1,1]=1) and (b[1,3]=1))
or ((b[2,2]=1) and (b[3,2]=1)))
and (b[1,2]<>2) then
begin
ck:=ck+1;
r:=2;
hc:=3;
end;
if (((b[1,1]=1) and (b[1,2]=1))
or ((b[2,3]=1) and (b[3,3]=1))
or ((b[2,2]=1) and (b[3,1]=1)))
and (b[1,3]<>2) then
begin
ck:=ck+1;
r:=3;
hc:=3;
end;
if (((b[1,1]=1) and (b[3,1]=1))
or ((b[2,2]=1) and (b[2,3]=1)))
and (b[2,1]<>2) then
begin
ck:=ck+1;
r:=4;
hc:=3;
end;
if (((b[1,1]=1) and (b[3,3]=1))
or ((b[1,3]=1) and (b[3,1]=1))
or ((b[1,2]=1) and (b[3,2]=1))
or ((b[2,1]=1) and (b[2,3]=1)))
and (b[2,2]<>2) then
begin
ck:=ck+1;
r:=5;
hc:=3;
end;
if (((b[2,1]=1) and (b[2,2]=1))
or ((b[1,3]=1) and (b[3,3]=1)))
and (b[2,3]<>2) then
begin
ck:=ck+1;
r:=6;
hc:=3;
end;
if (((b[1,1]=1) and (b[2,1]=1))
or ((b[3,2]=1) and (b[3,3]=1))
or ((b[1,3]=1) and (b[2,2]=1)))
and (b[3,1]<>2) then
begin
ck:=ck+1;
r:=7;
hc:=3;
end;
if (((b[1,2]=1) and (b[2,2]=1))
or ((b[3,1]=1) and (b[3,3]=1)))
and (b[3,2]<>2) then
begin
ck:=ck+1;
r:=8;
hc:=3;
end;
if (((b[1,1]=1) and (b[2,2]=1))
or ((b[1,3]=1) and (b[2,3]=1))
or ((b[1,1]=1) and (b[2,2]=1)))
and (b[3,3]<>2) then
begin
ck:=ck+1;
r:=9;
hc:=3;
end;
end;{else}
end;{if}
if ek>1 then writeln('you can be the winner');
if hc=0 then r:=random(9);
if time=1 then begin
if c='5' then r:=1;
if c<>'5' then r:=5;
end;
i:=r mod 3;
case r of
1,2,3:n:=1;
4,5,6:n:=2;
7,8,9:n:=3;
end;
if i=0 then i:=3;
writeln;
until (b[n,i]<>1) and (b[n,i]<>2) and (r<>0);
b[n,i]:=2;
clrscr;
case b[1,1] of
0:a[1,1]:=' ';
1:a[1,1]:='o';
2:a[1,1]:='x';
end;
case b[1,2] of
0:a[1,2]:=' ';
1:a[1,2]:='o';
2:a[1,2]:='x';
end;
case b[1,3] of
0:a[1,3]:=' ';
1:a[1,3]:='o';
2:a[1,3]:='x';
end;
case b[2,1] of
0:a[2,1]:=' ';
1:a[2,1]:='o';
2:a[2,1]:='x';
end;
case b[2,2] of
0:a[2,2]:=' ';
1:a[2,2]:='o';
2:a[2,2]:='x';
end;
case b[2,3] of
0:a[2,3]:=' ';
1:a[2,3]:='o';
2:a[2,3]:='x';
end;
case b[3,1] of
0:a[3,1]:=' ';
1:a[3,1]:='o';
2:a[3,1]:='x';
end;
case b[3,2] of
0:a[3,2]:=' ';
1:a[3,2]:='o';
2:a[3,2]:='x';
end;
case b[3,3] of
0:a[3,3]:=' ';
1:a[3,3]:='o';
2:a[3,3]:='x';
end;
writeln(a[1,1],chr(179),a[1,2],chr(179),a[1,3]);
writeln(chr(196),chr(197),chr(196),chr(197),chr(196));
writeln(a[2,1],chr(179),a[2,2],chr(179),a[2,3]);
writeln(chr(196),chr(197),chr(196),chr(197),chr(196));
writeln(a[3,1],chr(179),a[3,2],chr(179),a[3,3]);
if ((b[1,2]=2) and (b[2,2]=2) and (b[3,2]=2))
or ((b[1,1]=2) and (b[1,2]=2) and (b[1,3]=2))
or ((b[2,1]=2) and (b[2,2]=2) and (b[2,3]=2))
or ((b[3,1]=2) and (b[3,2]=2) and (b[3,3]=2))
or ((b[1,1]=2) and (b[2,1]=2) and (b[3,1]=2))
or ((b[1,3]=2) and (b[2,3]=2) and (b[3,3]=2))
or ((b[1,1]=2) and (b[2,2]=2) and (b[3,3]=2))
or ((b[1,3]=2) and (b[2,2]=2) and (b[3,1]=2))
then begin ch:=2; goto exit1; end;
goto xh;
exit1:
if cal=9 then writeln('deuce');
if ch=2 then writeln('lost');
if ch=1 then writeln('win');
if ch=3 then
begin
clrscr;
writeln('exited');
end;
writeln('press enter');
readln;
end.

Answer 3

Pascal贴吧（http://tieba.baidu.com/f?kw=pascal&pn=150）里有很多。
我给你找了一个魔兽RPG（http://tieba.baidu.com/f?kz=821759800）。
希望可以解决你的问题！

Answer 4

在安装目录下的demo/graph/里有很多

Answer 5

shen ma yi si?????