allbak.pas

象棋源码

     if (x-i>=1) and (y+i>=1)then
     if (ichess[x-i,y+i]=chess)then
      begin
      for j:=1 to i-1 do
       begin
       ichess[x,y]:=chess;
       ichess[x-j,y+j]:=chess;
      if (z=1) then begin
      printchess(x,y,color);
      locate(irol,irow,clred);
      if (chess=black) then turntobl(x-j,y+j);
      if (chess=white) then turntowh(x-j,y+j);
      end;end;
      break;
      end;end;end;
end;

function getmax:integer;
var
pus:array[1..9,1..9]of integer;
savcost:array[1..9,1..9]of integer;
value2,a,b,s:integer;
i,j:integer;
flag:boolean;
procedure getmax2;
var
m,n:integer;
begin
    if ((deepmax-depth)mod 2=0) then changechess(i,j,compcolor,0)
    else changechess(i,j,mancolor,0);
    if (chessable=0) then
    exit;
    if last<>1 then
    for m:=1 to 8 do
    for n:=1 to 8 do
    begin
    pus[m,n]:=ichess[m,n];
    savcost[m,n]:=cost[m,n];
    end
    else
    for m:=1 to 8 do
    for n:=1 to 8 do
    begin
    pus[m,n]:=ichess[m,n];
    end;
    if ((deepmax-depth)mod 2=0)then begin changechess(i,j,compcolor,2);ichess[i,j]:=compcolor;end
    else begin changechess(i,j,mancolor,2);ichess[i,j]:=mancolor;end;
    dec(runsteps);
    dec(depth);
    inc(steps);
    can:=1;
    s:=getmax();
    can:=1;
    dec(steps);
    inc(runsteps);
    inc(depth);
    flag:=false;
    if (cut>0) then
    begin
    flag:=true;
    //dec(cut);
    exit;
    end;
   if (s<>10000) then
   begin
        if ((deepmax-depth)mod 2=0) then
        begin
            if (value2<s)then
            begin
                value2:=s;value[depth]:=value2;
            end;
        end
        else
        begin
            if (value2>s) then
            begin
                value2:=s;value[depth]:=value2;
            end;
        end;
        if (depth=deepmax)then
        begin
        if (value2>max)then begin max:=value2;max_x:=i;max_y:=j;end;
        end;
   end;
   if last<>1 then
   for m:=1 to 8 do
   for n:=1 to 8 do
   begin
   ichess[m,n]:=pus[m,n];
   cost[m,n]:=savcost[m,n];
   end
   else
   for m:=1 to 8 do
   for n:=1 to 8 do
   begin
   ichess[m,n]:=pus[m,n];
   end;
end;


begin
if can<>-1 then can:=0;
if (deepmax-depth) mod 2=0
then begin value2:=-9000;value[depth]:=-9000;s:=-9000;end
else begin value2:=9000;value[depth]:=9000;s:=9000;end;
if depth=deepmax then max:=-9999;
if (runsteps=0) or (steps=65) then
begin
//------------------------branch
    inc(branch);
    if branch mod 1000=0 then
    begin
        if branch<1000 then mainfrm.statusbar1.Panels.Items[1].text:='推理分枝数：'+inttostr(branch)
        else
        begin
            mainfrm.statusbar1.Panels.Items[1].text:='推理分枝数：'+inttostr(branch div 1000)+'K';
            mainfrm.statusbar1.Refresh;
        end;
    end;
//------------------------end branch
    a:=countvalue;
    if ((deepmax-depth)mod 2=0) and (depth<>deepmax) then
    begin
        for i:=deepmax div 2 downto 1 do
        if depth+i*2<=deepmax then
        begin
            if a<=value[depth+i*2] then
            begin
                cut:=i*2-1;
                break;
            end;
        end;
    end
    else if ((deepmax-depth)mod 2=1) and (depth<>deepmax-1) then
    begin
        for i:=deepmax div 2 downto 1 do
        if depth+i*2<=deepmax then
        begin
            if a>=value[depth+i*2] then
            begin
                cut:=i*2-1;
                break;
            end;
        end;
    end;
    result:=a;
    exit;
end;


if (last<>1)and(ram) then
begin
tempram:=random(8);
end;
if (ram=false)or(last=1) then
begin
for j:=1 to 8 do
for i:=1 to 8 do
begin
flag:=false;
getmax2;
if flag then
if (cut>0) then
begin dec(cut);result:=10000;exit;end;
end;
end

else if (tempram<1)then
begin
for j:=1 to 8 do
for i:=1 to 8 do
begin
flag:=false;
getmax2;
if flag then
if (cut>0) then
begin dec(cut);result:=10000;exit;end;
end;
end

else if tempram<2 then
begin
for j:=8 downto 1 do
for i:=8 downto 1 do
begin
flag:=false;
getmax2;
if flag then
if (cut>0) then begin dec(cut);result:=10000;exit;end;
end;
end

else if tempram<3 then
begin
for j:=8 downto 1 do
for i:=1 to 8 do
begin
flag:=false;
getmax2;
if flag then
if (cut>0) then begin dec(cut);result:=10000;exit;end;
end;
end

else if tempram<4 then
begin
for j:=1 to 8 do
for i:=8 downto 1 do
begin
flag:=false;
getmax2;
if flag then
if (cut>0) then begin dec(cut);result:=10000;exit;end;
end;
end

else if tempram<5 then
begin
for i:=1 to 8 do
for j:=1 to 8 do
begin
flag:=false;
getmax2;
if flag then
if (cut>0) then begin dec(cut);result:=10000;exit;end;
end;
end

else if tempram<6 then
begin
for i:=8 downto 1 do
for j:=8 downto 1 do
begin
flag:=false;
getmax2;
if flag then
if (cut>0) then begin dec(cut);result:=10000;exit;end;
end;
end

else if tempram<7 then
begin
for i:=1 to 8 do
for j:=8 downto 1 do
begin
flag:=false;
getmax2;
if flag then
if (cut>0) then begin dec(cut);result:=10000;exit;end;
end;
end

else
begin
for i:=8 downto 1 do
for j:=1 to 8 do
begin
flag:=false;
getmax2;
if flag then
if (cut>0) then begin dec(cut);result:=10000;exit;end;
end;
end;

if (depth<>deepmax)then
begin
    if can=0 then         //有一方不能下
    begin
    dec(depth);
    dec(can);
    s:=getmax();
    can:=0;
    inc(depth);
    cut:=0;
    if ((deepmax-depth)mod 2=0)then begin if (value2<s)then value2:=s;value[depth]:=s;end
    else begin if (value2>s)then value2:=s;value[depth]:=s;end;
    end;
end;

if (can=-1)then          //双方都不能下
begin
countchess();
if (iblcount>iwhcount) then
    begin
    if last<>1 then value2:=8999
    else
    value2:=iblcount-iwhcount
end;
if (iblcount<iwhcount) then
    begin
    if last<>1 then value2:=-8999
    else
    value2:=iblcount-iwhcount
end;;
if (iblcount=iwhcount) then
value2:=0;
can:=0;
end;

b:=value2;
    if ((deepmax-depth)mod 2=0) and (depth<>deepmax) then
    begin
        for i:=deepmax div 2 downto 1 do
        if depth+i*2<=deepmax then
        begin
            if b<=value[depth+i*2] then
            begin
                cut:=i*2-1;
                break;
            end;
        end;
    end
    else if ((deepmax-depth)mod 2=1) and (depth<>deepmax-1) then
    begin
        for i:=deepmax div 2 downto 1 do
        if depth+i*2<=deepmax then
        begin
            if b>=value[depth+i*2] then
            begin
                cut:=i*2-1;
                break;
            end;
        end;
    end;
result:=b;
end;

procedure locate(x,y:integer;color:tcolor);
var grid:trect;
begin
grid:=drawgrid.CellRect(x-1, y-1);
drawgrid.canvas.pen.Color:=color;
drawgrid.canvas.pen.Width:=3;
drawgrid.canvas.MoveTo(grid.left+1,grid.top+1);
drawgrid.canvas.Lineto(grid.left+5,grid.top+1);
drawgrid.canvas.MoveTo(grid.left+1,grid.top+1);
drawgrid.canvas.Lineto(grid.left+1,grid.top+5);
drawgrid.canvas.MoveTo(grid.right-2,grid.bottom-2);
drawgrid.canvas.Lineto(grid.right-6,grid.bottom-2);
drawgrid.canvas.MoveTo(grid.right-2,grid.bottom-2);
drawgrid.canvas.Lineto(grid.right-2,grid.bottom-6);
drawgrid.canvas.MoveTo(grid.right-2,grid.top+1);
drawgrid.canvas.Lineto(grid.right-6,grid.top+1);
drawgrid.canvas.MoveTo(grid.right-2,grid.top+1);
drawgrid.canvas.Lineto(grid.right-2,grid.top+5);
drawgrid.canvas.MoveTo(grid.left+1,grid.bottom-2);
drawgrid.canvas.Lineto(grid.left+5,grid.bottom-2);
drawgrid.canvas.MoveTo(grid.left+1,grid.bottom-2);
drawgrid.canvas.Lineto(grid.left+1,grid.bottom-6);
end;

procedure turntobl(x:integer;y:integer);
var
wavname:string;
begin
wavname:=path+'bw.wav';
printchess(x,y,whitechess2);
if soundopen then sndplaysound(pchar(wavname),SND_SYNC);
printchess(x,y,whitechess3);
sleep(speed);
printchess(x,y,blackchess3);
sleep(speed);
printchess(x,y,blackchess2);
sleep(speed);
printchess(x,y,blackchess);
blcount:=blcount+1;
whcount:=whcount-1;
end;

procedure turntowh(x:integer;y:integer);
var
wavname:string;
begin
wavname:=path+'bw.wav';
printchess(x,y,blackchess2);
if soundopen then sndplaysound(pchar(wavname),SND_SYNC);
printchess(x,y,blackchess3);
sleep(speed);
printchess(x,y,whitechess3);
sleep(speed);
printchess(x,y,whitechess2);
sleep(speed);
printchess(x,y,whitechess);
blcount:=blcount-1;
whcount:=whcount+1;
end;

end.