main.pas

实现黑白棋的游戏

    countchess();
    depth := 1;
    if not singlemode then
    begin
      if (whogo = '黑棋') then
      begin
        Ewhogo := black;
      end
      else
      begin
        Ewhogo := white;
      end;
    end
    else
      Ewhogo := mancolor;
    if ichess[irol, irow] = black then printchess(irol, irow, blackchess)
    else if ichess[irol, irow] = white then printchess(irol, irow, whitechess);
    changechess(irol, irow, Ewhogo, 0);
    if chessable = 0 then begin beep; exit; end;
    gamerunning := true;
    if singlemode then
    begin
      save;
      if not cammode then
      begin
        btnBack.Enabled := true;
        MenuBack.enabled := true;
      end;
    end;
    changechess(irol, irow, Ewhogo, 1);
    step[steps - 4].x := irol;
    step[steps - 4].y := irow;
    steps := steps + 1;
    tree.Items.item[3].Text:='黑棋：'+inttostr(blcount);
    tree.Items.item[4].Text:='白棋：'+inttostr(whcount);
    if singlemode then
    begin {single}
      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;
      end
      else
      begin
        whogo := '电脑';
        label7.Caption := '电脑正在思考';
        label7.refresh;
        screen.Cursor := crhourglass;
        compgo;
        if showhintflag then
        begin
          clearhint;
          myshowhint;
        end;
        screen.Cursor := crdefault;
        exit;
      end;
      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;
        btnBack.Enabled := false;
        MenuBack.enabled := false;
        result;
        exit;
      end;
    end; {single}
    if not singlemode then begin {not single}
//drawgrid1.Enabled:=false;
      if whogo = '黑棋' then testchess := white
      else testchess := black;
      for i := 1 to 8 do begin
        for j := 1 to 8 do begin
          changechess(i, j, testchess, 0);
          if chessable = 1 then break;
        end;
        if chessable = 1 then break;
      end;
      if (chessable = 0) then
      begin
        if testchess = black then label7.caption := '黑棋略过    '
        else label7.Caption := '白棋略过    ';
        if not auto then
        begin
          if testchess = black then showmessage('黑棋略过')
          else showmessage('白棋略过');
        end;
        label7.Refresh;
        sleep(speed * 10);
        label7.Caption := '            ';
        label7.Refresh;
      end
      else //(chessabel<>0)
      begin
        label7.caption := '            ';
        if whogo = '白棋' then whogo := '黑棋'
        else whogo := '白棋';
        tree.Items.item[2].Text := '轮到'+whogo+'走';
        if showhintflag then
        begin
          clearhint;
          myshowhint;
        end;
        exit;
      end;
      if testchess = black then testchess := white
      else testchess := black;
      for i := 1 to 8 do begin
        for j := 1 to 8 do begin
          changechess(i, j, testchess, 0);
          if chessable = 1 then break;
        end;
        if chessable = 1 then break;
      end;
      if (chessable = 0) then
      begin
        if testchess = black then
          label7.caption := '黑棋略过    '
        else label7.Caption := '白棋略过    ';
        if not auto then
        begin
          if testchess = black then showmessage('黑棋略过')
          else showmessage('白棋略过');
        end;
        label7.Refresh;
        sleep(speed * 10);
        label7.Caption := '            ';
        label7.Refresh;
        btnBack.Enabled := false;
        MenuBack.enabled := false;
        result;
        exit;
      end
    end; {not single}
  finally
    if whogo = '黑棋' then
    begin
      if netmode then
        if isserver then drawgrid1.Enabled := true
        else drawgrid1.Enabled := false;
    end
    else if (whogo = '玩家') or (whogo = '白棋') then
    begin
      if netmode then
        if isserver then drawgrid1.Enabled := false
        else drawgrid1.Enabled := true;
    end;
  end;
end;


procedure Tmainfrm.drawgrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
  mainfrm.paint;
end;


procedure Tmainfrm.FormActivate(Sender: TObject);
begin
  if singlemode then begin
    case level of
        1:tree.Items.item[1].Text:='难度：一级';
        2:tree.Items.item[1].Text:='难度：二级';
        3:tree.Items.item[1].Text:='难度：三级';
        4:tree.Items.item[1].Text:='难度：四级';
        5:tree.Items.item[1].Text:='难度：五级';
        6:tree.Items.item[1].Text:='难度：六级';
        7:tree.Items.item[1].Text:='难度：七级';
    end;
  end
  else tree.Items.item[1].Text := '';
  tree.Items.item[2].Text := '轮到'+whogo+'走';
end;

procedure Tmainfrm.drawgrid1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  xx, yy: integer;
begin
  if button = mbleft then begin
    drawGrid1.MouseToCell(X, Y, xx, yy);
    locate(irol, irow, clwhite);
    irow := yy + 1; irol := xx + 1;
    if netmode then
    begin
      if isserver then myserver.Socket.Connections[0].SendText(inttostr(irow) + inttostr(irol))
      else myclient.Socket.SendText(inttostr(irow) + inttostr(irol));
    end;
    mango;
    locate(irol, irow, clred);
  end;
end;

procedure Tmainfrm.MenuServerClick(Sender: TObject);
begin
  myselfexit := true;
  if myclient.Active then myclient.Close;
  if myserver.Active then myserver.Close;
//if not myserver.Socket.Connected then
  begin
    waitfrm.show;
    screen.Cursor := crHourGlass;
    try
      myserver.Active := true;
    except
      showmessage('本台计算机已经有人做了主机');
    end;
    isserver := true;
    singlemode := false;
    tree.Items.item[1].Text := '    ';
    drawgrid1.Enabled := true;
    btnBack.Enabled := false;
    MenuBack.enabled := false;
    style := 1;
    ini;
    whogo := '黑棋';
    singlemode := false;
    cammode := false;
    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;

procedure Tmainfrm.MenuClientClick(Sender: TObject);
var
  server: string;
begin
  myselfexit := true;
  if myserver.Active then myserver.Close;
  if myclient.Active then myclient.Close;
//if not myclient.Socket.Connected then
  if inputquery('连接', '请输入主机的名字', server) then
  begin
    drawgrid1.Enabled := false;
    myclient.host := server;
    try
      myclient.active := true;
    except
      showmessage('本台计算机已经有人做了客机');
    end;
    isserver := false;
    cammode := false;
    singlemode := false;
    tree.Items.item[1].Text := '    ';
    btnBack.Enabled := false;
    MenuBack.enabled := false;
    style := 1;
    ini;
    whogo := '黑棋';
    singlemode := false;
    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;

procedure Tmainfrm.myServerClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  myselfexit := false;
  waitfrm.close;
  screen.Cursor := crdefault;
  netmode := true;
end;

procedure Tmainfrm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  myselfexit := true;
  netmode := false;
  if not isserver then myclient.Close
  else myserver.Close;
end;

procedure Tmainfrm.myClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  netmode := true;
  myselfexit := false;
end;

procedure Tmainfrm.myClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  netmode := false;
  if myselfexit = false then
    showmessage('有一方退出了比赛');
  ini;
end;

procedure Tmainfrm.myServerClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  netmode := false;
  if myselfexit = false then
    showmessage('有一方退出了比赛');
  ini;
end;

procedure Tmainfrm.myClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
  temp: string;
  tx, ty: integer;
begin
  temp := Socket.ReceiveText;
  ty := strtoint(copy(temp, 1, 1));
  tx := strtoint(copy(temp, 2, 1));
  locate(irol, irow, clwhite);
  irow := ty; irol := tx;
  mango;
  locate(irol, irow, clred);
//drawgrid1.Enabled:=true;
end;

procedure Tmainfrm.myServerClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  temp: string;
  tx, ty: integer;
begin
  temp := Socket.ReceiveText;
  ty := strtoint(copy(temp, 1, 1));
  tx := strtoint(copy(temp, 2, 1));
  locate(irol, irow, clwhite);
  irow := ty; irol := tx;
  mango;
  locate(irol, irow, clred);
//drawgrid1.Enabled:=true;
end;

procedure Tmainfrm.MenuVSClick(Sender: TObject);
begin
  if netmode then
    if MessageDlg('要退出联网模式吗?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
    begin
      netmode := false;
      cammode := true;
      myselfexit := true;
      if not isserver then myclient.Close
      else myserver.Close;
    end
    else exit;
  btnVS.Down:=true;
  MenuVS.Checked := true;
  drawgrid1.Enabled := true;
  MenuOpenning.Enabled := false;
  btnopenning.Enabled := false;
  MenuForce.Enabled := false;
  steps := 5;
  MenuSave.Enabled := false;
  MenuLoad.Enabled := false;
  btnsave.Enabled := false;
  btnload.Enabled := false;
  btnBack.Enabled := false;
  MenuBack.enabled := false;
  ini;
  if compcolor = white then whogo := '玩家'
  else whogo := '电脑';
  tree.Items.item[2].Text := '轮到'+whogo+'走';
  cammode := true;
  singlemode := true;
  locate(irol, irow, clred);
  tree.Items.item[3].Text:='黑棋：'+inttostr(blcount);
  tree.Items.item[4].Text:='白棋：'+inttostr(whcount);
  case level of
    1:tree.Items.item[1].Text:='难度：一级';
    2:tree.Items.item[1].Text:='难度：二级';
    3:tree.Items.item[1].Text:='难度：三级';
    4:tree.Items.item[1].Text:='难度：四级';
    5:tree.Items.item[1].Text:='难度：五级';
    6:tree.Items.item[1].Text:='难度：六级';
    7:tree.Items.item[1].Text:='难度：七级';
  end;
  compgo;
end;

procedure Tmainfrm.MenuForceClick(Sender: TObject);
begin
  whogo := '电脑';
  compgo;
end;

procedure Tmainfrm.Timer1Timer(Sender: TObject);
var
  i, j: integer;
  chess: Tbitmap;
begin
  try
    if candraw then
    begin
      for i := 1 to 8 do begin
        for j := 1 to 8 do begin
          if ichess[i, j] = black then chess := blackchess
          else if ichess[i, j] = white then chess := whitechess
          else chess := nonechess;
          printchess(i, j, chess);
        end; end;
      if showhintflag = true then myshowhint;
      if (irol <> 0) and (irow <> 0) then locate(irol, irow, clred);
      candraw := false;
      dm.timer1.Enabled := false;
    end;
  except
    showmessage('Can not draw!');
  end;
end;

procedure Tmainfrm.BitBtn1Click(Sender: TObject);
begin
  getstably;
  showmessage('comp:' + inttostr(stablycomp) + #13 + 'man:' + inttostr(stablyman))
end;

procedure Tmainfrm.BitBtn2Click(Sender: TObject);
begin
  showmessage('value' + floattostr(countvalue) + #13 + 'addvalue' + inttostr(addvalue));
end;

procedure Tmainfrm.ComevaChange(Sender: TObject);
begin
  showmessage(saveva[comeva.ItemIndex + 1].path);

end;

end.