谁有五子棋(人跟电脑对弈)的代码?或者在这里探讨一下,怎样模拟电脑下棋!
急需!

解决方案 »

  1.   


                                                                    
                                                                    
                                                                    
                                                                    
        gzgzgzgz        gzgzgzgz        gzgzgzgzgzgzgzgzgzgz        
        gzgzgz            gzgz            gzgzgz        gzgzgz      
        gzgzgz            gzgz            gzgzgz        gzgzgzgz    
        gzgzgz            gzgz            gzgzgz          gzgzgz    
        gzgzgz            gzgz            gzgzgz          gzgzgz    
        gzgzgz            gzgz            gzgzgz          gzgzgz    
        gzgzgz            gzgz            gzgzgz          gzgzgz    
        gzgzgz            gzgz            gzgzgz        gzgzgz      
        gzgzgz            gzgz            gzgzgz      gzgzgzgz      
        gzgzgz            gzgz            gzgzgzgzgzgzgzgzgz        
        gzgzgz            gzgz            gzgzgz                    
        gzgzgz            gzgz            gzgzgz                    
        gzgzgz            gzgz            gzgzgz                    
          gzgz            gzgz            gzgzgz                    
          gzgzgz        gzgz              gzgzgz                    
          gzgzgz        gzgz              gzgzgz                    
          gzgzgz        gzgz              gzgzgz                    
            gzgzgz    gzgz                gzgzgz                    
              gzgzgzgzgzgz            gzgzgzgzgzgzgz                
                                                                    
                                                                    
                                                                    
                                                                    
                                                                    
      

  2.   

    我有一个,不过棋力不高,我还想做好一点,如果有兴趣,我们可以一起探讨  [email protected]
    unit Unit_Computer;interface
    uses math;
    const n=17;type
      TChess=Array[-1..n+1,-1..n+1] of Integer;
      TTable=Array[0..n,0..n] of integer;
    var
      Table :TTable;function IsWin(x,y:integer;chess:TChess):boolean;
    procedure FillTable(color:integer;Chess:TChess);   // color 1:black  2 white
    procedure FillTableRow(color:integer;Chess:TChess);
    procedure FillTableCol(color:integer;Chess:TChess);
    procedure FillTableLeft(color:integer;Chess:TChess);  //判断左斜线上棋型
    procedure FillTableRight(color:integer;Chess:TChess);  //判断右斜线上棋型
    procedure Fill(x,y,color,value,zero:integer);
    procedure Computer_Chess(var x,y:integer;chess:TChess);implementationprocedure FillTable(color:integer;Chess:TChess);
    begin
      FillTableRow(color,chess);
      FillTableCol(color,chess);
      FillTableLeft(color,chess);
      FillTableRight(color,chess);
    end;procedure FillTableRow(color:integer;chess:TChess);
    var
      i,j,k:integer;
      value,zero:integer;
    begin
      for i:= 0 to n do
        for j:= 0 to n do
        begin
          if Chess[i,j] = 0 then
          begin
            value := 0; zero := 0;
            k := i - 1;
            while (k >= 0) and (chess[k,j] = color) do
            begin
              value := value + 1;
              k := k - 1;
            end;
            if  chess[k,j] = 0 then zero := zero + 1;         k := i + 1;
             while (k <= n ) and (chess[k,j] = color) do
             begin
               value := value + 1;
               k := k + 1;
             end;
             if  chess[k,j] = 0 then zero := zero + 1;         fill(i,j,color,value,zero);
          end else
          Table[i,j] := -1;
        end;
    end;procedure FillTableCol(color:integer;chess:TChess);
    var
      i,j,k:integer;
      value,zero:integer;
    begin
      for i:= 0 to n do
        for j:= 0 to n do
        begin
          if Chess[i,j] = 0 then
          begin
            value := 0; zero := 0;
            k := j - 1;
            while (k >= 0) and (chess[i,k] = color) do
            begin
              value := value + 1;
              k := k - 1;
            end;
            if  chess[i,k]=0 then zero := zero + 1;         k := j + 1;
             while (k <= n ) and (chess[i,k] = color) do
             begin
               value := value + 1;
               k := k + 1;
             end;
             if  chess[i,k] = 0 then zero := zero + 1;
             fill(i,j,color,value,zero);
          end else
          Table[i,j] := -1;
        end;
    end;procedure FillTableLeft(color:integer;chess:TChess);
    var
      i,j,k,l:integer;
      value,zero:integer;
    begin
      for i:=0 to n do
        for j:=0 to n do
        begin
          if chess[i,j] = 0 then
          begin
             k := i-1; l:=j-1;
             value := 0;zero := 0;
             while (k>=0) and (l>=0) and (chess[k,l]=color) do
             begin
               value := value + 1;
               k := k -1; l:= l-1;
             end;
             if  chess[k,l] = 0 then zero := zero + 1;         k := i+1; l:=j+1;
             while (k<=n) and (l<=n) and (chess[k,l]=color) do
             begin
               value := value + 1;
               k:= k+1; l:=l+1;
             end;
             if chess[k,l] =0 then zero := zero + 1;
             fill(i,j,color,value,zero);
          end else
            table[i,j] := -1;
        end;
    end;procedure FillTableRight(color:Integer;Chess:TChess);
    var
      i,j,k,l:integer;
      value,zero:integer;
    begin
      for i:=0 to n do
        for j:=0 to n do
        begin
          if chess[i,j] = 0 then
          begin
             k := i+1; l:=j-1;
             value := 0;zero := 0;
             while (k<=n) and (l>=0) and (chess[k,l]=color) do
             begin
               value := value + 1;
               k := k +1; l:= l-1;
             end;
             if  chess[k,l] = 0 then zero := zero + 1;         k := i-1; l:=j+1;
             while (k>=0) and (l<=n) and (chess[k,l]=color) do
             begin
               value := value + 1;
               k:= k-1; l:=l+1;
             end;
             if chess[k,l] =0 then zero := zero + 1;
             fill(i,j,color,value,zero);
          end else
            table[i,j] := -1;
        end;
    end;procedure Fill(x,y,color,value,zero:integer);
    begin
      case value of
      0:case zero of
          0:table[x,y] := table[x,y] + 1;
          1:table[x,y] := table[x,y] + 2;
          2:table[x,y] := table[x,y] + 3;
        end;
      1:case zero of
          0:table[x,y] := table[x,y] + 1;
          1:table[x,y] := table[x,y] + 5;
          2:table[x,y] := table[x,y] + 6;
        end;
      2:case zero of
          0:table[x,y] := table[x,y] + 1;
          1:table[x,y] := table[x,y] + 8;
          2:table[x,y] := table[x,y] + 50;   //活三
        end;
      3:case zero of
          0:table[x,y] := table[x,y] + 1;
          1:table[x,y] := table[x,y] + 50;   //冲四
          2:table[x,y] := table[x,y] +150;
        end;
      4:case zero of
          0:table[x,y] := table[x,y] + 1;
          1:table[x,y] := table[x,y] + 500;
          2:table[x,y] := table[x,y] + 500;
        end;
      end;
    end;procedure computer_chess(var x,y:integer;chess:TChess);
    var
      i,j,k:integer;
      max_Value:integer;
    begin
      for i:=0 to n do
        for j:=0 to n do
            table[i,j]:=0;
      FillTable(1,chess);
      FillTable(2,chess);  max_Value := 0;
      for i:=0 to n do
        for j:= 0 to n do
          begin
            if Max_Value <= table[i,j] then
            begin
              if (max_value < table[i,j]) or (RandomRange(1,100)<50) then
              begin
                x:=i;y:=j;Max_Value := table[i,j];
              end;
            end;
          end;
    end;function IsWin(x,y:integer;chess:TChess):boolean;
    var
      i,j:integer;
      color:integer;
      count:integer;
      winner:boolean;
    begin
      winner:=False;
      color := Chess[x,y];
      count := 1;
      if x > 0 then                     //判断同一行上是否成5子
        for i:=x-1 downto 0 do
        begin
          if chess[i,y]<> color then break
          else count := count + 1;
        end;
      if x < n then
      for i:= x + 1 to n do
      begin
        if chess[i,y] <> color then break
        else count := count + 1;
      end;
      if count >= 5 then winner := True; // ----------------------------------------------------
      count := 1;             //判断同一列上是否成5子
      if (y > 0) and (not winner) then
      for j := y-1 downto 0 do
      begin
        if chess[x,j] <> color then break
        else count := count + 1;
      end;
      if (y < n) and (not winner) then
      for j:= y + 1  to n do
      begin
        if chess[x,j] <> color then break
        else count := count + 1;
      end;
      if count >= 5 then winner := True;//--------------------------------------------------------  count := 1;              //判断左上对角线上是否成5子
      i := x; j := y;
      while (count < 5) and ((i-1)  > 0) and ((j-1) > 0) do
      begin
        i:= i-1 ;j:= j-1;
        if chess[i,j] <> color then break
        else count := count+1;
      end;  i:=x;j:= y;
      while (count < 5) and ((i+1)<n) and ((j+1) < n) do
      begin
        i := i+1; j:= j+1;
        if chess[i,j] <> color then break
        else count := count + 1;
      end;
      if count >=5 then winner := true;//-----------------------------------------------------
      count := 1 ;               //判断右上对角线上是否成5子
      i := x;j :=y ;
      while (count < 5) and ((i+1) < n) and ((j-1)>0 )  do
      begin
        i := i+1; j:= j-1;
        if chess[i,j] <> color then break
        else count := count + 1;
      end;  i := x; j:= y;
      while (count <5) and ((i-1) > 0) and ((j+1)< n) do
      begin
        i:= i-1;j:=j+1;
        if chess[i,j] <> color then break
        else count := count + 1;
      end;
      if count >=5 then winner := true;  iswin := winner;
    end;end.
      

  3.   

    这段代码并不是单单的判断输赢,其中的一大段都是模拟电脑下棋的unit Unit_Computer;interface
    uses math;
    const n=17;type
      TChess=Array[-1..n+1,-1..n+1] of Integer;
      TTable=Array[0..n,0..n] of integer;
    var
      Table :TTable;function IsWin(x,y:integer;chess:TChess):boolean;
    procedure FillTable(color:integer;Chess:TChess);   // color 1:black  2 white
    procedure FillTableRow(color:integer;Chess:TChess);
    procedure FillTableCol(color:integer;Chess:TChess);
    procedure FillTableLeft(color:integer;Chess:TChess);  //判断左斜线上棋型
    procedure FillTableRight(color:integer;Chess:TChess);  //判断右斜线上棋型
    procedure Fill(x,y,color,value,zero:integer);
    procedure Computer_Chess(var x,y:integer;chess:TChess);implementation//判断局面形势
    procedure FillTable(color:integer;Chess:TChess);
    begin
      FillTableRow(color,chess);
      FillTableCol(color,chess);
      FillTableLeft(color,chess);
      FillTableRight(color,chess);
    end;//判断行形势
    procedure FillTableRow(color:integer;chess:TChess);
    var
      i,j,k:integer;
      value,zero:integer;
    begin
      for i:= 0 to n do
        for j:= 0 to n do
        begin
          if Chess[i,j] = 0 then
          begin
            value := 0; zero := 0;
            k := i - 1;
            while (k >= 0) and (chess[k,j] = color) do
            begin
              value := value + 1;
              k := k - 1;
            end;
            if  chess[k,j] = 0 then zero := zero + 1;         k := i + 1;
             while (k <= n ) and (chess[k,j] = color) do
             begin
               value := value + 1;
               k := k + 1;
             end;
             if  chess[k,j] = 0 then zero := zero + 1;         fill(i,j,color,value,zero);
          end else
          Table[i,j] := -1;
        end;
    end;//判断列形势
    procedure FillTableCol(color:integer;chess:TChess);
    var
      i,j,k:integer;
      value,zero:integer;
    begin
      for i:= 0 to n do
        for j:= 0 to n do
        begin
          if Chess[i,j] = 0 then
          begin
            value := 0; zero := 0;
            k := j - 1;
            while (k >= 0) and (chess[i,k] = color) do
            begin
              value := value + 1;
              k := k - 1;
            end;
            if  chess[i,k]=0 then zero := zero + 1;         k := j + 1;
             while (k <= n ) and (chess[i,k] = color) do
             begin
               value := value + 1;
               k := k + 1;
             end;
             if  chess[i,k] = 0 then zero := zero + 1;
             fill(i,j,color,value,zero);
          end else
          Table[i,j] := -1;
        end;
    end;//判断正对角线形势
    procedure FillTableLeft(color:integer;chess:TChess);
    var
      i,j,k,l:integer;
      value,zero:integer;
    begin
      for i:=0 to n do
        for j:=0 to n do
        begin
          if chess[i,j] = 0 then
          begin
             k := i-1; l:=j-1;
             value := 0;zero := 0;
             while (k>=0) and (l>=0) and (chess[k,l]=color) do
             begin
               value := value + 1;
               k := k -1; l:= l-1;
             end;
             if  chess[k,l] = 0 then zero := zero + 1;         k := i+1; l:=j+1;
             while (k<=n) and (l<=n) and (chess[k,l]=color) do
             begin
               value := value + 1;
               k:= k+1; l:=l+1;
             end;
             if chess[k,l] =0 then zero := zero + 1;
             fill(i,j,color,value,zero);
          end else
            table[i,j] := -1;
        end;
    end;//判断反对角线形势
    procedure FillTableRight(color:Integer;Chess:TChess);
    var
      i,j,k,l:integer;
      value,zero:integer;
    begin
      for i:=0 to n do
        for j:=0 to n do
        begin
          if chess[i,j] = 0 then
          begin
             k := i+1; l:=j-1;
             value := 0;zero := 0;
             while (k<=n) and (l>=0) and (chess[k,l]=color) do
             begin
               value := value + 1;
               k := k +1; l:= l-1;
             end;
             if  chess[k,l] = 0 then zero := zero + 1;         k := i-1; l:=j+1;
             while (k>=0) and (l<=n) and (chess[k,l]=color) do
             begin
               value := value + 1;
               k:= k-1; l:=l+1;
             end;
             if chess[k,l] =0 then zero := zero + 1;
             fill(i,j,color,value,zero);
          end else
            table[i,j] := -1;
        end;
    end;//填充局面形势表
    procedure Fill(x,y,color,value,zero:integer);
    begin
      case value of
      0:case zero of
          0:table[x,y] := table[x,y] + 1;
          1:table[x,y] := table[x,y] + 2;
          2:table[x,y] := table[x,y] + 3;
        end;
      1:case zero of
          0:table[x,y] := table[x,y] + 1;
          1:table[x,y] := table[x,y] + 5;
          2:table[x,y] := table[x,y] + 6;
        end;
      2:case zero of
          0:table[x,y] := table[x,y] + 1;
          1:table[x,y] := table[x,y] + 8;
          2:table[x,y] := table[x,y] + 50;   //活三
        end;
      3:case zero of
          0:table[x,y] := table[x,y] + 1;
          1:table[x,y] := table[x,y] + 50;   //冲四
          2:table[x,y] := table[x,y] +150;
        end;
      4:case zero of
          0:table[x,y] := table[x,y] + 1;
          1:table[x,y] := table[x,y] + 500;
          2:table[x,y] := table[x,y] + 500;
        end;
      end;
    end;
    //模拟电脑落子
    procedure computer_chess(var x,y:integer;chess:TChess);
    var
      i,j,k:integer;
      max_Value:integer;
    begin
      for i:=0 to n do
        for j:=0 to n do
            table[i,j]:=0;
      FillTable(1,chess);
      FillTable(2,chess);  max_Value := 0;
      for i:=0 to n do
        for j:= 0 to n do
          begin
            if Max_Value <= table[i,j] then
            begin
              if (max_value < table[i,j]) or (RandomRange(1,100)<50) then
              begin
                x:=i;y:=j;Max_Value := table[i,j];
              end;
            end;
          end;
    end;
      

  4.   

    www.smiling.com.cn
    上有一个五子棋论坛,上面有很多源码
      

  5.   

    我这里有一个 BCB  版的 全部代码  要的话给你消息
    没有D  的
      

  6.   

    我自己写了一个五子棋,算法一般般,主要用递归实现的,画面用DelphiX写的,可惜本人的艺术水平太差,技术也不是太到家,加上时间仓促,仅仅只写了人机对弃的程序,连存盘和网络模式还没写!
    谁要得我可以发给他!
      

  7.   

    我要! [email protected]  //万分感谢
      

  8.   

    MMBBBBBB333333333333333333333333@@@@@@@@@@@@@@AAAA33333333BBBB..
    BBBB3333333333333333333333333333@@@@@@@@MM@@@@@@AAAA33333333BB..
    MM@@3333333333333333333333333333AA@@@@AAMMBB@@@@AA@@@@333333@@..
    AA33333333333333@@333333333333AABB@@@@AABBMMAA@@AAAAAA33333333..
    3333333333333333MM333333333333MMBB@@@@AABBBBMM@@BBBBAA33333333..
    333333BB333333MMMM3333333333AAMMBBAA@@BB33BBMM@@@@BBBB@@333333..
    333333BB333333BBAA3333333333BBBB33BB@@BB33BBMM@@BBAAMMAA333333..
    3333MMBB333333BBBB33333333BBBBBB3333AAAA3333BB@@AABBAAMM333333..
    3333MMMM3333BBBB33BB333333BBBB33..33AABB,,33AA@@AABBBBMM333333..
    33AABBBBBB33BBBB,,333333BBMM33,,..::BBBB,,33AA@@BBAAAABB@@3333..
    BBBBBB33BBBBBB::..333333BBBB,,....33BBBB,,,,AABBBBAABBMM@@3333..
    BBBBBB::33BB33....::33BBMM33......33BBBBBBBBBBAAMMAAAABBBB3333..
    BBBBBBBBBBBBBB......33BBAA,,..::33BB,,,,..BBBBBBMMAAAAMMAA3333..
    BBAA33,,..,,BBBB....,,BBBB....,,....,,,,....::BBMMMMAAMMMM3333..
    AABBAA::33BBBB33......33BB......::BBMMMMMMMM,,33MMAAMMMMMM3333..
    33BB@@AABBMMMMMMMM,,....BB,,....MMAAMMMMMMMMMM33MMMMAAMM@@3333..
    33BB@@BB33AABBMMMMMM....,,::........33MMMM..MM::BBBBAABB333333..
    3333@@BB::..BBMM..AA,,....,,,,......::BBMMMMAA::BBMMBBBB333333..
    @@@@@@@@::..AAMMAA33::..............::AAMMAA33::BBBBBBBB333333..
    @@@@@@BB33..,,AA::33................,,::AA33::33BBBBBBBB333333..
    @@@@@@BBAA..3333::,,..............,,33MM33,,,,BBBBBBBBAA333333..
    @@@@@@@@BB::....,,..........................33BBBBBBMM33333333..
    @@@@@@@@AABB........,,,,..................,,BBBBAAMMMM33333333..
    @@@@@@@@AABB33......BBBB..................BBMM@@BBMMMM33333333..
    @@@@AA@@AABBBB::........................BBMM33BB33BB33333333@@..
    @@@@@@AA@@BB@@AA,,......BBBBBB......::MMMM::BB@@AABB33333333@@..
    @@@@AABBBBBB3333BB::......BBBB,,::33MMMM,,BB33..BBMM33333333AA..
    @@@@BBBB@@333333BBBBBB,,,,::::::,,....::MM33..BB@@@@333333@@BB..
    AABBBBBB@@33MMMM@@@@@@AA::........,,33MM33....AA@@AA333333BBBB..
    BBBB@@MMMMMM@@@@@@@@@@@@BB33::,,@@MMBB3333..AA@@@@BB333333BBBB..
    AAAAMM@@@@@@@@@@@@@@@@@@@@@@MMAAMMBB33....AA@@@@AAAA333333BBBB..
    @@BB@@@@@@@@@@@@@@@@@@@@@@@@MM333333....AA@@@@AA@@@@BB33BBBBBB..
    ................................................................
      

  9.   

    MMBBBBBB333333333333333333333333@@@@@@@@@@@@@@AAAA33333333BBBB..
    BBBB3333333333333333333333333333@@@@@@@@MM@@@@@@AAAA33333333BB..
    MM@@3333333333333333333333333333AA@@@@AAMMBB@@@@AA@@@@333333@@..
    AA33333333333333@@333333333333AABB@@@@AABBMMAA@@AAAAAA33333333..
    3333333333333333MM333333333333MMBB@@@@AABBBBMM@@BBBBAA33333333..
    333333BB333333MMMM3333333333AAMMBBAA@@BB33BBMM@@@@BBBB@@333333..
    333333BB333333BBAA3333333333BBBB33BB@@BB33BBMM@@BBAAMMAA333333..
    3333MMBB333333BBBB33333333BBBBBB3333AAAA3333BB@@AABBAAMM333333..
    3333MMMM3333BBBB33BB333333BBBB33..33AABB,,33AA@@AABBBBMM333333..
    33AABBBBBB33BBBB,,333333BBMM33,,..::BBBB,,33AA@@BBAAAABB@@3333..
    BBBBBB33BBBBBB::..333333BBBB,,....33BBBB,,,,AABBBBAABBMM@@3333..
    BBBBBB::33BB33....::33BBMM33......33BBBBBBBBBBAAMMAAAABBBB3333..
    BBBBBBBBBBBBBB......33BBAA,,..::33BB,,,,..BBBBBBMMAAAAMMAA3333..
    BBAA33,,..,,BBBB....,,BBBB....,,....,,,,....::BBMMMMAAMMMM3333..
    AABBAA::33BBBB33......33BB......::BBMMMMMMMM,,33MMAAMMMMMM3333..
    33BB@@AABBMMMMMMMM,,....BB,,....MMAAMMMMMMMMMM33MMMMAAMM@@3333..
    33BB@@BB33AABBMMMMMM....,,::........33MMMM..MM::BBBBAABB333333..
    3333@@BB::..BBMM..AA,,....,,,,......::BBMMMMAA::BBMMBBBB333333..
    @@@@@@@@::..AAMMAA33::..............::AAMMAA33::BBBBBBBB333333..
    @@@@@@BB33..,,AA::33................,,::AA33::33BBBBBBBB333333..
    @@@@@@BBAA..3333::,,..............,,33MM33,,,,BBBBBBBBAA333333..
    @@@@@@@@BB::....,,..........................33BBBBBBMM33333333..
    @@@@@@@@AABB........,,,,..................,,BBBBAAMMMM33333333..
    @@@@@@@@AABB33......BBBB..................BBMM@@BBMMMM33333333..
    @@@@AA@@AABBBB::........................BBMM33BB33BB33333333@@..
    @@@@@@AA@@BB@@AA,,......BBBBBB......::MMMM::BB@@AABB33333333@@..
    @@@@AABBBBBB3333BB::......BBBB,,::33MMMM,,BB33..BBMM33333333AA..
    @@@@BBBB@@333333BBBBBB,,,,::::::,,....::MM33..BB@@@@333333@@BB..
    AABBBBBB@@33MMMM@@@@@@AA::........,,33MM33....AA@@AA333333BBBB..
    BBBB@@MMMMMM@@@@@@@@@@@@BB33::,,@@MMBB3333..AA@@@@BB333333BBBB..
    AAAAMM@@@@@@@@@@@@@@@@@@@@@@MMAAMMBB33....AA@@@@AAAA333333BBBB..
    @@BB@@@@@@@@@@@@@@@@@@@@@@@@MM333333....AA@@@@AA@@@@BB33BBBBBB..
    ................................................................
      

  10.   

    在线吗?用QQ给你传过去,棋力绝对不错.我也是下的,不记得是在哪下的了.D源版
      

  11.   

    同意kiboisme(jolt)的观点.
    保存一些定式,可以剪掉不少分枝,速度方面就会上去,搜索的深度也可以变得深一些.
    深蓝曾经用几十台联网计算机来保存定式.要不然就凭分支算法累死他也赢不了人类大师
      

  12.   

    我有
    http://j26.8u8.com/fivesource.rar