做了一个有AI的五子棋

2009 十月 4
tags:
by Luin

闲着没事弄了个五子棋程序，还是用delphi开发的。人工智能只用了1个小时做的，所以比较那啥~

五子棋

五子棋

下载地址：Five2.zip(内容已更新，请到文章末尾重新下载)
右边的调试台是输出电脑的思维的。
现在的AI还没有优化，优化后的落子速度将是瞬时的。

制作步骤(delphi2009)
一、素材
素材包括棋盘和棋子，棋盘可以在网上找也可以自己画-_-!,我直接用的网上的素材。棋子是我自己画的，类似下面设置混合效果即可：

棋子的画法

棋子的画法

二、代码
全局用Timer控件控制电脑下棋：

Procedure TForm1.Timer1Timer(Sender: TObject);
Var
  ix, iy: integer;
Begin
  Timer1.Enabled:=False;
  Timer2.Enabled:=False;
  If FullMap Then
  Begin
    Flag2;
    Exit;
  End;
  if not GetComXY(True,ix,iy) then ;
  AddButton(ix, iy, NowBlack);
  Timer2.Enabled:=true;
End;
 
Procedure TForm1.Timer2Timer(Sender: TObject);
Begin
  Timer1.Enabled:=NowCom;
End;

主程序如下：

Type
  TForm1=Class(TForm)
    Image2: TImage;
    Pnl: TPanel;
    Image1: TImage;
    Timer1: TTimer;
    Timer2: TTimer;
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    Procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    Procedure FormCreate(Sender: TObject);
    Procedure N1Click(Sender: TObject);
    Procedure N2Click(Sender: TObject);
    Procedure Timer1Timer(Sender: TObject);
    Procedure Timer2Timer(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  Private
    { Private declarations }
    NowBlack: boolean; //当前该白棋走
    NowCom: boolean; //当前该电脑走
    //人执黑棋： not(NowBlack xor NowCom)
    BFlag: byte; //棋局标志，0：尚未开始,1：第一阶段，2：第二阶段
    BComWin: boolean; //电脑赢(第一阶段末)
    Procedure Init; //初始化(地图等)
    Function WinCount: Integer; //如果是正数则是电脑赢
    Function FullMap: boolean; //棋盘已经满了
    Function IsEmpty(X, Y: byte): boolean; //判断当前位置是否有棋子
    Function IsWin(X, Y: byte): boolean; //判断当前位置是否有棋子
    Procedure AddButton(X, Y: byte; BButton: boolean{True:Black}); //放棋子
    Procedure DelButton(X, Y: byte); //移除棋子
    Procedure PressXY(X, Y: integer); //判断X,Y属于棋盘的哪个点
    Procedure Flag2; //进入阶段2
  Public
    { Public declarations }
  End;
 
Var
  Form1: TForm1;
  Map: Array[0..14, 0..14] Of byte;//棋盘：0:白，1：黑, 2:空
Implementation
Uses AI, mmsystem;
Var
  QiZi: TImage;
  SMulu: String;
{$R *.dfm}
  { TForm1 }
Procedure TForm1.AddButton(X, Y: byte; BButton: boolean);
Begin
  QiZi:=TImage.Create(Pnl);
  With QiZi Do
  Begin
    Name:='Img_Btn_'+IntToStr(X)+'_'+IntToStr(Y);
    Parent:=Pnl;
    Cursor:=crDefault;
    Left:=5+35*X;
    top:=5+35*Y;
    Transparent:=True;
    AutoSize:=True;
    If BButton Then
      Picture.LoadFromFile(SMulu+'pic\black.bmp')
    Else
      Picture.LoadFromFile(SMulu+'pic\white.bmp')
  End;
  Map[X, Y]:=Integer(BButton); //修改地图文件
  NowBlack:=Not NowBlack; //修改该黑或白的标志
  NowCom:=Not NowCom; //修改该谁走棋的标志
  If FileExists(SMulu+'res\at.wav') Then //播放走棋的声音
    PlaySound(pchar(SMulu+'res\at.wav'), 0, snd_Async);
  if IsWin(X,Y) then showmessage('Win');
 
End;
 
Procedure TForm1.DelButton(X, Y: byte);
Var
  ic: tComponent;
Begin
  ic:=Pnl.FindComponent('Img_Btn_'+IntToStr(X)+'_'+IntToStr(Y));
  If ic<>Nil Then
  Begin
    ic.Free;
    Map[X, Y]:=2;
  End;
End;
 
Procedure TForm1.PressXY(X, Y: integer);
Var
  ix, iy, i: byte;
  j:integer;
Begin
  ix:=15;
  iy:=15;
  j:=0;
  For i:=0 To 14 Do
  Begin
    If (X>(5 + j))And(X<(40 + j)) Then
      ix:=i;
    If (Y>(5 + j))And(Y<(40 + j)) Then
      iy:=i;
    if (ix<>15)and(iy<>15) then break;
    inc(j,35);
  End;
  If (ix = 15)Or(iy = 15) Then Exit;
  If not IsEmpty(ix,iy) Then
  begin
    beep;//TODO:不能走棋
    exit;
  end;
 
  AddButton(ix, iy, NowBlack);
End;
Procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: integer);
Begin
  If (BFlag=1)And(Not(NowCom)) Then
    PressXY(X, Y);
End;
 
procedure TForm1.Init;
var
  i: Integer;
  j: Integer;
begin
  for i := 0 to 14 do
    for j := 0 to 14 do
      Map[i][j] := 2;
end;
 
Procedure TForm1.FormCreate(Sender: TObject);
Begin
  SMulu:=ExtractFilePath(Application.ExeName);
  BFlag:=0; //比赛未开始；
  Init;
  BFlag:=1;
  NowBlack:=True;
  NowCom:=True;
End;
 
Function TForm1.IsEmpty(X, Y: byte): boolean;
Begin
  result:= (Map[X, Y] = 2);
End;
 
function TForm1.IsWin(X, Y: byte): boolean;
var CurrentChessman,i,j,n:byte;
begin
  result:=false;
  CurrentChessman := Map[X][Y];
  //横向
  n:=1;
  i:=X-1;
  while(i>=0)and(Map[i][Y]=CurrentChessman) do
  begin
    inc(n);
    dec(i);
  end;
  i:=X+1;
  while(i<=15)and(Map[i][Y]=CurrentChessman) do
  begin
    inc(n);
    inc(i);
  end;
  if n>=5 then exit(true);
  //纵向
  n:=1;
  j:=Y-1;
  while(j>=0)and(Map[X][j]=CurrentChessman) do
  begin
    inc(n);
    dec(j);
  end;
  j:=Y+1;
  while(j<=15)and(Map[X][j]=CurrentChessman) do
  begin
    inc(n);
    inc(j);
  end;
  if n>=5 then exit(true);
  //正斜向
  n:=1;
  i:=X-1;
  j:=Y-1;
  while(i>=0)and(j>=0)and(Map[i][j]=CurrentChessman) do
  begin
    inc(n);
    dec(i);
    dec(j);
  end;
  i:=X+1;
  j:=Y+1;
  while(i<=15)and(j<=15)and(Map[i][j]=CurrentChessman) do
  begin
    inc(n);
    inc(i);
    inc(j);
  end;
  if n>=5 then exit(true);
  //反斜向
  n:=1;
  i:=X-1;
  j:=Y+1;
  while(i>=0)and(j<=15)and(Map[i][j]=CurrentChessman) do
  begin
    inc(n);
    dec(i);
    inc(j);
  end;
  i:=X+1;
  j:=Y-1;
  while(i<=15)and(j>=0)and(Map[i][j]=CurrentChessman) do
  begin
    inc(n);
    inc(i);
    dec(j);
  end;
  if n>=5 then exit(true);
end;
 
Procedure TForm1.N1Click(Sender: TObject);
Begin
  BFlag:=1;
  NowBlack:=True;
  NowCom:=False;
End;
 
Procedure TForm1.N2Click(Sender: TObject);
Begin
  BFlag:=1;
  NowBlack:=True;
  NowCom:=True;
End;
 
Procedure TForm1.Timer1Timer(Sender: TObject);
Var
  ix, iy: integer;
Begin
  Timer1.Enabled:=False;
  Timer2.Enabled:=False;
  If FullMap Then
  Begin
    Flag2;
    Exit;
  End;
  if not GetComXY(True,ix,iy) then ;
  AddButton(ix, iy, NowBlack);
  Timer2.Enabled:=true;
End;
 
Procedure TForm1.Timer2Timer(Sender: TObject);
Begin
  Timer1.Enabled:=NowCom;
End;
 
Function TForm1.FullMap: boolean;
Var
  X, Y: byte;
Begin
  result:=True;
  For X:=0 To 14 Do
    For Y:=0 To 14 Do
      If Map[X, Y]=2 Then
      Begin
        result:=False;
        Exit;
      End;
End;
 
Procedure TForm1.Flag2;
Begin
  BFlag:=2;
  //TODO:计算被罚数目
  //提示用户
End;
 
Function TForm1.WinCount: Integer;
Begin
End;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(IntToStr(WinCount));
end;
 
procedure TForm1.Button2Click(Sender: TObject);
 var ix, iy: integer;
begin
  if not GetComXY(True,ix,iy) then ;
  AddButton(ix, iy, NowBlack);
end;

三、AI
AI总得来说很简单，只有假设棋子已经落下，然后搜索计算得分即可
当然这个AI相当简单，输的几率也很大，但是基本思想即是如此。更多可以参考更加强大的AI算法~
10月7日更新
主要重写了AI，代码如下：

Unit AI;
 
Interface
{
0
1单1
2双1
3单2
4双2
5单3
6双3
7单4
8双4
9单5
10双5
 
}
type
  TAi = class
    //AI是否扮演黑棋
    isBlack:Boolean;
  Private
    //是否在计算自己的得分
    bSelf : Boolean;
    //当前正在计算的位置
    curX,curY:Byte;
    //当前相同的棋子数
    TongNum:Integer;
    //当前棋子左右空余数目
    nLeft,nRight:byte;
    //初始化计算，数值清空
    procedure initCul;
    //判断横向
    function CM2H : integer;
    function CM2H_info : integer;
    //判断纵向
    function CM2V : integer;
    function CM2V_info : integer;
    //判断正斜向
    function CM2X : integer;
    function CM2X_info : integer;
    //判断反斜向
    function CM2X2 : integer;
    function CM2X2_info : integer;
    //分析类型
    Function N2ChessType(n:byte): Byte;
    //获得评分
    function GetMark(chessType:Byte):integer;
  Public
    //下棋，返回false表明无法选择位置
    function Play(var toX,toY:Byte): Boolean;
end;
 
 
 
Implementation
Uses Windows,SysUtils,Main;
 
{ TAi }
 
function TAi.CM2H: integer;
var i:integer;
begin
  result:=1;
  i:=curX-1;
  while(i>=0)and(Map[i][curY]=Map[curX][curY]) do
  begin
    inc(result);
    dec(i);
  end;
  i:=curX+1;
  while(i<=14)and(Map[i][curY]=Map[curX][curY]) do
  begin
    inc(result);
    inc(i);
  end;
end;
 
function TAi.CM2H_info: integer;
var i:Integer; n:Byte;
begin
  initCul;
  //第一轮
  i:=curX-1;
  while(i>=0)and((Map[i][curY]=Map[curX][curY])or(Map[i][curY]=2)) do
  begin
    if Map[i][curY]=Map[curX][curY] then inc(TongNum);
    inc(nLeft);
    dec(i);
  end;
  //第二轮
  i:=curX+1;
  while(i<=14)and((Map[i][curY]=Map[curX][curY])or(Map[i][curY]=2)) do
  begin
    if Map[i][curY]=Map[curX][curY] then inc(TongNum);
    inc(nRight);
    inc(i);
  end;
 
  if nLeft+nRight<4 then Exit(0);
 
  //分析
  n:=CM2H;
  dec(TongNum,n-1);
  result:=N2ChessType(n);
end;
 
function TAi.CM2V: integer;
var j:integer;
begin
  result:=1;
  j:=curY-1;
  while(j>=0)and(Map[curX][j]=Map[curX][curY]) do
  begin
    inc(result);
    dec(j);
  end;
  j:=curY+1;
  while(j<=14)and(Map[curX][j]=Map[curX][curY]) do
  begin
    inc(result);
    inc(j);
  end;
end;
 
function TAi.CM2V_info: integer;
var j:Integer; n:Byte;
begin
  initCul;
  //第一轮
  j:=curY-1;
  while(j>=0)and((Map[curX][j]=Map[curX][curY])or(Map[curX][j]=2)) do
  begin
    if Map[curX][j]=Map[curX][curY] then inc(TongNum);
    inc(nLeft);
    dec(j);
  end;
  //第二轮
  j:=curY+1;
  while(j<=14)and((Map[curX][j]=Map[curX][curY])or(Map[curX][j]=2)) do
  begin
    if Map[curX][j]=Map[curX][curY] then inc(TongNum);
    inc(nRight);
    inc(j);
  end;
 
  if nLeft+nRight<4 then Exit(0);
 
  //分析
  n:=CM2V;
  dec(TongNum,n-1);
  result:=N2ChessType(n);
end;
 
function TAi.CM2X: integer;
var i,j:integer;
begin
  result:=1;
  i:=curX-1;
  j:=curY-1;
  while(i>=0)and(j>=0)and(Map[i][j]=Map[curX][curY]) do
  begin
    Inc(result);
    Dec(i);
    Dec(j);
  end;
  i:=curX+1;
  j:=curY+1;
  while(i<=14)and(j<=14)and(Map[i][j]=Map[curX][curY]) do
  begin
    Inc(result);
    Inc(i);
    Inc(j);
  end;
end;
 
function TAi.CM2X2: integer;
var i,j:integer;
begin
  result:=1;
  i:=curX-1;
  j:=curY+1;
  while(i>=0)and(j<=14)and(Map[i][j]=Map[curX][curY]) do
  begin
    Inc(result);
    Dec(i);
    Inc(j);
  end;
  i:=curX+1;
  j:=curY-1;
  while(i<=14)and(j>=0)and(Map[i][j]=Map[curX][curY]) do
  begin
    Inc(result);
    Inc(i);
    Dec(j);
  end;
end;
 
function TAi.CM2X2_info: integer;
var i,j:Integer; n:Byte;
begin
  initCul;
  //第一轮
  i:=curX-1;
  j:=curY+1;
  while(i>=0)and(j<=14)and((Map[i][j]=Map[curX][curY])or(Map[i][j]=2)) do
  begin
    if Map[i][j]=Map[curX][curY] then inc(TongNum);
    Inc(nLeft);
    Dec(i);
    Inc(j);
  end;
  //第二轮
  i:=curX+1;
  j:=curY-1;
  while(i<=14)and(j>=0)and((Map[i][j]=Map[curX][curY])or(Map[i][j]=2)) do
  begin
    if Map[i][j]=Map[curX][curY] then inc(TongNum);
    Inc(nRight);
    Inc(i);
    Dec(j);
  end;
 
  if nLeft+nRight<4 then Exit(0);
 
  //分析
  n:=CM2X2;
  dec(TongNum,n-1);
  result:=N2ChessType(n);
end;
 
function TAi.CM2X_info: integer;
var i,j:Integer; n:Byte;
begin
  initCul;
  //第一轮
  i:=curX-1;
  j:=curY-1;
  while(i>=0)and(j>=0)and((Map[i][j]=Map[curX][curY])or(Map[i][j]=2)) do
  begin
    if Map[i][j]=Map[curX][curY] then inc(TongNum);
    inc(nLeft);
    Dec(i);
    dec(j);
  end;
  //第二轮
  i:=curX+1;
  j:=curY+1;
  while(i<=14)and(j<=14)and((Map[i][j]=Map[curX][curY])or(Map[i][j]=2)) do
  begin
    if Map[i][j]=Map[curX][curY] then inc(TongNum);
    inc(nRight);
    Inc(i);
    inc(j);
  end;
 
  if nLeft+nRight<4 then Exit(0);
 
  //分析
  n:=CM2X;
  dec(TongNum,n-1);
  result:=N2ChessType(n);
end;
 
function TAi.GetMark(chessType: Byte): integer;
begin
  case chessType of
  0:Exit(0);
  1:Exit(0);
  2:Exit(5);
  3:Exit(11);
  4:Exit(31);
  5:Exit(21);
  6:Exit(910);
  7:Exit(41);
  8:Exit(11000);
  9:Exit(110000);
  10:Exit(110000);
  13:Exit(0);
  14:Exit(5);
  15:Exit(10);
  16:Exit(30);
  17:Exit(20);
  18:Exit(900);
  19:Exit(40);
  20:Exit(10000);
  21:Exit(100000);
  22:Exit(100000);
  end;
end;
 
procedure TAi.initCul;
begin
  TongNum:=0;
  nLeft:=0;
  nRight:=0;
end;
 
function TAi.N2ChessType(n:Byte): Byte;
var bsc,h:Byte;
begin
  h:=0;
  if nLeft>0 then Inc(h);
  if nRight>0 then Inc(h);
  if bSelf then bsc:=0 else bsc:=12;
 
  if h = 0 then Exit(0);
  case n of
    1:
    begin
      if h=1 then Exit(bsc+1)
      else Exit(bsc+2);
    end;
    2:
    begin
      if h=1 then Exit(bsc+3)
      else Exit(bsc+4);
    end;
    3:
    begin
      if h=1 then Exit(bsc+5)
      else Exit(bsc+6);
    end;
    4:
    begin
      if h=1 then Exit(bsc+7)
      else Exit(bsc+8);
    end;
    else
    begin
      if h=1 then Exit(bsc+9)
      else Exit(bsc+10);
    end;
  end;
end;
 
function TAi.Play(var toX, toY: Byte): Boolean;
Var
  mark,maxMark:integer;
  i,j: integer;
  mx,my:integer;
Begin
   maxMark:=0;
   form1.Memo1.Clear;
   for i := 0 to 14 do
   begin
    for j := 0 to 14 do
    begin
      if (i=7)and(j=7) then
      TongNum:=0;
      if Map[i][j]=2 then
      begin
        curX:=i;
        curY:=j;
        mark:=0;
        Map[i][j]:=Ord(isBlack);
        bSelf:=True;
        //form1.Memo1.Lines.Add('-------------');
        //form1.Memo1.Lines.Add('loc：x:'+inttostr(i)+',y:'+inttostr(j));
        Inc(mark,nLeft*nRight+1000*TongNum+10000*GetMark(CM2H_info));
        if TongNum>0 then
        TongNum:=0;
 
        Inc(mark,nLeft*nRight+1000*TongNum+10000*GetMark(CM2V_info));
        Inc(mark,nLeft*nRight+1000*TongNum+10000*GetMark(CM2X_info));
        Inc(mark,nLeft*nRight+1000*TongNum+10000*GetMark(CM2X2_info));
        {form1.Memo1.Lines.Add('f1：'+inttostr(GetMark(CM2H_info))
          +inttostr(GetMark(CM2V_info))+inttostr(GetMark(CM2X_info))+
          inttostr(GetMark(CM2X2_info)));  }
        Map[i][j]:=Ord(not isBlack);
        bSelf:=False;
        Inc(mark,nLeft*nRight+1000*TongNum+10000*GetMark(CM2H_info));
        Inc(mark,nLeft*nRight+1000*TongNum+10000*GetMark(CM2V_info));
        Inc(mark,nLeft*nRight+1000*TongNum+10000*GetMark(CM2X_info));
        Inc(mark,nLeft*nRight+1000*TongNum+10000*GetMark(CM2X2_info));
        {form1.Memo1.Lines.Add('f2：'+inttostr(GetMark(CM2H_info))
          +inttostr(GetMark(CM2V_info))+inttostr(GetMark(CM2X_info))+
          inttostr(GetMark(CM2X2_info)));  }
        Map[i][j]:=2;
        if mark>maxMark then
        begin
          maxMark:=mark;
          mx:=i;
          my:=j;
        end
        else if mark=maxMark then  form1.Memo1.Lines.Add('s');
 
      end;
    end;
   end;
   toX:=mx;
   toY:=my;
End;
 
End.

点此下载五子棋程序及源代码(Delphi 2009)

相关日志

from → Borland Delphi

5 Responses leave one →
  1. Gip0 permalink
    十一月 2, 2009

    来个记忆化搜索,多往后判断几步~~

    回复
    • Luin permalink*
      十一月 2, 2009

      那样太麻烦了吼吼我好懒。。

      回复
  2. TOM permalink
    十一月 15, 2009

    强!

    回复
  3. 打酱油的 permalink
    十二月 25, 2009

    。。。太强悍了。。。。

    回复
    • Luin permalink*
      一月 19, 2010

      呵呵还好吧，其实代码挺乱的

      回复

Leave a Reply

Note: You can use basic XHTML in your comments. Your email address will never be published.

Subscribe to this comment feed via RSS