回 帖 发 新 帖 刷新版面

主题:[原创]一个计算小游戏

偶编的一个计算小游戏
还请大家多多指教~~~
其中还借用了啊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. 

回复列表 (共2个回复)

沙发

还请大家多多发表见解~~~~

板凳

不错,但球的下落速度是不是快了些?进入游戏后还没反应过来就Game Over了。

还有,你说引用了我的一段程序,但我已在[url=http://www.programfan.com/club/showbbs.asp?id=110047]那帖子[/url]告诉大家,
那是我的朋友[url=http://www.programfan.com/club/member.asp?name=lzl1403]lzl1403[/url]的程序。

我来回复

您尚未登录,请登录后再回复。点此登录或注册