main.pas

实现黑白棋的游戏

      myfile.Free;
      with tablefrm.grid do
        if wintab then tablefrm.showmodal;
    end;
  end;
  if MessageDlg('想再玩一局吗?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  begin
    if singlemode then
    begin
      if cammode then MenuVSclick(self)
      else MenuOneclick(self);
    end
    else if not netmode then MenuTwoclick(self)
    else if isserver then
    begin
      ini;
      whogo := '黑棋';
      tree.Items.item[2].Text := '轮到'+whogo+'走';
      locate(irol, irow, clred);
      tree.Items.item[3].Text:='黑棋：'+inttostr(blcount);
      tree.Items.item[4].Text:='白棋：'+inttostr(whcount);
    end
    else
    begin
      drawgrid1.Enabled := false;
      ini;
      whogo := '黑棋';
      tree.Items.item[2].Text:='轮到'+whogo+'走';
      locate(irol, irow, clred);
      tree.Items.item[3].Text:='黑棋：'+inttostr(blcount);
      tree.Items.item[4].Text:='白棋：'+inttostr(whcount);
    end;
  end
  else
  begin
    if singlemode then MenuOne.Checked := false
    else MenuTwo.Checked := false;
    if netmode then
    begin
      myselfexit := true;
      netmode := false;
      if not isserver then myclient.Close
      else myserver.Close;
    end;
  end;
  formpaint(self);
end;

procedure Tmainfrm.compgo;
var
  i, j: integer;
  time1, time2: longint;
  h1, h2, m1, m2, s1, s2, ms1, ms2: word;
  temp: real;
begin
//computergo
  if whogo <> '电脑' then exit;
  for i := 1 to 8 do begin
    for j := 1 to 8 do begin
      changechess(i, j, compcolor, 0);
      if chessable = 1 then break;
    end;
    if chessable = 1 then break;
  end;
  if (chessable = 0) then
  begin
    label7.caption := '电脑略过    ';
    label7.Refresh;
    if not auto then showmessage('电脑略过');
    sleep(speed * 10);
    label7.caption := '            ';
    label7.Refresh;
    whogo := '玩家';
    exit;
  end;
  gamerunning := true;
  lastdepth := level * 2 + 1;
  whitetime := whitetime + time - wstime;
  label12.Caption := FormatDateTime('"玩家用时："hh:mm:ss:zz', whitetime);
  label12.Refresh;
  decodetime(blacktime, h1, m1, s1, ms1);
  decodetime(whitetime, h2, m2, s2, ms2);
  time1 := h1 * 360000 + m1 * 60000 + s1 * 1000 + ms1;
  time2 := h2 * 360000 + m2 * 60000 + s2 * 1000 + ms2;
  if (time1 + time2) <> 0 then gauge1.Progress := time1 * 100 div (time1 + time2)
  else gauge1.Progress := 100;
  if (time1 + time2) <> 0 then gauge2.Progress := time2 * 100 div (time1 + time2)
  else gauge2.Progress := 100;
  bstime := time;
  drawgrid1.Enabled := false;
  try
    tree.Items.item[2].Text := '轮到'+whogo+'走';
    tree.refresh;
    locate(irol, irow, clwhite);
    countchess();
//初始化
    if (ispace <= lastdepth) then
    begin
      runsteps := lastdepth;
      deepmax := lastdepth;
    end
    else
    begin
      runsteps := level;
      deepmax := level;
    end;
    depth := deepmax;
    for i := -15 to 15 do
    begin
      if (i mod 2) = 0 then value[i] := 9000;
      if (i mod 2 = 1) or (i mod 2 = -1) then value[i] := -9000;
    end;
    cut := 0;
    branch := 0;
    randomize();
    comeva.Items.Clear;
    evapoint := 1;
    for i := 1 to 21 do
      chesspath[i] := '';
//end初始化
    if ispace <= lastdepth then
    begin last := 1; changecost2; end
    else if ispace <= lastdepth + 6 then
    begin last2 := 1; end;

    if (usebook) and (not bookend) then
    begin
      if not getbook then
      begin
        for i := 1 to 40 do
        begin
          saveva[i].max := -10000;
          saveva[i].x := 0;
          saveva[i].y := 0;
          saveva[i].path := ''
        end;
        addflag := 0;
        temp := getmax;
        sorteva;
        evapoint := 1;
        while saveva[evapoint].x <> 0 do
        begin
          comeva.items.add(chr(saveva[evapoint].x + 64) + inttostr(saveva[evapoint].y) + ':' + floattostr(saveva[evapoint].max));
          inc(evapoint);
        end;
        comeva.ItemIndex := 0;
      end
      else begin temp := 0; branch := 0; end;
    end
    else
    begin
      for i := 1 to 40 do
      begin
        saveva[i].max := -10000;
        saveva[i].x := 0;
        saveva[i].y := 0;
        saveva[i].path := ''
      end;
      addflag := 0;
      temp := getmax;
      sorteva;
      evapoint := 1;
      while saveva[evapoint].x <> 0 do
      begin
        comeva.items.add(chr(saveva[evapoint].x + 64) + inttostr(saveva[evapoint].y) + ':' + floattostr(saveva[evapoint].max));
        inc(evapoint);
      end;
      comeva.ItemIndex := 0;
    end;

    statusbar.Panels.Items[1].text := '推理分枝数：' + inttostr(branch);
    if last <> 1 then
    begin
      if temp >= 0 then temp := round(power(temp, 0.88) * 100) / 100
      else temp := -round(power(-temp, 0.88) * 100) / 100;
    end;
    if not cammode then statusbar.Panels.Items[2].text := '估值：' + floattostr(temp);
    statusbar.Panels.Items[3].text := '开局：' + bookname;
    irol := max_x; irow := max_y;
    step[steps - 4].x := max_x;
    step[steps - 4].y := max_y;
    steps := steps + 1;
    changechess(max_x, max_y, compcolor, 1);
    if last <> 1 then changecost;
    tree.Items.item[3].Text:='黑棋：'+inttostr(blcount);
    tree.Items.item[4].Text:='白棋：'+inttostr(whcount);
    for i := 1 to 8 do begin
      for j := 1 to 8 do begin
        changechess(i, j, mancolor, 0);
        if chessable = 1 then break;
      end;
      if chessable = 1 then break;
    end;
    if (chessable = 0) then
    begin
      label7.caption := '玩家略过    ';
      label7.Refresh;
      if not auto then showmessage('玩家略过');
      sleep(speed * 10);
      label7.caption := '            ';
      label7.Refresh;
    end
    else
    begin
      label7.caption := '            ';
      whogo := '玩家';
      tree.Items.item[2].Text:='轮到'+whogo+'走';
      exit;
    end;
    for i := 1 to 8 do begin
      for j := 1 to 8 do begin
        changechess(i, j, compcolor, 0);
        if chessable = 1 then break;
      end;
      if chessable = 1 then break;
    end;
    if (chessable = 0) then
    begin
      label7.caption := '电脑略过    ';
      label7.Refresh;
      if not auto then showmessage('电脑略过');
      sleep(speed * 10);
      label7.caption := '            ';
      label7.Refresh;
      btnBack.Enabled := false;
      MenuBack.enabled := false;
      result; exit;
    end
    else
    begin
      label7.caption := '            ';
      whogo := '电脑';
      tree.Items.item[2].Text:='轮到'+whogo+'走';
      compgo;
      exit;
    end;
  finally
    drawgrid1.Enabled := true;
    blacktime := blacktime + time - bstime;
    label11.Caption := FormatDateTime('"电脑用时："hh:mm:ss:zzz', blacktime);
    decodetime(blacktime, h1, m1, s1, ms1);
    decodetime(whitetime, h2, m2, s2, ms2);
    time1 := h1 * 360000 + m1 * 60000 + s1 * 1000 + ms1;
    time2 := h2 * 360000 + m2 * 60000 + s2 * 1000 + ms2;
    if (time1 + time2) <> 0 then gauge1.Progress := time1 * 100 div (time1 + time2)
    else gauge1.Progress := 100;
    if (time1 + time2) <> 0 then gauge2.Progress := time2 * 100 div (time1 + time2)
    else gauge2.Progress := 100;
    wstime := time;
  end;
end;

procedure Tmainfrm.load;
var
  i, j: integer;
begin
  irol := 1; irow := 1;
  for i := 1 to 8 do begin
    for j := 1 to 8 do begin
      ichess[i, j] := savechess[i, j];
      cost[i, j] := savecost[i, j];
      if (ichess[i, j] = black) then printchess(i, j, blackchess)
      else if (ichess[i, j] = white) then printchess(i, j, whitechess)
      else printchess(i, j, nonechess);
    end;
  end;
  steps := savesteps;
  blcount := saveblcount;
  whcount := savewhcount;
  whogo := savego;
  tree.Items.item[3].Text:='黑棋：'+inttostr(blcount);
  tree.Items.item[4].Text:='白棋：'+inttostr(whcount);
end;

procedure Tmainfrm.save;
var
  i, j: integer;
begin
  for i := 1 to 9 do begin
    for j := 1 to 9 do begin
      savechess[i, j] := ichess[i, j];
      savecost[i, j] := cost[i, j];
    end; end;
  savesteps := steps;
  saveblcount := blcount;
  savewhcount := whcount;
  savego := whogo;
end;

procedure Tmainfrm.FormShow(Sender: TObject);
begin
  if not fileexists(path + 'bw.wav') then messagebox(0, '找不到文件“bw.wav”,将不能播放声音', '警告', mb_ok);
  drawgrid := mainfrm.drawgrid1;
  statusbar := statusbar1;
  gauge1.ForeColor := panel1.color;
  gauge2.ForeColor := panel1.color;
  tree.FullExpand;
end;

procedure Tmainfrm.MenuSoundClick(Sender: TObject);
begin
  if MenuSound.Checked = true then
  begin
    MenuSound.checked := false;
    btnSound.Down:=false;
    soundopen := false
  end
  else
  begin
    MenuSound.Checked := true;
    btnSound.Down:=true;
    soundopen := true;
  end;
end;

procedure Tmainfrm.MenuExpClick(Sender: TObject);
begin
  if cammode then
  begin
    if MessageDlg('使用高级选项前必须结束当前棋局,' + #13 + '要继续吗?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
    begin
      MenuOne.Checked := false;
      MenuTwo.Checked := false;
      MenuVS.Checked := false;
      myselfexit := true;
      netmode := false;
      if not isserver then myclient.Close
      else myserver.Close;
      setfrm.showmodal;
    end;
  end
  else
  begin
    setfrm.showmodal;
  end;
end;

procedure Tmainfrm.MenuBkClick(Sender: TObject);
begin
  if dm.colorDialog1.execute then
    panel1.Color := dm.colorDialog1.color;
  gauge1.ForeColor := panel1.color;
  gauge2.ForeColor := panel1.color;
end;

procedure Tmainfrm.MenuSlowClick(Sender: TObject);
begin
  MenuSlow.Checked := true;
  speed := speedslow;
end;

procedure Tmainfrm.MenuNormalClick(Sender: TObject);
begin
  MenuNormal.Checked := true;
  speed := speednormal;
end;

procedure Tmainfrm.MenuFastClick(Sender: TObject);
begin
  MenuFast.Checked := true;
  speed := speedfast;
end;

procedure Tmainfrm.MenuTopicClick(Sender: TObject);
begin
  application.HelpCommand(help_finder, 0);
end;

procedure tmainfrm.bmpcrt;
begin
  blackchess := Tbitmap.Create;
  blackchess2 := Tbitmap.Create;
  blackchess3 := Tbitmap.Create;
  whitechess := Tbitmap.Create;
  whitechess2 := Tbitmap.Create;
  whitechess3 := Tbitmap.Create;
  blackchess.assign(image2.picture);
  blackchess2.assign(image3.picture);
  blackchess3.assign(image4.picture);
  whitechess.assign(image7.picture);
  whitechess2.assign(image8.picture);
  whitechess3.assign(image9.picture);
end;

procedure Tmainfrm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (irow <> 0) and (irol <> 0) then begin
    locate(irol, irow, clwhite);
    case key of
      vk_up: begin
          if irow = 1 then irow := 8
          else irow := irow - 1;
        end;
      vk_Down: begin
          if irow = 8 then irow := 1
          else irow := irow + 1;
        end;
      vk_left: begin
          if irol = 1 then irol := 8
          else irol := irol - 1;
        end;
      vk_right: begin
          if irol = 8 then irol := 1
          else irol := irol + 1;
        end;
      vk_space: mango;
      vk_back: if btnBack.Enabled = true then load;
    end;
    mainfrm.paint;
    locate(irol, irow, clred);
  end;
end;

procedure tmainfrm.mango;
var
  i, j, Ewhogo: integer;
  testchess: integer;
  time1, time2: integer;
  h1, h2, m1, m2, s1, s2, ms1, ms2: word;
begin
  try
    if not singlemode then
    begin
      if whogo = '白棋' then whitetime := whitetime + time - wstime
      else blacktime := blacktime + time - bstime;
      if whogo = '黑棋' then
      begin
        label11.Caption := FormatDateTime('"黑棋用时："hh:mm:ss:zz', blacktime);
        label11.Refresh;
      end
      else
      begin
        label12.Caption := FormatDateTime('"白棋用时："hh:mm:ss:zz', whitetime);
        label12.Refresh;
      end;
      decodetime(blacktime, h1, m1, s1, ms1);
      decodetime(whitetime, h2, m2, s2, ms2);
      time1 := h1 * 360000 + m1 * 60000 + s1 * 1000 + ms1;
      time2 := h2 * 360000 + m2 * 60000 + s2 * 1000 + ms2;
      if (time1 + time2) <> 0 then gauge1.Progress := time1 * 100 div (time1 + time2)
      else gauge1.Progress := 100;
      if (time1 + time2) <> 0 then gauge2.Progress := time2 * 100 div (time1 + time2)
      else gauge2.Progress := 100;
      if whogo = '黑棋' then wstime := time
      else bstime := time;
    end;
    if (steps = 4) or (steps = 5) then backsteps := 0
    else backsteps := 1;