allbak.pas

实现黑白棋的游戏

if (ichess[3,7]=mancolor)and(ichess[4,7]=mancolor)and(ichess[5,7]=mancolor)and(ichess[6,7]=mancolor)or
(ichess[3,7]=compcolor)and(ichess[4,7]=compcolor)and(ichess[5,7]=compcolor)and(ichess[6,7]=compcolor)then
begin
if ichess[1,8]<>none then cost[1,7]:=100;
if ichess[8,8]<>none then cost[8,7]:=100;
end
else if (ichess[3,7]<>none)and(ichess[4,7]<>none)and(ichess[5,7]<>none)and(ichess[6,7]<>none) then
begin
if ichess[1,8]<>none then cost[1,7]:=90;
if ichess[8,8]<>none then cost[8,7]:=90;
end;
if (ichess[3,2]=mancolor)and(ichess[4,2]=mancolor)and(ichess[5,2]=mancolor)and(ichess[6,2]=mancolor)or
(ichess[3,2]=compcolor)and(ichess[4,2]=compcolor)and(ichess[5,2]=compcolor)and(ichess[6,2]=compcolor)then
begin
if ichess[1,1]<>none then cost[1,2]:=100;
if ichess[8,1]<>none then cost[8,2]:=100;
end
else if (ichess[3,2]<>none)and(ichess[4,2]<>none)and(ichess[5,2]<>none)and(ichess[6,2]<>none)then
begin
if ichess[1,1]<>none then cost[1,2]:=90;
if ichess[8,1]<>none then cost[8,2]:=90;
end;
if (ichess[2,3]=mancolor)and(ichess[2,4]=mancolor)and(ichess[2,5]=mancolor)and(ichess[2,6]=mancolor)or
(ichess[2,3]=compcolor)and(ichess[2,4]=compcolor)and(ichess[2,5]=compcolor)and(ichess[2,6]=compcolor)then
begin
if ichess[1,1]<>none then cost[2,1]:=100;
if ichess[1,8]<>none then cost[2,8]:=100;
end
else if (ichess[2,3]<>none)and(ichess[2,4]<>none)and(ichess[2,5]<>none)and(ichess[2,6]<>none)then
begin
if ichess[1,1]<>none then cost[2,1]:=90;
if ichess[1,8]<>none then cost[2,8]:=90;
end;
if (ichess[7,3]=mancolor)and(ichess[7,4]=mancolor)and(ichess[7,5]=mancolor)and(ichess[7,6]=mancolor)or
(ichess[7,3]=compcolor)and(ichess[7,4]=compcolor)and(ichess[7,5]=compcolor)and(ichess[7,6]=compcolor)then
begin
if ichess[8,1]<>none then cost[7,1]:=100;
if ichess[8,8]<>none then cost[7,8]:=100;
end
else if (ichess[7,3]<>none)and(ichess[7,4]<>none)and(ichess[7,5]<>none)and(ichess[7,6]<>none)then
begin
if ichess[8,1]<>none then cost[7,1]:=90;
if ichess[8,8]<>none then cost[7,8]:=90;

end;


if ichess[1,1]<>none then
begin
cost[2,2]:=-1;
for i:=3 to 6 do
begin
cost[1,i]:=1;cost[i,1]:=1;
if (cost[2,1]=100)or(cost[2,8]=100) then cost[2,i]:=1
else cost[2,i]:=-1;
if (cost[1,2]=100)or(cost[8,2]=100) then cost[i,2]:=1
else cost[i,2]:=-1;
end;
end;
if ichess[8,8]<>none then
begin
cost[7,7]:=-1;
for i:=3 to 6 do
begin
cost[i,8]:=1;cost[8,i]:=1;
if (cost[1,7]=100)or(cost[8,7]=100) then cost[i,7]:=1
else cost[i,7]:=-1;
if (cost[7,1]=100)or(cost[7,8]=100) then cost[7,i]:=1
else cost[7,i]:=-1;
end;
end;
if ichess[8,1]<>none then
begin
cost[7,2]:=-1;
for i:=3 to 6 do
begin
cost[i,1]:=1;cost[8,i]:=1;
if (cost[1,2]=100)or(cost[8,2]=100) then cost[i,2]:=1
else cost[i,2]:=-1;
if (cost[7,1]=100)or(cost[7,8]=100) then cost[7,i]:=1
else cost[7,i]:=-1;
end;
end;
if ichess[1,8]<>none then
begin
cost[2,7]:=-1;
for i:=3 to 6 do
begin
cost[1,i]:=1;cost[i,8]:=1;
if (cost[2,1]=100)or(cost[2,8]=100) then cost[2,i]:=1
else cost[2,i]:=-1;
if (cost[1,7]=100)or(cost[8,7]=100) then cost[i,7]:=1
else cost[i,7]:=-1;
end;
end;

end;

procedure changecost2;
var
i,j:integer;
begin
for i:=1 to 8 do begin
for j:=1 to 8 do begin
cost[i,j]:=1;end;end;
end;

function countvalue:integer;
var
vb,vw,temp,i,j:integer;
wg,bg:integer;
begin
vb:=0;vw:=0;
wg:=0;bg:=0;
if last=0 then changecost();

for i:=1 to 8 do begin
for j:=1 to 8 do begin
if ((i<>1) and (j<>1))or((i<>1) and (j<>8))or((i<>8) and (j<>1))or((i<>8) and (j<>8))or((i<>2) and (j<>2))or((i<>2) and (j<>7))or((i<>7) and (j<>2))or((i<>7) and (j<>7))then
begin
changechess(i,j,compcolor,0);
if chessable<>0 then
begin
if (i=1)and(j=2) then begin if ichess[1,3]<>mancolor then inc(bg);end
else if (i=2)and(j=1) then begin if ichess[3,1]<>mancolor then inc(bg);end
else if (i=7)and(j=1) then begin if ichess[6,1]<>mancolor then inc(bg);end
else if (i=1)and(j=7) then begin if ichess[1,6]<>mancolor then inc(bg);end
else if (i=8)and(j=2) then begin if ichess[8,3]<>mancolor then inc(bg);end
else if (i=2)and(j=8) then begin if ichess[3,8]<>mancolor then inc(bg);end
else if (i=8)and(j=7) then begin if ichess[8,6]<>mancolor then inc(bg);end
else if (i=7)and(j=8) then begin if ichess[6,8]<>mancolor then inc(bg);end
else inc(bg);
end;
changechess(i,j,mancolor,0);
if chessable<>0 then
begin
if (i=1)and(j=2) then begin if ichess[1,3]<>compcolor then inc(wg);end
else if (i=2)and(j=1) then begin if ichess[3,1]<>compcolor then inc(wg);end
else if (i=7)and(j=1) then begin if ichess[6,1]<>compcolor then inc(wg);end
else if (i=1)and(j=7) then begin if ichess[1,6]<>compcolor then inc(wg);end
else if (i=8)and(j=2) then begin if ichess[8,3]<>compcolor then inc(wg);end
else if (i=2)and(j=8) then begin if ichess[3,8]<>compcolor then inc(wg);end
else if (i=8)and(j=7) then begin if ichess[8,6]<>compcolor then inc(wg);end
else if (i=7)and(j=8) then begin if ichess[6,8]<>compcolor then inc(wg);end
else inc(wg);
end;
end;end;end;

for i:=1 to 8 do begin
for j:=1 to 8 do begin
if (ichess[i,j]=compcolor) then vb:=vb+cost[i,j];
if (ichess[i,j]=mancolor) then vw:=vw+cost[i,j];
end;end;
if abs(vb-vw)<30 then
temp:=(abs(vb-vw)+5)*(bg-wg) div 10
else
temp:=(abs(vb-vw)+5)*(bg-wg) div 30;
result:=(vb-vw)+temp;
end;

procedure printchess(x,y:integer;chess:Tbitmap);
var
grid:trect;
begin
grid:=drawgrid.CellRect(x-1, y-1);
if chess=nonechess then begin
drawgrid.Canvas.FillRect(grid);
exit;
end;
drawgrid.canvas.draw(grid.left,grid.top,chess);
end;

procedure changechess(x, y,chess,z:integer);
var
i,j:integer;color:Tbitmap;
begin
if (chess=black) then color:=blackchess
else color:=whitechess;
chessable:=0;
l := 0; r := 0; u := 0; d := 0; lu := 0; ld := 0; rd := 0; ru := 0;
if ichess[x,y]<>none then exit;
if (y>2)and(ichess[x,y-1]<>0)and(ichess[x,y-1]<>chess) then
   begin
   for i:=y-2 downto 1 do
       begin
       if (ichess[x,i]=0) then break;
       if (ichess[x,i]=chess) then begin u:=1;chessable:=1;break;end;
       end;
   end;
if (y<7)and(ichess[x,y+1]<>0)and(ichess[x,y+1]<>chess) then
   begin
   for i:=y+2 to 8 do
       begin
       if (ichess[x,i]=0) then break;
       if (ichess[x,i]=chess) then begin d:=1;chessable:=1;break;end;
       end;
   end;
if (x>2)and(ichess[x-1,y]<>0)and(ichess[x-1,y]<>chess) then
   begin
   for i:=x-2 downto 1 do
       begin
       if (ichess[i,y]=0) then break;
       if (ichess[i,y]=chess) then begin l:=1;chessable:=1;break;end;
       end;
   end;
if (x<7)and(ichess[x+1,y]<>0)and(ichess[x+1,y]<>chess)  then
   begin
   for i:=x+2 to 8 do
       begin
       if (ichess[i,y]=0) then break;
       if (ichess[i,y]=chess) then begin r:=1;chessable:=1;break;end;
       end;
   end;
if (y>2) and (x>2)and(ichess[x-1,y-1]<>0)and(ichess[x-1,y-1]<>chess) then
   begin
   for i:=2 to 7 do
       begin
       if (x-i>=1) and (y-i>=1) then begin
       if (ichess[x-i,y-i]=0) then break;
       if (ichess[x-i,y-i]=chess) then begin lu:=1;chessable:=1;break;end;
       end;end;
   end;
if (y>2) and (x<7)and(ichess[x+1,y-1]<>0)and(ichess[x+1,y-1]<>chess) then
   begin
   for i:=2 to 7 do
       begin
       if (x+i<=8) and (y-i>=1) then begin
       if ichess[x+i,y-i]=0 then break;
       if ichess[x+i,y-i]=chess then begin ru:=1;chessable:=1;break;end;
       end;end;
   end;
if (y<7) and (x<7)and(ichess[x+1,y+1]<>0)and(ichess[x+1,y+1]<>chess) then
   begin
   for i:=2 to 7 do
       begin
       if (x+i<=8) and (y+i<=8) then begin
       if ichess[x+i,y+i]=0 then break;
       if ichess[x+i,y+i]=chess then begin rd:=1;chessable:=1;break;end;
       end;end;
   end;
if (y<7)and(x>2)and(ichess[x-1,y+1]<>0)and(ichess[x-1,y+1]<>chess)then
   begin
   for i:=2 to 7 do
       begin
       if (x-i>=1) and (y+i<=8) then begin
       if ichess[x-i,y+i]=0 then break;
       if ichess[x-i,y+i]=chess then begin ld:=1;chessable:=1;break; end;
       end;end;
   end;
if (chessable=0) or (z=0) then exit;
if (z=1) then
begin
if (chess=black) then blcount:=blcount+1
else whcount:=whcount+1;
end;
if (u=1)then
   begin
   for i:=y-2 downto 1 do
     begin
     if (ichess[x,i]=chess)then
      begin
      for j:=y-1 downto i+1 do
       begin
       ichess[x,y]:=chess;
       ichess[x,j]:=chess;
      if (z=1) then begin
      printchess(x,y,color);
      locate(irol,irow,clred);
      if (chess=black) then turntobl(x,j);
      if (chess=white) then turntowh(x,j);
      end;end;
      break;
      end;end;end;

if (d=1) then
   begin
   for i:=y+2 to 8 do
     begin
     if (ichess[x,i]=chess) then
      begin
      for j:=y+1 to i-1 do
       begin
       ichess[x,y]:=chess;
       ichess[x,j]:=chess;
      if (z=1)then begin
      printchess(x,y,color);
      locate(irol,irow,clred);
      if (chess=black) then turntobl(x,j);
      if (chess=white) then turntowh(x,j);
      end;end;
      break;
      end;end;end;
if (l=1) then
   begin
   for i:=x-2 downto 1 do
     begin
     if (ichess[i,y]=chess) then
      begin
      for j:=x-1 downto i+1 do
       begin
       ichess[x,y]:=chess;
       ichess[j,y]:=chess;
      if (z=1) then begin
      printchess(x,y,color);
      locate(irol,irow,clred);
      if (chess=black) then turntobl(j,y);
      if (chess=white) then turntowh(j,y);
      end;end;
      break;
      end;end;end;
if (r=1) then
   begin
   for i:=x+2 to 8 do
     begin
     if (ichess[i,y]=chess) then
      begin
      for j:=x+1 to i-1 do
       begin
       ichess[x,y]:=chess;
       ichess[j,y]:=chess;
      if (z=1) then begin
      printchess(x,y,color);
      locate(irol,irow,clred);
      if (chess=black) then turntobl(j,y);
      if (chess=white) then turntowh(j,y);
       end;end;
       break;
      end;end;end;
if (lu=1)then
   begin
   for i:=2 to 7 do
     begin
     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;
if (ru=1)then
   begin
   for i:=2 to 7 do
     begin
     if (x+i<=8) 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;
if (rd=1)then
   begin
   for i:=2 to 7 do
     begin
     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;
if (ld=1)then
   begin
   for i:=2 to 7 do
     begin