unit1.pas

用delphi 7写的贪食蛇游戏的源代码

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Buttons, Menus, ImgList;

const
  glasswidth=30;
  glassheight=20;
  glasstop=10;
  glassleft=10;

  unitwidth=12;
  unitheight=12;

  gamelevel: array[1..6] of integer= (1000,500,250,100,70,40);
  gamescore: array[1..6] of integer= (5,10,15,20,25,30);
  specialscore=100;
type
  Tdirect= (none,mbup,mbdown,mbleft,mbright);

type
  TPosition= record
    x: byte;
    y: byte;
  end;

type
  Tmoving= record
    value: byte;
    direct: Tdirect;
  end;

type
  Tglasssheet= array[1..glasswidth,1..glassheight] of Tmoving;

var
  gamemap: array[1..2]of Tglasssheet;
  GlassWorkSheet: Tglasssheet;
  OldGlassWorkSheet: Tglasssheet;
  selectedmap: Tglasssheet;
  Headofsnake,Tailofsnake,special: Tposition;
  subsituteofhead: byte;
  originaldirect: Tdirect;
  cout: integer;
  currentlevel: integer;
  specialexit: boolean;
  specialtype: byte;
  gamestart: boolean;
  totalscore: integer;
  eatscore: integer;
  fackkey: word;
  fackShiftState: TShiftState;
  pause: boolean;

type
  TSnake = class(TForm)
    Movementtimer: TTimer;
    Gamerect: TBevel;
    btdown: TSpeedButton;
    btup: TSpeedButton;
    btleft: TSpeedButton;
    btright: TSpeedButton;
    btpause: TSpeedButton;
    btcontrol: TSpeedButton;
    Gameinfo: TGroupBox;
    level: TLabel;
    map: TLabel;
    score: TLabel;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    Specialfoodtimer: TTimer;
    gameimage: TImage;
    N8: TMenuItem;
    N21: TMenuItem;
    N31: TMenuItem;
    N41: TMenuItem;
    N51: TMenuItem;
    N61: TMenuItem;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    time: TLabel;
    Label4: TLabel;
    N11: TMenuItem;
    N22: TMenuItem;
    N9: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure MovementtimerTimer(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure btcontrolClick(Sender: TObject);
    procedure SpecialfoodtimerTimer(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure N21Click(Sender: TObject);
    procedure N31Click(Sender: TObject);
    procedure N41Click(Sender: TObject);
    procedure N51Click(Sender: TObject);
    procedure N61Click(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure N22Click(Sender: TObject);
    procedure btupClick(Sender: TObject);
    procedure btleftClick(Sender: TObject);
    procedure btdownClick(Sender: TObject);
    procedure btrightClick(Sender: TObject);
    procedure btpauseClick(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function Snakemove: Boolean;
    function nextposition(cur: Tposition): Tposition;
    procedure gamerepaint;
    procedure generatefood;
    procedure drawfood(x,y: byte);
    procedure initailizegame;
    procedure drawbody(x,y,value: byte);
    procedure drawwall(x,y: byte);
    procedure generatespecial;
    procedure drawspecial(x,y,value: byte);
    procedure drawhead(x,y,value: byte);
    procedure drawblank(x,y: byte);
    procedure drawcorner(x,y,value: byte);
    procedure drawtail(x,y,value: byte);
    procedure drawmouth(x,y,value: byte);
    procedure specialinbox;
    procedure generatesnake;
  end;

var
  Snake: TSnake;

implementation

{$R *.dfm}

procedure TSnake.FormCreate(Sender: TObject);
var
  i,j: byte;
begin
  for i := 1 to glasswidth do
  begin
    gamemap[2][i][1].value := 27;
    gamemap[2][i][glassheight].value := 27;
  end;
  for j := 1 to glassheight do
  begin
    gamemap[2][1][j].value := 27;
    gamemap[2][glasswidth][j].value := 27;
  end;
  move(gamemap[2],selectedmap,sizeof(selectedmap));
  label2.Caption := '地图2';
  totalscore := 0;
  cout := 0;
  currentlevel := gamelevel[4];
  eatscore := gamescore[4];
  label1.Caption := '等级4';
  gamestart := false;
  pause := false;
  label3.Caption := '0';
  randomize;
end;

procedure TSnake.FormPaint(Sender: TObject);
var
  glassrect: TRect;
begin
  Canvas.Brush.Color:=clwhite;
  glassrect:=rect(glassleft,glasstop,glassleft+glasswidth*unitwidth,glasstop+glassheight*unitheight);
  Canvas.FillRect(glassrect);
  initailizegame;
end;

function TSnake.Snakemove: Boolean;
var
  Headnext,Tailnext,foresee: Tposition;
begin
  Snakemove := true;
  headnext := nextposition(headofsnake);
  Tailnext := nextposition(tailofsnake);
  case oldglassworksheet[headnext.x][headnext.y].value of
    0:
    begin
      glassworksheet[Tailofsnake.x][Tailofsnake.y].value :=0;
      with glassworksheet[tailnext.x][tailnext.y] do
      begin
        case direct of
          mbup: value := 10;
          mbdown: value := 12;
          mbleft: value := 9;
          mbright: value := 11;
        end;
      end;
      tailofsnake := tailnext;
      glassworksheet[headnext.x][headnext.y].direct := glassworksheet[headofsnake.x][headofsnake.y].direct;
      with glassworksheet[headnext.x][headnext.y] do
      begin
        case direct of
          mbup: value := 2;
          mbdown: value := 4;
          mbleft: value := 1;
          mbright: value := 3;
        end;
      end;
      with glassworksheet[headofsnake.x][headofsnake.y] do
      begin
        case direct of
          mbup:
            case originaldirect of
              mbup: subsituteofhead := 17;
              mbdown: subsituteofhead := 17;
              mbleft: subsituteofhead := 16;
              mbright: subsituteofhead := 15;
            end;
          mbdown:
            case originaldirect of
              mbup: subsituteofhead := 17;
              mbdown: subsituteofhead := 17;
              mbleft: subsituteofhead := 13;
              mbright: subsituteofhead := 14;
            end;
          mbleft:
            case originaldirect of
              mbup: subsituteofhead := 14;
              mbdown: subsituteofhead := 15;
              mbleft: subsituteofhead := 18;
              mbright: subsituteofhead := 18;
            end;
          mbright:
            case originaldirect of
              mbup: subsituteofhead := 13;
              mbdown: subsituteofhead := 16;
              mbleft: subsituteofhead := 18;
              mbright: subsituteofhead := 18;
            end;
          end;
        end;
      glassworksheet[headofsnake.x][headofsnake.y].value := subsituteofhead;
      headofsnake := headnext;
      originaldirect := glassworksheet[headofsnake.x][headofsnake.y].direct;
    end;
    1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,27:
    begin
      Snakemove := false;
      exit;
    end;
    26:
    begin
      inc(totalscore,eatscore);
      generatefood;
      glassworksheet[headnext.x][headnext.y].direct := glassworksheet[headofsnake.x][headofsnake.y].direct;
      with glassworksheet[headnext.x][headnext.y] do
      begin
        case direct of
          mbup: value := 2;
          mbdown: value := 4;
          mbleft: value := 1;
          mbright: value := 3;
        end;
      end;
      with glassworksheet[headofsnake.x][headofsnake.y] do
      begin
        case direct of
          mbup,mbdown: subsituteofhead := 19;
          mbleft,mbright: subsituteofhead := 20;
        end;
      end;
      glassworksheet[headofsnake.x][headofsnake.y].value := subsituteofhead;
      originaldirect := glassworksheet[headofsnake.x][headofsnake.y].direct;
      headofsnake := headnext;
    end;
    21,22,23,24,25:
    begin
      glassworksheet[headnext.x][headnext.y].direct := glassworksheet[headofsnake.x][headofsnake.y].direct;
      with glassworksheet[headnext.x][headnext.y] do
      begin
        case direct of
          mbup: value := 2;
          mbdown: value := 4;
          mbleft: value := 1;
          mbright: value := 3;
        end;
      end;
      with glassworksheet[headofsnake.x][headofsnake.y] do
      begin
        case direct of
          mbup,mbdown: subsituteofhead := 19;
          mbleft,mbright: subsituteofhead := 20;
        end;
      end;
      glassworksheet[headofsnake.x][headofsnake.y].value := subsituteofhead;
      originaldirect := glassworksheet[headofsnake.x][headofsnake.y].direct;
      headofsnake := headnext;
    end;
  end;
  foresee := nextposition(headofsnake);
  if glassworksheet[foresee.x][foresee.y].value > 0 then
    with glassworksheet[headofsnake.x][headofsnake.y] do
      case direct of
        mbup: value := 6;
        mbdown: value := 8;
        mbleft: value := 5;
        mbright: value := 7;
      end;
end;

function TSnake.nextposition(cur: Tposition): Tposition;
begin
  case glassworksheet[cur.x][cur.y].direct of
    mbright: cur.x := Cur.x + 1;
    mbdown: cur.y := Cur.y + 1;
    mbleft: cur.x := Cur.x - 1;
    mbup: cur.y := Cur.y - 1;
    none: ;
  end;
  if cur.x = glasswidth + 1 then
    cur.x := 1;
  if cur.x = 0 then
    cur.x := glasswidth;
  if cur.y = glassheight + 1 then
    cur.y := 1;
  if cur.y = 0 then
    cur.y := glassheight;
  nextposition := cur;
end;

procedure TSnake.gamerepaint;
var
  i,j:byte;
begin
  for i := 1 to glasswidth do
    for j := 1 to glassheight do
    begin
      if oldglassworksheet[i][j].value<>glassworksheet[i][j].value then
      begin
        case glassworksheet[i][j].value of
          0: drawblank(i,j);
          1,2,3,4: drawhead(i,j,glassworksheet[i][j].value);
          5,6,7,8: drawmouth(i,j,glassworksheet[i][j].value - 4);
          9,10,11,12: drawtail(i,j,glassworksheet[i][j].value - 8);
          13,14,15,16: drawcorner(i,j,glassworksheet[i][j].value - 12);
          17,18,19,20: drawbody(i,j,glassworksheet[i][j].value - 16);
          21,22,23,24,25: drawspecial(i,j,glassworksheet[i][j].value - 20);
          26:
          begin
            drawfood(i,j);
            label3.Caption := inttostr(totalscore);
          end;
          27: drawwall(i,j);
        end;
      end;
    end;
end;

procedure TSnake.MovementtimerTimer(Sender: TObject);
begin
  if not snakemove then
  begin
    movementtimer.Enabled := false;
    messagedlg('Game Over',mtinformation,[mbok],0);
  end