main0.~pas

五指棋游戏,很经典

unit main0;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Timer1: TTimer;
    Labeltime: TLabel;
    Image2: TImage;
    Image3: TImage;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    N18: TMenuItem;
    GiGi1: TMenuItem;
    N19: TMenuItem;
    N21: TMenuItem;
    KOF1: TMenuItem;
    N20: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Timer1Timer(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure N12Click(Sender: TObject);
    procedure N13Click(Sender: TObject);
    procedure N14Click(Sender: TObject);
    procedure N15Click(Sender: TObject);
    procedure N16Click(Sender: TObject);
    procedure N18Click(Sender: TObject);
    procedure GiGi1Click(Sender: TObject);
    procedure N19Click(Sender: TObject);
    procedure N21Click(Sender: TObject);
    procedure KOF1Click(Sender: TObject);
    procedure N20Click(Sender: TObject);
   
      private
  switch : boolean;
  swi : array[1..15,1..15] of integer;
  leg : integer;
  colorswi : integer;


    { Private declarations }
  public
  procedure linepen;
  procedure linepen1;
  procedure showend(var aa : integer; var bb : integer);
  procedure double(var aa : integer; var bb : integer);
  procedure changecolor;
  procedure colorctrl;
  //procedure computer(var aa : integer; var bb : integer);
      { Public declarations }
  end;

var

  Form1: TForm1;

implementation

{$R *.dfm}




procedure TForm1.FormCreate(Sender: TObject);
var j,k : integer;
begin
leg := 20;
doublebuffered := true;
colorswi := 1;


 for j := 1 to 15 do
  for k := 1 to 15 do
    swi[j,k] := 1;
if leg = 20 then
linepen1
else if leg = 30 then
linepen;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
  var a,b,al,bl : integer;
  var i,j,k : integer;
  label 1;
begin

a := x;
b := y;
if (a mod leg) < 10 then
        a := a div leg
else    a:= (a div leg +1);
if (b mod leg) < 10 then
  b := b div leg
else
  b := (b div leg +1);

if swi[a,b]=1 then
begin
if ((x>15) and (y>15)and(x<310)and (y<310))then
begin
  {if switch then
    image1.Canvas.Brush.Color := clblack
  else image1.Canvas.Brush.Color := clwhite;
  image1.Canvas.Ellipse(a*leg-7,b*leg-7,a*leg+7,b*leg+7);
  switch := not switch;
  if switch then
  begin
    swi[a,b] := 2 ;
    label2.Caption := '黑旗走';
  end
  else
  begin
  swi[a,b] := 3; label2.Caption := '白旗走';
  end; }
  double(a,b);
end
else goto 1;
end
else goto 1;

//以下判断是否应定输赢
j := 0;
al := a;
bl := b;
for i := 0 to 4 do
if swi[al,bl]=swi[a,b] then
 begin
  j := j+1;
  al := al-1;
  bl := bl-1;
  if ((al<1)or(bl<1))  then
  begin
  al := a+1;
  bl := b+1;
  break;
  end;
 end
else
begin
al := a+1; bl := b+1; break;
end ;

for i:= 0 to 4 do
   if swi[al,bl]=swi[a,b] then
   begin
    j := j+1;
    al := al+1;
    bl := bl+1;
    //if ((al>10)or(bl>10)) then  break;
     if ((al>15)or(bl>15)) then  break;
   end
   else
    break;
if j>= 5 then
begin
  showend(a,b);
    {if swi[a,b]=2 then
       showmessage('白棋胜')
     else if swi[a,b]=3 then showmessage('黑棋胜');
 //for j := 1 to 10 do
  //for k := 1 to 10 do
    for j := 1 to 15 do
     for k := 1 to 15 do
    swi[j,k] := 4; }          //判定输赢后不能继续,删该句可进行悔棋等操作
     goto 1;
end
      else
   begin
   j := 0;
   al := a;
   bl := b;
   end;


for i := 0 to 4 do
if swi[al,bl]=swi[a,b] then
begin
 j := j+1;
 al := al-1;
 if (al<1) then
 begin
 al := a+1;
break;
 end ;
end
else
begin
 al := a+1;  break;
end;
for i:= 0 to 4 do
   if swi[al,bl]=swi[a,b] then
   begin
    j := j+1;
    al := al+1;
    //if (al>10) then
      if (al>15) then
       break;
   end
   else
    break;

 if j>= 5 then
 begin
     showend(a,b);
     goto 1;
 end
      else
   begin
   j := 0;
   al := a;
   bl := b;
   end;

for i := 0 to 4 do
if swi[al,bl]=swi[a,b] then
begin
 j := j+1;
 bl := bl-1;
 if (bl<1) then
 begin
 bl := b+1;
break;
 end ;
end
else
begin
 bl := b+1;  break;
end;
for i:= 0 to 4 do
   if swi[al,bl]=swi[a,b] then
   begin
    j := j+1;
    bl := bl+1;
    //if (bl>10) then
      if (bl>15) then
       break;
   end
   else
    break;

 if j>= 5 then
 begin
     showend(a,b);
     goto 1;
 end
      else
   begin
   j := 0;
   al := a;
   bl := b;
   end;

for i := 0 to 4 do
if swi[al,bl]=swi[a,b] then
begin
 j := j+1;
 al := al-1;
 bl := bl+1;
 if ((al<1)or(bl>15)) then
 begin
 al := a+1;
 bl := b-1;
break;
 end ;
end
else
begin
 al := a+1; bl := b-1;  break;
end;
for i:= 0 to 4 do
   if swi[al,bl]=swi[a,b] then
   begin
    j := j+1;
    al := al+1;
    bl := bl-1;
      if ((al>15)or (bl<1)) then
       break;
   end
   else
    break;

 if j>= 5 then
 begin
     showend(a,b);    
     goto 1;
 end
      else
   begin
   j := 0;
   al := a;
   bl := b;
   end;
1: end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if messagedlg('感谢你使用了正版软件,但你真的忍心退出吗?',mtconfirmation,
 [mbyes,mbno],0)=mryes
then canclose := true else canclose := false;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
labeltime.caption := timetostr(time);
end;

procedure TForm1.N3Click(Sender: TObject);
var canclose : boolean;
begin
 close;
end;

procedure TForm1.N2Click(Sender: TObject);
var j,k : integer;
begin
colorctrl;
if leg = 20 then
linepen1
else if leg = 30 then
linepen;
  for j:=1 to 15 do
    for k:= 1 to 15 do
    swi[j,k] := 1;
end;

procedure TForm1.linepen;
var i : integer;
begin

for i := 1 to 10 do
begin
  image1.Canvas.MoveTo(i*30,30);
  image1.Canvas.lineTo(i*30,300);
end;
for i:= 1 to 10 do
begin
  image1.Canvas.MoveTo(30,i*30);
  image1.Canvas.LineTo(300,i*30);
end;

end;

procedure TForm1.linepen1;
var i : integer;
begin
 for i := 0 to 14 do
begin
  image1.Canvas.MoveTo(20+i*20,20);
  image1.Canvas.lineTo(i*20+20,300);
end;
for i:= 0 to 14 do
begin
  image1.Canvas.MoveTo(20,i*20+20);
  image1.Canvas.LineTo(300,i*20+20);
end;
end;

procedure TForm1.N5Click(Sender: TObject);
var a : integer;
begin
a := leg;
leg := 30;
if (a = 20) then
N2Click(Sender);
end;

procedure TForm1.N6Click(Sender: TObject);
var a: integer;
begin
a := leg;
leg := 20;
if ( a = 30) then
N2Click(Sender);
end;


procedure TForm1.showend(var aa : integer; var bb : integer);
var j,k : integer;
begin
 if swi[aa,bb]=2 then
       showmessage('白棋胜')
     else if swi[aa,bb]=3 then  showmessage('黑棋胜');

   for j := 1 to 15 do
     for k := 1 to 15 do
     begin
     if swi[j,k] = 1 then
     begin
     swi[j,k] := 4;
     end;
     end;
end;


procedure TForm1.double(var aa : integer; var bb : integer);
begin
if switch then
    image1.Canvas.Brush.Color := clblack
  else image1.Canvas.Brush.Color := clwhite;
  image1.Canvas.Ellipse(aa*leg-7,bb*leg-7,aa*leg+7,bb*leg+7);
  switch := not switch;
if switch then
  begin
    swi[aa,bb] := 2 ;
    label2.Caption := '黑旗走';
  end
  else
  begin
  swi[aa,bb] := 3; label2.Caption := '白旗走';
  end;
end;

{procedure TForm1.computer(var aa : integer; var bb : integer);
l : array[1..4] of integer;
r : array[1..4] of integer;
var i,j,k : integer;
begin
for i := 1 to 4 do
begin
if aa-i > 0 then
l[i] := swi[aa-i,bb];
if aa+i <= 15 then
r[i] := swi[aa+i,bb];
end;



end;}

procedure TForm1.N8Click(Sender: TObject);
begin
form2.ShowModal;
end;

procedure TForm1.changecolor;
var i,j : integer;
begin
if leg = 20 then
linepen1
else if leg = 30 then
linepen;
for i := 1 to 15 do
begin
        for j := 1 to 15 do
        begin
                if swi[i,j]=2 then
                begin
                    image1.Canvas.Brush.Color := clwhite;
                    image1.Canvas.Ellipse(i*leg-7,j*leg-7,i*leg+7,j*leg+7);
                end
                else if swi[i,j]=3 then
                begin
                      image1.Canvas.Brush.Color := clblack;
                      image1.Canvas.Ellipse(i*leg-7,j*leg-7,i*leg+7,j*leg+7);
                end;
        end;
end;
end;


procedure TForm1.colorctrl;
begin
if colorswi = 1 then
begin
image1.Picture.LoadFromFile('bg3.bmp');
end
else if colorswi = 2 then
begin
image1.Picture.LoadFromFile('bg7.bmp');
end
else if colorswi = 3 then
begin
image1.Picture.LoadFromFile('bg4.bmp');
end
else if colorswi = 4 then
begin
image1.Picture.LoadFromFile('bg5.bmp');
end
else if colorswi =5 then
begin
image1.Picture.LoadFromFile('bg6.bmp');
end
else if colorswi = 6 then
begin
image1.Picture.LoadFromFile('bg.bmp');
end
else if colorswi = 7 then
begin
image1.Picture.LoadFromFile('qp1.bmp');
end
else if colorswi = 8 then
begin
image1.Picture.LoadFromFile('qp.bmp');
end
else if colorswi = 9 then
begin
image1.Picture.LoadFromFile('qp2.bmp'); 
end
else if colorswi = 10 then
begin
image1.Picture.LoadFromFile('qp3.bmp');
end
else if colorswi = 11 then
begin
image1.Picture.LoadFromFile('qp4.bmp');
end
else if colorswi = 12 then
begin
image1.Picture.LoadFromFile('qp6.bmp');
end;
end;

 procedure TForm1.N16Click(Sender: TObject);
begin
colorswi := 1;
colorctrl;
changecolor;
end;

procedure TForm1.N11Click(Sender: TObject);
begin
colorswi := 2;
colorctrl;
changecolor;
end;

procedure TForm1.N12Click(Sender: TObject);
begin
colorswi := 3;
colorctrl;
changecolor;
end;

procedure TForm1.N13Click(Sender: TObject);
begin
colorswi := 4;
colorctrl;
changecolor;
end;

procedure TForm1.N14Click(Sender: TObject);
begin
colorswi := 5;
colorctrl;
changecolor;
end;

procedure TForm1.N15Click(Sender: TObject);
begin
colorswi := 6;
colorctrl;
changecolor;
end;

procedure TForm1.N18Click(Sender: TObject);
begin
colorswi := 7;
colorctrl;
changecolor;
end;

procedure TForm1.GiGi1Click(Sender: TObject);
begin
colorswi := 8;
colorctrl;
changecolor;
end;

procedure TForm1.N19Click(Sender: TObject);
begin
colorswi := 9 ;
colorctrl;
changecolor;
end;

procedure TForm1.N21Click(Sender: TObject);
begin
colorswi := 10;
colorctrl;
changecolor;
end;

procedure TForm1.KOF1Click(Sender: TObject);
begin
colorswi := 11;
colorctrl;
changecolor;
end;

procedure TForm1.N20Click(Sender: TObject);
begin
colorswi := 12;
colorctrl;
changecolor;
end;

end.