{705行的五子棋高效pascal代码!
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Notice !
! Software edited by Zhou Renjian,Shanghai Jiao Tong University,Mathethics!
!Application Apartment F0007102. !
! (C)Copyright Stand Man Studio (to be built)!
! 本软件有上海交通大学数学系F0007102班周仁建编写,在Turbo Pascal 7.0 下通 !
!过。可以写信给我共同讨论。 !
! Email:bombjet.joo@263.net !
! !
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
}
uses Graph,Crt;
const
ChessW=19;{棋盘宽}
BlankW=24;{棋盘高}
_Color1=BROWN;
_Color2=WHITE;
Delta:array [1..4,0..1] of Integer=((1,0),(0,1),(1,1),(1,-1));
{Directories for the Chess.}
VV:array [0..4] of Word=(0,8,64,512,4096);
{The value for the Chess,as 0:_ _ _ _ _;8:_ O _ _ _;4096:O O O O _.}
type
ValueDot=record
V:Word;
VN,D,LD,RD:Byte;
LB,RB:Boolean;
end;
ValueD=record
X,Y,D,LD,RD:Byte;
LB,RB:Boolean;
VN,V:Word;
end;
var
V0:ValueDot;
Value:array [1..2,1..ChessW,1..ChessW,0..4] of ValueDot;
{To record the chesses'values if it's empty;}
{记录各个棋子的信息,1..2代表玩家代码,1..4代表四个方位,0代表总起来的。}
ValueC:array [1..2,0..ChessW*ChessW,1..4] of ValueD;
{记录有几粒的棋子条的信息,1..2代表玩家代码,1..4代表几粒。}
BeginX,BeginY,CurrentX,CurrentY:Word;
{For the screen.}
Order:array[0..ChessW+1,0..ChessW+1] of Byte;
{原本打算用作记录走棋的顺序,以便研究的,本程序没有用。}
JustBegin:Boolean;
procedure InitChess;{Draw the forms and make some necessary init,such as give the 0 the chesses.}
var
grDriver: Integer;
grMode: Integer;
ErrCode: Integer;
HalfX,HalfY,H:Word;
ex,ey,i,j:Word;
begin
DirectVideo:=False;
Randomize;
JustBegin:=True;
V0.VN:=0;V0.V:=0;V0.D:=25;V0.LD:=5;V0.RD:=5;V0.LB:=False;V0.RB:=False;
for i:=1 to ChessW do
for j:=1 to ChessW do {初始化棋盘上的各个价值}
begin
Order[i,j]:=0;
Value[1,i,j,0]:=V0;
Value[1,i,j,1]:=V0;
Value[1,i,j,2]:=V0;
Value[1,i,j,3]:=V0;
Value[1,i,j,4]:=V0;
Value[2,i,j,0]:=V0;
Value[2,i,j,1]:=V0;
Value[2,i,j,2]:=V0;
Value[2,i,j,3]:=V0;
Value[2,i,j,4]:=V0;
end;
for i:=0 to ChessW+1 do
begin
Order[i,0]:=$ff;
Order[0,i]:=$ff;
Order[i,ChessW+1]:=$ff;
Order[ChessW+1,0]:=$ff;
end;
CurrentX:=ChessW div 2;CurrentY:=ChessW div 2;
grDriver := Detect;
InitGraph(grDriver, grMode,'C:\TP\BGI'); {画棋盘}
ErrCode := GraphResult;
if ErrCode = grOk then
begin { Do graphics }
BeginX:=GetMaxX div 2-(ChessW*BlankW div 2);
BeginY:=GetMaxY div 2-(ChessW*BlankW div 2);
ex:=GetMaxX div 2+(ChessW*BlankW div 2);
ey:=GetMaxY div 2+(ChessW*BlankW div 2);
SetFillStyle(1,BLUE);
Bar(BeginX,BeginY,ex,ey);
SetColor(YELLOW);
for i:=1 to ChessW+1 do
begin
Line(BeginX+(i-1)*BlankW,BeginY,BeginX+(i-1)*BlankW,ey);
Line(BeginX,BeginY+(i-1)*BlankW,ex,BeginY+(i-1)*BlankW);
end;
end
else
Halt;
end;
procedure PutRect(_x,_y:Word;Erase:Boolean);{走棋时的方框}
var
r:Word;
begin
r:=BlankW -2;
if Erase then SetColor(BLUE) else SetColor(RED);
Rectangle(BeginX+_x*BlankW-r,BeginY+_y*BlankW-r,BeginX+_x*BlankW-1,BeginY+_y*BlankW-1);
Rectangle(BeginX+_x*BlankW-r-1,BeginY+_y*BlankW-r-1,BeginX+_x*BlankW-2,BeginY+_y*BlankW-2);
end;
procedure TPut(x,y,p:Byte);forward;
procedure PutChess(_x,_y:Word;player:Byte);
var
r:Word;
color:Byte;
begin
r:=(BlankW div 2);
if (_x>ChessW)or(_y>ChessW)or(Order[_x,_y]<>0) then exit;
if player=1 then color:=_Color1 else
if player=2 then color:=_Color2 else exit;
SetColor(color);
Circle(BeginX+_x*BlankW-r,BeginY+_y*BlankW-r,r-3);
SetFillStyle(1,color);
FloodFill(BeginX+_x*BlankW-r,BeginY+_y*BlankW-r,color);
PutRect(CurrentX,CurrentY,True);{画棋子}
Order[_x,_y]:=player;
CurrentX:=_x;CurrentY:=_y; {把此处的价值设置好}
Value[1,_x,_y,0]:=V0;
Value[2,_x,_y,0]:=V0;
Value[1,_x,_y,1]:=V0;
Value[2,_x,_y,1]:=V0;
Value[1,_x,_y,2]:=V0;
Value[2,_x,_y,2]:=V0;
Value[1,_x,_y,3]:=V0;
Value[2,_x,_y,3]:=V0;
Value[1,_x,_y,4]:=V0;
Value[2,_x,_y,4]:=V0;
PutRect(CurrentX,CurrentY,False);
end;
procedure ManTake(player:Byte);{Use the keyboard the take the chess.}
var
ch:Char;
Take:Boolean;
begin
Take:=False;
repeat
ch:=#0;
if KeyPressed then ch:=ReadKey;
case ch of
#71:{UpLeft}
begin
PutRect(CurrentX,CurrentY,True);
if CurrentX>1 then CurrentX:=CurrentX-1;
if CurrentY>1 then CurrentY:=CurrentY-1;
PutRect(CurrentX,CurrentY,False);
end;
#72:{Up}
begin
PutRect(CurrentX,CurrentY,True);
if CurrentY>1 then CurrentY:=CurrentY-1;
PutRect(CurrentX,CurrentY,False);
end;
#73:{UpRight}
begin
PutRect(CurrentX,CurrentY,True);
if CurrentX<ChessW then CurrentX:=CurrentX+1;
if CurrentY>1 then CurrentY:=CurrentY-1;
PutRect(CurrentX,CurrentY,False);
end;
#75:{Left}
begin
PutRect(CurrentX,CurrentY,True);
if CurrentX>1 then CurrentX:=CurrentX-1;
PutRect(CurrentX,CurrentY,False);
end;
#77:{Right}
begin
PutRect(CurrentX,CurrentY,True);
if CurrentX<ChessW then CurrentX:=CurrentX+1;
PutRect(CurrentX,CurrentY,False);
end;
#79:{DownLeft}
begin
PutRect(CurrentX,CurrentY,True);
if CurrentX>1 then CurrentX:=CurrentX-1;
if CurrentY<ChessW then CurrentY:=CurrentY+1;
PutRect(CurrentX,CurrentY,False);
end;
#80:{Down}
begin
PutRect(CurrentX,CurrentY,True);
if CurrentY<ChessW then CurrentY:=CurrentY+1;
PutRect(CurrentX,CurrentY,False);
end;
#81:{DownRight}
begin
PutRect(CurrentX,CurrentY,True);
if CurrentX<ChessW then CurrentX:=CurrentX+1;
if CurrentY<ChessW then CurrentY:=CurrentY+1;
PutRect(CurrentX,CurrentY,False);
end;
#13:{For sure}
begin
if Order[CurrentX,CurrentY]=0 then
begin
TPut(CurrentX,CurrentY,player);
PutRect(CurrentX,CurrentY,False);
Take:=True;
end;
end;
else;
end;
until Take;
end;
function CheckWin(player:Byte):Boolean;
function CheckLine(bx,by:Word;dx,dy:Integer):Byte;
{Check if there is 5 chesses in directions of -- | \ /.}
var
sum,maxsum:Byte;
begin
maxsum:=0;sum:=0;
repeat
if Order[bx,by]=player then
begin
sum:=sum+1;
if sum>maxsum then maxsum:=sum;
end
else
sum:=0;
bx:=bx+dx;by:=by+dy;
until (bx<1)or(bx>ChessW)or(by<1)or(by>ChessW);
CheckLine:=maxsum;
end;
var
i:Byte;
begin
CheckWin:=False;
for i:=1 to ChessW do
if CheckLine(1,i,1,0)>4 then
begin {--}
CheckWin:=True;Exit;
end;
for i:=1 to ChessW do
if CheckLine(i,1,0,1)>4 then
begin {|}
CheckWin:=True;Exit;
end;
for i:=1 to ChessW-4 do
if CheckLine(1,i,1,1)>4 then
begin {\}
CheckWin:=True;Exit;
end;
for i:=1 to ChessW-4 do
if CheckLine(i,1,1,1)>4 then
begin {\}
CheckWin:=True;Exit;
end;
for i:=5 to ChessW do
if CheckLine(i,1,-1,1)>4 then
begin {/}
CheckWin:=True;Exit;
end;
for i:=1 to ChessW-4 do
if CheckLine(ChessW,i,-1,1)>4 then
begin {/}
CheckWin:=True;Exit;
end;
end;
procedure NetTake(player:Byte);
{This is for two players in two computers.It is based on the NETWARE 4.12,
not for the normal 2 computers.You can ignore this.}
{下面两个过程是为了使两台PC通过NETWARE4.12联起来玩游戏而作,可忽略。}
var
f:Text;
tx,ty:Word;
begin
Assign(f,'SMS.NET');
repeat
{$I-}
Reset(f);
{$I+}
until IOResult=0;
Readln(f,tx);Readln(f,ty);
Close(f);
TPut(tx,ty,player);
end;
procedure MyNetTake(player:Byte);
var
f:Text;
tx,ty:Word;
begin
Assign(f,'SMS.NET');
Rewrite(f);
ManTake(player);
Writeln(f,CurrentX);Writeln(f,CurrentY);
Close(f);
end;
procedure VD(x0,y0,d,p:Byte);{Caculate the value of the spot of (x0,y0).}
var
dx,dy:Integer;
x,y,x1,y1,x2,y2,
i,j,
s0,s1,s2,ls,rs,s,_p,
r0,l0,rd,ld,d0:Byte;
lb,rb,rb0,lb0:Boolean;ll,rr:Byte;
t,t0:Word;
out,bb:Boolean;
d1,d2:ValueDot;
begin
if Order[x0,y0]<>0 then Exit;
dx:=Delta[d,0];dy:=Delta[d,1];{方向:--,|,/,\}
if p=1 then _p:=2 else _p:=1;
t0:=0;s0:=0;
x:=x0;y:=y0;s1:=0;out:=false;
repeat
x:=x+dx;y:=y+dy;
Inc(s1); {左有空白?}
if (s1>4)or(Order[x,y]=$ff)or(Order[x,y]=_p) then out:=True;
until out;
if (Order[x,y]=$ff)or(Order[x,y]=_p) then Dec(s1);
x:=x0;y:=y0;s2:=0;out:=false;
repeat
x:=x-dx;y:=y-dy;
Inc(s2); {右有空白?}
if (s2>4)or(Order[x,y]=$ff)or(Order[x,y]=_p) then out:=True;
until out;
if (Order[x,y]=$ff)or(Order[x,y]=_p) then Dec(s2);
if s1+s2<4 then
Value[p,x0,y0,d]:=V0
else
begin
for i:=0 to s1 do
if (4-i>=0)and(4-i<=s2) then
begin
ld:=1;rd:=1;rs:=0;ls:=0;
x:=x0;y:=y0;ll:=0;bb:=True;lb:=False;
for j:=1 to i do
begin
x:=x+dx;y:=y+dy; {中间有空白?数目几何?}
if Order[x,y]=p then Inc(ls);
if (ls=0)and(Order[x,y]=0) then Inc(ld);
if (bb)and(ls>0)and(Order[x,y]=0) then begin lb:=True;ll:=ls;bb:=False;end;
end;
if ls=ll then lb:=False;
if ls=0 then ld:=5;
x1:=x+dx;y1:=y+dy;
x:=x0;y:=y0;rr:=0;bb:=True;rb:=False;
for j:=1 to 4-i do
begin
x:=x-dx;y:=y-dy;
if Order[x,y]=p then Inc(rs);
if (rs=0)and(Order[x,y]=0) then Inc(rd);
if (bb)and(rs>0)and(Order[x,y]=0) then begin rb:=True;rr:=rs;bb:=False;end;
end;
if rs=0 then rd:=5;
if rs=rr then rb:=False;
x2:=x-dx;y2:=y-dy;
s:=ls+rs;
t:=VV[s];
if (Order[x1,y1]=$ff)or(Order[x1,y1]=_p) then t:=t div 2;
if (Order[x2,y2]=$ff)or(Order[x2,y2]=_p) then t:=t div 2;
if t0<t then
begin
t0:=t;s0:=s;r0:=rd;l0:=ld;rb0:=rb;lb0:=lb;
end;
end;
Value[p,x0,y0,d].V:=t0;{此处d方向上价值}
Value[p,x0,y0,d].VN:=s0;{此处d方向上棋子数}
Value[p,x0,y0,d].LD:=l0;{此处d方向左空为几?}
Value[p,x0,y0,d].RD:=r0;{此处d方向右空为几?}
Value[p,x0,y0,d].LB:=lb0;{此处d方向左空?}
Value[p,x0,y0,d].RB:=rb0;{此处d方向右空?}
Value[p,x0,y0,d].D:=l0*r0;
end;
Value[p,x0,y0,0].V:=Value[p,x0,y0,1].V+Value[p,x0,y0,2].V+Value[p,x0,y0,3].V
+Value[p,x0,y0,4].V;
{四个方位的价值加起来,有选择地更新此处的价值,如果新的价值比原来的高。}
if Value[p,x0,y0,1].V>Value[p,x0,y0,2].V then d1:=Value[p,x0,y0,1] else d1:=
Value[p,x0,y0,2];
if Value[p,x0,y0,3].V>Value[p,x0,y0,4].V then d2:=Value[p,x0,y0,3] else d2:=
Value[p,x0,y0,4];
if d1.V>d2.V then d2:=d1;
Value[p,x0,y0,0].VN:=d2.VN;
Value[p,x0,y0,0].D:=d2.D;
Value[p,x0,y0,0].RD:=d2.RD;
Value[p,x0,y0,0].LD:=d2.LD;
Value[p,x0,y0,0].RB:=d2.RB;
Value[p,x0,y0,0].LB:=d2.LB;
end;
procedure VAdd(x0,y0,dir,p:Byte);{计算空白处(x0,y0)的价值。}
var
dx,dy:Integer;
x,y,i,_p:Byte;
out:Boolean;
begin
dx:=Delta[dir,0];dy:=Delta[dir,1];
if p=1 then _p:=2 else _p:=1;
x:=x0;y:=y0;i:=0;out:=false;
repeat
x:=x+dx;y:=y+dy;
Inc(i);
if (i>4)or(Order[x,y]=$ff)or(Order[x,y]=_p) then out:=True;
if Order[x,y]=0 then VD(x,y,dir,p);
until out;
x:=x0;y:=y0;i:=0;out:=false;
repeat
x:=x-dx;y:=y-dy;
Inc(i);
if (i>4)or(Order[x,y]=$ff)or(Order[x,y]=_p) then out:=True;
if Order[x,y]=0 then VD(x,y,dir,p);
until out;
end;
procedure TPut(x,y,p:Byte);{下一步棋,计算其周围的空白处的价值。}
var
x0,y0:Byte;
d1,d2:ValueDot;
begin
if Order[x,y]=0 then
begin
PutChess(x,y,p);
VAdd(x,y,1,2);
VAdd(x,y,2,2);
VAdd(x,y,3,2);
VAdd(x,y,4,2);
VAdd(x,y,1,1);
VAdd(x,y,2,1);
VAdd(x,y,3,1);
VAdd(x,y,4,1);
end;
end;
procedure Ps(x,y:Byte;s:string);{调试程序时用}
var
i:Byte;
begin
for i:=2 to Length(s) do
case s[1] of
'-':
begin
x:=x+1;TPut(x,y,Ord(s[i])-48);
end;
'|':
begin
y:=y+1;TPut(x,y,Ord(s[i])-48);
end;
'\':
begin
x:=x+1;y:=y+1;TPut(x,y,Ord(s[i])-48);
end;
'/':
begin
x:=x-1;y:=y+1;TPut(x,y,Ord(s[i])-48);
end;
end;
end;
function CheckC(p,n:Byte):Word;
{整理各点的价值,并整理成到记录棋子条的数组中。}
{p代表玩家的代码,1为电脑或为玩家;n是几粒棋。}
var
i,j:Byte;
t:Word;
begin
t:=0;
for i:=1 to ChessW do
for j:=1 to ChessW do
if Value[p,i,j,0].V>=VV[n] then
begin
Inc(t);
ValueC[p,t,n].X:=i;
ValueC[p,t,n].Y:=j;
ValueC[p,t,n].V:=Value[p,i,j,0].V;
ValueC[p,t,n].VN:=Value[p,i,j,0].VN;
ValueC[p,t,n].D:=Value[p,i,j,0].D;
ValueC[p,t,n].RD:=Value[p,i,j,0].RD;
ValueC[p,t,n].LD:=Value[p,i,j,0].LD;
ValueC[p,t,n].RB:=Value[p,i,j,0].RB;
ValueC[p,t,n].LB:=Value[p,i,j,0].LB;
end;
ValueC[p,0,n].V:=t;CheckC:=t;
end;
procedure SortC(p,n,xx:Byte);{把每一空的地方的值排队,以便下最有价值的一步棋。}
{xx表示是1时按价值排,2时按是否两边有空白来排,差不多的,只是走起来,不同。}
var
t,i,j:Word;
t0:ValueD;
begin
t:=ValueC[p,0,n].V;
for i:=1 to t-1 do
for j:=i+1 to t do
begin
if xx=1 then
begin
if ValueC[p,i,n].V<ValueC[p,j,n].V then
begin
t0:=ValueC[p,i,n];ValueC[p,i,n]:=ValueC[p,j,n];ValueC[p,j,n]:=t0;
end
else
if ValueC[p,i,n].V=ValueC[p,j,n].V then
if ValueC[p,i,n].D>ValueC[p,j,n].D then
begin
t0:=ValueC[p,i,n];ValueC[p,i,n]:=ValueC[p,j,n];ValueC[p,j,n]:=t0;
end;
end;
if xx=2 then
begin
if ValueC[p,i,n].D>ValueC[p,j,n].D then
begin
t0:=ValueC[p,i,n];ValueC[p,i,n]:=ValueC[p,j,n];ValueC[p,j,n]:=t0;
end
else
if ValueC[p,i,n].D=ValueC[p,j,n].D then
if ValueC[p,i,n].V<ValueC[p,j,n].V then
begin
t0:=ValueC[p,i,n];ValueC[p,i,n]:=ValueC[p,j,n];ValueC[p,j,n]:=t0;
end;
end;
end;
end;
procedure PC(p:Byte);
var
_p,x,y,i,j,k,s,t:Byte;
b:Boolean;
begin
if p=1 then _p:=2 else _p:=1;{这一行是为了可以方便地更改人走先还是走后。}
for i:=1 to ChessW do
for j:=1 to ChessW do
if Value[p,i,j,0].VN=4 then begin TPut(i,j,p);Exit;end;
{走有四粒的}
for i:=1 to ChessW do
for j:=1 to ChessW do
if Value[_p,i,j,0].VN=4 then begin TPut(i,j,p);Exit;end;
{防有四粒的}
for i:=1 to ChessW do
for j:=1 to ChessW do
if (Value[p,i,j,0].VN=3) and (Value[p,i,j,0].V>=VV[3]) and not(Value[p,i,j,0].LB)
and not(Value[p,i,j,0].RB) and (Value[p,i,j,0].D<=5) then
begin TPut(i,j,p);Exit;end;
{走有三粒的,如此类推。}
for i:=1 to ChessW do
for j:=1 to ChessW do
begin
if (Value[p,i,j,0].VN=3) then
begin
s:=0;
if Value[p,i,j,1].VN=3 then Inc(s);
if Value[p,i,j,2].VN=3 then Inc(s);
if Value[p,i,j,3].VN=3 then Inc(s);
if Value[p,i,j,4].VN=3 then Inc(s);
if s>=2 then begin TPut(i,j,p);Exit;end;
b:=False;
for k:=1 to 4 do
if (Value[p,i,j,k].V=VV[2]) then b:=True;
if b then begin TPut(i,j,p);Exit;end;
{这里走入经验的陷阱,究竟怎样走半三粒的,和两粒交叉的,是先防还是先攻,
我弄不明白。在此调试可提高程序智力。}
{Follow no way}
if Value[p,i,j,0].V>=VV[3] then
begin
s:=0;
for k:=1 to 4 do
if (Value[_p,i,j,k].V=VV[2])and(
(Value[_p,i,j,k].D=1)or(Value[_p,i,j,k].D=2)
or(Value[_p,i,j,k].D=5)or(Value[_p,i,j,k].D=10) )
then Inc(s);
if s>1 then begin TPut(i,j,p);Exit;end;
end;
end;
end;
s:=0;
for i:=1 to ChessW do
for j:=1 to ChessW do
if (Value[_p,i,j,0].V>=VV[3]) then Inc(s);
if s>4 then
for i:=1 to ChessW do
for j:=1 to ChessW do
if (Value[p,i,j,0].VN=3)and(Value[p,i,j,0].D<=5) then
begin TPut(i,j,p);Exit;end;
for i:=1 to ChessW do
for j:=1 to ChessW do
begin
if (Value[_p,i,j,0].VN=3) then
begin
if (Value[_p,i,j,0].V>=VV[3]) and not(Value[_p,i,j,0].LB)
and not(Value[_p,i,j,0].RB) and (Value[_p,i,j,0].D<=5) then
begin TPut(i,j,p);Exit;end;
s:=0;
if Value[_p,i,j,1].VN=3 then Inc(s);
if Value[_p,i,j,2].VN=3 then Inc(s);
if Value[_p,i,j,3].VN=3 then Inc(s);
if Value[_p,i,j,4].VN=3 then Inc(s);
if s>=2 then begin TPut(i,j,p);Exit;end;
b:=False;
for k:=1 to 4 do
if (Value[_p,i,j,k].V=VV[2]) then b:=True;
if b then begin TPut(i,j,p);Exit;end;
end;
end;
for i:=1 to ChessW do
for j:=1 to ChessW do
begin
s:=0;
for k:=1 to 4 do
if (Value[p,i,j,k].V=VV[2])and(
(Value[p,i,j,k].D=1)or(Value[p,i,j,k].D=2)
or(Value[p,i,j,k].D=5)or(Value[p,i,j,k].D=10) )
then Inc(s);
if s>1 then begin TPut(i,j,p);Exit;end;
end;
for i:=1 to ChessW do
for j:=1 to ChessW do
begin
s:=0;
for k:=1 to 4 do
if (Value[_p,i,j,k].V=VV[2])and(
(Value[_p,i,j,k].D=1)or(Value[_p,i,j,k].D=2)
or(Value[_p,i,j,k].D=5)or(Value[_p,i,j,k].D=10) )
then Inc(s);
if s>1 then begin TPut(i,j,p);Exit;end;
end;
for i:=1 to ChessW do
for j:=1 to ChessW do
if (Value[p,i,j,0].V>=VV[3]) then begin TPut(i,j,p);Exit;end;
for i:=1 to ChessW do
for j:=1 to ChessW do
if (Value[p,i,j,0].VN=2) and (Value[p,i,j,0].V>=VV[2]) and not(Value[p,i,j,0].LB)
and not(Value[p,i,j,0].RB) and (Value[p,i,j,0].D<=5) then
begin TPut(i,j,p);Exit;end;
if CheckC(p,2)>0 then
begin
SortC(p,2,1);
TPut(ValueC[p,1,2].X,ValueC[p,1,2].Y,p);
Exit;
end;
for i:=1 to ChessW do
for j:=1 to ChessW do
if (Value[p,i,j,0].VN=2) and (Value[p,i,j,0].V>=VV[2]) and not(Value[p,i,j,0].LB)
and not(Value[p,i,j,0].RB) and (Value[p,i,j,0].D<=5) then
begin TPut(i,j,p);Exit;end;
if CheckC(_p,2)>0 then
begin
SortC(_p,2,2);
TPut(ValueC[_p,1,2].X,ValueC[_p,1,2].Y,p);
Exit;
end;
if CheckC(p,1)>0 then
begin
SortC(p,1,2);
TPut(ValueC[p,1,1].X,ValueC[p,1,1].Y,p);
Exit;
end;
if JustBegin then
if CheckC(_p,1)>0 then
begin {棋局刚开始反击走法:紧紧贴住。}
SortC(_p,1,2);
t:=ValueC[_p,0,1].V;
if t>3 then t:=Random(8)+1;
TPut(ValueC[_p,t,1].X,ValueC[_p,t,1].Y,p);
JustBegin:=False;
Exit;
end;
begin{第一步随机}
x:=(ChessW div 3)+Random(ChessW div 3);
y:=(ChessW div 3)+Random(ChessW div 3);
TPut(x,y,p);
end;
Write('Fail');{调试程序用}
end;
procedure Wait;
var
ch:Char;
begin
repeat
until KeyPressed;
ch:=ReadKey;
end;
var
tx,ty,dt:Word;ch:Char;
begin
InitChess;
repeat
{ ManTake(2); {人走一步}
{ Wait;}
Pc(2);
if CheckWin(2) then begin write('Man win');halt;end;
{ Wait;}
ManTake(1);
{ Pc(1); {电脑走一步}
if CheckWin(1) then begin write('PC win');halt;end;
until FALSE;{无直接退出,只有一方输才结束。}
end.