allbak.pas

实现黑白棋的游戏

//函数单元 all.pas
//BY Lishun,1999,all rights reserved

unit all;
interface
uses
windows,Graphics,Grids,mmsystem,ComCtrls,Sysutils,forms;
type
data=record
  name:string[15];
  level:integer;
  score:integer;
end;
type
openning=record
  x:integer;
  y:integer;
end;
type
openning2=record
  step:array[1..30]of openning;
  name:string;
  level:integer;
  balance:boolean;
end;
type
    pos=record
    x:integer;
    y:integer;
end;
type
    check=record
    position:integer;
    bit:array[1..20]of boolean;
end;

const
none=0;
black=1;
white=2;
speedfast=10;
speednormal=30;
speedslow=60;
booklenth=150;
var
//compchess,manchess:Tbitmap;
eat:array[1..6]of check;
gamerunning:boolean;
compcolor,mancolor:integer;
runsteps:integer;
booklevel:integer=1;
bookname:string;
direction:integer;
bookend:boolean=false;
step:array[1..60]of pos;
book:array[1..booklenth]of openning2;
usebook,balance:boolean;
branch:integer;
isserver,netmode,myselfexit:boolean;
path:string[50];
speed:integer;
drawgrid:tdrawgrid;
statusbar:Tstatusbar;
thisrec:integer;
chess:integer;
dat:array[0..10]of data;
style:integer;
cammode:boolean;
singlemode:boolean;
color,bkcolor:tcolor;
level:integer;
irow,irol:integer;
blcount,whcount,steps:integer;
iblcount,iwhcount,ispace:integer;
deepmax,depth:integer;
ichess:array[1..9,1..9] of integer;
cost: array[1..9,1..9]of integer;
value:array[-15..15] of integer;
savechess: array[1..9,1..9]of integer;
savecost: array[1..9,1..9]of integer;
savesteps,saveblcount,savewhcount:integer;
savego:string[6];
backsteps:integer;
can:integer;
chessable:integer;
l,r,u,d,lu,ld,rd,ru:integer;
cut,max_x,max_y:integer;
max:integer;
last:integer;
  blackchess,whitechess,nonechess:Tbitmap;
  blackchess2,blackchess3,whitechess2,whitechess3:tbitmap;
  lastdepth:integer;
  whogo:string[6];
  soundopen:boolean;
  ram:boolean;
  tempram:integer;
  showhintflag:boolean;
procedure countchess;
procedure changecost;
procedure changecost2;
function countvalue:integer;
procedure printchess(x,y:integer;chess:Tbitmap);
function getmax:integer;
function getbook:boolean;
procedure changechess(x, y,chess,z:integer);
procedure locate(x,y:integer;color:tcolor);
procedure turntobl(x:integer;y:integer);
procedure turntowh(x:integer;y:integer);


implementation

uses main;

function getbook;
var
i:integer;j:integer;success:boolean;
a,b:array[1..booklenth]of integer;temp:integer;
allnone,secsearch:boolean;
label bak;
begin
if booklevel=7 then begin bookend:=true;result:=false;exit;end;
if steps=5 then begin result:=false;exit;end;
if (step[1].x=3)and(step[1].y=4)then direction:=1
else if (step[1].x=4)and(step[1].y=3)then direction:=2
else if (step[1].x=6)and(step[1].y=4)then direction:=3
else if (step[1].x=4)and(step[1].y=6)then direction:=4
else if (step[1].x=3)and(step[1].y=5)then direction:=5
else if (step[1].x=5)and(step[1].y=3)then direction:=6
else if (step[1].x=6)and(step[1].y=5)then direction:=7
else if (step[1].x=5)and(step[1].y=6)then direction:=8;

Randomize;
for i:=1 to booklenth do
begin
a[i]:=Random(32000);
b[i]:=a[i];
end;
for j:=1 to booklenth-1 do
for i:=1 to booklenth-j do
if a[i]>a[i+1] then begin temp:=a[i];a[i]:=a[i+1];a[i+1]:=temp;end;
for i:=1 to booklenth do
for j:=1 to booklenth do
if a[j]=b[i] then begin b[i]:=j;a[j]:=-1;end;
allnone:=false;
secsearch:=false;
bak:
success:=true;
for i:=1 to booklenth do
begin
if (book[b[i]].balance=false)and(balance)and(allnone=false)then continue;
if book[b[i]].level=booklevel then
begin
    //showmessage(inttostr(i));
    success:=true;
    for j:=1 to steps-5 do
    begin
    if direction=1 then begin
        if (step[j].x<>book[b[i]].step[j].x)or(step[j].y<>book[b[i]].step[j].y) then success:=false;end
    else if direction=2 then begin
        if (step[j].y<>book[b[i]].step[j].x)or(step[j].x<>book[b[i]].step[j].y) then success:=false;end
    else if direction=3 then begin
        if (9-step[j].x<>book[b[i]].step[j].x)or(step[j].y<>book[b[i]].step[j].y) then success:=false;end
    else if direction=4 then begin
        if (9-step[j].y<>book[b[i]].step[j].x)or(step[j].x<>book[b[i]].step[j].y) then success:=false;end
    else if direction=5 then begin
        if (step[j].x<>book[b[i]].step[j].x)or(9-step[j].y<>book[b[i]].step[j].y) then success:=false;end
    else if direction=6 then begin
        if (step[j].y<>book[b[i]].step[j].x)or(9-step[j].x<>book[b[i]].step[j].y) then success:=false;end
    else if direction=7 then begin
        if (9-step[j].x<>book[b[i]].step[j].x)or(9-step[j].y<>book[b[i]].step[j].y) then success:=false;end
    else if direction=8 then begin
        if (9-step[j].y<>book[b[i]].step[j].x)or(9-step[j].x<>book[b[i]].step[j].y) then success:=false;end
    end;
    if (success)and(book[b[i]].step[j].x<>0)and(book[b[i]].step[j].y<>0) then
    begin
    result:=true;
    begin
    if direction=1 then begin max_x:=book[b[i]].step[j].x;max_y:=book[b[i]].step[j].y;end
    else if direction=2 then begin max_x:=book[b[i]].step[j].y;max_y:=book[b[i]].step[j].x;end
    else if direction=3 then begin max_x:=9-book[b[i]].step[j].x;max_y:=book[b[i]].step[j].y;end
    else if direction=4 then begin max_x:=book[b[i]].step[j].y;max_y:=9-book[b[i]].step[j].x;end
    else if direction=5 then begin max_x:=book[b[i]].step[j].x;max_y:=9-book[b[i]].step[j].y;end
    else if direction=6 then begin max_x:=9-book[b[i]].step[j].y;max_y:=book[b[i]].step[j].x;end
    else if direction=7 then begin max_x:=9-book[b[i]].step[j].x;max_y:=9-book[b[i]].step[j].y;end
    else if direction=8 then begin max_x:=9-book[b[i]].step[j].y;max_y:=9-book[b[i]].step[j].x;end;
    end;
    bookname:=book[b[i]].name;
    exit;
    end;
end;
end;
if not success then allnone:=true;
if (balance)and(allnone=true)and(not secsearch)then begin secsearch:=true;goto bak;end;
inc(booklevel);
result:=getbook;
end;

procedure countchess;
var
i,j:integer;
begin
iblcount:=0;iwhcount:=0;ispace:=0;
for i:=1 to 8 do begin
for j:=1 to 8 do begin
if ichess[i,j]=compcolor then iblcount:=iblcount+1;
if ichess[i,j]=mancolor then iwhcount:=iwhcount+1;
if ichess[i,j]=none then ispace:=ispace+1;
end;
end;
end;

procedure changecost;
var
i,j:integer;
flu,fru,fld,frd:integer;
temp:integer;
edgleft,edgright,edgtop,edgbot:string;
begin
edgleft:='';edgright:='';edgtop:='';edgbot:='';
for i:=1 to 8 do
begin
    if ichess[1,i]=compcolor then edgleft:=edgleft+'1'
    else if ichess[1,i]=mancolor then edgleft:=edgleft+'2'
    else edgleft:=edgleft+'0';
end;
for i:=1 to 8 do
begin
    if ichess[8,i]=compcolor then edgright:=edgright+'1'
    else if ichess[8,i]=mancolor then edgright:=edgright+'2'
    else edgright:=edgright+'0';
end;
for i:=1 to 8 do
begin
    if ichess[i,1]=compcolor then edgtop:=edgtop+'1'
    else if ichess[i,1]=mancolor then edgtop:=edgtop+'2'
    else edgtop:=edgtop+'0';
end;
for i:=1 to 8 do
begin
    if ichess[i,8]=compcolor then edgbot:=edgbot+'1'
    else if ichess[i,8]=mancolor then edgbot:=edgbot+'2'
    else edgbot:=edgbot+'0';
end;

if (edgleft='01111110')or(edgleft='02222220') then
    for i:=2 to 7 do cost[1,i]:=1
else if (edgleft='01022220')or(edgleft='01102220')or(edgleft='01110220')or(edgleft='01111020') then
   begin cost[1,1]:=20;cost[2,2]:=-10;end
else if (edgleft='02011110')or(edgleft='02201110')or(edgleft='02220110')or(edgleft='02222010') then
   begin cost[1,8]:=20;cost[2,7]:=-10;end
else if (edgleft='00200000')or(edgleft='00220000')or(edgleft='00222000')or(edgleft='00222200') then
   begin cost[1,1]:=100;cost[2,2]:=-20;end
else if (edgleft='00202000')or(edgleft='00202200')then
   begin cost[1,1]:=50;cost[2,2]:=-10;end
else if (edgleft='00000200')or(edgleft='00002200')or(edgleft='00022200')then
   begin cost[1,8]:=100;cost[2,7]:=-20;end
else if (edgleft='00020200')or(edgleft='00220200')then
   begin cost[1,8]:=50;cost[2,7]:=-10;end
else if ((edgleft='00111110')and(ichess[2,3]=compcolor))or((edgleft='00222220')and(ichess[2,3]=mancolor)) then for i:=3 to 7 do cost[1,i]:=-5
else if ((edgleft='01111100')and(ichess[2,6]=compcolor))or((edgleft='02222200')and(ichess[2,6]=mancolor)) then for i:=2 to 6 do cost[1,i]:=-5;


if (edgright='01111110')or(edgright='02222220') then
    for i:=2 to 7 do cost[8,i]:=1
else if (edgright='01022220')or(edgright='01102220')or(edgright='01110220')or(edgright='01111020') then
   begin cost[8,1]:=20;cost[7,2]:=-10;end
else if (edgright='02011110')or(edgright='02201110')or(edgright='02220110')or(edgright='02222010') then
      begin cost[8,8]:=20;cost[7,7]:=-10;end
else if (edgright='00200000')or(edgright='00220000')or(edgright='00222000')or(edgright='00222200') then
      begin cost[8,1]:=100;cost[7,2]:=-20;end
else if (edgright='00202000')or(edgright='00202200')then
      begin cost[8,1]:=50;cost[7,2]:=-10;end
else if (edgright='00000200')or(edgright='00002200')or(edgright='00022200')then
      begin cost[8,8]:=100;cost[7,7]:=-20;end
else if (edgright='00020200')or(edgright='00220200')then
      begin cost[8,8]:=50;cost[7,7]:=-10;end
else if ((edgright='00111110')and(ichess[7,3]=compcolor))or((edgright='00222220')and(ichess[7,3]=mancolor)) then for i:=3 to 7 do cost[8,i]:=-5
else if ((edgright='01111100')and(ichess[7,6]=compcolor))or((edgright='02222200')and(ichess[7,6]=mancolor)) then for i:=2 to 6 do cost[8,i]:=-5;

if (edgtop='01111110')or(edgtop='02222220') then
    for i:=2 to 7 do cost[i,1]:=1
else if (edgtop='01022220')or(edgtop='01102220')or(edgtop='01110220')or(edgtop='01111020') then
         begin cost[1,1]:=20;cost[2,2]:=-10;end
else if (edgtop='02011110')or(edgtop='02201110')or(edgtop='02220110')or(edgtop='02222010') then
         begin cost[8,1]:=20;cost[7,2]:=-10;end
else if (edgtop='00200000')or(edgtop='00220000')or(edgtop='00222000')or(edgtop='00222200') then
         begin cost[1,1]:=100;cost[2,2]:=-20;end
else if (edgtop='00202000')or(edgtop='00202200')then
         begin cost[1,1]:=50;cost[2,2]:=-10;end
else if (edgtop='00000200')or(edgtop='00002200')or(edgtop='00022200')then
         begin cost[8,1]:=100;cost[7,2]:=-20;end
else if (edgtop='00020200')or(edgtop='00220200')then
         begin cost[8,1]:=50;cost[7,2]:=-10;end
else if ((edgtop='00111110')and(ichess[3,2]=compcolor))or((edgtop='00222220')and(ichess[3,2]=mancolor)) then for i:=3 to 7 do cost[i,1]:=-5
else if ((edgtop='01111100')and(ichess[6,2]=compcolor))or((edgtop='02222200')and(ichess[6,2]=mancolor)) then for i:=2 to 6 do cost[i,1]:=-5;

if (edgbot='01111110')or(edgbot='02222220') then
    for i:=2 to 7 do cost[i,8]:=1
else if (edgbot='01022220')or(edgbot='01102220')or(edgbot='01110220')or(edgbot='01111020') then
            begin cost[1,8]:=20;cost[2,8]:=-10;end
else if (edgbot='02011110')or(edgbot='02201110')or(edgbot='02220110')or(edgbot='02222010') then
            begin cost[8,8]:=20;cost[7,7]:=-10;end
else if (edgbot='00200000')or(edgbot='00220000')or(edgbot='00222000')or(edgbot='00222200') then
            begin cost[1,8]:=100;cost[2,8]:=-20;end
else if (edgbot='00202000')or(edgbot='00202200')then
            begin cost[1,8]:=50;cost[2,8]:=-10;end
else if (edgbot='00000200')or(edgbot='00002200')or(edgbot='00022200')then
            begin cost[8,8]:=100;cost[7,7]:=-20;end
else if (edgbot='00020200')or(edgbot='00220200')then
            begin cost[8,8]:=50;cost[7,7]:=-10;end
else if ((edgbot='00111110')and(ichess[3,7]=compcolor))or((edgbot='00222220')and(ichess[3,7]=mancolor)) then for i:=3 to 7 do cost[i,8]:=-5
else if ((edgbot='01111100')and(ichess[6,7]=compcolor))or((edgbot='02222200')and(ichess[6,7]=mancolor)) then for i:=2 to 6 do cost[i,8]:=-5;

temp:=-9;
for i:=2 to 7 do begin
for j:=2 to 7 do begin
if (ichess[i,j]<>none)
and(not((i=2)and(j=2)))and(not((i=7)and(j=2)))and(not((i=2)and(j=7)))and((not(i=7)and(j=7)))
then
begin
if (ichess[i+1,j+1]<>none) then inc(temp);
if (ichess[i-1,j-1]<>none) then inc(temp);
if (ichess[i+1,j-1]<>none) then inc(temp);
if (ichess[i-1,j+1]<>none) then inc(temp);
if (ichess[i+1,j]<>none) then inc(temp);
if (ichess[i,j+1]<>none) then inc(temp);
if (ichess[i-1,j]<>none) then inc(temp);
if (ichess[i,j-1]<>none) then inc(temp);
cost[i,j]:=temp;
temp:=-9;
end;
end;end;
{
if (ichess[1,3]<>none)or(ichess[1,4]<>none)then cost[1,2]:=-5;
if (ichess[8,3]<>none)or(ichess[8,4]<>none)then cost[8,2]:=-5;
if (ichess[3,1]<>none)or(ichess[4,1]<>none)then cost[2,1]:=-5;
if (ichess[3,8]<>none)or(ichess[4,8]<>none)then cost[2,8]:=-5;
if (ichess[1,5]<>none)or(ichess[1,6]<>none)then cost[1,7]:=-5;
if (ichess[8,5]<>none)or(ichess[8,6]<>none)then cost[8,7]:=-5;
if (ichess[5,1]<>none)or(ichess[6,1]<>none)then cost[7,1]:=-5;
if (ichess[5,8]<>none)or(ichess[6,8]<>none)then cost[7,8]:=-5;
}
{for i:=3 to 6 do
begin
if ichess[i,1]<>none then cost[i,2]:=-8;
if ichess[1,i]<>none then cost[2,i]:=-8;
if ichess[i,8]<>none then cost[i,7]:=-8;
if ichess[8,i]<>none then cost[7,i]:=-8;
end;  }

flu:=0;fru:=0;fld:=0;frd:=0;

if ((ichess[2,3]=compcolor)and(ichess[2,4]=compcolor)and(ichess[2,5]=compcolor)and(ichess[2,6]=compcolor))or((ichess[2,3]=white)and(ichess[2,4]=mancolor)and(ichess[2,5]=mancolor)and(ichess[2,6]=mancolor))then
begin
inc(flu);inc(fld);
end;
{else
for i:=3 to 6 do begin if ichess[1,i]=black then cost[2,i]:=5;end;}

if ((ichess[7,3]=compcolor)and(ichess[7,4]=compcolor)and(ichess[7,5]=compcolor)and(ichess[7,6]=compcolor))or((ichess[7,3]=mancolor)and(ichess[7,4]=mancolor)and(ichess[7,5]=mancolor)and(ichess[7,6]=mancolor))then
begin
inc(fru);inc(frd);
end;

{else
for i:=3 to 6 do begin if ichess[8,i]=black then cost[7,i]:=5;end; }

if ((ichess[3,2]=compcolor)and(ichess[4,2]=compcolor)and(ichess[5,2]=compcolor)and(ichess[6,2]=compcolor))or((ichess[3,2]=mancolor)and(ichess[4,2]=mancolor)and(ichess[5,2]=mancolor)and(ichess[6,2]=mancolor))then
begin
inc(flu);inc(fru);
end;
{else
for i:=3 to 6 do begin if ichess[i,1]=black then cost[i,2]:=5;end; }

if ((ichess[3,7]=compcolor)and(ichess[4,7]=compcolor)and(ichess[5,7]=compcolor)and(ichess[6,7]=compcolor))or((ichess[3,7]=mancolor)and(ichess[4,7]=mancolor)and(ichess[5,7]=mancolor)and(ichess[6,7]=mancolor))then
begin
inc(fld);inc(frd);
end;
{else
for i:=3 to 6 do begin if ichess[i,8]=black then cost[i,7]:=5;end; }

if flu=1 then begin if (ichess[2,3]=compcolor)or(ichess[3,2]=compcolor) then cost[2,2]:=-10 else cost[2,2]:=-1;end;
if fld=1 then begin if (ichess[2,6]=compcolor)or(ichess[3,7]=compcolor) then cost[2,7]:=-10 else cost[2,7]:=-1;;end;
if fru=1 then begin if (ichess[7,3]=compcolor)or(ichess[6,2]=compcolor) then cost[7,2]:=-10 else cost[7,2]:=-1;;end;
if frd=1 then begin if (ichess[7,6]=compcolor)or(ichess[6,7]=compcolor) then cost[7,7]:=-10 else cost[7,7]:=-1;;end;

if flu=2 then begin if (ichess[2,3]=compcolor)or(ichess[3,2]=compcolor) then cost[2,2]:=-20 else cost[2,2]:=20;end;
if fld=2 then begin if (ichess[2,6]=compcolor)or(ichess[3,7]=compcolor) then cost[2,7]:=-20 else cost[2,7]:=20;;end;
if fru=2 then begin if (ichess[7,3]=compcolor)or(ichess[6,2]=compcolor) then cost[7,2]:=-20 else cost[7,2]:=20;;end;
if frd=2 then begin if (ichess[7,6]=compcolor)or(ichess[6,7]=compcolor) then cost[7,7]:=-20 else cost[7,7]:=20;;end;