Game Snack Dengan Delphi

Project aplikasi Snack dengan menggunakan delphi 7

{ description: a simple snake game (note: using static array, in later versions
               of delphi dynamic array can be used for snake.
  language:    delphi 1 (code chould work with any version of delphi)
  author:      Joakim Skoglund
  email:       mmiskim@hotmail.com

  freeware with open source code - please do whatever you want with this code

  disclaimer: use on your own risk!
    i can not be held responsible for any damage in software and/or
    hardware or any other kind of problem caused by the use of this source code
    and/or exe file. }
unit Unit1;

interface

uses
  SysUtils, WinTypes, graphics, Controls, Forms, Dialogs, Classes, ExtCtrls;

type
  TForm1 = class(TForm)
    snakeTimer: TTimer;
    procedure snakeTimerTimer(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1 : TForm1;
  score : integer;

Procedure ResetGame;        {// Resets the snake and score}
Function HitWall : Boolean; {// returns true if snake hits the wall}
Function HitFood : boolean; {// Returns true if snake hits food}
function HitSelf : boolean; {// Returns true if the snake hits itself}
procedure DrawSnake;        {// Draws the snake, increase points if
                             // snake hit food,
                             // ends game if snake hit a wall or itself.}
Procedure PlaceFood;
procedure DrawPlayfield;    {// Draws the playfield
                             // (the area which the snake navigates on)}
implementation

{$R *.DFM}

const
  snakewidth      = 10;                       {// specify how wide the snake is}
  snakegrow       : integer = 2;              {// specify how fast snake grows}
  snakecolor      : tcolor = clBlack;
  foodcolor       : tcolor = clRed;
  pfcolor         : tcolor = clWhite;         {// playfield color           }
  pfdimention     : tpoint = (x:200; y:200);  {// playfield width and hight }
  pfposition      : tpoint = (x:5; y:5);      {// playfield position on form}
  dup             = 0;
  ddown           = 1;
  dleft           = 2;
  dright          = 3;
  dnone           = 4;
  speed           : integer = 100;           { // snake speed higher value}
                                             { // equals slower snake     }

var
  snake           : array[0..9099] of tpoint;{ // array holding snake}
                                             { // coordinates    }
  snakelength     : integer;                 { // length of snake}
  food            : tpoint;                  { // food position  }
  direction       : dup..dnone;
  olddirection    : dup..dnone;

{// HitWall: returns true if snake hits the wall}
Function HitWall : Boolean;
var
  i : integer;

Begin
  For i := 0 to snakelength - 1 do
  begin
    if (snake[i].x < pfposition.X) or
      (snake[i].x + snakewidth > pfposition.X + pfdimention.X) or
      (snake[i].y < pfposition.y) or
      (snake[i].y + snakewidth > pfposition.y + pfdimention.y) then
    begin
      hitwall := true;
      exit;
    end;
  end;
  hitwall := false;
End;

{// HitFood: Returns true if snake hits food}
Function HitFood : boolean;
var
  i : integer;

Begin
  for i := 0 to snakelength - 1 do
  begin
    if (snake[i].x = food.x) and (snake[i].y = food.y) then
    begin
      hitfood := true;
      exit;
    end;
  end;
  hitfood := false;
End;

{ PlaceFood: Draws the food on the playfield on a random location}
Procedure PlaceFood;
Begin
  food.x := random(pfdimention.x - snakewidth - pfposition.x) + pfposition.x;
  food.y := random(pfdimention.y - snakewidth - pfposition.y) + pfposition.y;
  while (pfdimention.x - (food.x - pfposition.x)) mod snakewidth <> 0 do
    inc(food.x);
  while (pfdimention.y - (food.y - pfposition.y)) mod snakewidth <> 0 do
    inc(food.y);
  if HitFood then
    PlaceFood;
  Form1.Canvas.Brush.Color := foodcolor;
  Form1.Canvas.Pen.Color := snakecolor;
  Form1.Canvas.Ellipse(food.x + 1, food.y + 1,
    food.x + snakewidth - 2, food.y + snakewidth - 2);
End;

{// HitSelf: Returns true if the snake hits itself}
function HitSelf : boolean;
var
  i : integer;

begin
  for i := 1 to snakelength - 1 do
    if (snake[0].x = snake[i].x) and (snake[0].y = snake[i].y) then
    begin
      hitself := true;
      exit;
    end;
  hitself := false;
end;

{// DrawSnake: Draws the snake, increase points if snake hit food,
 // ends game if snake hit a wall or itself.}
procedure DrawSnake;
var
  i : integer;

Begin
  if direction = dnone then
    exit;
  Form1.Canvas.Brush.Color := pfcolor;
  Form1.Canvas.Pen.Color := pfcolor;
  Form1.Canvas.Rectangle(snake[snakelength - 1].X, snake[snakelength - 1].Y,
    snake[snakelength - 1].X + snakewidth, snake[snakelength - 1].Y + snakewidth);
  For i := snakelength - 1 downto 1 do
    snake[i] := snake[i - 1];
  snake[0]:= snake[1];
  case direction of
    dup    : dec(snake[0].y, snakewidth);
    ddown  : inc(snake[0].y, snakewidth);
    dleft  : dec(snake[0].x, snakewidth);
    dright : inc(snake[0].x, snakewidth);
  end;
  if HitFood then
  begin
    inc(score, 5);
    inc(snakelength, snakegrow);
    for i := 1 to snakegrow do
      snake[snakelength - i] := snake[(snakelength - snakegrow) - 1];
    PlaceFood;
  end;
  if HitWall or HitSelf then
  begin
    form1.snaketimer.enabled := false;
    showmessage(#10 + '               simple snake game version 1.0 beta              ' + #10#10 +
      ' Stear the snake with the arrow keys or w,a,d,s,' + #10 +
      ' pause game with space.' + #10 +
      ' Collect points eating food.' + #10 +
      ' Avoid hitting the walls and yourself.' + #10#10 +
      ' OK to start, end by Alt-F4x2.' + #10#10 +
      ' Score: ' + inttostr(score));
    ResetGame;
  end;
  Form1.Canvas.Brush.Color := snakecolor;
  Form1.Canvas.Pen.Color := snakecolor;
  case direction of
    dup    : Form1.Canvas.Rectangle(snake[0].X+1, snake[0].Y+1,
               snake[0].X + snakewidth-1, snake[0].Y + snakewidth+1);
    ddown  : Form1.Canvas.Rectangle(snake[0].X+1, snake[0].Y-1,
               snake[0].X + snakewidth-1, snake[0].Y + snakewidth-1);
    dleft  : Form1.Canvas.Rectangle(snake[0].X+1, snake[0].Y+1,
               snake[0].X + snakewidth+1, snake[0].Y + snakewidth-1);
    dright : Form1.Canvas.Rectangle(snake[0].X-1, snake[0].Y+1,
               snake[0].X + snakewidth-1, snake[0].Y + snakewidth-1);
  end;
End;

{// DrawPlayField: Draws the playfield (the area where the snake navigates on)}
procedure DrawPlayfield;
begin
  Form1.Canvas.Brush.Color := pfcolor;
  Form1.Canvas.Pen.Color := pfcolor;
  Form1.Canvas.Rectangle(pfposition.x, pfposition.y,
    pfdimention.x + pfposition.x, pfdimention.y + pfposition.y);
end;

{// ResetGame: Resets the game; resets the snake and score}
Procedure ResetGame;
var
 i : integer;

Begin
  form1.snaketimer.enabled := false;
  randomize;
  snakelength := 10;
  snake[0].x := pfposition.x + (pfdimention.x div 2) - (snakewidth div 2);
  snake[0].y := pfposition.y + (pfdimention.y div 2) - (snakewidth div 2);
  while ((pfdimention.x-(snake[0].x-pfposition.x)) mod snakewidth <> 0) do
    inc(snake[0].x);
  while ((pfdimention.y-(snake[0].y-pfposition.y)) mod snakewidth <> 0) do
    inc(snake[0].y);
  for i := 1 to snakelength - 1 do
    snake[i] := snake[0];
  score := 0;
  food.x := 0;
  food.y := 0;
  direction := dright;
  olddirection := direction;
  DrawPlayfield;
  DrawSnake;
  PlaceFood;
  form1.snaketimer.Interval := speed;
  form1.snaketimer.enabled := true;
End;

procedure TForm1.snakeTimerTimer(Sender: TObject);
begin
  olddirection := direction;
  DrawSnake;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  form1.ClientWidth := pfdimention.x + (pfposition.x * 2);
  form1.ClientHeight := pfdimention.y + (pfposition.y * 2);
  form1.Color := clBlack;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case chr(key) of
    chr(38),'w', 'W': if olddirection <> ddown then direction := dup;
    chr(40),'s', 'S': if olddirection <> dup then direction := ddown;
    chr(37),'a', 'A': if olddirection <> dright then direction := dleft;
    chr(39),'d', 'D': if olddirection <> dleft then direction := dright;
    #32: direction := dnone;
  end;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  ResetGame;
end;

end.

Download  Snack