unit1.pas

一个用delphi+delphiX写的贪吃蛇程序

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Menus, StdCtrls,MMSystem, DXDraws, DXClass, DXSounds,
  DXInput;

type
  TMainForm = class(TDXForm)
    MainMenu: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    DXDraw: TDXDraw;
    DXImageList: TDXImageList;
    DXTimer: TDXTimer;
    N4: TMenuItem;
    N8: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
    DXInput: TDXInput;
    procedure FormCreate(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure N13Click(Sender: TObject);
    procedure N12Click(Sender: TObject);
    procedure DXTimerTimer(Sender: TObject; LagCount: Integer);
    procedure N4Click(Sender: TObject);
    procedure N14Click(Sender: TObject);
    procedure N15Click(Sender: TObject);
  private
    { Private declarations }
  public
    procedure gameover;
    { Public declarations }
  end;

var
  MainForm: TMainForm;
  setkey: byte; //保存按键数据
  long:byte; //保存小蛇的长度
  body:array[0..200] of Tpoint;  //保存小蛇数据
  i:longint; //循环变量
  food:tpoint;  //保存食物数据
  x:Boolean;  //食物是否与蛇身冲突
  Fraction:longint;  //保存得分
  music:boolean;  //是否播放音效
  level:byte;  //保存关数
implementation

{$R *.dfm}


procedure TMainForm.FormCreate(Sender: TObject);
begin
  //初始化
  dximagelist.Items.MakeColorTable ;
  dxdraw.ColorTable :=dximagelist.Items.ColorTable ;
  dxdraw.DefColorTable :=dximagelist.Items.ColorTable ;
  dxdraw.UpdatePalette ;
  music:=true;
  randomize;
end;


procedure TMainForm.N2Click(Sender: TObject);
begin
  //初始化
  level:=1;
  dxtimer.Interval :=100;
  setkey:=1;
  long:=5;
  body[1].X :=100;
  body[1].y:=400;
  body[2].x:=100;
  body[2].y:=425;
  body[3].x:=100;
  body[3].y:=450;
  body[4].X :=100;
  body[4].Y :=475;
  body[5].X :=100;
  body[5].Y :=500;
  food.X :=250;
  food.Y :=350;
  if music then
    sndplaysound('sounds\begin.wav',snd_async or snd_filename);
  Fraction:=0;
  mainform.Caption :='贪吃蛇(DirectX版)    得分：0    第1关';
  dxtimer.Enabled :=true;
end;

procedure TMainForm.N3Click(Sender: TObject);
begin
  //退出
  close;
end;


procedure TMainForm.N10Click(Sender: TObject);
begin
  music:=true;
  n10.Checked :=true;
  n11.Checked :=false;
end;

procedure TMainForm.N11Click(Sender: TObject);
begin
  music:=false;
  n10.Checked :=false;
  n11.Checked :=true;
end;

procedure TMainForm.N13Click(Sender: TObject);
begin
  showmessage('作者：曹扬！！！^_^');
end;
procedure TMainForm.N12Click(Sender: TObject);
begin
  showmessage('方向键控制小蛇移动，小蛇不能撞墙，也不能碰到自己的身体。');
end;

procedure TMainForm.DXTimerTimer(Sender: TObject; LagCount: Integer);
begin
  //取得键盘信息
  dxinput.Update;
  if (isup in dxinput.States) and (setkey<>2) then
    setkey:=1;
  if (isdown in dxinput.States) and (setkey<>1) then
    setkey:=2;
  if (isleft in dxinput.States) and (setkey<>4) then
    setkey:=3;
  if (isright in dxinput.States) and (setkey<>3) then
    setkey:=4;
  //清屏
  dxdraw.Surface.Fill(0);
  //画背景
  dximagelist.Items[2].Draw(dxdraw.Surface,0,0,0);
  //处理小蛇数据
  for i:=long downto 2 do
    body[i]:=body[i-1];
  case setkey of
    1:body[1].y :=body[1].y -25;
    2:body[1].Y :=body[1].Y +25;
    3:body[1].X :=body[1].X -25;
    4:body[1].X :=body[1].X +25;
  end;
  //画小蛇
  for i:=1 to long do
    dximagelist.Items[0].Draw(dxdraw.Surface,body[i].X ,body[i].Y,0);
  //判断是否撞墙
  if (body[1].X <0) or (body[1].X >475) or (body[1].y <0) or (body[1].y >550) then
    gameover;
  //判断是否撞到自己
  for i:=2 to long do
  begin
    if (body[i].X =body[1].x) and (body[i].y=body[1].Y) then
      gameover;
  end;
  //判断是否吃到食物
  if (body[1].X =food.X) and (body[1].Y =food.Y)  then
  begin
    if music then
      sndplaysound('sounds\eat.wav',snd_async or snd_filename);
    Fraction:=Fraction+10;
    mainform.Caption :='贪吃蛇(DirectX版)    得分：' + inttostr(Fraction) + '    第' + inttostr(level) + '关';
    //过关
    if (Fraction>=300) and n4.Checked then
    begin
      Fraction:=0;
      if music then
        sndplaysound('sounds\level.wav',snd_async or snd_filename);
      dxtimer.Interval :=dxtimer.Interval -10;
      level:=level+1;
      mainform.Caption :='贪吃蛇    得分：' + inttostr(Fraction) + '    第' + inttostr(level) + '关';
      setkey:=1;
      dxdraw.Surface.Fill(0);
      long:=5;
      body[1].X :=100;
      body[1].y:=400;
      body[2].x:=100;
      body[2].y:=425;
      body[3].x:=100;
      body[3].y:=450;
      body[4].X :=100;
      body[4].Y :=475;
      body[5].X :=100;
      body[5].Y :=500;
    end;
    //重新生成食物
    repeat
      x:=true;
      food.X :=random(20)*25;
      food.Y :=random(23)*25;
      for i:=1 to long do
      begin
        if (food.X =body[i].x) and (food.Y =body[i].Y) then
          x:=false;
      end;
    until x;
    //加长蛇身
    long:=long+1;
    body[long].X :=body[long-1].X +25;
    body[long].Y :=body[long-1].Y ;
  end;
  //画食物
  dximagelist.Items[1].Draw(dxdraw.Surface,food.X ,food.y,0);
  //显示帧率
  with DXDraw.Surface.Canvas do
  begin
    Brush.Style := bsClear;
    Font.Color := clBlack;
    Font.Size := 12;
    Textout(0, 0, 'FPS: '+inttostr(DXTimer.FrameRate));
    Release;
  end;
  //换页
  dxdraw.Flip;
end;

procedure TMainForm.gameover;
begin
  if music then
    sndplaysound('sounds\over.wav',snd_async or snd_filename);
  dxdraw.Surface.Fill(0);
  dximagelist.Items[2].Draw(dxdraw.Surface,0,0,0);
  //显示"GAME OVER!"
  with dxdraw.Surface.Canvas do
  begin
    Brush.Style := bsClear;
    font.Name :='黑体';
    Font.Color := clRed;
    Font.Size := 50;
    Textout(100, 300, 'GAME OVER!');
    Release;
  end;
  dxtimer.Enabled :=false;
end;

procedure TMainForm.N4Click(Sender: TObject);
begin
  if n4.Checked then n4.Checked :=false else n4.Checked :=true;
end;

procedure TMainForm.N14Click(Sender: TObject);
var
  f:textfile;
begin
  //储存进度
  dxtimer.Enabled :=false;
  if savedialog.Execute then
  begin
    assignfile(f,savedialog.FileName);
    rewrite(f);
    writeln(f,inttostr(dxtimer.Interval));
    writeln(f,inttostr(Fraction));
    writeln(f,inttostr(level));
    writeln(f,inttostr(long));
    writeln(f,inttostr(food.X));
    writeln(f,inttostr(food.Y));
    writeln(f,inttostr(setkey));
    for i:=1 to long do
    begin
      writeln(f,inttostr(body[i].X));
      writeln(f,inttostr(body[i].Y));
    end;
    closefile(f);
    dxtimer.Enabled :=true;
  end;
  dxtimer.Enabled :=true;
end;

procedure TMainForm.N15Click(Sender: TObject);
var
  f:textfile;
  temp:longint;
begin
  //毒取进度
  dxtimer.Enabled :=false;
  if opendialog.Execute then
  begin
    assignfile(f,opendialog.FileName);
    reset(f);
    readln(f,temp);
    dxtimer.Interval :=temp;
    readln(f,Fraction);
    readln(f,level);
    readln(f,long);
    readln(f,food.x);
    readln(f,food.y);
    readln(f,setkey);
    for i:=1 to long do
    begin
      readln(f,body[i].X);
      readln(f,body[i].Y);
    end;
    closefile(f);
    dxtimer.Enabled :=true;
  end;
  dxtimer.Enabled :=true;
end;

end.