main.pas

实现黑白棋的游戏

      netmode := false;
      myselfexit := true;
      if not isserver then myclient.Close
      else myserver.Close;
    end
    else exit;
  btnTwo.Down:=true;
  cammode := false;
  MenuTwo.Checked := true;
  tree.Items.item[1].Text:= '    ';
  drawgrid1.Enabled := true;
  MenuOpenning.Enabled := true;
  btnopenning.Enabled := true;
  MenuForce.Enabled := true;
  MenuSave.Enabled := true;
  MenuLoad.Enabled := true;
  btnsave.Enabled := true;
  btnload.Enabled := true;
  btnback.Enabled := false;
  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);
  mainfrm.paint;
end;

procedure Tmainfrm.FormCreate(Sender: TObject);
var
  inifile: tinifile;
  i, j: integer;
  temp: string;
  temp2: char;
begin
  statusbar1.DoubleBuffered := true;
  gamerunning := false;
  netmode := false;
  application.OnHint := barhint;
  drawgrid1.TabStop := false;
  soundopen := true;
  speed := speednormal;
  path := extractfilepath(application.exename);
  Application.HelpFile := path + 'Othello.HLP';
  MenuSave.Enabled := false;
  MenuLoad.Enabled := false;
  btnsave.Enabled := false;
  btnload.Enabled := false;
  if not fileexists(path + 'setting.ini') then
  begin
    level := 5; style := 1;
    compcolor := black; mancolor := white; bkcolor := clgreen;
    ram := true; showhintflag := true; usebook := true; balance := true; auto := true;
  end
  else
  begin
    inifile := Tinifile.create(path + 'setting.ini');
    level := inifile.readinteger('setting', 'level', 5);
    style := inifile.readinteger('setting', 'style', 1);
    bkcolor := inifile.readinteger('setting', 'bkcolor', clgreen);
    compcolor := inifile.readinteger('setting', 'compcolor', 1);
    ram := inifile.readbool('setting', 'random', true);
    showhintflag := inifile.readbool('setting', 'showhintflag', true);
    usebook := inifile.readbool('setting', 'usebook', true);
    balance := inifile.readbool('setting', 'balance', true);
    speed := inifile.readinteger('setting', 'changespeed', speednormal);
    auto := inifile.readbool('setting', 'autorun', true);
    inifile.free;
    if compcolor = black then mancolor := white
    else mancolor := black;
    if speed = speedslow then begin MenuSlow.Click; end
    else if speed = speednormal then begin MenuNormal.Click; end
    else begin MenuFast.Click; end;
    panel1.Color := bkcolor;
  end;
  inifile := Tinifile.create(path + 'book.opn');
  inifile.ReadSections(listbox.items);
  for i := 1 to listbox.Items.Count do
  begin
    temp := inifile.ReadString(listbox.items.strings[i - 1], 'chess', '');
    book[i].name := listbox.items.strings[i - 1];
    book[i].level := inifile.Readinteger(listbox.items.strings[i - 1], 'level', 1);
    book[i].balance := inifile.Readbool(listbox.items.strings[i - 1], 'balance', false);
    for j := 1 to (length(temp) div 2) do
    begin
      temp2 := temp[j * 2 - 1];
      if (temp2 >= 'A') and (temp2 <= 'H') then
      begin book[i].step[j].x := ord(temp2) - 64; end
      else if (temp2 >= 'a') and (temp2 <= 'h') then
      begin book[i].step[j].x := ord(temp2) - 96; end;
      temp2 := temp[j * 2];
      book[i].step[j].y := ord(temp2) - 48;
    end;
  end;
  inifile.free;
  bmpcrt;
end;

procedure Tmainfrm.MenuExitClick(Sender: TObject);
begin
  application.Terminate;
end;

procedure Tmainfrm.MenuSaveClick(Sender: TObject);
var
  i, j: integer;
  myfile: Tfilestream;
begin
  dm.savedialog1.InitialDir := path;
  dm.SaveDialog1.DefaultExt := 'sun';
  dm.saveDialog1.Filter := '(*.sun)|*.sun';
  if dm.savedialog1.execute then
  begin
    myfile := Tfilestream.Create(dm.savedialog1.filename, fmCreate);
    for i := 1 to 8 do
      for j := 1 to 8 do
      begin
        myfile.writeBuffer(ichess[i, j], 1);
      end;
    myfile.Free;
  end;
end;

procedure Tmainfrm.MenuLoadClick(Sender: TObject);
var
  i, j: integer;
  myfile: Tfilestream;
begin
  dm.opendialog1.InitialDir := path;
  dm.openDialog1.Filter := '(*.sun)|*.sun';
  if dm.opendialog1.execute then
  begin
    ini;
    bookend := true;
    blacktime := 0;
    whitetime := 0;
    myfile := Tfilestream.Create(dm.opendialog1.filename, fmOpenRead);
    steps := 1;
    blcount := 0; whcount := 0;
    for i := 1 to 8 do
      for j := 1 to 8 do
      begin
        myfile.readBuffer(ichess[i, j], 1);
        if ichess[i, j] <> 0 then steps := steps + 1;
        if ichess[i, j] = 1 then blcount := blcount + 1;
        if ichess[i, j] = 2 then whcount := whcount + 1;
      end;
    myfile.Free;
    for i := 1 to 8 do begin
      for j := 1 to 8 do begin
        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;
    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;
    tree.Refresh;
    if not singlemode then tree.Items.item[1].Text := '';
    tree.Items.item[3].Text:='黑棋：'+inttostr(blcount);
    tree.Items.item[4].Text:='白棋：'+inttostr(whcount);
    changecost;
    if whogo = '电脑' then compgo;
  end;
  changecost;
  formpaint(self);
end;

procedure Tmainfrm.MenuListClick(Sender: TObject);
begin
  thisrec := 0;
  tablefrm.showmodal;
end;

procedure Tmainfrm.FormPaint(Sender: TObject);
begin
  candraw := true;
  dm.timer1.Enabled := true;
end;

procedure Tmainfrm.btnBackClick(Sender: TObject);
begin
  if (backsteps <> 0) then
  begin
    step[steps - 4].x := 0; step[steps - 4].y := 0;
    step[steps - 5].x := 0; step[steps - 5].y := 0;
    load;
    btnBack.enabled := false;
    MenuBack.enabled := false;
    booklevel := 1;
    formpaint(self);
  end;
end;

procedure Tmainfrm.ini;
var
  i, j: integer;
begin
  statusbar.Panels.Items[1].text := '推理分枝数：';
  statusbar.Panels.Items[2].text := '估值：';
  statusbar.Panels.Items[3].text := '开局：';
  wstime := time; bstime := time; blacktime := 0; whitetime := 0;
  steps := 5;
  bookend := false;
  booklevel := 1;
  blcount := 2; whcount := 2;
  tree.Items.item[1].Text := '难度:';
  tree.Items.item[3].Text := '黑棋=';
  tree.Items.item[4].Text := '白棋=';
  label7.Caption := '            ';
  tree.Items.item[2].Text:='轮到'+'    '+'走';
  tree.Items.item[1].Text := '';
  tree.Items.item[3].Text := '';
  tree.Items.item[4].Text := '';
  for i := 1 to 8 do
    for j := 1 to 8 do
    begin
      printchess(i, j, nonechess);
      myhint[i, j] := false;
    end;
  if style = 1 then begin
    printchess(4, 4, blackchess);
    printchess(5, 5, blackchess);
    printchess(4, 5, whitechess);
    printchess(5, 4, whitechess);
  end
  else begin
    printchess(4, 4, whitechess);
    printchess(5, 5, whitechess);
    printchess(4, 5, blackchess);
    printchess(5, 4, blackchess);
  end;
  chessable := 0;
  last := 0; backsteps := 1;
  irow := 1; irol := 1;
  for i := 1 to 8 do
    for j := 1 to 8 do
      ichess[i, j] := none;
  if style = 1 then
  begin
    ichess[4, 4] := black;
    ichess[5, 5] := black;
    ichess[4, 5] := white;
    ichess[5, 4] := white;
  end
  else begin
    ichess[4, 4] := white;
    ichess[5, 5] := white;
    ichess[4, 5] := black;
    ichess[5, 4] := black;
  end;
  for i := 0 to 9 do
  begin
    stablyc[i, 0] := true;
    stablym[i, 0] := true;
    stablyc[i, 9] := true;
    stablym[i, 9] := true;
    stablyc[0, i] := true;
    stablym[0, i] := true;
    stablyc[9, i] := true;
    stablym[9, i] := true;
  end;
  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
      cost[i, j] := -9;

  cost[2, 2] := -100;
  cost[2, 7] := -100;
  cost[7, 2] := -100;
  cost[7, 7] := -100;
  cost[2, 1] := -5;
  cost[1, 2] := -5;
  cost[7, 1] := -5;
  cost[1, 7] := -5;
  cost[8, 2] := -5;
  cost[2, 8] := -5;
  cost[8, 7] := -5;
  cost[7, 8] := -5;
  cost[1, 1] := 200;
  cost[8, 8] := 200;
  cost[1, 8] := 200;
  cost[8, 1] := 200;
  for i := 3 to 6 do
  begin
//cost[2,i]:= -10;
//cost[i,2]:= -10;
//cost[7,i]:= -10;
//cost[i,7]:= -10;
    cost[1, i] := -5;
    cost[i, 1] := -5;
    cost[8, i] := -5;
    cost[i, 8] := -5;
  end;
end;

procedure tmainfrm.result;
var
  i, j: integer;
  txt: string;
  m, n, sblack, swhite, scomp, sman: integer;
  wintab: boolean;
  temprank: string;
  myfile: Tfilestream;
  time1: integer;
  h, mi, s, ms: word;
  temp: integer;
begin
  gamerunning := false;
  sblack := 0; swhite := 0;
  MenuOpenning.enabled := false;
  btnopenning.Enabled := true;
  MenuForce.Enabled := false;
  MenuSave.Enabled := false;
  MenuLoad.Enabled := false;
  btnsave.Enabled := false;
  btnload.Enabled := false;
  for m := 1 to 8 do begin
    for n := 1 to 8 do begin
      if ichess[m, n] = black then sblack := sblack + 1;
      if ichess[m, n] = white then swhite := swhite + 1;
    end; end;
  if sblack + swhite <> 64 then
  begin
    if sblack > swhite then sblack := 64 - swhite
    else if sblack < swhite then swhite := 64 - sblack
    else
    begin
      sblack := 32;
      swhite := 32;
    end;
  end;
  if compcolor = black then begin scomp := sblack; sman := swhite; end
  else begin scomp := swhite; sman := sblack; end;
  h := 0; mi := 0; s := 0; ms := 0;
  decodetime(whitetime, h, mi, s, ms);
  time1 := h * 3600 + mi * 60 + s;
  if usebook then temp := 10 else temp := -10;

  dat[0].score := (level - 2) * (level - 2) * (level - 2) + level * (sman - scomp) + (120 - time1) div 20 + temp + 64;

  if (dat[0].score <= 65) then temprank := '学员'
  else if (dat[0].score <= 80) then temprank := '下士'
  else if (dat[0].score <= 95) then temprank := '中士'
  else if (dat[0].score <= 110) then temprank := '上士'
  else if (dat[0].score <= 130) then temprank := '少尉'
  else if (dat[0].score <= 150) then temprank := '中尉'
  else if (dat[0].score <= 170) then temprank := '上尉'
  else if (dat[0].score <= 190) then temprank := '少校'
  else if (dat[0].score <= 215) then temprank := '中校'
  else if (dat[0].score <= 240) then temprank := '上校'
  else if (dat[0].score <= 265) then temprank := '少将'
  else if (dat[0].score <= 290) then temprank := '中将'
  else if (dat[0].score <= 320) then temprank := '上将'
  else temprank := '元首';
  if not singlemode then begin
    if (sblack > swhite) then messagebox(0, '黑棋胜', '结果', mb_ok)
    else if (sblack < swhite) then messagebox(0, '白棋胜', '结果', mb_ok)
    else messagebox(0, '平局', '结果', mb_ok);
  end;
  if singlemode then begin
    if (scomp > sman) then messagebox(0, '电脑胜', '结果', mb_ok)
    else if (scomp < sman) then messagebox(0, '恭喜!你胜了!', '结果', mb_ok)
    else messagebox(0, '平局', '结果', mb_ok);
    dat[0].level := level;
    if cammode then
    begin
      tree.Items.item[2].Text:='得分:'+inttostr(dat[0].score);
      label7.caption := '军衔:' + temprank;
      tree.Refresh;
      label7.Refresh;
      if fileexists(path + 'chessrec.lis') then
      begin
        myfile := Tfilestream.Create(path + 'chessrec.lis', fmOpenRead);
        for i := 1 to 10 do
        begin
          myfile.ReadBuffer(dat[i].name, sizeof(dat[i].name));
          myfile.ReadBuffer(dat[i].level, 1);
          myfile.ReadBuffer(dat[i].score, sizeof(dat[i].score));
        end;
        myfile.Free;
      end
      else
      begin
        for i := 0 to 3 do
        begin
          dat[10 - i].name := 'li shun';
          dat[10 - i].level := 1;
          dat[10 - i].score := 30 + i * 10;
        end;
        for i := 4 to 7 do
        begin
          dat[10 - i].name := 'li shun';
          dat[10 - i].level := 2;
          dat[10 - i].score := 30 + i * 20;
        end;
        for i := 7 to 9 do
        begin
          dat[10 - i].name := 'li shun';
          dat[10 - i].level := 3;
          dat[10 - i].score := i * 30;
        end;
      end;
      if (dat[10].score < dat[0].score) then
      begin
        txt := inputbox('恭喜进入排行榜!', '请输入姓名(15字以内)', 'NoName');
        wintab := true;
      end
      else wintab := false;
      begin
        dat[0].name := txt;
        if dat[0].name = '' then dat[0].name := 'NoName';
      end;
      for i := 1 to 10 do
      begin
        if (dat[0].score > dat[i].score) then
        begin
          for j := 10 downto i do
          begin
            dat[j].name := dat[j - 1].name;
            dat[j].level := dat[j - 1].level;
            dat[j].score := dat[j - 1].score;
          end;
          dat[i].name := dat[0].name;
          dat[i].level := dat[0].level;
          dat[i].score := dat[0].score;
          thisrec := i;
          break;
        end;
      end;
      myfile := Tfilestream.Create(path + 'chessrec.lis', fmCreate);
      for i := 1 to 10 do
      begin
        myfile.writeBuffer(dat[i].name, sizeof(dat[i].name));
        myfile.writeBuffer(dat[i].level, 1);
        myfile.writeBuffer(dat[i].score, sizeof(dat[i].score));
      end;