all.pas

象棋源码

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

unit all;
interface
uses
  windows, Graphics, Grids, mmsystem, ComCtrls, Sysutils, forms, ueval;

type
  _eva = record
    max: real;
    x: integer;
    y: integer;
    path: string;
  end;
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 = 20;
  speedslow = 50;
  booklenth = 200;
  freehand = 2;
var
  auto: boolean;
  chesspath: array[0..21] of string;
  stablycomp, stablyman: integer;
  candraw: boolean;
  addflag: integer;
  evapoint: integer;
  saveva: array[1..40] of _eva;
  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;
  stablyc, stablym: array[0..9, 0..9] of boolean;
  ichess: array[1..9, 1..9] of integer;
  cost: array[1..9, 1..9] of integer;
  value: array[-15..15] of real;
  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: real;
  last, last2: integer;
  blackchess, whitechess, nonechess: Tbitmap;
  blackchess2, blackchess3, whitechess2, whitechess3: tbitmap;
  lastdepth: integer;
  whogo: string[6];
  soundopen: boolean;
  ram: boolean;
  tempram: integer;
  showhintflag: boolean;
procedure getstably;
procedure sorteva;
procedure countchess;
procedure changecost;
procedure changecost2;
//procedure changecost3;
procedure printchess(x, y: integer; chess: Tbitmap);
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;

procedure getstably;
var
  i, j: integer;
  dirc, dirm: integer;
begin
  stablyman := 0; stablycomp := 0;
  for i := 1 to 8 do
    for j := 1 to 8 do
    begin
      stablyc[i, j] := false;
      stablym[i, j] := false;
    end;
  for i := 1 to 8 do
    for j := 1 to 8 do
    begin
      dirc := 0; dirm := 0;
      if ichess[i, j] = compcolor then
      begin
        if (stablyc[i - 1, j] = true) or (stablyc[i + 1, j] = true) then inc(dirc);
        if (stablyc[i - 1, j - 1] = true) or (stablyc[i + 1, j + 1] = true) then inc(dirc);
        if (stablyc[i, j - 1] = true) or (stablyc[i, j + 1] = true) then inc(dirc);
        if (stablyc[i - 1, j + 1] = true) or (stablyc[i + 1, j - 1] = true) then inc(dirc);
      end
      else if ichess[i, j] = mancolor then
      begin
        if (stablym[i - 1, j] = true) or (stablym[i + 1, j] = true) then inc(dirm);
        if (stablym[i - 1, j - 1] = true) or (stablym[i + 1, j + 1] = true) then inc(dirm);
        if (stablym[i, j - 1] = true) or (stablym[i, j + 1] = true) then inc(dirm);
        if (stablym[i - 1, j + 1] = true) or (stablym[i + 1, j - 1] = true) then inc(dirm);
      end;
      if dirc = 4 then stablyc[i, j] := true;
      if dirm = 4 then stablym[i, j] := true;
    end;
  for i := 1 to 8 do
    for j := 8 downto 1 do
    begin
      dirc := 0; dirm := 0;
      if ichess[i, j] = compcolor then
      begin
        if (stablyc[i - 1, j] = true) or (stablyc[i + 1, j] = true) then inc(dirc);
        if (stablyc[i - 1, j - 1] = true) or (stablyc[i + 1, j + 1] = true) then inc(dirc);
        if (stablyc[i, j - 1] = true) or (stablyc[i, j + 1] = true) then inc(dirc);
        if (stablyc[i - 1, j + 1] = true) or (stablyc[i + 1, j - 1] = true) then inc(dirc);
      end
      else if ichess[i, j] = mancolor then
      begin
        if (stablym[i - 1, j] = true) or (stablym[i + 1, j] = true) then inc(dirm);
        if (stablym[i - 1, j - 1] = true) or (stablym[i + 1, j + 1] = true) then inc(dirm);
        if (stablym[i, j - 1] = true) or (stablym[i, j + 1] = true) then inc(dirm);
        if (stablym[i - 1, j + 1] = true) or (stablym[i + 1, j - 1] = true) then inc(dirm);
      end;
      if dirc = 4 then stablyc[i, j] := true;
      if dirm = 4 then stablym[i, j] := true;
    end;
  for j := 1 to 8 do
    for i := 1 to 8 do
    begin
      dirc := 0; dirm := 0;
      if ichess[i, j] = compcolor then
      begin
        if (stablyc[i - 1, j] = true) or (stablyc[i + 1, j] = true) then inc(dirc);
        if (stablyc[i - 1, j - 1] = true) or (stablyc[i + 1, j + 1] = true) then inc(dirc);
        if (stablyc[i, j - 1] = true) or (stablyc[i, j + 1] = true) then inc(dirc);
        if (stablyc[i - 1, j + 1] = true) or (stablyc[i + 1, j - 1] = true) then inc(dirc);
      end
      else if ichess[i, j] = mancolor then
      begin
        if (stablym[i - 1, j] = true) or (stablym[i + 1, j] = true) then inc(dirm);
        if (stablym[i - 1, j - 1] = true) or (stablym[i + 1, j + 1] = true) then inc(dirm);
        if (stablym[i, j - 1] = true) or (stablym[i, j + 1] = true) then inc(dirm);
        if (stablym[i - 1, j + 1] = true) or (stablym[i + 1, j - 1] = true) then inc(dirm);
      end;
      if dirc = 4 then stablyc[i, j] := true;
      if dirm = 4 then stablym[i, j] := true;
    end;
  for j := 1 to 8 do
    for i := 8 downto 1 do
    begin
      dirc := 0; dirm := 0;
      if ichess[i, j] = compcolor then
      begin
        if (stablyc[i - 1, j] = true) or (stablyc[i + 1, j] = true) then inc(dirc);
        if (stablyc[i - 1, j - 1] = true) or (stablyc[i + 1, j + 1] = true) then inc(dirc);
        if (stablyc[i, j - 1] = true) or (stablyc[i, j + 1] = true) then inc(dirc);
        if (stablyc[i - 1, j + 1] = true) or (stablyc[i + 1, j - 1] = true) then inc(dirc);
      end
      else if ichess[i, j] = mancolor then
      begin
        if (stablym[i - 1, j] = true) or (stablym[i + 1, j] = true) then inc(dirm);
        if (stablym[i - 1, j - 1] = true) or (stablym[i + 1, j + 1] = true) then inc(dirm);
        if (stablym[i, j - 1] = true) or (stablym[i, j + 1] = true) then inc(dirm);
        if (stablym[i - 1, j + 1] = true) or (stablym[i + 1, j - 1] = true) then inc(dirm);
      end;
      if dirc = 4 then stablyc[i, j] := true;
      if dirm = 4 then stablym[i, j] := true;
    end;
  for i := 1 to 8 do
    for j := 1 to 8 do
    begin
      if stablyc[i, j] = true then inc(stablycomp);
      if stablym[i, j] = true then inc(stablyman);
    end;
end;


procedure sorteva;
var
  i, j: integer;
  templink: _eva;
begin
//
  for j := 1 to 39 do
    for i := 1 to 40 - j do
    begin
      if saveva[i].max <= saveva[i + 1].max then
      begin
        templink.max := saveva[i].max;
        templink.x := saveva[i].x;
        templink.y := saveva[i].y;
        templink.path := saveva[i].path;
        saveva[i].max := saveva[i + 1].max;
        saveva[i].x := saveva[i + 1].x;
        saveva[i].y := saveva[i + 1].y;
        saveva[i].path := saveva[i + 1].path;
        saveva[i + 1].max := templink.max;
        saveva[i + 1].x := templink.x;
        saveva[i + 1].y := templink.y;
        saveva[i + 1].path := templink.path;
      end;
    end
end;

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 = 8 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:
  for i := 1 to booklenth do
  begin
//success:=true;
    if (book[b[i]].balance = false) and (balance) and (allnone = false) then continue;
    if book[b[i]].level = booklevel then
    begin
      success := true;
    //showmessage(inttostr(i));
      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 inc(iblcount);
      if ichess[i, j] = mancolor then inc(iwhcount);
      if ichess[i, j] = none then inc(ispace);
    end;
  end;
end;

procedure changecost;
var
  i, j: integer;
  temp: integer;
//flag:array[1..8,1..8]of boolean;
begin
{for i:=1 to 8 do
for j:=1 to 8 do
    flag[i,j]:=false;
for i:=1 to 4 do
    if ichess[i,1]<>none then
    if i>2 then begin cost[i,2]:=-10;flag[i,2]:=true;break;end
    else break;
for i:=1 to 4 do
    if ichess[i,8]<>none then
    if i>2 then begin cost[i,7]:=-10;flag[i,7]:=true;break;end
    else break;
for i:=1 to 4 do
    if ichess[1,i]<>none then
    if i>2 then begin cost[2,i]:=-10;flag[2,i]:=true;break;end
    else break;
for i:=1 to 4 do
    if ichess[8,i]<>none then
    if i>2 then begin cost[7,i]:=-10;flag[7,i]:=true;break;end
    else break;
for i:=8 downto 5 do