Question

要free pascal游戏程序

Answer 1

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;
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

var
player1,player2:longint;
a,b,l,o,i,v:longint; w:boolean;
begin
randomize;
write('A=');readln(player1);
write('B=');readln(player2);
b:=1;
i:=1;
while(player1>0)and(player2>0)do
begin
if i=1 then
begin
a:=random(101)+1;
if a<=70 then
begin
writeln('A against B,B has ',a,' damage.');
player2:=player2-a;
end;
if (a>70)and(a<=80) then
begin
o:=random(30);
writeln('A thumping B,B has ',a*2+o,' damage.');
player2:=player2-a*2;
end;
if (a>80)and(a<=85) then
begin
o:=random(120);
writeln('A restored ',a*2+o-50,' points.');
player1:=player1+a*2+o-50;
end;
if (a>85)and(a<=90) then
begin
writeln('A launched combo. ');
l:=100;
w:=true;
while w do
begin
o:=random(71);
writeln('B has ',o,' damage.');
player2:=player2-o;
if l<random(80) then w:=false;
l:=l-random(15);
end;
end;
if (a>90)and(a<=95) then
begin
o:=random(300);
writeln('A launch from exploding!');
writeln('A has ',o div 2,' damage.');
writeln('B has ',o+10,' damage.');
player1:=player1-o div 2;
player2:=player2-(o+10);
end;
if (a>95)and(a<=97) then
begin
writeln('A midicine,restore ',400,' points!');
player1:=player1+400;
end;
if (a>97)and(a<=100) then
begin
o:=random(100)+100;
writeln('A vampire ',o,' points.');
player1:=player1+o;
player2:=player2-o;
end;
if (a=101) then
begin
writeln('A colossus heaven boxing! ');
l:=100;
o:=random(20)+1;
for v:=1 to 100 do
begin
writeln('B has ',v*o,' damage.');
player2:=player2-v*o;
if l<random(80) then break;
l:=l-random(15);
end;
end;
i:=2;
if player1<0 then player1:=0;
if player2<0 then player2:=0;
writeln(' A ',player1);
writeln(' B ',player2);
readln;
end;
if i=2 then
begin
a:=random(101)+1;
if a<=70 then
begin
writeln('B against A,A has ',a,' damage.');
player1:=player1-a;
end;
if (a>70)and(a<=80) then
begin
o:=random(30);
writeln('B thumping A,A has ',a*2+o,' damage.');
player1:=player1-a*2;
end;
if (a>80)and(a<=85) then
begin
o:=random(120);
writeln('B restored ',a*2+o-50,' points.');
player2:=player2+a*2+o-50;
end;
if (a>85)and(a<=90) then
begin
writeln('B launched combo. ');
l:=100;
w:=true;
while w do
begin
o:=random(71);
writeln('A has ',o,' damage.');
player1:=player1-o;
if l<random(80) then w:=false;
l:=l-random(15);
end;
end;
if (a>90)and(a<=95) then
begin
o:=random(300);
writeln('B launch from exploding!');
writeln('B has ',o div 2,' damage.');
writeln('A has ',o+10,' damage.');
player2:=player2-o div 2;
player1:=player1-(o+10);
end;
if (a>95)and(a<=97) then
begin
writeln('B midicine,restore ',400,' points!');
player2:=player2+400;
end;
if (a>97)and(a<=100) then
begin
o:=random(100)+100;
writeln('B vampire ',o,' points.');
player2:=player2+o;
player1:=player1-o;
end;
if (a=200) then
begin
writeln('B colossus heaven boxing! ');
l:=100;
o:=random(20)+1;
for v:=1 to 100 do
begin
writeln('A has ',v*o,' damage.');
player1:=player1-v*o;
if l<random(80) then break;
l:=l-random(15);
end;
end;
i:=1;
if player1<0 then player1:=0;
if player2<0 then player2:=0;
writeln(' A ',player1);
writeln(' B ',player2);
readln;
end;
end;
writeln;
if player1>player2 then writeln('A WIN!')
else if player2>player1 then writeln('B WIN!')
else writeln('DRAW');
readln;
end.

Answer 3

最好是加分，给你一个贪吃蛇：
program tanchishe；
var
cj:array[1..22,1..9] of -1..300;
cd,js1,js2,x,y,active:integer;
js,active2,speed:integer;
procedure show;
begin
clrscr;
gotoxy(1,1);
write('**********************');
gotoxy(1,11);
write('**********************');
gotoxy(1,2);
for js2:=1 to 9 do
for js1:=1 to 22 do
begin
if cj[js1,js2]=0 then
write(' ');
if cj[js1,js2]<0 then
write('o');
if cj[js1,js2]>0 then
write(chr(219));
end;
gotoxy(x,y+1);
write('o');
gotoxy(6,12);
write(speed,' ',speed*(cd-3));
end;
procedure bean;
var
wpx,wpy:integer;
begin
repeat
wpx:=random(22)+1;
wpy:=random(9)+1;
until (cj[wpx,wpy]=0) and ((wpx<>x) or (wpy<>y));
cj[wpx,wpy]:=-1;
end;
function canmove:boolean;
begin
if (x<1) or (x>22) or (y<1) or (y>9) or (cj[x,y]>0) then
canmove:=false
else
canmove:=true
end;
begin
randomize;textbackground(black);clrscr;window(30,7,51,18);textbackground(white);textcolor(black);clrscr;
gotoxy(1,6);
write('press enter to start');
readln;
clrscr;
gotoxy(3,5);
write('speed(1-30):');
repeat
readln(speed);
until (speed>=1) and (speed<=30);
for js2:=1 to 9 do
for js1:=1 to 21 do
cj[js1,js2]:=0;
cd:=3;
x:=2;
y:=5;
cj[2,4]:=3;
cj[2,3]:=2;
cj[2,2]:=1;
active:=2;
js:=10;
bean;
repeat
show;
delay(700-speed*10);
active2:=active;
repeat
active:=active2;
if keypressed then
case upcase(readkey) of
#0:case readkey of
#75:if active<>4 then active:=3;
#77:if active<>3 then active:=4;
#80:if active<>1 then active:=2;
#72:if active<>2 then active:=1;
end;
#27:exit;
end;
until not(keypressed);
cj[x,y]:=cd+1;
case active of
1:y:=y-1;
2:y:=y+1;
3:x:=x-1;
4:x:=x+1;
end;
if cj[x,y]=-1 then
begin
cd:=cd+1;
bean;
end;
for js2:=1 to 9 do
for js1:=1 to 22 do
if cj[js1,js2]>0then
cj[js1,js2]:=cj[js1,js2]-1;
if (cd=js) and (speed<650) then
begin
speed:=speed+5;
js:=js+10;
end;
until not(canmove);
gotoxy(7,6);
write('Game over');
readln;
end.