6 楼
绿步甲 [专家分:1610] 发布于 2006-02-02 20:14:00
学校寒假的作业了
还请大家多多指教~~~
其中还借用了啊BEN的一段程序呀~````````
uses crt,graph;
const x1=160;
y1=96;
x2=480;
y2=384;
where:array[1..2,0..3]of integer=((212,320,428,0),
(110,196,282,368));
math:array[0..9] of integer=(99,62,12,10,23,67,1,5,3,33);
s0:string='45*2+9=?';
s1:string='2*34-6=?';
s2:string='1*9+3=?';
s3:string='23/23+9=?';
s4:string='12+32-21=?';
s5:string='65-5+7=?';
s6:string='1*1+1-1/1=?';
s7:string='(2-2)/3*4+5=?';
s8:string='(8+9)/17-2+4=?';
s9:string='7+13-32+45=?';
fast=2;
style=3;
wide=5;
var
gd,gm,i,j,e,p,maths,g:integer;
ball:array[0..2,1..10,1..3] of integer;
ch:char;
player:array[1..3] of integer;
Palette: PaletteType;
procedure music;
begin
sound(500);
delay(225);
nosound;
delay(25);
sound(500);
delay(225);
nosound;
delay(25);
sound(400);
delay(225);
nosound;
delay(25);
sound(500);
delay(225);
nosound;
delay(25);
sound(600);
delay(225);
nosound;
delay(25);
sound(400);
delay(225);
nosound;
delay(25);
sound(500);
delay(1000);
nosound;
delay(1000);
end;
procedure picmaths;
var
t:integer;s:string;
begin
setcolor(0);
for t:=1 to 20 do
line(300,40+t,450,40+t);
t:=random(10);
setcolor(7);
case t of
0:outtextxy(300,50,s0);
1:outtextxy(300,50,s1);
2:outtextxy(300,50,s2);
3:outtextxy(300,50,s3);
4:outtextxy(300,50,s4);
5:outtextxy(300,50,s5);
6:outtextxy(300,50,s6);
7:outtextxy(300,50,s7);
8:outtextxy(300,50,s8);
9:outtextxy(300,50,s9);
end;
maths:=math[t];
end;
procedure ballruns;
var
a,b,c:byte;
d:integer;
begin
a:=random(3);
for b:=1 to a do
begin
c:=random(3);
for d:=1 to 10 do
if ball[c,d,1]=0
then begin
ball[c,d,1]:=where[1,c];
ball[c,d,2]:=where[2,0];
repeat
ball[c,d,3]:=random(maths+5);
until ball[c,d,3]>=maths-5;
break;
end;
end;
end;
procedure pic;
var
n,m,k,o,p:integer;
s:string;
begin
setcolor(0);
bar(x1,y1,263,y2);
bar(269,y1,371,y2);
bar(377,y1,x2,y2);
for n:=0 to 2 do
for m:=1 to 10 do
if ball[n,m,1]<>0
then begin
if ball[n,m,2]>368
then
for k:=1 to 3 do
ball[n,m,k]:=0
else begin
repeat
o:=random(16)
until (o=2)or(o=6)or(o=10)or(o=12);
setcolor(o);
for k:=0 to 15 do
circle(ball[n,m,1],ball[n,m,2],k);
setcolor(0);
str(ball[n,m,3],s);
outtextxy(ball[n,m,1]-3,ball[n,m,2],s);
ball[n,m,2]:=ball[n,m,2]+86;
end;
end;
sound(500);
delay(100);
nosound;
end;
procedure playerruns(e:integer);
var
p,q:integer;
begin
case e of
75:if player[1]<>212
then begin
player[1]:=player[1]-108;
for p:=0 to 10 do
begin
setcolor(p);
circle(player[1],player[2],p);
end;
end;
77:if player[1]<>428
then begin
player[1]:=player[1]+108;
for p:=0 to 10 do
begin
setcolor(p);
circle(player[1],player[2],p);
end;
end;
72:if player[2]<>110
then begin
player[2]:=player[2]-86;
for p:=0 to 10 do
begin
setcolor(p);
circle(player[1],player[2],p);
end;
end;
80:if player[2]<>368
then begin
player[2]:=player[2]+86;
for p:=0 to 10 do
begin
setcolor(p);
circle(player[1],player[2],p);
end;
end;
end;
end;
procedure over;
var
x,y,p,q,j,k,i:integer;
begin
for x:=0 to 2 do
for y:=1 to 10 do
if (ball[x,y,1]=player[1])and(ball[x,y,2]>player[2])
then begin
if ball[x,y,3]=maths
then begin
setcolor(14);
for q:=1 to 10 do
circle(g,440,q);
g:=g+25;
picmaths;
bar(x1,y1,x2,y2);
setcolor(0);
player[1]:=320;
player[2]:=368;
for j:=1 to 5 do
begin
line(263+j,y1,263+j,y2);
line(371+j,y1,371+j,y2);
end;
for j:=0 to 2 do
for k:=1 to 10 do
begin
ball[j,k,1]:=0;
ball[j,k,2]:=0;
ball[j,k,3]:=0;
end;
end
else begin
sound(350);
delay(2000);
nosound;
setcolor(4);
for p:=0 to 40 do
begin
circle(player[1],player[2],p);
delay(50);
end;
setcolor(14);
for p:=0 to 20 do
begin
circle(player[1],player[2],p);
delay(50);
end;
setcolor(4);
for p:=0 to 10 do
begin
circle(player[1],player[2],p);
delay(50);
end;
setcolor(14);
for p:=0 to 5 do
begin
circle(player[1],player[2],p);
delay(50);
end;
for i:=1 to 5 do
begin
setrgbpalette(i,(i-1)*10,0,0);
end;
for i:=0 to getmaxx do
if i mod fast=0 then
begin
for j:=0 to 4 do
begin
setfillstyle(style,j+1);
bar(i+j*wide,0,i+j*wide+wide-1,getmaxy);
bar(i+(9-j)*wide,0,i+(10-j)*wide-1,getmaxy);
end;
setfillstyle(1,0);
bar(i,0,i+fast-1,getmaxy);
end;
settextstyle(5,0,5);
outtextxy(200,100,'ACHIEVEMENT');
setcolor(14);
for j:=1 to (g-100)div 25 do
for k:=1 to 10 do
circle(125+j*25,240,k);
music;
halt;
end;
end;
end;
procedure gamebegins;
var
i,j:integer;
begin
GetPalette(Palette);
setrgbpalette(1,0,0,0);
setcolor(5);
settextstyle(10,0,2);
for i:=1 to 200 do
begin
setcolor(5);
for j:=1 to 2 do
begin
outtextxy(150,i,'Wonderful Foresight !');
delay((2-j)*25);
setcolor(0);
end;
end;
setcolor(5);
settextstyle(4,0,6);
outtextxy(150,175,'Wonderful Foresight!');
music;
ClearDevice;
bar(x1,y1,x2,y2);
setcolor(0);
player[1]:=320;
player[2]:=368;
g:=100;
settextstyle(0,0,1);
picmaths;
for i:=1 to 5 do
begin
line(263+i,y1,263+i,y2);
line(371+i,y1,371+i,y2);
end;
end;
begin
randomize;
gd:=detect;
initgraph(gd,gm,' ');
gamebegins;
repeat
if keypressed
then begin
ch:=readkey;
if ch=#0 then
begin
ch:=readkey;
e:=ord(ch);
playerruns(e);
delay(700);
end;
end
else begin
for p:=0 to 10 do
begin
setcolor(p);
circle(player[1],player[2],p);
end;
delay(700);
end;
ballruns;
pic;
over;
until ch=#13;
end.