Question

用pascal可编什么游戏

Answer 1

通过运用crt单元，可以编出一些简单的游戏。例如贪吃蛇、推箱子、扫雷等。这些都是我编过的游戏下面附上代码。

贪吃蛇：
program she;
uses crt;
label 1,2,3;
type point=record
x,y:1..20;
end;
type shuzu=array[1..20,1..20] of char;
var a:shuzu;s:string;b:array[1..1000]of point;i,j,f,fen:integer;
head,tail:0..1001;c:boolean;
procedure ran2;
var p,q:integer;
begin
randomize;
p:=random(17)+2;
q:=random(17)+2;
if a[p,q]=' ' then a[p,q]:='#' else ran2;
end;
procedure ran;
var p,q:integer;
begin
randomize;
p:=random(17)+2;
q:=random(17)+2;
if a[p,q]=' ' then a[p,q]:=chr(2) else ran;
end;
procedure print(x:shuzu);
var i,j:1..20;
begin
for i:=1 to 20 do
for j:=1 to 20 do
begin
textcolor(15);
if a[i,j]=chr(2) then textcolor(12);
write(a[i,j]);
if j=20 then writeln
end;
writeln('Score:',fen);
end;
begin
textmode(1);cursoroff;
3:fillchar(a,sizeof(a),' ');
head:=0;tail:=3;fen:=0;f:=4;
b[1].x:=2;b[1].y:=2;
b[2].x:=2;b[2].y:=3;
b[3].x:=2;b[3].y:=4;
for i:=1 to 20 do
begin
a[1,i]:='#';a[i,1]:='#';
a[20,i]:='#';a[i,20]:='#';
end;
a[2,2]:='o';a[2,3]:='o';a[2,4]:='?;
ran;
1:
c:=false;
clrscr;
print(a);
for i:=1 to 300 do
begin
delay(1);
if (keypressed)and(not(c)) then
case readkey of
#72:
if (f=3)or(f=4) then begin f:=1;c:=true; end;
#80:
if (f=3)or(f=4) then begin f:=2;c:=true end;
#75:
if (f=1)or(f=2) then begin f:=3;c:=true end;
#77:
if (f=1)or(f=2) then begin f:=4;c:=true end;
#27:
begin
writeln('Do you want to exit(Y/N)?');
repeat
readln(s);
if (s='Y')or(s='y') then halt;
until (s='N')or(s='n');
goto 1;
end;
end;
end;
a[b[tail].x,b[tail].y]:='o';
case f of
1:
begin
if (a[b[tail].x-1,b[tail].y]='#')or
((a[b[tail].x-1,b[tail].y]='o')and(not((b[tail].x-1=b[head mod 1000+1].x)and(b[tail].y=b[head mod 1000+1].y)))) then goto 2;
if a[b[tail].x-1,b[tail].y]=chr(2) then
begin
fen:=fen+10;
ran;ran2
end
else
begin
head:=head mod 1000+1;
a[b[head].x,b[head].y]:=' ';
end;
tail:=tail+1;
if tail=1001 then
begin
tail:=1;
b[1].x:=b[1000].x-1;b[1].y:=b[1000].y;
end
else
begin
b[tail].x:=b[tail-1].x-1;b[tail].y:=b[tail-1].y;
end;
end;
2:
begin
if (a[b[tail].x+1,b[tail].y]='#')or
((a[b[tail].x+1,b[tail].y]='o')and(not((b[tail].x+1=b[head mod 1000+1].x)and(b[tail].y=b[head mod 1000+1].y)))) then goto 2;
if a[b[tail].x+1,b[tail].y]=chr(2) then
begin
fen:=fen+10;
ran;ran2
end
else
begin
head:=head mod 1000+1;
a[b[head].x,b[head].y]:=' ';
end;
tail:=tail+1;
if tail=1001 then
begin
tail:=1;
b[1].x:=b[1000].x+1;b[1].y:=b[1000].y;
end
else
begin
b[tail].x:=b[tail-1].x+1;b[tail].y:=b[tail-1].y;
end;
end;
3:
begin
if (a[b[tail].x,b[tail].y-1]='#')or
((a[b[tail].x,b[tail].y-1]='o')and(not((b[tail].x=b[head mod 1000+1].x)and(b[tail].y-1=b[head mod 1000+1].y)))) then goto 2;
if a[b[tail].x,b[tail].y-1]=chr(2) then
begin
fen:=fen+10;
ran;ran2
end
else
begin
head:=head mod 1000+1;
a[b[head].x,b[head].y]:=' ';
end;
tail:=tail+1;
if tail=1001 then
begin
tail:=1;
b[1].x:=b[1000].x;b[1].y:=b[1000].y-1;
end
else
begin
b[tail].x:=b[tail-1].x;b[tail].y:=b[tail-1].y-1;
end;
end;
4:
begin
if (a[b[tail].x,b[tail].y+1]='#')or
((a[b[tail].x,b[tail].y+1]='o')and(not((b[tail].x=b[head mod 1000+1].x)and(b[tail].y+1=b[head mod 1000+1].y)))) then goto 2;
if a[b[tail].x,b[tail].y+1]=chr(2) then
begin
fen:=fen+10;
ran;ran2
end
else
begin
head:=head mod 1000+1;
a[b[head].x,b[head].y]:=' ';
end;
tail:=tail+1;
if tail=1001 then
begin
tail:=1;
b[1].x:=b[1000].x;b[1].y:=b[1000].y+1;
end
else
begin
b[tail].x:=b[tail-1].x;b[tail].y:=b[tail-1].y+1;
end;
end;
end;
a[b[tail].x,b[tail].y]:='?;
goto 1;
2:writeln('Game Over!Score:',fen);
writeln('Play again(Y/N)?');
repeat
readln(s);
if (s='Y')or(s='y') then goto 3;
if (s='N')or(s='n') then halt;
until (s='Y')or(s='y')or(s='N')or(s='n');
end.

推箱子（主文件）：
program tuixiang;
uses crt,tx,dos;
label 1,2,3,4,5;
var f:text;n,p,q,i,j:integer;s1,s:string;
a:sz1;b:sz2;top:integer;ren:poi;
procedure wrong;
begin
sound(300);
delay(100);
nosound;
end;
function over:boolean;
var i:integer;
begin
for i:=1 to top do
if a[b[i].x,b[i].y]<>'? then exit(false);
exit(true);
end;
begin
textmode(1);cursoroff;
highvideo;
window(15,7,30,25);
write('Please choose a unit(1~11):');
read(n);
2:str(n,s1);s:='c:\map'+s1+'.in';
print(n,ren,a,b,top);
assign(f,s);
reset(f);
readln(f,i);
for j:=1 to i do
readln(f,p,q);
readln(f,p,q);
close(f);
1:case readkey of
#72:
if (a[ren.x-1,ren.y]=' ')or(a[ren.x-1,ren.y]='o') then
begin
if dong(ren.x,ren.y,top,b) then a[ren.x,ren.y]:='o' else a[ren.x,ren.y]:=' ';
a[ren.x-1,ren.y]:=chr(2);
ren.x:=ren.x-1;
end
else
if a[ren.x-1,ren.y]=chr(233) then
if (a[ren.x-2,ren.y]=' ')or(a[ren.x-2,ren.y]='o') then
begin
if dong(ren.x,ren.y,top,b) then a[ren.x,ren.y]:='o' else a[ren.x,ren.y]:=' ';
a[ren.x-1,ren.y]:=chr(2);a[ren.x-2,ren.y]:=chr(233);
ren.x:=ren.x-1;
end
else wrong
else
wrong;
#80:
if (a[ren.x+1,ren.y]=' ')or(a[ren.x+1,ren.y]='o') then
begin
if dong(ren.x,ren.y,top,b) then a[ren.x,ren.y]:='o' else a[ren.x,ren.y]:=' ';
a[ren.x+1,ren.y]:=chr(2);
ren.x:=ren.x+1;
end
else
if a[ren.x+1,ren.y]=chr(233) then
if (a[ren.x+2,ren.y]=' ')or(a[ren.x+2,ren.y]='o') then
begin
if dong(ren.x,ren.y,top,b) then a[ren.x,ren.y]:='o' else a[ren.x,ren.y]:=' ';
a[ren.x+1,ren.y]:=chr(2);a[ren.x+2,ren.y]:=chr(233);
ren.x:=ren.x+1;
end
else wrong
else
wrong;
#75:
if (a[ren.x,ren.y-1]=' ')or(a[ren.x,ren.y-1]='o') then
begin
if dong(ren.x,ren.y,top,b) then a[ren.x,ren.y]:='o' else a[ren.x,ren.y]:=' ';
a[ren.x,ren.y-1]:=chr(2);
ren.y:=ren.y-1;
end
else
if a[ren.x,ren.y-1]=chr(233) then
if (a[ren.x,ren.y-2]=' ')or(a[ren.x,ren.y-2]='o') then
begin
if dong(ren.x,ren.y,top,b) then a[ren.x,ren.y]:='o' else a[ren.x,ren.y]:=' ';
a[ren.x,ren.y-1]:=chr(2);a[ren.x,ren.y-2]:=chr(233);
ren.y:=ren.y-1;
end
else wrong
else
wrong;
#77:
if (a[ren.x,ren.y+1]=' ')or(a[ren.x,ren.y+1]='o') then
begin
if dong(ren.x,ren.y,top,b) then a[ren.x,ren.y]:='o' else a[ren.x,ren.y]:=' ';
a[ren.x,ren.y+1]:=chr(2);
ren.y:=ren.y+1;
end
else
if a[ren.x,ren.y+1]=chr(233) then
if (a[ren.x,ren.y+2]=' ')or(a[ren.x,ren.y+2]='o') then
begin
if dong(ren.x,ren.y,top,b) then a[ren.x,ren.y]:='o' else a[ren.x,ren.y]:=' ';
a[ren.x,ren.y+1]:=chr(2);a[ren.x,ren.y+2]:=chr(233);
ren.y:=ren.y+1;
end
else wrong
else
wrong;
#27:
begin
write('Are you sure to exit(Y/N)?');
4:readln(s1);
if (s1='y')or(s1='Y') then
begin
textmode(lo(lastmode));
halt
end
else
if (s1<>'n')and(s1<>'N') then goto 4;
end;
else
goto 1;
end;
pr(p,q,top,a,b);
if over then
begin
erase(f);
if n=11 then
begin
write('Congratulations!Play again(Y/N)?');
5:readln(s1);
if (s1='y')or(s1='Y') then
begin
n:=1;goto 2;
end
else
if (s1='n')or(s1='N') then halt
else goto 5;
end;
write('Congratulations!Go to next unit(Y/N)?');
3:readln(s1);
if (s1='y')or(s1='Y') then
begin
n:=n+1;goto 2;
end
else
if (s1='n')or(s1='N') then halt
else goto 3;
end;
goto 1;
end.

推箱子（附带单元）：
unit tx;
interface
uses crt;
type poi=record
x,y:integer;
end;
type sz1=array[1..50,1..50]of char;
type sz2=array[1..10]of poi;
function dong(x,y,top:integer;var b:sz2):boolean;
procedure print(x:integer;var ren:poi;var a:sz1;var b:sz2;var top:integer);
procedure pr(x,y,top:integer;a:sz1;b:sz2);
implementation
function dong(x,y,top:integer;var b:sz2):boolean;
var i:integer;
begin
for i:=1 to top do
if (b[i].x=x)and(b[i].y=y) then exit(true);
exit(false);
end;
procedure print(x:integer;var ren:poi;var a:sz1;var b:sz2;var top:integer);
var f:text;s1,s:string;
procedure prsc;
var i,j,m,n:integer;
begin
clrscr;
assign(f,s);
reset(f);
readln(f,top);
for i:=1 to top do
readln(f,b[i].x,b[i].y);
readln(f,m,n);
for i:=1 to m do
for j:=1 to n do
begin
textcolor(15);
if dong(i,j,top,b) then textcolor(12);
read(f,a[i,j]);write(a[i,j]);
if a[i,j]=chr(2) then
begin
ren.x:=i;
ren.y:=j;
end;
if j=n then
begin
readln(f);
writeln
end;
end;
close(f);
end;
begin
str(x,s1);s:='c:\map'+s1+'.in';
assign(f,s);rewrite(f);
case x of
1:
begin
writeln(f,3);
writeln(f,5,' ',2);
writeln(f,6,' ',2);
writeln(f,7,' ',2);
writeln(f,9,' ',8);
writeln(f,' #####');
writeln(f,'#### #');
writeln(f,'# # ?#');
writeln(f,'# ? #');
writeln(f,'#o ####');
writeln(f,'#o# ?# ');
writeln(f,'#o# # # ');
writeln(f,'### # ');
writeln(f,' ##### ');
end;
2:
begin
writeln(f,5);
writeln(f,6,' ',2);
writeln(f,7,' ',2);
writeln(f,7,' ',3);
writeln(f,7,' ',4);
writeln(f,7,' ',5);
writeln(f,8,' ',6);
writeln(f,' #### ');
writeln(f,'## # ');
writeln(f,'#?# ');
writeln(f,'##?##');
writeln(f,'## ?#');
writeln(f,'#o? #');
writeln(f,'#oo閛# ');
writeln(f,'###### ');
end;
3:
begin
writeln(f,3);
writeln(f,4,' ',8);
writeln(f,5,' ',8);
writeln(f,6,' ',8);
writeln(f,9,' ',9);
writeln(f,'##### ');
writeln(f,'# # ');
writeln(f,'# 殚# ###');
writeln(f,'# ?# #o#');
writeln(f,'### ###o#');
writeln(f,' ## o#');
writeln(f,' # # #');
writeln(f,' # ####');
writeln(f,' ##### ');
end;
4:
begin
writeln(f,4);
writeln(f,3,' ',5);
writeln(f,3,' ',6);
writeln(f,4,' ',5);
writeln(f,4,' ',6);
writeln(f,10,' ',7);
writeln(f,' #### ');
writeln(f,'### ##');
writeln(f,'# ?oo#');
writeln(f,'# # oo#');
writeln(f,'# #?##');
writeln(f,'# # #');
writeln(f,'# ?#');
writeln(f,'## ? #');
writeln(f,' # ###');
writeln(f,' #### ');
end;
5:
begin
writeln(f,3);
writeln(f,5,' ',2);
writeln(f,6,' ',2);
writeln(f,7,' ',2);
writeln(f,8,' ',8);
writeln(f,' #### ');
writeln(f,' # ### ');
writeln(f,' # ? # ');
writeln(f,'### # ##');
writeln(f,'#o# # #');
writeln(f,'#o? # #');
writeln(f,'#o ?#');
writeln(f,'########');
end;
6:
begin
writeln(f,5);
writeln(f,2,' ',7);
writeln(f,3,' ',7);
writeln(f,4,' ',7);
writeln(f,5,' ',7);
writeln(f,6,' ',7);
writeln(f,10,' ',8);
writeln(f,' ###');
writeln(f,' #o#');
writeln(f,' #####o#');
writeln(f,'## ? o#');
writeln(f,'# 殚o#');
writeln(f,'# ? o#');
writeln(f,'### ## #');
writeln(f,'# ? #');
writeln(f,'# ###');
writeln(f,'###### ');
end;
7:
begin
writeln(f,5);
writeln(f,2,' ',4);
writeln(f,2,' ',5);
writeln(f,3,' ',3);
writeln(f,3,' ',4);
writeln(f,3,' ',5);
writeln(f,10,' ',7);
writeln(f,' #### ');
writeln(f,' ##oo# ');
writeln(f,' #ooo# ');
writeln(f,'## ?# ');
writeln(f,'# ?? ');
writeln(f,'# #?##');
writeln(f,'# # ?#');
writeln(f,'# #');
writeln(f,'######');
writeln(f,' ### ');
end;
8:
begin
writeln(f,6);
writeln(f,5,' ',5);
writeln(f,5,' ',6);
writeln(f,6,' ',5);
writeln(f,6,' ',6);
writeln(f,7,' ',5);
writeln(f,7,' ',6);
writeln(f,11,' ',9);
writeln(f,' ####');
writeln(f,'###### #');
writeln(f,'# ? ?#');
writeln(f,'# ## #');
writeln(f,'## #oo #');
writeln(f,'##?oo?#');
writeln(f,'# #oo ##');
writeln(f,'# ## #');
writeln(f,'# ? ?#');
writeln(f,'###### #');
writeln(f,' ####');
end;
9:
begin
writeln(f,5);
writeln(f,4,' ',5);
writeln(f,5,' ',4);
writeln(f,5,' ',5);
writeln(f,6,' ',4);
writeln(f,6,' ',5);
writeln(f,8,' ',7);
writeln(f,' #### ');
writeln(f,' # # ');
writeln(f,'### ? ');
writeln(f,'# 殚o##');
writeln(f,'# 閛o #');
writeln(f,'# 閛o #');
writeln(f,'# ###');
writeln(f,'##### ');
end;
10:
begin
writeln(f,4);
writeln(f,5,' ',4);
writeln(f,6,' ',4);
writeln(f,7,' ',4);
writeln(f,8,' ',4);
writeln(f,12,' ',6);
writeln(f,' #### ');
writeln(f,'## ##');
writeln(f,'# ? #');
writeln(f,'# ?#');
writeln(f,'###o #');
writeln(f,' #o #');
writeln(f,' #o##');
writeln(f,'###o #');
writeln(f,'# ?#');
writeln(f,'# ?#');
writeln(f,'# ##');
writeln(f,'##### ');
end;
11:
begin
writeln(f,4);
writeln(f,5,' ',4);
writeln(f,5,' ',5);
writeln(f,6,' ',4);
writeln(f,6,' ',5);
writeln(f,9,' ',7);
writeln(f,'##### ');
writeln(f,'# ###');
writeln(f,'# ? #');
writeln(f,'# ? #');
writeln(f,'# 閛o #');
writeln(f,'###oo #');
writeln(f,' ##?#');
writeln(f,' # #');
writeln(f,' ####');
end;
end;
close(f);
prsc;
end;
procedure pr(x,y,top:integer;a:sz1;b:sz2);
var i,j:integer;
begin
clrscr;
for i:=1 to x do
for j:=1 to y do
begin
textcolor(15);
if dong(i,j,top,b) then textcolor(12);
write(a[i,j]);
if j=y then writeln
end;
end;
end.

扫雷：
program saolei;
uses crt;
label 1,2,3,4;
var a,b:array[1..14,1..14]of char;i,j,t,t2,l:integer;s:string;
procedure ran;
var p:integer;nu:integer;
begin
randomize;
for i:=1 to t do
for j:=1 to t do
begin
b[i,j]:='?;a[i,j]:='?;
end;
for p:=1 to t2 do
begin
repeat
i:=random(t)+1;j:=random(t)+1;
until (a[i,j]='?)and(not((i=1)and(j=1)));
a[i,j]:='';
end;
for i:=1 to t do
for j:=1 to t do
if a[i,j]='? then
begin
nu:=0;
if (i>1)and(j>1) then if a[i-1,j-1]='' then inc(nu);
if (i>1) then if a[i-1,j]='' then inc(nu);
if (i>1)and(j<t) then if a[i-1,j+1]='' then inc(nu);
if (j>1) then if a[i,j-1]='' then inc(nu);
if (j<t) then if a[i,j+1]='' then inc(nu);
if (i<t)and(j>1) then if a[i+1,j-1]='' then inc(nu);
if (i<t) then if a[i+1,j]='' then inc(nu);
if (i<t)and(j<t) then if a[i+1,j+1]='' then inc(nu);
if nu>0 then a[i,j]:=chr(ord('0')+nu);
end;
i:=1;j:=1;
end;
procedure print;
var p,q:integer;
begin
clrscr;
for p:=1 to t do
for q:=1 to t do
begin
if b[p,q]='' then textcolor(12);
if (p=i)and(q=j) then textcolor(8);
write(b[p,q]);
if q=t then writeln;
textcolor(15);
end;
writeln('last:',l);
end;
procedure wrong;
begin
sound(300);
delay(100);
nosound
end;
procedure find(x,y:integer);
begin
b[x,y]:=a[x,y];
if b[x,y]<>'? then exit;
if (x>1)and(b[x-1,y]='?) then find(x-1,y);
if (y>1)and(b[x,y-1]='?) then find(x,y-1);
if (x<t)and(b[x+1,y]='?) then find(x+1,y);
if (y<t)and(b[x,y+1]='?) then find(x,y+1);
if (x>1)and(y>1)and(b[x-1,y-1]='?) then find(x-1,y-1);
if (x>1)and(y<t)and(b[x-1,y+1]='?) then find(x-1,y+1);
if (x<t)and(y>1)and(b[x+1,y-1]='?) then find(x+1,y-1);
if (x<t)and(y<t)and(b[x+1,y+1]='?) then find(x+1,y+1);
end;
procedure print2;
var p,q:integer;
begin
clrscr;
for p:=1 to t do
for q:=1 to t do
begin
if b[p,q]='' then
begin
textcolor(12);
write(b[p,q]);
end
else
if (a[p,q]='') then
begin
textcolor(9);
write(a[p,q]);
end
else write(b[p,q]);
if q=t then writeln;
textcolor(15);
end;
end;
function wan:boolean;
var p,q:integer;
begin
for p:=1 to t do
for q:=1 to t do
if b[p,q]='? then exit(false);
exit(true);
end;
begin
textmode(1);cursoroff;
window(12,8,30,25);
3:clrscr;
writeln('Please choose the level:');
writeln('1--easy 2--normal3--hard');
4:case readkey of
'1':begin t:=11;t2:=20; end;
'2':begin t:=12;t2:=30; end;
'3':begin t:=14;t2:=50; end;
else goto 4;
end;
l:=t2;
ran;
print;
1:case readkey of
#72:if i>1 then dec(i) else wrong;
#80:if i<t then inc(i) else wrong;
#75:if j>1 then dec(j) else wrong;
#77:if j<t then inc(j) else wrong;
#27:
begin
writeln('Do you want to exit(Y/N)?');
repeat
readln(s);
if (s='Y')or(s='y') then halt;
until (s='n')or(s='N');
end;
'j':
begin
b[i,j]:=a[i,j];
if b[i,j]='? then find(i,j);
if b[i,j]='' then begin print2;goto 2;end;
end;
'k':if (l>0)and(b[i,j]='?) then begin b[i,j]:='';dec(l); end;
'l':if b[i,j]='' then begin b[i,j]:='?;inc(l); end;
else goto 1;
end;
print;
if not(wan) then goto 1;
writeln('Congratulations!Play once again(Y/N)?');
repeat
readln(s);
if (s='N')or(s='n') then halt;
if (s='Y')or(s='y') then goto 3;
until s='y';
2:writeln('Game Over!Play once again(Y/N)?');
repeat
readln(s);
if (s='N')or(s='n') then halt;
if (s='Y')or(s='y') then goto 3;
until s='y';
end.

另外我又用c++编了一次贪吃蛇，也一起提供给你。

#include<iostream>
#include<windows.h>
using namespace std;
struct point
{short x,y;
};
char a[22][42];bool f;short i,j,fa;short x[5],y[5];
point s[1001];short h,t,p,q;char st;
short juage()
{if (GetKeyState(VK_UP)<0)
if (fa>=3) {f=true;fa=1;return(0);}
if (GetKeyState(VK_DOWN)<0)
if (fa>=3) {f=true;fa=2;return(0);}
if (GetKeyState(VK_LEFT)<0)
if (fa<=2) {f=true;fa=3;return(0);}
if (GetKeyState(VK_RIGHT)<0)
if (fa<=2) {f=true;fa=4;return(0);}
if (GetKeyState(27)<0)
{cout<<"您真的要退出吗(Y/N) ？";
while (true)
{cin>>st;
if (st=='Y' || st=='y') exit(0); else
if (st=='N' || st=='n') break;
}
}
}
short ran()
{srand(time(0));
short x,y;
while (true)
{
x=rand()%20+1;y=rand()%40+1;
if (a[x][y]==' ') a[x][y]='T';return(0);
}
}
int main()
{x[1]=-1;y[1]=0;
x[2]=1;y[2]=0;
x[3]=0;y[3]=-1;
x[4]=0;y[4]=1;
cout<<" 贪吃蛇\n";
cout<<"本程序由聊城一中09级12班张凯开发\n";
cout<<" 版权所有，翻版必究\n";cout<<endl<<endl;
cout<<"游戏说明：\n";
cout<<" 方向键控制方向，Esc退出\n";
system("pause");
sta:
for (i=1;i<=20;i++)
for (j=1;j<=40;j++)
a[i][j]=' ';
for (i=0;i<=41;i++) {a[0][i]='#';a[21][i]='#';}
for (i=1;i<=20;i++) {a[i][0]='#';a[i][41]='#';}
a[1][1]='0';a[1][2]='0';a[1][3]='8';ran();
h=0;t=3;s[1].x=1;s[1].y=1;s[2].x=1;s[2].y=2;s[3].x=1;s[3].y=3;fa=4;
l1:
system("cls");
for (i=0;i<=21;i++)
{for (j=0;j<=41;j++) cout<<a[i][j];
cout<<endl;
}
f=false;
for (i=1;i<=15;i++)
{Sleep(1);if (!f) juage();}
p=s[t].x+x[fa];q=s[t].y+y[fa];
if (a[p][q]=='#' || (a[p][q]=='0' && !(p==s[h+1].x && q==s[h+1].y))) goto l2;
a[s[t].x][s[t].y]='0';
if (a[p][q]=='T')
{a[p][q]='8';t++;if (t==1001)t=1;s[t].x=p;s[t].y=q;ran();
}
else
{h++;if (h==1001) h=1;a[s[h].x][s[h].y]=' ';a[p][q]='8';
t++;if (t==1001) t=1;s[t].x=p;s[t].y=q;
}
goto l1;
l2:
cout<<"游戏结束！再玩一次吗(Y/N) ？";
while (true)
{cin>>st;
if (st=='Y' || st=='y') goto sta; else
if (st=='N' || st=='n') return(0);
}
}

Answer 2

　　{迷宫 （转）IJKM控制}
　　program makemaze;

　　{apptype GUI, disabled, there are too many writes PM }

　　uses
　　{$ifdef Win32}
　　WinCrt,Windows,
　　{$else}
　　crt,
　　{$endif}
　　graph;

　　const
　　screenwidth = 640;
　　screenheight = 480;
　　minblockwidth = 2;
　　maxx = 200; { BP: [3 * maxx * maxy] must be less than 65520 (memory segment) }
　　{ FPC: Normally no problem. ( even if you'd use 1600x1200x3< 6MB)}
　　maxy = 200; { here maxx/maxy about equil to screenwidth/screenheight }
　　flistsize = maxx*maxy DIV 2; { flist size (fnum max, about 1/3 of maxx * maxy) }

　　background = black;
　　gridcolor = green;
　　solvecolor = white;

　　rightdir = $01;
　　updir = $02;
　　leftdir = $04;
　　downdir = $08;

　　unused = $00; { cell types used as flag bits }
　　frontier = $10;
　　{ reserved = $20; }
　　tree = $30;

　　type
　　frec = record
　　column, row : byte;
　　end;
　　farr = array [1..flistsize] of frec;

　　cellrec = record
　　point : word; { pointer to flist record }
　　flags : byte;
　　end;
　　cellarr = array [1..maxx,1..maxy] of cellrec;

　　{
　　one byte per cell, flag bits...

　　0: right, 1 = barrier removed
　　1: top "
　　2: left "
　　3: bottom "
　　5,4: 0,0 = unused cell type
　　0,1 = frontier "
　　1,1 = tree "
　　1,0 = reserved "
　　6: (not used)
　　7: solve path, 1 = this cell part of solve path
　　}

　　var
　　flist : farr; { list of frontier cells in random order }
　　cell : ^cellarr; { pointers and flags, on heap }
　　fnum,
　　width,
　　height,
　　blockwidth,
　　halfblock,
　　maxrun : word;
　　runset : byte;
　　ch : char;

　　procedure initbgi;
　　var
　　grdriver,
　　grmode,
　　errcode : integer;
　　begin
　　grdriver := vga;
　　grmode := vgahi;
　　initgraph(grdriver, grmode, 'd:\pp\bp\bgi');
　　errcode:= graphresult;
　　if errcode <> grok then
　　begin
　　CloseGraph;
　　writeln('Graphics error: ', grapherrormsg(errcode));
　　halt(1);
　　end;
　　end;

　　function adjust(var x, y : word; d : byte) : boolean;
　　begin { take x,y to next cell in direction d }
　　case d of { returns false if new x,y is off grid }
　　rightdir:
　　begin
　　inc (x);
　　adjust:= x <= width;
　　end;

　　updir:
　　begin
　　dec (y);
　　adjust:= y > 0;
　　end;

　　leftdir:
　　begin
　　dec (x);
　　adjust:= x > 0;
　　end;

　　downdir:
　　begin
　　inc (y);
　　adjust:= y <= height;
　　end;
　　end;
　　end;

　　procedure remove(x, y : word); { remove a frontier cell from flist }
　　var
　　i : word; { done by moving last entry in flist into it's place }
　　begin
　　i := cell^[x,y].point; { old pointer }
　　with flist[fnum] do
　　cell^[column,row].point := i; { move pointer }
　　flist[i] := flist[fnum]; { move data }
　　dec(fnum); { one less to worry about }
　　end;

　　procedure add(x, y : word; d : byte); { add a frontier cell to flist }
　　var
　　i : byte;
　　begin
　　i := cell^[x,y].flags;
　　case i and $30 of { check cell type }
　　unused :
　　begin
　　cell^[x,y].flags := i or frontier; { change to frontier cell }
　　inc(fnum); { have one more to worry about }
　　if fnum > flistsize then
　　begin { flist overflow error! }
　　dispose(cell); { clean up memory }
　　closegraph;
　　writeln('flist overflow! - To correct, increase "flistsize"');
　　write('hit return to halt program ');
　　readln;
　　halt(1); { exit program }
　　end;
　　with flist[fnum] do
　　begin { copy data into last entry of flist }
　　column := x;
　　row := y;
　　end;
　　cell^[x,y].point := fnum; { make the pointer point to the new cell }
　　runset := runset or d; { indicate that a cell in direction d was }
　　end; { added to the flist }

　　frontier : runset := runset or d; { allready in flist }
　　end;
　　end;

　　procedure addfront(x, y : word); { change all unused cells around this }
　　var { base cell to frontier cells }
　　j, k : word;
　　d : byte;
　　begin
　　remove(x, y); { first remove base cell from flist, it is now }
　　runset := 0; { part of the tree }
　　cell^[x,y].flags := cell^[x,y].flags or tree; { change to tree cell }
　　d := $01; { look in all four directions- $01,$02,$04,$08 }
　　while d <= $08 do
　　begin
　　j := x;
　　k := y;
　　if adjust(j, k, d) then
　　add(j, k, d); { add only if still in bounds }
　　d := d shl 1; { try next direction }
　　end;
　　end;

　　procedure remline(x, y : word; d : byte); { erase line connecting two blocks }
　　begin
　　setcolor(background);
　　x := (x - 1) * blockwidth;
　　y := (y - 1) * blockwidth;
　　case d of
　　rightdir : line (x + blockwidth, y + 1, x + blockwidth, y + blockwidth - 1);
　　updir : line (x + 1, y, x + blockwidth - 1, y);
　　leftdir : line (x, y + 1, x, y + blockwidth - 1);
　　downdir : line (x + 1, y + blockwidth, x + blockwidth - 1, y + blockwidth);
　　end;
　　end;

　　{ erase line and update flags to indicate the barrier has been removed }
　　procedure rembar(x, y : word; d : byte);
　　var
　　d2 : byte;
　　begin
　　remline(x, y, d); { erase line }
　　cell^[x,y].flags := cell^[x,y].flags or d; { show barrier removed dir. d }
　　d2 := d shl 2; { shift left twice to reverse direction }
　　if d2 > $08 then
　　d2 := d2 shr 4; { wrap around }
　　if adjust(x, y, d) then { do again from adjacent cell back to base cell }
　　cell^[x,y].flags := cell^[x,y].flags or d2; { skip if out of bounds }
　　end;

　　function randomdir : byte; { get a random direction }
　　begin
　　case random(4) of
　　0 : randomdir := rightdir;
　　1 : randomdir := updir;
　　2 : randomdir := leftdir;
　　3 : randomdir := downdir;
　　end;
　　end;

　　procedure connect(x, y : word); { connect this new branch to the tree }
　　var { in a random direction }
　　j, k : word;
　　d : byte;
　　found : boolean;
　　begin
　　found := false;
　　while not found do
　　begin { loop until we find a tree cell to connect to }
　　j := x;
　　k := y;
　　d := randomdir;
　　if adjust(j, k, d) then
　　found := cell^[j,k].flags and $30 = tree;
　　end;
　　rembar(x, y, d); { remove barrier connecting the cells }
　　end;

　　procedure branch(x, y : word); { make a new branch of the tree }
　　var
　　runnum : word;
　　d : byte;
　　begin
　　runnum := maxrun; { max number of tree cells to add to a branch }
　　connect(x, y); { first connect frontier cell to the tree }
　　addfront(x, y); { convert neighboring unused cells to frontier }
　　dec(runnum); { number of tree cells left to add to this branch }
　　while (runnum > 0) and (fnum > 0) and (runset > 0) do
　　begin
　　repeat
　　d := randomdir;
　　until d and runset > 0; { pick random direction to known frontier }
　　rembar(x, y, d); { and make it part of the tree }
　　adjust(x, y, d);
　　addfront(x, y); { then pick up the neighboring frontier cells }
　　dec(runnum);
　　end;
　　end;

　　procedure drawmaze;
　　var
　　x, y, i : word;
　　begin
　　setcolor(gridcolor); { draw the grid }
　　y := height * blockwidth;
　　for i := 0 to width do
　　begin
　　x := i * blockwidth;
　　line(x, 0, x, y);
　　end;
　　x := width * blockwidth;
　　for i := 0 to height do
　　begin
　　y := i * blockwidth;
　　line (0, y, x, y);
　　end;
　　fillchar(cell^, sizeof(cell^), chr(0)); { zero flags }
　　fnum := 0; { number of frontier cells in flist }
　　runset := 0; { directions to known frontier cells from a base cell }
　　randomize;
　　x := random(width) + 1; { pick random start cell }
　　y := random(height) + 1;
　　add(x, y, rightdir); { direction ignored }
　　addfront(x, y); { start with 1 tree cell and some frontier cells }
　　while (fnum > 0) do
　　with flist[random(fnum) + 1] do
　　branch(column, row);
　　end;

　　procedure dot(x, y, colr : word);
　　begin
　　putpixel(blockwidth * x - halfblock, blockwidth * y - halfblock, colr);
　　end;

　　procedure solve(x, y, endx, endy : word);
　　var
　　j, k : word;
　　d : byte;
　　begin
　　d := rightdir; { starting from left side of maze going right }
　　while (x <> endx) or (y <> endy) do
　　begin
　　if d = $01 then
　　d := $08
　　else
　　d := d shr 1; { look right, hug right wall }
　　while cell^[x,y].flags and d = 0 do
　　begin { look for an opening }
　　d := d shl 1; { if no opening, turn left }
　　if d > $08 then
　　d := d shr 4;
　　end;
　　j := x;
　　k := y;
　　adjust(x, y, d); { go in that direction }
　　with cell^[j,k] do
　　begin { turn on dot, off if we were here before }
　　flags := ((((cell^[x,y].flags xor $80) xor flags) and $80) xor flags);
　　if flags and $80 <> 0 then
　　dot(j, k, solvecolor)
　　else
　　dot(j, k, background);
　　end;
　　end;
　　dot(endx, endy, solvecolor); { dot last cell on }
　　end;

　　procedure mansolve (x,y,endx,endy: word);
　　var
　　j, k : word;
　　d : byte;
　　ch : char;
　　begin
　　ch := ' ';
　　while ((x <> endx) or (y <> endy)) and (ch <> 'X') and (ch <> #27) do
　　begin
　　dot(x, y, solvecolor); { dot man on, show where we are in maze }
　　ch := upcase(readkey);
　　dot(x, y, background); { dot man off after keypress }
　　d := 0;
　　case ch of
　　#0:
　　begin
　　ch := readkey;
　　case ch of
　　#72 : d := updir;
　　#75 : d := leftdir;
　　#77 : d := rightdir;
　　#80 : d := downdir;
　　end;
　　end;

　　'I' : d := updir;
　　'J' : d := leftdir;
　　'K' : d := rightdir;
　　'M' : d := downdir;
　　end;

　　if d > 0 then
　　begin
　　j := x;
　　k := y; { move if no wall and still in bounds }
　　if (cell^[x,y].flags and d > 0) and adjust(j, k, d) then
　　begin
　　x := j;
　　y := k;
　　end;
　　end;
　　end;
　　end;

　　procedure solvemaze;
　　var
　　x, y,
　　endx,
　　endy : word;
　　begin
　　x := 1; { pick random start on left side wall }
　　y := random(height) + 1;
　　endx := width; { pick random end on right side wall }
　　endy := random(height) + 1;
　　remline(x, y, leftdir); { show start and end by erasing line }
　　remline(endx, endy, rightdir);
　　mansolve(x, y, endx, endy); { try it manually }
　　solve(x, y, endx, endy); { show how when he gives up }
　　while keypressed do
　　readkey;
　　readkey;
　　end;

　　procedure getsize;
　　var
　　j, k : real;
　　begin
　　{$ifndef win32}
　　clrscr;
　　{$endif}
　　writeln(' Mind');
　　writeln(' Over');
　　writeln(' Maze');
　　writeln;
　　writeln(' by Randy Ding');
　　writeln;
　　writeln('Use I,J,K,M or arrow keys to walk thru maze,');
　　writeln('then hit X when you give up!');
　　repeat
　　writeln;
　　write('Maze size: ', minblockwidth, ' (hard) .. 95 (easy) ');
　　readln(blockwidth);
　　until (blockwidth >= minblockwidth) and (blockwidth < 96);
　　writeln;
　　write('Maximum branch length: 1 easy .. 50 harder, (0 unlimited) ');
　　readln(maxrun);
　　if maxrun <= 0 then
　　maxrun := 65535; { infinite }
　　j := Real(screenwidth) / blockwidth;
　　k := Real(screenheight) / blockwidth;
　　if j = system.int(j) then
　　j := j - 1;
　　if k= system.int(k) then
　　k := k - 1;
　　width := trunc(j);
　　height := trunc(k);
　　if (width > maxx) or (height > maxy) then
　　begin
　　width := maxx;
　　height := maxy;
　　end;
　　halfblock := blockwidth div 2;
　　end;

　　begin
　　{$ifdef Win32}
　　ShowWindow(GetActiveWindow,0);
　　Initbgi;
　　{$endif}
　　repeat
　　getsize;
　　{$ifndef Win32}
　　initbgi;
　　{$endif}
　　new(cell); { allocate this large array on heap }
　　drawmaze;
　　solvemaze;
　　dispose(cell);
　　{$ifndef Win32}
　　closegraph;
　　{$endif}
　　while keypressed do
　　ch := readkey;
　　write ('another one? ');
　　ch := upcase (readkey);
　　until (ch = 'N') or (ch = #27);
　　{$ifdef Win32}
　　CloseGraph;
　　{$endif}
　　end.
　　{射击(转)player1: i上k下f射击 player2: 8上5下0射击(小键盘)}
　　uses crt;
　　const cz:array[1..4,1..2] of -1..1=((0,1),(1,0),(0,-1),(-1,0));
　　var i,j,xz1,yz1,y1,xz2,yz2,y2,t1,t2,t3,k,v1,v2:integer;
　　ch:char;
　　a:array[1..20] of integer;

　　procedure priter;
　　begin
　　gotoxy(1,1);
　　textbackground(green);
　　for i:=1 to 20 do
　　begin
　　for j:=1 to 40 do
　　write(' ');
　　writeln;
　　end;
　　end;
　　procedure priv;
　　begin
　　gotoxy(1,1);
　　write('v1:',v1:3,' v2:',v2:2);
　　end;
　　procedure start;
　　begin
　　priter;
　　textcolor(black);
　　textbackground(green);
　　gotoxy(1,1);
　　write('Really? ');
　　ch:=readkey;
　　for i:=3 downto 1 do
　　begin
　　write(i);
　　sound(1871);
　　delay(500);
　　nosound;
　　delay(500);
　　write(#8);
　　end;
　　write('Go!!!');
　　sound(2500);
　　delay(500);
　　nosound;
　　end;
　　procedure GameOver(p:integer);
　　begin
　　if p=1 then begin gotoxy(1,y1);write(']*');end;
　　if p=2 then begin gotoxy(39,y2);write('*[');end;
　　textcolor(green);
　　textbackground(black);
　　gotoxy(10,10);
　　p:=3-p;
　　write('Player ',p:1,' is Win!!!');
　　repeat ch:=readkey;until ord(ch)=13;
　　textbackground(black);
　　ClrScr;
　　halt;
　　end;
　　procedure over(p:integer);
　　begin
　　if p=1 then begin dec(v1);gotoxy(1,y1);write(']*');end;
　　if p=2 then begin dec(v2);gotoxy(39,y2);write('*[');end;
　　priv;
　　if v1=0 then gameover(1);
　　if v2=0 then gameover(2);
　　end;
　　procedure go;
　　begin
　　textbackground(black);
　　ClrScr;
　　for i:=1 to 20 do a[i]:=38;
　　textbackground(green);
　　textcolor(black);
　　priter;
　　gotoxy(1,2);
　　y1:=1;
　　write(']>');
　　gotoxy(39,2);
　　write('<[');
　　gotoxy(1,1);
　　y1:=2;t1:=0;t2:=0;t3:=0;y2:=2;v1:=10;v2:=10;
　　priv;
　　while true do
　　begin
　　delay(1);
　　inc(t1,1);
　　if t1=1000 then
　　begin
　　inc(t2);
　　if t2=60 then begin t2:=0;inc(t3);end;
　　end;
　　if keypressed then
　　begin
　　ch:=readkey;
　　if (ch='i') and (y1>2) then
　　begin
　　gotoxy(1,y1);
　　write(' ');
　　dec(y1);
　　gotoxy(1,y1);
　　write(']>');
　　end;
　　if (ch='k') and (y1<20) then
　　begin
　　gotoxy(1,y1);
　　write(' ');
　　inc(y1);
　　gotoxy(1,y1);
　　write(']>');
　　end;
　　if (ch='q') then break;
　　if (ch='f')and(xz1=0) then
　　begin
　　xz1:=3;
　　yz1:=y1;
　　end;
　　{play2}
　　if (ch='8') and (y2>2) then
　　begin
　　gotoxy(39,y2);
　　write(' ');
　　dec(y2);
　　gotoxy(39,y2);
　　write('<[');
　　end;
　　if (ch='5') and (y2<20) then
　　begin
　　gotoxy(39,y2);
　　write(' ');
　　inc(y2);
　　gotoxy(39,y2);
　　write('<[');
　　end;
　　if (ch='0')and(xz2=0) then
　　begin
　　xz2:=37;
　　yz2:=y2;
　　end;
　　end;{end of keyprssed}
　　if (t1 mod 5=0)and(xz1<>0) then
　　begin
　　if xz1>38 then
　　begin
　　gotoxy(xz1,yz1);
　　write(' ');
　　if yz1=y2 then Over(2);
　　xz1:=0;
　　yz1:=0;
　　end
　　else
　　begin
　　gotoxy(xz1,yz1);
　　write(' .');
　　inc(xz1);
　　end;
　　end;
　　{play2}
　　if (t1 mod 5=0)and(xz2<>0) then
　　begin
　　if xz2<2 then
　　begin
　　gotoxy(xz2,yz2);
　　write(' ');
　　if yz2=y1 then Over(1);
　　xz2:=0;
　　yz2:=0;
　　end
　　else
　　begin
　　gotoxy(xz2-1,yz2);
　　write('. ');
　　dec(xz2);
　　end;
　　end;
　　end;{end of while}
　　end; {end of go}
　　begin
　　start;
　　go;
　　end.

Answer 3

猜数字

Answer 4

新手推荐文字游戏
可以用到crys（？）来清屏，随便编个十万字不是梦还贼好玩（前提是剧情和脑洞）只要学会顺序结构和简单的循环就可以了
记得把pascal调成中文模式