谁有五子棋(人跟电脑对弈)的代码?或者在这里探讨一下,怎样模拟电脑下棋!
急需!
急需!
解决方案 »
- 鼠标移动到TSplitter上时,鼠标会变,这个在源码中哪里可以看到?
- 求生成一个Int64的数的算法和解码方法
- 怎样把几幅位图连接成一张图片, 并且屏蔽几种颜色...谢谢
- 求实现多行标题并行列可以合并的dbgrid或stringGrid源码头
- 关于QiuckRport的问题,高手救命啊,解决立即结帐
- 如何用Delphi控制ACCESS的权限?
- 初学者的问题,怎样打开Delphi中的工程文件.bpr?
- 如何写一个Print函数
- 怎麼修改sql server的sysobjects表紀錄
- Access数据库,通过ADO连接,请问发布时需要哪些文件?
- 各位老大:问一个关于TREEVIEW的问题!
- DxDbgrid的问题
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
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.
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;
上有一个五子棋论坛,上面有很多源码
没有D 的
谁要得我可以发给他!
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..
................................................................
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..
................................................................
保存一些定式,可以剪掉不少分枝,速度方面就会上去,搜索的深度也可以变得深一些.
深蓝曾经用几十台联网计算机来保存定式.要不然就凭分支算法累死他也赢不了人类大师
http://j26.8u8.com/fivesource.rar