ppl.~pa

是delphi开发的小游戏

unit ppl;

interface

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

type block=record
       x:byte;
       y:byte;
     end;
type sequence=array[1..60]of block;
const  right=1;
       down=2;
       lef=3;
       up=4;
type
  TForm1 = class(TForm)
    Image1: TImage;
    PopupMenu1: TPopupMenu;
    start: TMenuItem;
    exit: TMenuItem;
    Timer1: TTimer;
    Label1: TLabel;
    about1: TMenuItem;
    procedure FormShow(Sender: TObject);
    procedure exitClick(Sender: TObject);
    procedure startClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure about1Click(Sender: TObject);
  private
    line:sequence;
    len:byte;
    direction:byte;
    ball:block;
    procedure draw(x,y:byte);
    procedure remove(x,y:byte);
    procedure ballgenerate(var ball:block;line:sequence;len:byte);
    function check(line:sequence;len:byte):boolean;//检测队列是否形成环路，true为真
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses about;

{$R *.DFM}

function tform1.check(line:sequence;len:byte):boolean;//检测队列是否形成环路，true为真
var i:byte;
begin
  check:=false;
  for i:=2 to len do
    begin
      if (line[1].x=line[i].x) and (line[1].y=line[i].y) then
          check:=true;
    end;
end;
procedure tform1.ballgenerate(var ball:block;line:sequence;len:byte);
var x,y,i:integer;
    flag:boolean;//判断产生的球是否与长列重合，false为重合
begin
 randomize;
 flag:=false;
 while flag=false do
   begin
     flag:=true;
     x:=random(20)+1;
     y:=random(20)+1;
     for i:=1 to len do
       begin
         if (line[i].x=x) and (line[i].y=y) then
            flag:=false;
       end;
   end;
  ball.x:=x;
  ball.y:=y;
  image1.Canvas.brush.Color:=clred;
  image1.Canvas.pen.Color:=clblack;
  image1.canvas.rectangle(x*20-20,y*20-20,x*20,y*20);
  image1.canvas.floodfill(x*20-15,y*20-15,clblack,fssurface);
end;
procedure tform1.remove(x,y:byte);
begin
  image1.Canvas.brush.Color:=clblack;
  image1.Canvas.pen.Color:=clblack;
  image1.canvas.rectangle(x*20-20,y*20-20,x*20,y*20);
  image1.canvas.floodfill(x*20-15,y*20-15,clwhite,fssurface);
end;

procedure tform1.draw(x,y:byte);
begin
  image1.Canvas.brush.Color:=clgreen;
  image1.Canvas.pen.Color:= clLime;
  image1.canvas.rectangle(x*20-20,y*20-20,x*20,y*20);
  image1.canvas.floodfill(x*20-15,y*20-15,cllime,fssurface);
end;
procedure TForm1.FormShow(Sender: TObject);
var bg:trect;
begin
  bg:=rect(0,0,image1.width,image1.height);
  image1.canvas.brush.color:=clblack;
  image1.canvas.fillrect(bg);
end;

procedure TForm1.exitClick(Sender: TObject);
begin
close;
end;

procedure TForm1.startClick(Sender: TObject);
var i,j:byte;
    bg:trect;
begin
  bg:=rect(0,0,image1.width,image1.height);
  image1.canvas.brush.color:=clblack;
  image1.canvas.fillrect(bg);
  len:=4;
  for i:=1 to len do
    begin
     line[i].x:=len-i+1;
     line[i].y:=10;
    end; 
  for i:=1 to len do
    draw(line[i].x,line[i].y);
  ballgenerate(ball,line,len);
  timer1.Enabled:=true;
  direction:=right;
  label1.Visible:=false;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var i,endx,endy,headx,heady:byte;
    flag:boolean;
begin
  flag:=false;
  headx:=line[1].x;
  heady:=line[1].y;
  case direction of
     right:line[1].x:=line[1].x+1;
     down: line[1].y:=line[1].y+1;
     lef:  line[1].x:=line[1].x-1;
     up:   line[1].y:=line[1].y-1;
   end;
   if (line[1].x<1) or (line[1].x>20) or (line[1].y<1) or (line[1].y>20) then
     begin
      timer1.Enabled:=false;
      label1.Visible:=true;
     end;
   if (line[1].x=ball.x) and (line[1].y=ball.y) then
     begin
      len:=len+1;
      flag:=true;
     end;
   endx:=line[len].x;
   endy:=line[len].y;
   for i:=len downto 3 do
    begin
     line[i].x:=line[i-1].x;
     line[i].y:=line[i-1].y;
    end;
   line[2].x:=headx;
   line[2].y:=heady;
   if check(line,len) then
     begin
      timer1.Enabled:=false;
      label1.Visible:=true;
     end;
   if flag=true then
      ballgenerate(ball,line,len)
   else
      remove(endx,endy);
   draw(line[1].x,line[1].y);
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case key of
  37:if direction<>right then direction:=lef;
  38:if direction<>down then direction:=up;
  39:if direction<>left then direction:=right;
  40:if direction<>up then direction:=down;
  end;
end;

procedure TForm1.about1Click(Sender: TObject);
begin
   timer1.Enabled:=false;
   form2.showmodal;
end;

end.