求五子棋源程序

Question

我有，一定要给分，但没有人机对下！
程序如下：unit study;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Grids, Menus;type
  TMainform = class(TForm)
    Panel1: TPanel;
    DrawGrid1: TDrawGrid;
    Timer1: TTimer;
    PopupMenu1: TPopupMenu;
    A1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure A1Click(Sender: TObject);
    procedure DrawGrid1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
  private
    { Private declarations }
    Tag:array[0..18,0..18]of integer;
    {0 for nome,1 for black,2 for while}
    IsBlack:Boolean;
  public
    { Public declarations }
    MainDir:string[80];
    function IsWin(IsBlack:boolean):boolean;
  end;var
  Mainform: TMainform;implementationuses about;{$R *.dfm}function Tmainform.IsWin(IsBlack:boolean):boolean;
label exit1;
var
  i,j:integer;
  wtag:integer;
begin
  IsWin:=false;
  if IsBlack then
    wtag:=1 else
    wtag:=2;
  for i:=0 to 18 do
    for j:=0 to 14 do
    begin
      if (i<15)   //是否有行连成
      and(Tag[i,j]=wtag)
      and(Tag[i+1,j]=wtag)
      and(Tag[i+2,j]=wtag)
      and(Tag[i+3,j]=wtag)
      and(Tag[i+4,j]=wtag)
      then
      begin
        IsWin:=True;
        goto exit1;
      end;
      if (Tag[i,j]=wtag)    //是否有列连成
      and(Tag[i,j+1]=wtag)
      and(Tag[i,j+2]=wtag)
      and(Tag[i,j+3]=wtag)
      and(Tag[i,j+4]=wtag)
      then
      begin
        IsWin:=True;
        goto exit1;
      end;
      if (i<15)    //是否有主对角线连成
      and(Tag[i,j]=wtag)
      and(Tag[i+1,j+1]=wtag)
      and(Tag[i+2,j+2]=wtag)
      and(Tag[i+3,j+3]=wtag)
      and(Tag[i+4,j+4]=wtag)
      then
      begin
        IsWin:=True;
        goto exit1;
      end;
      if (Tag[i,j]=wtag)    //是否有副对角线连成
      and(Tag[i-1,j+1]=wtag)
      and(Tag[i-2,j+2]=wtag)
      and(Tag[i-3,j+3]=wtag)
      and(Tag[i-4,j+4]=wtag)
      then
      begin
        IsWin:=True;
        goto exit1;
      end;
    end;
  exit1:
end;
procedure Tmainform.FormCreate(Sender: TObject);
var
  i,j:integer;
begin
  for i:=0 to 18 do
    for j:=0 to 18 do
    begin
      Tag[i,j]:=0;
    end;
  IsBlack:=true;  //设置IsBlack初值，第一局黑棋先下
  MainDir:=ExtractFilePath(ParamStr(0));  //获取程序路径
end;procedure TMainform.Timer1Timer(Sender: TObject);
begin
   case Timer1.Tag of
    0:MainForm.Icon.LoadFromFile(MainDir+'Icon\'+'Face01.ico');
    1:MainForm.Icon.LoadFromFile(MainDir+'Icon\'+'Face02.ico');
    2:MainForm.Icon.LoadFromFile(MainDir+'Icon\'+'Face03.ico');
    3:MainForm.Icon.LoadFromFile(MainDir+'Icon\'+'Face04.ico');
   end;   if Timer1.Tag>2 then //更新图标
    Timer1.Tag:=0
   else
    Timer1.Tag:=Timer1.Tag+1;
end;procedure TMainform.A1Click(Sender: TObject);
begin
    tabout.Show ;
end;procedure TMainform.DrawGrid1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  col,row:integer;
  i,j:integer;
begin
  DrawGrid1.Canvas.Pen.Color :=clBlack;  //设置画笔颜色
  DrawGrid1.Canvas.Brush.Color :=clBlack;  //设置画刷颜色
  DrawGrid1.MouseToCell(x,y,col,row);   //绘制网格
  if tag[col,row]=0 then
  begin
    if IsBlack then
    begin
      DrawGrid1.Canvas.Ellipse(col*21,row*21,(col+1)*21,(row+1)*21);
      tag[col,row]:=1;   //判断黑棋的标志
    end else
    begin
      DrawGrid1.Canvas.Arc(col*21,row*21,(col+1)*21,(row+1)*21,col*21,row*21,col*21,row*21);
      tag[col,row]:=2;   //判断白棋的标志
    end;
    if IsWin(IsBlack) then
    begin
      if IsBlack then
        if MessageDlg(' 黑方胜利',mtInformation,[mbOK],0)=mrOK then
        begin
          for i:=0 to 18 do
            for j:=0 to 18 do
            begin
              tag[i,j]:=0;
            end;
          DrawGrid1.Invalidate;  //网格初始化，下局白方先下
        end;
      if not IsBlack then
        if MessageDlg('白方胜利',mtInformation,[mbOK],0)=mrOK then
        begin
          for i:=0 to 18 do
            for j:=0 to 18 do
            begin
              tag[i,j]:=0;
            end;
          DrawGrid1.Invalidate;   //网格初始化
        end;
      end;
      IsBlack:=not IsBlack;   //白方胜利则下局黑方先下
    end;
end;procedure TMainform.DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
  DrawGrid1.Canvas.Pen.Color :=clBlack;  //设置画笔颜色
  DrawGrid1.Canvas.Brush.Color :=clBlack;  //设置画刷颜色
  if tag[acol,arow]=1 then
    DrawGrid1.Canvas.Ellipse(acol*21,arow*21,(acol+1)*21,(arow+1)*21) //绘制黑棋
    else if tag[acol,arow]=2 then
      DrawGrid1.Canvas.Arc(acol*21,arow*21,(acol+1)*21,(arow+1)*21,acol*21,arow*21,acol*21,arow*21)  //绘制白棋
      else
      begin
        DrawGrid1.Canvas.Pen.Color :=clWhite;  //设置画笔颜色
        DrawGrid1.Canvas.Brush.Color :=clWhite;  //设置画刷颜色
        DrawGrid1.Canvas.Ellipse(acol*21,arow*21,(acol+1)*21,(arow+1)*21);
      end;
end;end.

Answer 1

哈，那是从一本书上抄回来的，我以前弄过，用drawgrid的效果好烂啊!@!
我第二次是直接在窗体上面画的。不过我还没有做好，因我不知道五子棋的
规则。
也只是随便写写，很多要优化的地方未作优化。unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,printers, StdCtrls, ExtCtrls, Menus;type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure FormPaint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    function hasWin(x,y:integer):integer;
    function threecount(x,y:integer):integer;
  public
    { Public declarations }
    loc:array[1..15,1..15]of integer;
    whocontrol:integer;//0 is none,,,,1 is black,,,,2 is white;
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.FormPaint(Sender: TObject);
var
  i,j:integer;
begin
  with canvas do
  begin
    Pen.Color:=clred;
    Brush.Color:=color;
    for i:=1 to 15 do
    begin
      MoveTo(i*30,30);
      LineTo(i*30,15*30);
      TextOut(i*30-5,5,inttostr(i));
      ////////////////////////////////////
      MoveTo(30,i*30);
      LineTo(15*30,i*30);
      TextOut(5,i*30-5,inttostr(i));
    end;
    Brush.Color:=clred;
    Ellipse(8*30-7,8*30-7,8*30+7,8*30+7);
    for i:=1 to 15 do
      for j:=1 to 15 do
      begin
        if loc[i,j]=1 then
        begin
          Pen.Color:=clblack;
          Brush.Color:=clblack;
          Ellipse(i*30-14,j*30-14,i*30+14,j*30+14);
        end
        else if loc[i,j]=2 then
        begin
          Pen.Color:=clwhite;
          Brush.Color:=clwhite;
          Ellipse(i*30-14,j*30-14,i*30+14,j*30+14);
        end;
      end;
  end;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
  left:=(screen.Width-width)div 2;
  top:=(screen.Height-height)div 2;
  ////////////
  self.Button1Click(sender);
end;procedure TForm1.Button1Click(Sender: TObject);
var
  i,j:integer;
begin
  WhoControl:=1;//black;
  for i:=1 to 15 do
    for j:=1 to 15 do
      loc[i,j]:=0;
  self.Refresh;
end;procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i,j:integer;
begin
  /////////////此处做得比较差，但我不想动脑了
  if whocontrol=0 then exit;
  if (x>(16*30+10))or(x<16)or(y>(16*30+10))or(y<16)then exit;
  i:=(x div 30)+((x mod 30)div 15);
  j:=(y div 30)+((y mod 30)div 15);
  if (i<1)or(i>15)or(j<1)or(j>15)or(canvas.Pixels[i*30,j*30]=clwhite)
    or(canvas.Pixels[i*30,j*30]=clblack) then exit;
  //////////////////////////////
  loc[i,j]:=whocontrol;
  with canvas do
  begin
    if whocontrol=1 then
    begin
      Pen.Color:=clblack;
      Brush.Color:=clblack;
    end
    else if whocontrol=2 then
    begin
      Pen.Color:=clwhite;
      Brush.Color:=clwhite;
    end;
    Ellipse(i*30-14,j*30-14,i*30+14,j*30+14);
  end;
  i:=haswin(i,j);
  if i<>0 then
  begin
    showmessage('player '+inttostr(i)+' is win!');
    whocontrol:=0;
    exit;
  end;
  whocontrol:=(whocontrol mod 2)+1;
end;function TForm1.hasWin(x, y: integer): integer;
var
  i,j:integer;
begin
  result:=0;
  for i:=x-4 to x+4 do
    for j:=y-4 to y+4 do
    begin
      if(i>0)and(i<12)and(loc[i,y]<>0)and(loc[i,y]=loc[i+1,y])
        and(loc[i,y]=loc[i+2,y])and(loc[i,y]=loc[i+3,y])
        and(loc[i,y]=loc[i+4,y])then
      begin
        result:=whocontrol;
        exit;
      end;
      ///////////////////////////
      if(j>0)and(j<12)and(not(loc[x,j]=0))and(loc[x,j]=loc[x,j+1])
        and(loc[x,j]=loc[x,j+2])and(loc[x,j]=loc[x,j+3])
        and(loc[x,j]=loc[x,j+4])then
      begin
        result:=whocontrol;
        exit;
      end;
      ////////////////////////////
      if(i>0)and(j>0)and(i<12)and(j<12)and(loc[i,j]<>0)
        and(loc[i,j]=loc[i+1,j+1])and(loc[i,j]=loc[i+2,j+2])
        and(loc[i,j]=loc[i+3,j+3])and(loc[i,j]=loc[i+4,j+4])then
      begin
        result:=whocontrol;
        exit;
      end;
      /////////////////////////////
      if(i>=5)and(j<12)and(i<16)and(j>0)and(loc[i,j]<>0)and
        (loc[i,j]=loc[i-1,j+1])and(loc[i,j]=loc[i-2,j+2])and
        (loc[i,j]=loc[i-3,j+3])and(loc[i,j]=loc[i-4,j+4])then
      begin
        result:=whocontrol;
        exit;
      end;
    end;
  ////////////////////////
  if threecount(x,y)=2 then
    result:=(whocontrol mod 2)+1;
end;function TForm1.threecount(x, y: integer): integer;
begin
  //////////////////////////三三未做
  result:=0;
end;end.

Answer 2

哈，那是从一本书上抄回来的，我以前弄过，用drawgrid的效果好烂啊!@!
我第二次是直接在窗体上面画的。不过我还没有做好，因我不知道五子棋的
规则。
也只是随便写写，很多要优化的地方未作优化。unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,printers, StdCtrls, ExtCtrls, Menus;type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure FormPaint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    function hasWin(x,y:integer):integer;
    function threecount(x,y:integer):integer;
  public
    { Public declarations }
    loc:array[1..15,1..15]of integer;
    whocontrol:integer;//0 is none,,,,1 is black,,,,2 is white;
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.FormPaint(Sender: TObject);
var
  i,j:integer;
begin
  with canvas do
  begin
    Pen.Color:=clred;
    Brush.Color:=color;
    for i:=1 to 15 do
    begin
      MoveTo(i*30,30);
      LineTo(i*30,15*30);
      TextOut(i*30-5,5,inttostr(i));
      ////////////////////////////////////
      MoveTo(30,i*30);
      LineTo(15*30,i*30);
      TextOut(5,i*30-5,inttostr(i));
    end;
    Brush.Color:=clred;
    Ellipse(8*30-7,8*30-7,8*30+7,8*30+7);
    for i:=1 to 15 do
      for j:=1 to 15 do
      begin
        if loc[i,j]=1 then
        begin
          Pen.Color:=clblack;
          Brush.Color:=clblack;
          Ellipse(i*30-14,j*30-14,i*30+14,j*30+14);
        end
        else if loc[i,j]=2 then
        begin
          Pen.Color:=clwhite;
          Brush.Color:=clwhite;
          Ellipse(i*30-14,j*30-14,i*30+14,j*30+14);
        end;
      end;
  end;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
  left:=(screen.Width-width)div 2;
  top:=(screen.Height-height)div 2;
  ////////////
  self.Button1Click(sender);
end;procedure TForm1.Button1Click(Sender: TObject);
var
  i,j:integer;
begin
  WhoControl:=1;//black;
  for i:=1 to 15 do
    for j:=1 to 15 do
      loc[i,j]:=0;
  self.Refresh;
end;procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i,j:integer;
begin
  /////////////此处做得比较差，但我不想动脑了
  if whocontrol=0 then exit;
  if (x>(16*30+10))or(x<16)or(y>(16*30+10))or(y<16)then exit;
  i:=(x div 30)+((x mod 30)div 15);
  j:=(y div 30)+((y mod 30)div 15);
  if (i<1)or(i>15)or(j<1)or(j>15)or(canvas.Pixels[i*30,j*30]=clwhite)
    or(canvas.Pixels[i*30,j*30]=clblack) then exit;
  //////////////////////////////
  loc[i,j]:=whocontrol;
  with canvas do
  begin
    if whocontrol=1 then
    begin
      Pen.Color:=clblack;
      Brush.Color:=clblack;
    end
    else if whocontrol=2 then
    begin
      Pen.Color:=clwhite;
      Brush.Color:=clwhite;
    end;
    Ellipse(i*30-14,j*30-14,i*30+14,j*30+14);
  end;
  i:=haswin(i,j);
  if i<>0 then
  begin
    showmessage('player '+inttostr(i)+' is win!');
    whocontrol:=0;
    exit;
  end;
  whocontrol:=(whocontrol mod 2)+1;
end;function TForm1.hasWin(x, y: integer): integer;
var
  i,j:integer;
begin
  result:=0;
  for i:=x-4 to x+4 do
    for j:=y-4 to y+4 do
    begin
      if(i>0)and(i<12)and(loc[i,y]<>0)and(loc[i,y]=loc[i+1,y])
        and(loc[i,y]=loc[i+2,y])and(loc[i,y]=loc[i+3,y])
        and(loc[i,y]=loc[i+4,y])then
      begin
        result:=whocontrol;
        exit;
      end;
      ///////////////////////////
      if(j>0)and(j<12)and(not(loc[x,j]=0))and(loc[x,j]=loc[x,j+1])
        and(loc[x,j]=loc[x,j+2])and(loc[x,j]=loc[x,j+3])
        and(loc[x,j]=loc[x,j+4])then
      begin
        result:=whocontrol;
        exit;
      end;
      ////////////////////////////
      if(i>0)and(j>0)and(i<12)and(j<12)and(loc[i,j]<>0)
        and(loc[i,j]=loc[i+1,j+1])and(loc[i,j]=loc[i+2,j+2])
        and(loc[i,j]=loc[i+3,j+3])and(loc[i,j]=loc[i+4,j+4])then
      begin
        result:=whocontrol;
        exit;
      end;
      /////////////////////////////
      if(i>=5)and(j<12)and(i<16)and(j>0)and(loc[i,j]<>0)and
        (loc[i,j]=loc[i-1,j+1])and(loc[i,j]=loc[i-2,j+2])and
        (loc[i,j]=loc[i-3,j+3])and(loc[i,j]=loc[i-4,j+4])then
      begin
        result:=whocontrol;
        exit;
      end;
    end;
  ////////////////////////
  if threecount(x,y)=2 then
    result:=(whocontrol mod 2)+1;
end;function TForm1.threecount(x, y: integer): integer;
begin
  //////////////////////////三三未做
  result:=0;
end;end.

Answer 3

哈，那是从一本书上抄回来的，我以前弄过，用drawgrid的效果好烂啊!@!
我第二次是直接在窗体上面画的。不过我还没有做好，因我不知道五子棋的
规则。
也只是随便写写，很多要优化的地方未作优化。unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,printers, StdCtrls, ExtCtrls, Menus;type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure FormPaint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    function hasWin(x,y:integer):integer;
    function threecount(x,y:integer):integer;
  public
    { Public declarations }
    loc:array[1..15,1..15]of integer;
    whocontrol:integer;//0 is none,,,,1 is black,,,,2 is white;
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.FormPaint(Sender: TObject);
var
  i,j:integer;
begin
  with canvas do
  begin
    Pen.Color:=clred;
    Brush.Color:=color;
    for i:=1 to 15 do
    begin
      MoveTo(i*30,30);
      LineTo(i*30,15*30);
      TextOut(i*30-5,5,inttostr(i));
      ////////////////////////////////////
      MoveTo(30,i*30);
      LineTo(15*30,i*30);
      TextOut(5,i*30-5,inttostr(i));
    end;
    Brush.Color:=clred;
    Ellipse(8*30-7,8*30-7,8*30+7,8*30+7);
    for i:=1 to 15 do
      for j:=1 to 15 do
      begin
        if loc[i,j]=1 then
        begin
          Pen.Color:=clblack;
          Brush.Color:=clblack;
          Ellipse(i*30-14,j*30-14,i*30+14,j*30+14);
        end
        else if loc[i,j]=2 then
        begin
          Pen.Color:=clwhite;
          Brush.Color:=clwhite;
          Ellipse(i*30-14,j*30-14,i*30+14,j*30+14);
        end;
      end;
  end;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
  left:=(screen.Width-width)div 2;
  top:=(screen.Height-height)div 2;
  ////////////
  self.Button1Click(sender);
end;procedure TForm1.Button1Click(Sender: TObject);
var
  i,j:integer;
begin
  WhoControl:=1;//black;
  for i:=1 to 15 do
    for j:=1 to 15 do
      loc[i,j]:=0;
  self.Refresh;
end;procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i,j:integer;
begin
  /////////////此处做得比较差，但我不想动脑了
  if whocontrol=0 then exit;
  if (x>(16*30+10))or(x<16)or(y>(16*30+10))or(y<16)then exit;
  i:=(x div 30)+((x mod 30)div 15);
  j:=(y div 30)+((y mod 30)div 15);
  if (i<1)or(i>15)or(j<1)or(j>15)or(canvas.Pixels[i*30,j*30]=clwhite)
    or(canvas.Pixels[i*30,j*30]=clblack) then exit;
  //////////////////////////////
  loc[i,j]:=whocontrol;
  with canvas do
  begin
    if whocontrol=1 then
    begin
      Pen.Color:=clblack;
      Brush.Color:=clblack;
    end
    else if whocontrol=2 then
    begin
      Pen.Color:=clwhite;
      Brush.Color:=clwhite;
    end;
    Ellipse(i*30-14,j*30-14,i*30+14,j*30+14);
  end;
  i:=haswin(i,j);
  if i<>0 then
  begin
    showmessage('player '+inttostr(i)+' is win!');
    whocontrol:=0;
    exit;
  end;
  whocontrol:=(whocontrol mod 2)+1;
end;function TForm1.hasWin(x, y: integer): integer;
var
  i,j:integer;
begin
  result:=0;
  for i:=x-4 to x+4 do
    for j:=y-4 to y+4 do
    begin
      if(i>0)and(i<12)and(loc[i,y]<>0)and(loc[i,y]=loc[i+1,y])
        and(loc[i,y]=loc[i+2,y])and(loc[i,y]=loc[i+3,y])
        and(loc[i,y]=loc[i+4,y])then
      begin
        result:=whocontrol;
        exit;
      end;
      ///////////////////////////
      if(j>0)and(j<12)and(not(loc[x,j]=0))and(loc[x,j]=loc[x,j+1])
        and(loc[x,j]=loc[x,j+2])and(loc[x,j]=loc[x,j+3])
        and(loc[x,j]=loc[x,j+4])then
      begin
        result:=whocontrol;
        exit;
      end;
      ////////////////////////////
      if(i>0)and(j>0)and(i<12)and(j<12)and(loc[i,j]<>0)
        and(loc[i,j]=loc[i+1,j+1])and(loc[i,j]=loc[i+2,j+2])
        and(loc[i,j]=loc[i+3,j+3])and(loc[i,j]=loc[i+4,j+4])then
      begin
        result:=whocontrol;
        exit;
      end;
      /////////////////////////////
      if(i>=5)and(j<12)and(i<16)and(j>0)and(loc[i,j]<>0)and
        (loc[i,j]=loc[i-1,j+1])and(loc[i,j]=loc[i-2,j+2])and
        (loc[i,j]=loc[i-3,j+3])and(loc[i,j]=loc[i-4,j+4])then
      begin
        result:=whocontrol;
        exit;
      end;
    end;
  ////////////////////////
  if threecount(x,y)=2 then
    result:=(whocontrol mod 2)+1;
end;function TForm1.threecount(x, y: integer): integer;
begin
  //////////////////////////三三未做
  result:=0;
end;end.