unit1.pas

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

unit Unit1;

interface

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

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

const
  glasswidth=30;
  glassheight=20;
  glasstop=6;
  glassleft=5;

  unitwidth=12;
  unitheight=12;

var
  GlassWorkSheet: array[1..glasswidth,1..glassheight] of byte;
  OldGlassWorkSheet: array[1..glasswidth,1..glassheight] of byte;
  Headofsnake,Tailofsnake: Tposition;
  Direction: byte;

type
  TSnake = class(TForm)
    Movementtimer: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormClick(Sender: TObject);
    procedure MovementtimerTimer(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
  public
    { Public declarations }
    function Snakemove: Boolean;
    function nextposition(curposition: Tposition; value: byte): Tposition;
    procedure gamerepaint;
    procedure generatefood;
    procedure drawfood(x,y: byte);
    procedure initailizegame;
    procedure drawbody(x,y: byte);
    procedure drawwall(x,y: byte);
  end;

var
  Snake: TSnake;

implementation

{$R *.dfm}

procedure TSnake.FormCreate(Sender: TObject);
begin
  FillChar(GlassWorkSheet,sizeof(GlassWorksheet),0);
  FillChar(OldGlassWorkSheet,sizeof(OldGlassWorksheet),0);
  glassworksheet[12][3] := 1;
  glassworksheet[11][3] := 1;
  glassworksheet[10][3] := 1;
  glassworksheet[9][3] := 1;
  glassworksheet[16][12] := 6;
  move(glassworksheet,oldglassworksheet,sizeof(glassworksheet));
  headofsnake.x := 12;
  headofsnake.y := 3;
  tailofsnake.x := 9;
  tailofsnake.y := 3;
  direction := 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;

procedure TSnake.FormClick(Sender: TObject);
var
  num: byte;
begin
  num := 0;
  dec(num);
  messagedlg(inttostr(num),mtconfirmation,[mbok],0);
end;

function TSnake.Snakemove: Boolean;
var
  Headnext,Tailnext: Tposition;
begin
  Snakemove := true;
  headnext := nextposition(headofsnake,oldglassworksheet[headofsnake.x][headofsnake.y]);
  Tailnext := nextposition(Tailofsnake,oldglassworksheet[Tailofsnake.x][Tailofsnake.y]);
  case oldglassworksheet[headnext.x][headnext.y] of
    0:
    begin
      glassworksheet[Tailofsnake.x][Tailofsnake.y] :=0;
      tailofsnake := tailnext;
      glassworksheet[headnext.x][headnext.y] := glassworksheet[headofsnake.x][headofsnake.y];
      headofsnake := headnext;
    end;
    1,2,3,4,5:
    begin
      Snakemove := false;
      exit;
    end;
    6:
    begin
      generatefood;
      glassworksheet[headnext.x][headnext.y] := glassworksheet[headofsnake.x][headofsnake.y];
      headofsnake := headnext;
    end;
  end;
end;

function TSnake.nextposition(CurPosition: Tposition; value: byte): Tposition;
begin
  case value of
    1: curposition.x := Curposition.x + 1;
    2: curposition.y := Curposition.y + 1;
    3: curposition.x := Curposition.x - 1;
    4: curposition.y := Curposition.y - 1;
  end;
  if curposition.x = glasswidth + 1 then  curposition.x := 1;
  if curposition.x = 0 then curposition.x := glasswidth;
  if curposition.y = glassheight + 1 then curposition.y := 1;
  if curposition.y = 0 then curposition.y := glassheight;
  nextposition.x := Curposition.x;
  nextposition.y := Curposition.y;
end;

procedure TSnake.gamerepaint;
var
  i,j:byte;
  glassrect:TRect;
begin
  for i := 1 to glasswidth do
    for j := 1 to glassheight do
    begin
      if oldglassworksheet[i][j]<>glassworksheet[i][j] then
      begin
        case glassworksheet[i][j] of
          0:
          begin
            glassrect:=rect(glassleft+(i-1)*unitwidth,glasstop+(j-1)*unitheight,glassleft+i*unitwidth,glasstop+j*unitheight);
            canvas.Brush.Color := clwhite;
            canvas.FillRect(glassrect);
            oldglassworksheet[i][j] := 0;
          end;
          1,2,3,4:
          begin
            glassrect:=rect(glassleft+(i-1)*unitwidth,glasstop+(j-1)*unitheight,glassleft+i*unitwidth,glasstop+j*unitheight);
            canvas.Brush.Color := clblack;
            canvas.FillRect(glassrect);
            oldglassworksheet[i][j] := glassworksheet[i][j];
          end;
          6: drawfood(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
  else
  begin
    gamerepaint;
    move(glassworksheet,oldglassworksheet,sizeof(glassworksheet));
  end;
end;

procedure TSnake.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case key of
    vk_up: direction := 4;
    vk_down: direction := 2;
    vk_left: direction := 3;
    vk_right: direction := 1;
  end;
  if (oldglassworksheet[headofsnake.x][headofsnake.y] = 2) and (direction = 4) then exit;
  if (oldglassworksheet[headofsnake.x][headofsnake.y] = 4) and (direction = 2) then exit;
  if (oldglassworksheet[headofsnake.x][headofsnake.y] = 3) and (direction = 1) then exit;
  if (oldglassworksheet[headofsnake.x][headofsnake.y] = 1) and (direction = 3) then exit;
  oldglassworksheet[headofsnake.x][headofsnake.y] := direction;
  move(oldglassworksheet,glassworksheet,sizeof(glassworksheet));
end;

procedure TSnake.generatefood;
var
  i,j:byte;
begin
  repeat
    i := random(glasswidth) + 1;
    j := random(glassheight) + 1;
  until (oldglassworksheet[i][j] = 0) and (glassworksheet[i][j] =0);
  glassworksheet[i][j] := 6;
end;

procedure TSnake.drawfood(x,y: byte);
begin
  canvas.Pen.Color := clblack;
  canvas.Pen.Width := 2;
  canvas.MoveTo(glassleft+(x-1)*unitwidth+1,glasstop+(y-1)*unitheight+1);
  canvas.LineTo(glassleft+(x-1)*unitwidth+1,glasstop+y*unitheight-1);
  canvas.LineTo(glassleft+x*unitwidth-1,glasstop+y*unitheight-1);
  canvas.LineTo(glassleft+x*unitwidth-1,glasstop+(y-1)*unitheight+1);
  canvas.LineTo(glassleft+(x-1)*unitwidth+1,glasstop+(y-1)*unitheight+1);
end;

procedure TSnake.initailizegame;
var
  i,j: Integer;
begin
  for i := 1 to glasswidth do
    for j := 1 to glassheight do
    begin
      if glassworksheet[i][j] > 0 then
        case glassworksheet[i][j] of
          1,2,3,4: drawbody(i,j);
          5: drawwall(i,j);
          6: drawfood(i,j);
        end;
    end;
end;

procedure TSnake.drawbody(x, y: byte);
var
glassrect: TRect;
begin
  canvas.Brush.Color := clblack;
  glassrect := rect(glassleft+(x-1)*unitwidth,glasstop+(y-1)*unitheight,glassleft+x*unitwidth,glasstop+y*unitheight);
  Canvas.FillRect(glassrect);
end;

procedure TSnake.drawwall(x, y: byte);
var
glassrect: TRect;
begin
  canvas.Brush.Color := clblack;
  glassrect := rect(glassleft+(x-1)*unitwidth,glasstop+(y-1)*unitheight,glassleft+x*unitwidth,glasstop+y*unitheight);
  Canvas.FillRect(glassrect);
end;

end.