回 帖 发 新 帖 刷新版面

主题:[原创]自制赛车游戏(模仿单色液晶屏)

program race;
uses
  crt;

type
  cartype=record
    x,y:byte;
  end;

var
  map:array[1..10,1..200] of 0..1;
  screen:byte;
  car:cartype;
  i,speed:byte;

procedure createscreen;
var
  i,j:byte;
begin
  window(35,5,44,24);
  textbackground(yellow);
  textcolor(blue);
  for i:=1 to 20 do
    for j:=1 to 10 do
    begin
      gotoxy(j,i);
      write(' ');
    end;
end;

procedure init;
var
  fin:text;
  i,j,n:byte;
  x:char;
begin
  assign(fin,'road.map');
  reset(fin);
  readln(fin,n);
  for i:=n downto 1 do
  begin
    for j:=1 to 10 do
    begin
      read(fin,x);
      if x='x' then map[j,i]:=1
      else map[j,i]:=0;
    end;
    readln(fin);
  end;
  close(fin);
  car.x:=5;
  car.y:=5;
  screen:=0;
end;

function crash:boolean;
begin
  crash:=false;
  if map[car.x,car.y]=1 then crash:=true;
  if map[car.x-1,car.y-1]=1 then crash:=true;
  if map[car.x-1,car.y-3]=1 then crash:=true;
  if map[car.x+1,car.y-1]=1 then crash:=true;
  if map[car.x+1,car.y-3]=1 then crash:=true;
end;

procedure goleft;
begin
  if car.x>0 then car.x:=car.x-1;
end;

procedure goright;
begin
  if car.x<10 then car.x:=car.x+1;
end;

procedure gogogo;
begin
  car.y:=car.y+1;
  screen:=screen+1;
end;

procedure print;
var
  i,j:byte;
begin
  for i:=1 to 20 do
    for j:=1 to 10 do
    begin
      gotoxy(j,21-i);
      if map[j,screen+i]=1 then write(#219)
      else write(' ');
    end;

  {print car}
  for i:=15 to 18 do
  begin
    textcolor(red);
    gotoxy(car.x,i);
    write(#219);
  end;
  gotoxy(car.x-1,16);
  write(#219);
  gotoxy(car.x-1,18);
  write(#219);
  gotoxy(car.x+1,16);
  write(#219);
  gotoxy(car.x+1,18);
  write(#219);
  textcolor(blue);

  {print information}
  textbackground(blue);
  textcolor(white);
  gotoxy(1,1);
  delline;
  write('speed:',speed);
  textbackground(yellow);
  textcolor(blue);
end;

procedure playmusic(s:string);
var
  i:byte;
begin
  for i:=1 to length(s) do
  begin
    case s[i] of
      'a':sound(264);
      's':sound(297);
      'd':sound(330);
      'f':sound(352);
      'j':sound(396);
      'k':sound(440);
      'l':sound(495);
      ';':sound(528);
      '.':nosound;
    end;
    delay(100);
  end;
  nosound;
end;

{main program}
begin
  for speed:=1 to 10 do
  begin
    createscreen;
    init;
    print;
    playmusic('aaddjjddjj;;;;;;.......aaaaaa.....aaaaaa.....aaaaaa.....;;;;;;;;;..');
    sound(100);
    repeat
      if keypressed then
      begin
        case upcase(readkey) of
          'A':goleft;
          'D':goright;
          'Q':halt;
        end;
        print;
      end
      else
      begin
        gogogo;
        print;
        delay(400-speed*20);
      end;
      if crash then
      begin
        textbackground(blue);
        textcolor(yellow);
        gotoxy(1,10);
        write('game over!');
        sound(200);
        delay(1000);
        nosound;
        delay(10000);
        halt;
        textbackground(yellow);
        textcolor(blue);
      end;
    until car.y>=120;
    playmusic('aaadddjjjjjjkkkjjj');
    nosound;
    delay(5000);
  end;
  nosound;
  delay(10000);
end.

回复列表 (共31个回复)

沙发

程序运行需要文件,在目录下新建立一个文本文件,更名为"road.map",并将以下内容复制进文件中:
125
xxxxxxxxxx
x        x
x        x
x        x
xx      xx
xxx    xxx
xxx    xxx
xxx    xxx
xxx    xxx
xxx    xxx
xxx    xxx
xxxx   xxx
xxxx   xxx
xxxx   xxx
xxxx   xxx
xxxx   xxx
xxxx   xxx
xxxx   xxx
xxx     xx
xxx     xx
xxx     xx
xxx     xx
xxx     xx
xxx     xx
xxx     xx
xx     xxx
xx     xxx
xx     xxx
xx     xxx
xxx    xxx
xxxx   xxx
xxxx   xxx
xxxx   xxx
xxxx   xxx
xxxx    xx
xxxx    xx
xxxx    xx
xxxx    xx
xxxxx   xx
xxxxx   xx
xxxxx    x
xxxxx    x
xxxxx    x
xxxx     x
xxxx    xx
xxxx    xx
xxxx    xx
xxx     xx
xxx    xxx
xx     xxx
xx     xxx
xx     xxx
x     xxxx
x     xxxx
x     xxxx
x     xxxx
x    xxxxx
x   xxxxxx
x   xxxxxx
x   xxxxxx
x   xxxxxx
x   xxxxxx
x   xxxxxx
x   xxxxxx
x   xxxxxx
x    xxxxx
x    xxxxx
x    xxxxx
x    xxxxx
x    xxxxx
x    xxxxx
x    xxxxx
x    xxxxx
x    xxxxx
x    xxxxx
x    xxxxx
xx   xxxxx
xx   xxxxx
xx   xxxxx
xx   xxxxx
xx   xxxxx
xx    xxxx
xx    xxxx
xx    xxxx
xx    xxxx
xxx   xxxx
xxx   xxxx
xxx   xxxx
xxx    xxx
xxx    xxx
xxx    xxx
xxx    xxx
xxxx   xxx
xxxx   xxx
xxxx   xxx
xxx    xxx
xx     xxx
xx     xxx
xx     xxx
xxx   xxxx
xxx   xxxx
xxx   xxxx
xxx   xxxx
xxx    xxx
xxx    xxx
xxx    xxx
xxx    xxx
xxx    xxx
xxx    xxx
xx    xxxx
xx    xxxx
xx    xxxx
xxx    xxx
xxx    xxx
xxx    xxx
xx      xx
x        x
x        x
x        x
x        x
x        x
x        x
x        x
x        x
xxxxxxxxxx

板凳

要用到crt阿。。现在没几个机器能用了

3 楼

无法运行,文件未找到!

4 楼

在读取文件的地方加个盘符如“D:\road.map” 然后……

为什么老是game over我还没玩呢

声音没有

5 楼

建议把声音去掉(太烦人,且关音像都不行)

6 楼

为什么老是game over我还没玩呢

用产生的exe文件玩

7 楼

建议用FP编译,FP的CRT没有漏洞
我是用FP做的,呵呵!

因为PASCAL CRT单元的SOUND(X)是控制的主机箱中的内部扬声器,所以关音箱没用.
如果把里面的sound(x)语句和过程playmusic(s)去掉就没声音了

编译后要把"road.map"和"race.exe"放在一起,否则会出现找不到文件的错误.
如果是在编译环境中按"ctrl+F9"运行则工作路径要改成"road.map"所在的目录,不然就会找不到文件

左右控制是  左:A 右:D
4楼和6楼的可能是按键没搞对吧,我自己测试时都没有问题.

8 楼

建议在GAME OVER后加一个继续玩游戏的选择,不然每次一结束,有得重新打开文件.

9 楼

不错,试试看。。。。

10 楼

好办法!其实也很简单的你们自己都可以加!
希望大家能把作出改进的源码贴上来,大家好交流嘛

我来回复

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