?? unit1.pas
字號:
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.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -