main.pas

实现黑白棋的游戏

//主单元 main.pas
//BY Lishun,1999,all rights reserved

unit main;

interface

uses
  all, windows, Dialogs, Menus, Grids, Buttons, StdCtrls, jpeg,
  Graphics, Controls, ExtCtrls, Classes, Forms, shellapi, inifiles, SysUtils,
  ImgList, ComCtrls, ToolWin, ScktComp, Gauges, ueval, math, udm;

type

  Tmainfrm = class(TForm)
    StatusBar1: TStatusBar;
    MainMenu1: TMainMenu;
    MenuGame: TMenuItem;
    MenuOne: TMenuItem;
    MenuTwo: TMenuItem;
    MenuVS: TMenuItem;
    MenuNet: TMenuItem;
    MenuServer: TMenuItem;
    MenuClient: TMenuItem;
    N4: TMenuItem;
    MenuSave: TMenuItem;
    MenuLoad: TMenuItem;
    MenuList: TMenuItem;
    N6: TMenuItem;
    MenuExit: TMenuItem;
    MenuOpenning: TMenuItem;
    PerpendicularOpennings1: TMenuItem;
    Rabbit1: TMenuItem;
    Mimura1: TMenuItem;
    ShamanDanish1: TMenuItem;
    Inoue1: TMenuItem;
    IAGO1: TMenuItem;
    Bhagat1: TMenuItem;
    Rose1: TMenuItem;
    Flat1: TMenuItem;
    RotatingFlat1: TMenuItem;
    MurakamiVariation1: TMenuItem;
    RotatingFlatKlingContinuation1: TMenuItem;
    RoseBirth1: TMenuItem;
    Brightstein1: TMenuItem;
    RosebirdieRoseTamenori1: TMenuItem;
    RoseTamenoriKling1: TMenuItem;
    GreenbergDawg1: TMenuItem;
    Ralle1: TMenuItem;
    Horse1: TMenuItem;
    NoCat1: TMenuItem;
    Swallow1: TMenuItem;
    NoCatContinuation1: TMenuItem;
    Italian1: TMenuItem;
    Cat1: TMenuItem;
    Sakaguchi1: TMenuItem;
    Berner1: TMenuItem;
    Ganglion1: TMenuItem;
    Tiger1: TMenuItem;
    Stephenson1: TMenuItem;
    NoKung1: TMenuItem;
    NoKungContinuation1: TMenuItem;
    COMPOTH1: TMenuItem;
    Kung1: TMenuItem;
    LeadersTiger1: TMenuItem;
    Brightwell1: TMenuItem;
    Ishii1: TMenuItem;
    MainlineTiger1: TMenuItem;
    RoseBILL1: TMenuItem;
    Tamenori1: TMenuItem;
    AubreyTanaka1: TMenuItem;
    DiagonalOpennings1: TMenuItem;
    XsquareOpening1: TMenuItem;
    SnakePeasant1: TMenuItem;
    PyramidCheckerboardingPeasant1: TMenuItem;
    HeathTobidashiJumpingOut1: TMenuItem;
    MimuravariationII1: TMenuItem;
    HeathBat1: TMenuItem;
    Iwasakivariation1: TMenuItem;
    HeathChimneyMassTurning1: TMenuItem;
    RaccoonDog1: TMenuItem;
    Hamilton1: TMenuItem;
    Lollipop1: TMenuItem;
    Cow1: TMenuItem;
    Chimney1: TMenuItem;
    CowBatBatCambridge1: TMenuItem;
    BatPiauContinuation21: TMenuItem;
    MelnikovBatPiauContinuation11: TMenuItem;
    BatKlingContinuation1: TMenuItem;
    BatKlingAlternative1: TMenuItem;
    RosevToth1: TMenuItem;
    Tanida1: TMenuItem;
    AircraftFeldborg1: TMenuItem;
    Sailboat1: TMenuItem;
    Maruoka1: TMenuItem;
    Landau1: TMenuItem;
    BuffaloKenichiVariation1: TMenuItem;
    MaruokaBuffalo1: TMenuItem;
    TanidaBuffalo1: TMenuItem;
    HokurikuBuffalo1: TMenuItem;
    WingVariation1: TMenuItem;
    SemiWingVariation1: TMenuItem;
    ParallelOpennings1: TMenuItem;
    Mouse1: TMenuItem;
    MenuOption: TMenuItem;
    MenuSound: TMenuItem;
    MenuBk: TMenuItem;
    MenuSpeed: TMenuItem;
    MenuSlow: TMenuItem;
    MenuNormal: TMenuItem;
    MenuFast: TMenuItem;
    N13: TMenuItem;
    MenuBack: TMenuItem;
    MenuForce: TMenuItem;
    N3: TMenuItem;
    MenuExp: TMenuItem;
    MenuHelp: TMenuItem;
    MenuTopic: TMenuItem;
    N12: TMenuItem;
    MenuAbout: TMenuItem;
    Panel8: TPanel;
    BitBtn2: TBitBtn;
    BitBtn1: TBitBtn;
    Panel2: TPanel;
    Panel5: TPanel;
    Panel6: TPanel;
    Panel7: TPanel;
    Panel3: TPanel;
    btnBack: TSpeedButton;
    Label7: TLabel;
    Panel9: TPanel;
    Label11: TLabel;
    Label13: TLabel;
    Gauge1: TGauge;
    Label12: TLabel;
    Label14: TLabel;
    Gauge2: TGauge;
    Panel1: TPanel;
    Image1: TImage;
    Image2: TImage;
    Image3: TImage;
    Image4: TImage;
    Image7: TImage;
    Image8: TImage;
    Image9: TImage;
    ListBox: TListBox;
    drawgrid1: TDrawGrid;
    Panel10: TPanel;
    Label15: TLabel;
    Panel11: TPanel;
    Label16: TLabel;
    ControlBar1: TControlBar;
    ToolBar5: TToolBar;
    ToolButton7: TToolButton;
    btnopenning: TToolButton;
    ToolButton9: TToolButton;
    ToolButton10: TToolButton;
    ToolBar6: TToolBar;
    btnOne: TToolButton;
    btnTwo: TToolButton;
    btnVS: TToolButton;
    ToolButton27: TToolButton;
    btnLoad: TToolButton;
    btnSave: TToolButton;
    ToolBar7: TToolBar;
    ToolBar8: TToolBar;
    btnSound: TToolButton;
    btnColor: TToolButton;
    btnSpeed: TToolButton;
    btnExp: TToolButton;
    btnTopic: TToolButton;
    btnAbout: TToolButton;
    ToolButton36: TToolButton;
    btnList: TToolButton;
    btnExit: TToolButton;
    Comeva: TComboBox;
    Tree: TTreeView;
    myClient: TClientSocket;
    myServer: TServerSocket;
    procedure MenuAboutClick(Sender: TObject);
    procedure MenuOneClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure MenuTwoClick(Sender: TObject);
    procedure MenuExitClick(Sender: TObject);
    procedure MenuSaveClick(Sender: TObject);
    procedure MenuLoadClick(Sender: TObject);
    procedure MenuListClick(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure btnBackClick(Sender: TObject);
    procedure ini;
    procedure result;
    procedure compgo;
    procedure mango;
    procedure save;
    procedure load;
    procedure myshowhint;
    procedure clearhint;
    procedure FormShow(Sender: TObject);
    procedure MenuSoundClick(Sender: TObject);
    procedure MenuExpClick(Sender: TObject);
    procedure MenuBkClick(Sender: TObject);
    procedure MenuSlowClick(Sender: TObject);
    procedure MenuNormalClick(Sender: TObject);
    procedure MenuFastClick(Sender: TObject);
    procedure MenuTopicClick(Sender: TObject);
    procedure bmpcrt;
    procedure barhint(sender: Tobject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure drawgrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure FormActivate(Sender: TObject);
    procedure drawgrid1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure MenuServerClick(Sender: TObject);
    procedure MenuClientClick(Sender: TObject);
    procedure myServerClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure myClientConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure myClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure myServerClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure myClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure myServerClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure MenuVSClick(Sender: TObject);
    procedure exebookclick(Sender: Tobject);
    procedure MenuForceClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure ComevaChange(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  mainfrm: Tmainfrm;
  myhint: array[1..9, 1..9] of boolean;
  blacktime, whitetime, bstime, wstime: Ttime;

implementation

uses setting, help, input, table, Uwait;

{$R *.DFM}


procedure Tmainfrm.exebookclick(Sender: Tobject);
var
  i, j: integer;
  inifile: tinifile;
  captemp: string;
  no_and_captemp: string[40];
begin
  ini;
  blcount := 0; whcount := 0;
  style := 2;
  inifile := Tinifile.create(path + 'setting.ini');
  inifile.Writeinteger('setting', 'style', style);
  inifile.Free;
  bookend := false;
  blacktime := 0;
  whitetime := 0;
  for i := 1 to 60 do begin step[i].x := 0; step[i].y := 0; end;
  captemp := (sender as Tmenuitem).caption;
  setlength(no_and_captemp, length(captemp) - 1);
  for i := 1 to 40 do
    no_and_captemp[i] := #0;
  j := 0;
  for i := 1 to length(captemp) do
    if captemp[i] <> '&' then
    begin
      inc(j);
      no_and_captemp[j] := captemp[i];
    end;
  for i := 1 to booklenth do
  begin
    if book[i].name = no_and_captemp then
    begin
      for j := 1 to 30 do
        if book[i].step[j].x <> 0 then
        begin
          step[j].x := book[i].step[j].x;
          step[j].y := book[i].step[j].y;
          if odd(j) then
          begin
            changechess(step[j].x, step[j].y, black, 2);
            ichess[step[j].x, step[j].y] := black;
            printchess(step[j].x, step[j].y, blackchess);
          end
          else
          begin
            changechess(step[j].x, step[j].y, white, 2);
            ichess[step[j].x, step[j].y] := white;
            printchess(step[j].x, step[j].y, whitechess);
          end;
        end;
    end;
  end;
  steps := 1;
  for i := 1 to 8 do
    for j := 1 to 8 do
    begin
      if ichess[i, j] <> 0 then inc(steps);
      if ichess[i, j] = 1 then begin printchess(i, j, blackchess); blcount := blcount + 1; end;
      if ichess[i, j] = 2 then begin printchess(i, j, whitechess); whcount := whcount + 1; end;
    end;
  tree.Items.item[3].Text:='黑棋：'+inttostr(blcount);
  tree.Items.item[4].Text:='白棋：'+inttostr(whcount);
  if singlemode then
  begin
    if odd(steps) then begin if compcolor = black then whogo := '电脑' else whogo := '玩家'; end
    else begin if compcolor = black then whogo := '玩家' else whogo := '电脑'; end;
  end
  else
  begin
    if odd(steps) then begin whogo := '黑棋'; end
    else begin whogo := '白棋'; end;
  end;
  tree.Items.item[2].Text:='轮到'+whogo+'走';
  formpaint(self);
  if whogo = '电脑' then compgo;
end;


procedure Tmainfrm.barhint(sender: Tobject);
begin
  statusbar1.Panels.Items[0].text := application.Hint;
end;


procedure Tmainfrm.myshowhint;
var
  i, j: integer;
begin
  for i := 1 to 8 do
    for j := 1 to 8 do
      myhint[1, 1] := false;
  if whogo = '黑棋' then
  begin
    for i := 1 to 8 do begin
      for j := 1 to 8 do begin
        changechess(i, j, black, 0);
        if (chessable = 1) then
        begin
          locate(i, j, clgreen);
          myhint[i, j] := true;
        end;
      end; end;
  end
  else if (whogo = '白棋') then
  begin
    for i := 1 to 8 do begin
      for j := 1 to 8 do begin
        changechess(i, j, white, 0);
        if (chessable = 1) then
        begin
          locate(i, j, clgreen);
          myhint[i, j] := true;
        end;
      end; end;
  end
  else if (whogo = '玩家') then
  begin
    for i := 1 to 8 do begin
      for j := 1 to 8 do begin
        changechess(i, j, mancolor, 0);
        if (chessable = 1) then
        begin
          locate(i, j, clgreen);
          myhint[i, j] := true;
        end;
      end; end;
  end;
  locate(irol, irow, clred);
end;

procedure Tmainfrm.clearhint;
var
  i, j: integer;
begin
  for i := 1 to 8 do begin
    for j := 1 to 8 do begin
      if myhint[i, j] = true then locate(i, j, clwhite);
    end;
  end;
end;

procedure Tmainfrm.MenuAboutClick(Sender: TObject);
begin
  aboutfrm.showmodal;
end;

procedure Tmainfrm.MenuOneClick(Sender: TObject);
begin
  if netmode then
    if MessageDlg('要退出联网模式吗?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
    begin
      netmode := false;
      cammode := false;
      myselfexit := true;
      if not isserver then myclient.Close
      else myserver.Close;
    end
    else exit;
  btnOne.Down:=true;
  singlemode := true;
  cammode := false;
  MenuOne.Checked := true;
  drawgrid1.Enabled := true;
  MenuOpenning.Enabled := true;
  btnopenning.Enabled := true;
  MenuForce.Enabled := true;
  steps := 5;
  MenuSave.Enabled := true;
  MenuLoad.Enabled := true;
  btnsave.Enabled := true;
  btnload.Enabled := true;
  btnback.Enabled := false;
  ini;
  if compcolor = white then whogo := '玩家'
  else 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);
  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;
  mainfrm.paint;
  compgo;
end;

procedure tmainfrm.MenuTwoClick(Sender: TObject);
begin
  if netmode then
    if MessageDlg('要退出联网模式吗?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
    begin