uses crt
type type1=record
h,l,f:integer
end
const m:array[1..6,1..16]of integer=
((1,0,1,1,1,0,1,0,1,0,1,1,1,0,0,0),
(1,2,1,2,0,2,1,2,1,2,0,2,0,2,0,2),
(1,1,1,0,1,1,1,0,1,0,1,0,0,1,1,1),
{(0,2,0,2,1,2,0,2,0,2,1,2,1,2,0,2),
(0,0,0,1,1,1,1,1,1,1,1,1,1,1,0,0), }
(0,2,1,2,1,2,0,2,0,2,1,2,1,2,1,2),
(0,0,1,0,1,1,1,0,1,0,1,0,1,1,1,1),
(0,2,1,2,0,2,0,2,1,2,0,2,0,2,1,2))
var yellow,white:type1
ybomb,wbomb:array[1..10]of type1
fire:array[1..100]of type1
map:array[0..6,0..16]of integer
yb,wb,ybo,wbo,yw,yv,wv,ww,tms,ts,tm,t:integer
yueshi,weili:array[1..10]of type1
b:boolean
procedure pushtype1(var t:array of type1th,tl,tf:integer)
var i:integer
begin
for i:=1 to high(t) do
with t[i] do
if f<=0 then
begin
f:=tf
h:=th
l:=tl
exit
end
end
procedure print
var i,j:integer
begin
textbackground(black)
clrscr
for i:=1 to 16 do
for j:=1 to 6 do
if map[j,i] in [1,2] then
begin
if map[j,i]=1 then textcolor(green)
else if map[j,i]=2 then textcolor(brown)
gotoxy(i*4-3,j*4-3)write('>>>>')
gotoxy(i*4-3,j*4-2)write('>>>>')
gotoxy(i*4-3,j*4-1)write('>>>>')
gotoxy(i*4-3,j*4-0)write('>>>>')
end
for i:=1 to high(fire) do
with fire[i] do
if f>0 then
begin
textcolor(red)
gotoxy(l*4-3,h*4-3)write('>><<')
gotoxy(l*4-3,h*4-2)write('>><<')
gotoxy(l*4-3,h*4-1)write('>><<')
gotoxy(l*4-3,h*4-0)write('>><<')
end
for i:=1 to high(yueshi) do
with yueshi[i] do
if f>0 then
begin
textcolor(red)
gotoxy(l*4-3,h*4-3)write(' /\ ')
gotoxy(l*4-3,h*4-2)write('/__\')
gotoxy(l*4-3,h*4-1)write('\ /')
gotoxy(l*4-3,h*4-0)write(' \/ ')
end
for i:=1 to high(weili) do
with weili[i] do
if f>0 then
begin
textcolor(114)
gotoxy(l*4-3,h*4-3)write('____')
gotoxy(l*4-3,h*4-2)write('|/\|')
gotoxy(l*4-3,h*4-1)write('|\/|')
gotoxy(l*4-3,h*4-0)write('/__/')
end
for i:=1 to high(ybomb) do
with ybomb[i] do
if f>0 then
begin
textcolor(blue)
gotoxy(l*4-3,h*4-3)write(' XX ')
gotoxy(l*4-3,h*4-2)write('| |')
gotoxy(l*4-3,h*4-1)write('| |')
gotoxy(l*4-3,h*4-0)write('\__/')
end
for i:=1 to high(wbomb) do
with wbomb[i] do
if f>0 then
begin
textcolor(blue)
gotoxy(l*4-3,h*4-3)write(' XX ')
gotoxy(l*4-3,h*4-2)write('| |')
gotoxy(l*4-3,h*4-1)write('| |')
gotoxy(l*4-3,h*4-0)write('\__/')
end
textbackground(black)
textbackground(black)
if yellow.f>0 then textcolor(14)
else textcolor(12)
gotoxy(yellow.l*4-3,yellow.h*4-3)write('/--\')
gotoxy(yellow.l*4-3,yellow.h*4-2)write('|^^|')
gotoxy(yellow.l*4-3,yellow.h*4-1)write('|\/|')
gotoxy(yellow.l*4-3,yellow.h*4-0)write('\__/')
if white.f>0 then textcolor(15)
else textcolor(12)
gotoxy(white.l*4-3,white.h*4-3)write('/--\')
gotoxy(white.l*4-3,white.h*4-2)write('|^^|')
gotoxy(white.l*4-3,white.h*4-1)write('|\/|')
gotoxy(white.l*4-3,white.h*4-0)write('\__/')
end
procedure newthing(h,l:integer)
var i:integer
begin
b:=true
i:=random(3)
if i<=0 then pushtype1(yueshi,h,l,1)
else if i=1 then pushtype1(weili,h,l,1)
end
procedure checkthing
var i:integer
begin
for i:=1 to high(yueshi) do
with yueshi[i] do
begin
if (f>0)and(h=yellow.h)and(l=yellow.l) then begin b:=trueinc(yb)f:=0end
if (f>0)and(h=white.h)and(l=white.l) then begin b:=trueinc(wb)f:=0end
end
for i:=1 to high(weili) do
with weili[i] do
begin
if (f>0)and(h=yellow.h)and(l=yellow.l) then begin b:=trueinc(yw)f:=0end
if (f>0)and(h=white.h)and(l=white.l) then begin b:=trueinc(ww)f:=0end
end
end
procedure runbomby(ch:char)
begin
if ch='q' then halt
{yellow}
if ch in['f','j','k','l','i'] then
begin
if(ch='f')and(yb>0){and(map[yellow.h,yellow.l]=0)}then
begin dec(yb)pushtype1(ybomb,yellow.h,yellow.l,3)map[yellow.h,yellow.l]:=4end
else if(ch='j')and(map[yellow.h,yellow.l-1]=0)and(yellow.l>1) then dec(yellow.l)
else if(ch='l')and(map[yellow.h,yellow.l+1]=0)and(yellow.l<16) then inc(yellow.l)
else if(ch='i')and(map[yellow.h-1,yellow.l]=0)and(yellow.h>1) then dec(yellow.h)
else if(ch='k')and(map[yellow.h+1,yellow.l]=0)and(yellow.h<6) then inc(yellow.h)
end
{white}
else if ch in['8','6','5','4','0'] then
begin
if(ch='0')and(wb>0){and(map[white.h,white.l]=0)}then
begin dec(wb)pushtype1(wbomb,white.h,white.l,3)map[white.h,white.l]:=4end
else if(ch='4')and(map[white.h,white.l-1]=0)and(white.l>1) then dec(white.l)
else if(ch='6')and(map[white.h,white.l+1]=0)and(white.l<16) then inc(white.l)
else if(ch='8')and(map[white.h-1,white.l]=0)and(white.h>1) then dec(white.h)
else if(ch='5')and(map[white.h+1,white.l]=0)and(white.h<6) then inc(white.h)
end
end
procedure bomb(h,l,w:integer)
const fx:array[1..4,1..2]of -1..1=((1,0),(0,1),(-1,0),(0,-1))
var i,j,xh,xl:integer
begin
b:=true
pushtype1(fire,h,l,5)
for j:=1 to 4 do
begin
xh:=hxl:=l
for i:=1 to w do
begin
inc(xh,fx[j,1])
inc(xl,fx[j,2])
if (xh<1)or(xh>6)or(xl<1)or(xl>16) then break
if map[xh,xl]=1 then begin pushtype1(fire,xh,xl,5)map[xh,xl]:=0newthing(xh,xl)breakend
else if map[xh,xl]=2 then break
else pushtype1(fire,xh,xl,5)
end
end
end
procedure check
var i,t:integer
begin
t:=0
for i:=1 to high(fire) do
with fire[i] do
begin
if (f>0)and(h=yellow.h)and(l=yellow.l) then begin yellow.f:=0b:=trueend
if (f>0)and(h=white.h)and(l=white.l) then begin white.f:=0b:=trueend
end
end
procedure runbomb
var i:integer
begin
for i:=1 to high(ybomb) do
with ybomb[i] do
if f>0 then
begin
dec(f)
if f<=0 then
begin
map[h,l]:=0
bomb(h,l,yw)
inc(yb)
end
end
for i:=1 to high(wbomb) do
with wbomb[i] do
if f>0 then
begin
dec(f)
if f<=0 then
begin
map[h,l]:=0
bomb(h,l,ww)
inc(wb)
end
end
end
procedure init
var i,j:integer
begin
yb:=1wb:=1yw:=1ww:=1
textbackground(black)
clrscr
fillchar(map,sizeof(map),0)
for i:=1 to 6 do
for j:=1 to 16 do
map[i,j]:=m[i,j]
with yellow do begin f:=1h:=6l:=1end
with white do begin f:=1h:=1l:=16end
fillchar(ybomb,sizeof(ybomb),0)
fillchar(wbomb,sizeof(wbomb),0)
fillchar(fire,sizeof(fire),0)
fillchar(yueshi,sizeof(yueshi),0)
fillchar(weili,sizeof(weili),0)
tms:=0tm:=0ts:=0
end
procedure main
var ch:char
i:integer
begin
t:=0
while (white.f=1)and(yellow.f=1) do
begin
b:=false
delay(8)
inc(tms,10)
if tms=1000 then
begin
tms:=0
inc(ts)
if ts=60 then
begin
inc(tm)
ts:=0
end
end
if tms mod 100=0 then
for i:=1 to high(fire) do
begin
if fire[i].f=0 then b:=true
dec(fire[i].f)
end
if keypressed then
begin
ch:=readkey
b:=true
runbomby(ch)
end
if tms=0 then runbomb
check
checkthing
if b then begin printinc(t)end
end
delay(500)
end
procedure over
var ch:char
i:integer
begin
clrscr
gotoxy(1,1)
if (white.f=0)and(yellow.f=0) then
begin
writeln('DDDRRR A W W W ')
writeln('D D R RA AW W W W ')
writeln('D D RR AAAAA WWWW ')
writeln('DDDR RR AA W W ')
end
else if yellow.f=0 then
begin
textcolor(15)
writeln('W W W HH IIII TTTTTT EEEEEEW W W OOO N N')
writeln('W W W W HHHHH II TTEE____W W W W OO NN N')
writeln('WWWW HH II TTEEWWWW OO N NN')
writeln('W W HH IIIITTEEEEEEW W OOO N N')
end
else if white.f=0 then
begin
textcolor(14)
writeln('YY EEEEEE L L OOO W W WW W W OOO N N')
writeln(' Y Y EE____ L L OO W W W WW W W W OO NN N')
writeln(' YEE L L OO WWWWWWWW OO N NN')
writeln(' YEEEEEE LLLL LLLL OOO W WW W OOO N N')
end
repeat ch:=readkeyuntil ch=#13
end
begin
while true do
begin
init
main
over
end
readln
end.
这是SCOI的省选题吧思路是这样的枚举第一个格子里的雷的情况（有雷或者没有雷）
然后第2～N个格子里就可以推出来了
然后顺着推到最下面，如果没有矛盾 把解输出
通过运用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:shuzus:stringb:array[1..1000]of pointi,j,f,fen:integer
head,tail:0..1001c: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:=0tail:=3fen:=0f:=4
b[1].x:=2b[1].y:=2
b[2].x:=2b[2].y:=3
b[3].x:=2b[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:=1c:=trueend
#80:
if (f=3)or(f=4) then begin f:=2c:=true end
#75:
if (f=1)or(f=2) then begin f:=3c:=true end
#77:
if (f=1)or(f=2) then begin f:=4c:=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
ranran2
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-1b[1].y:=b[1000].y
end
else
begin
b[tail].x:=b[tail-1].x-1b[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
ranran2
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+1b[1].y:=b[1000].y
end
else
begin
b[tail].x:=b[tail-1].x+1b[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
ranran2
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].xb[1].y:=b[1000].y-1
end
else
begin
b[tail].x:=b[tail-1].xb[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
ranran2
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].xb[1].y:=b[1000].y+1
end
else
begin
b[tail].x:=b[tail-1].xb[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:textn,p,q,i,j:integers1,s:string
a:sz1b:sz2top:integerren: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:=1goto 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+1goto 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:integervar b:sz2):boolean
procedure print(x:integervar ren:poivar a:sz1var b:sz2var top:integer)
procedure pr(x,y,top:integera:sz1b:sz2)
implementation
function dong(x,y,top:integervar 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:integervar ren:poivar a:sz1var b:sz2var top:integer)
var f:texts1,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:integera:sz1b: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 chari,j,t,t2,l:integers:string
procedure ran
var p:integernu: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)+1j:=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:=1j:=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:=11t2:=20end
'2':begin t:=12t2:=30end
'3':begin t:=14t2:=50end
else goto 4
end
l:=t2
ran
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 print2goto 2end
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
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 fshort i,j,fashort x[5],y[5]
point s[1001]short h,t,p,qchar st
short juage()
{if (GetKeyState(VK_UP)<0)
if (fa>=3) {f=truefa=1return(0)}
if (GetKeyState(VK_DOWN)<0)
if (fa>=3) {f=truefa=2return(0)}
if (GetKeyState(VK_LEFT)<0)
if (fa<=2) {f=truefa=3return(0)}
if (GetKeyState(VK_RIGHT)<0)
if (fa<=2) {f=truefa=4return(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+1y=rand()%40+1
if (a[x][y]==' ') a[x][y]='T'return(0)
}
}
int main()
{x[1]=-1y[1]=0
x[2]=1y[2]=0
x[3]=0y[3]=-1
x[4]=0y[4]=1
cout<<"贪吃蛇\n"
cout<<"本程序由聊城一中09级12班张凯开发\n"
cout<<"版权所有，翻版必究\n"cout<<endl<<endl
cout<<"游戏说明：\n"
cout<<"方向键控制方向，Esc退出\n"
system("pause")
sta:
for (i=1i<=20i++)
for (j=1j<=40j++)
a[i][j]=' '
for (i=0i<=41i++) {a[0][i]='#'a[21][i]='#'}
for (i=1i<=20i++) {a[i][0]='#'a[i][41]='#'}
a[1][1]='0'a[1][2]='0'a[1][3]='8'ran()
h=0t=3s[1].x=1s[1].y=1s[2].x=1s[2].y=2s[3].x=1s[3].y=3fa=4
l1:
system("cls")
for (i=0i<=21i++)
{for (j=0j<=41j++) cout<<a[i][j]
cout<<endl
}
f=false
for (i=1i<=15i++)
{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=1s[t].x=ps[t].y=qran()
}
else
{h++if (h==1001) h=1a[s[h].x][s[h].y]=' 'a[p][q]='8'
t++if (t==1001) t=1s[t].x=ps[t].y=q
}
goto l1
l2:
cout<<"游戏结束！再玩一次吗(Y/N) ？"
while (true)
{cin>>st
if (st=='Y' || st=='y') goto staelse
if (st=='N' || st=='n') return(0)
}
}
欢迎分享，转载请注明来源：内存溢出
微信扫一扫
支付宝扫一扫
评论列表（0条）