unit1.pas

经典的推箱子游戏

unit Unit1;

interface

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

type
  Tcolor=(black,white,none);
  TForm1 = class(TForm)
    Image1: TImage;
    BitBtn1: TBitBtn;
    Image2: TImage;
    Image3: TImage;
    BitBtn2: TBitBtn;
    Timer1: TTimer;
    Label1: TLabel;
    Image5: TImage;
    Image6: TImage;
    Label2: TLabel;
    Image4: TImage;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Timer1Timer(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
  private
    sec1,sec2:integer;
    min1,min2:integer;
    hour1,hour2:integer;
    timestop:boolean;
    startgame:boolean;
    cleartime:boolean;
  public
    procedure init;
    procedure  searchfive(a,b:integer;cl:Tcolor);
    procedure  drawchess(a,b:integer;cl:Tcolor);
  end;
  Tplayer=(player1,player2,nobody);
  Tclnumber= array[1..8] of integer;
  chess=record
    isempty:boolean;
    cx,cy: integer;
    color:Tcolor;
  end;


var
  Form1: TForm1;
  che:array[0..14,0..14] of chess;
  ismbleftdown:boolean;
  player:Tplayer;

implementation
uses Unit2;
{$R *.dfm}

procedure TForm1.init;
var i,j: integer;
begin
    image1.Canvas.CopyRect(image1.ClientRect,image4.Canvas,image4.ClientRect);
    image1.Canvas.Pen.Width:=2;
    image1.canvas.Pen.Color:=clNavy;
    for i:=0 to 14 do
    begin
        image1.Canvas.MoveTo(i*24+12,12);
        image1.Canvas.LineTo(i*24+12,348);
    end;
    for j:=0 to 14 do
    begin
        image1.Canvas.MoveTo(11,24*j+12);
        image1.Canvas.LineTo(348,24*j+12);
    end;

    image1.Canvas.Pen.Width:=3;
    image1.Canvas.MoveTo(84,84);
    image1.Canvas.Ellipse(82,82,86,86);

    image1.Canvas.MoveTo(276,84);
    image1.Canvas.Ellipse(274,82,278,86);

    image1.Canvas.MoveTo(84,276);
    image1.Canvas.Ellipse(82,274,86,278);

    image1.Canvas.MoveTo(276,276);
    image1.Canvas.Ellipse(274,274,278,278);

    image1.Canvas.MoveTo(180,180);
    image1.Canvas.Ellipse(178,178,182,182);

    image1.Canvas.Pen.Width:=3;

    for i:=0 to 14 do
    for j:=0 to 14 do
    begin
        che[i,j].isempty:=true;
        che[i,j].color:=none;
    end;
    player:=player1;
    startgame:=true;
    image5.Visible:=false;
    image6.Visible:=false;
    cleartime:=true;
    timestop:=false;
    sec1:=0;sec2:=0;min1:=0;min2:=0;hour1:=0;hour2:=0;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
    doublebuffered:=true;
    init;
end;

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

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var  a,b,i:integer;
     clnumber:Tclnumber;
begin
    cleartime:=false;
    a:=y div 24;b:=x div 24;
    if(che[a,b].isempty=true) then
        if(player=player1) then
        begin
            if(startgame=true)
            then drawchess(a,b,black);
            searchfive(a, b,black);
        end
        else
        begin
            if(startgame=true)
            then drawchess(a,b,white);
            searchfive(a, b,white);
        end
    else
        if(startgame=true)
        then    messagedlg('该位置已有棋子！',mtWarning,[mbOk], 0);
end;



procedure TForm1.searchfive(a, b: integer;cl:Tcolor);
var i: integer;
    clnumber:Tclnumber;
begin
    for i:=1 to 8 do
    clnumber[i]:=0;
    for i:=0 to 14 do
    begin
        if(che[a,i].color=cl)
        then clnumber[1]:=clnumber[1]+1
        else clnumber[1]:=0;
        if(che[i,b].color=cl)
        then clnumber[2]:=clnumber[2]+1
        else clnumber[2]:=0;
        if((clnumber[1]=5) or (clnumber[2]=5)) then
        break;
    end;
    if(a>b)then
    begin
        for i:=0 to 14-a+b do
        begin
            if (che[a-b+i,i].color=cl)
            then clnumber[3]:=clnumber[3]+1
            else clnumber[3]:=0;
            if(clnumber[3]=5) then break;
        end;
        if(a+b<14) then
        for i:=0 to a+b do
        begin
            if(che[i,a+b-i].color=cl)
            then clnumber[4]:=clnumber[4]+1
            else clnumber[4]:=0;
            if(clnumber[4]=5) then break;
        end
        else
        begin
            for i:=0 to 28-a-b do
            begin
                if(che[a+b-14+i,14-i].color=cl)
                then    clnumber[5]:=clnumber[5]+1
                else    clnumber[5]:=0;
                if(clnumber[5]=5) then break;
            end;
        end;
    end
    else
    begin
            for i:=0 to 14+a-b do
            begin
                if(che[i,b-a+i].color=cl)
                then    clnumber[6]:=clnumber[6]+1
                else    clnumber[6]:=0;
                if(clnumber[6]=5) then break;
            end;
            if(a+b<14) then
            begin
                for i:=0 to a+b do
                begin
                    if(che[i,a+b-i].color=cl)
                    then clnumber[7]:=clnumber[7]+1
                    else clnumber[7]:=0;
                    if(clnumber[7]=5) then break;
                end;
            end
            else
            begin
                 for i:=0 to 28-a-b do
                    begin
                        if(che[a+b-14+i,14-i].color=cl)
                        then    clnumber[8]:=clnumber[8]+1
                        else    clnumber[8]:=0;
                        if(clnumber[8]=5) then break;
                    end;
            end;
    end;
    for i:=1 to 8 do
    begin
        if(clnumber[i]=5) then
        begin
        timestop:=true;
        startgame:=false;
        if(cl=black)
        then
        begin
            image6.Visible:=false;

            messagedlg('黑方获胜！^_^',mtInformation,[mbOk], 0);
        end
        else
        begin
            image5.Visible:=false;
            messagedlg('白方获胜！^_^',mtInformation,[mbOk], 0);
        end;
        end;
    end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var s1,s2,s3,s4,s5,s6:string;
begin

    if( not timestop and not cleartime) then
    if(player=player1) then
    begin
        if(sec1<59)
        then    sec1:=sec1+1
        else
        if(min1<59)
        then    begin min1:=min1+1;sec1:=0; end
        else
            if(hour1<23)
            then   begin hour1:=hour1+1; min1:=0;sec1:=0; end
            else    hour1:=0;
        if(hour1<10)then s1:='0'+inttostr(hour1)
        else s1:=inttostr(hour1);
        if(min1<10)then s2:='0'+inttostr(min1)
        else s2:=inttostr(hour1);
        if(sec1<10)then s3:='0'+inttostr(sec1)
        else s3:=inttostr(sec1);
        if(cleartime) then
        begin label1.Caption:='00:00:00'; label1.Refresh;   end
        else
        begin   label1.Caption:=s1+':'+s2+':'+s3;label2.Refresh;    end;
    end
    else
    begin
        if(sec2<59)
        then    sec2:=sec2+1
        else

        if(min2<59)
        then    begin min2:=min2+1;sec2:=0; end
        else
            if(hour2<23)
            then   begin hour2:=hour2+1; min2:=0;sec2:=0; end
            else    hour2:=0;
        if(hour2<10)then s4:='0'+inttostr(hour2)
        else s4:=inttostr(hour2);
        if(min2<10)then s5:='0'+inttostr(min2)
        else s5:=inttostr(hour2);
        if(sec2<10)then s6:='0'+inttostr(sec2)
        else s6:=inttostr(sec2);
        if(cleartime) then
        begin   label2.Caption:='00:00:00';label2.Refresh;    end
        else
        begin   label2.Caption:=s4+':'+s5+':'+s6; label2.Refresh;   end;
    end;
    if(cleartime) then
    begin
        label1.Caption:='00:00:00';
        label2.Caption:='00:00:00';
    end;
end;

procedure TForm1.drawchess(a, b: integer; cl: Tcolor);
begin
    if(cl=black)
    then
    begin
        image1.Canvas.Brush.Color:=clblack;
        image1.Canvas.Pen.Color:=clblack;
        image1.Canvas.Pen.Width:=1;
        image1.Canvas.Ellipse(b*24,a*24,b*24+24,a*24+24);
        che[a,b].isempty:=false;
        che[a,b].color:=black;
        image5.Visible:=false;
        image6.Visible:=true;
        player:=player2;

    end
    else
    begin
        image1.Canvas.Brush.Color:=clwhite;
        image1.Canvas.Pen.Color:=clwhite;
        image1.Canvas.Pen.Width:=1;
        image1.Canvas.Ellipse(b*24,a*24,b*24+24,a*24+24);
        che[a,b].isempty:=false;
        che[a,b].color:=white;
        image5.Visible:=true;
        image6.Visible:=false;
        searchfive(a, b,white);
        player:=player1;

    end;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
    init;

end;

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

procedure TForm1.N2Click(Sender: TObject);
begin
    init;    
end;

procedure TForm1.N6Click(Sender: TObject);
begin
    Form2.ShowModal;
end;

end.