xqmain.pas

象棋演播室1.6的dephi源码 作者 董世伟

  NewXQTable.XQFileName := sName;

  frmMain.Caption := dCVersionInfo + ' - '
                     + ChangeFileExt(ExtractFileName(sName), '');

  NewXQTable.Refresh;
  Screen.Cursor := crHourglass;

  if (bIsNew and FIsOpenFromClipBoard) then
  begin
    FIsOpenFromClipBoard := False;
    NewXQTable.isPasteMsgEnabled := False;
    NewXQTable.ppmPasteQipuClick(NewXQTable.ppmPasteQipu);
    NewXQTable.actPlayRecFirstExecute(NewXQTable.actPlayRecFirst);
  end;

  if FileExists(Name) then              // 判断文件是否存在？
  begin
    XQFile := dTXQFILE.Create(Name, NewXQTable.XQ.PlayTree);
    if (XQFile=nil) then
    begin
      Screen.Cursor := crDefault;
      Exit;
    end;

    case XQFile.iLoadXQFile of          // 读入XQF文件
      0:
        begin
          with NewXQTable do
          begin
            XQ.dLoadAllRecForPlayNode(XQ.PlayTree);
            XQ.dDispQiziAtRecNo(0);
            XQ.dEnablePlayer(XQ.PlayTree);
            dGetHeadInfoFromXQFHead(XQFile.XQFHead);
            dRefreshXQInfo;
          end;
          if (not bIsNew) then dAddFileListItem(sName);
          Screen.Cursor := crDefault;
        end;
      else
        begin
          btnStopAutoPlayClick(nil);
          Application.MessageBox(
            '打开文件出错，可能的原因有：'+chr($0D)+chr($0A)+
            '    1.该文件不是XQF格式文件(扩展名为.XQF)；'+chr($0D)+chr($0A)+
            '    2.磁盘物理故障；'+chr($0D)+chr($0A)+
            '    3.该文件的内容被破坏；'+chr($0D)+chr($0A)+
            '    4.该文件需要更高版本的XQStudio的支持。'+chr($0D)+chr($0A)+
            chr($0D)+chr($0A)+
            '按“确定”按钮返回XQStudio。',
            '系统信息',
            MB_OK + MB_ICONERROR + MB_DEFBUTTON1);
          XQFile.Free;
          NewXQTable.Close;
          Screen.Cursor := crDefault;
          Exit;
        end;
    end;
    XQFile.Free;
    Screen.Cursor := crDefault;
  end
  else
  begin                                 // 要打开的文件不存在？
    Screen.Cursor := crDefault;
    if (Name<>'') then
    begin
      btnStopAutoPlayClick(nil);
      Application.MessageBox(
        '打开文件出错，出错原因：'+chr($0D)+chr($0A)+
        '    找不到指定的文件。'+chr($0D)+chr($0A)+
                                 chr($0D)+chr($0A)+
        '按“确定”按钮返回XQStudio。',
        '系统信息',
        MB_OK + MB_ICONERROR + MB_DEFBUTTON1);
      NewXQTable.Close;
    end;
  end;
  Screen.Cursor := crDefault;
end;

//-------------------------------------------------------------------------
// 新建一个象棋桌
//.........................................................................
procedure TfrmMain.actFileNewExecute(Sender: TObject);
var
  i: dTInt32;
begin
  if (MDIChildCount>=10) then
  begin
    Application.MessageBox(
      '打开的窗口个数太多，请先关闭一些没有用的窗口再进行本操作。',
      '系统信息',
      MB_OK + MB_ICONWARNING + MB_DEFBUTTON1);
      Exit;
  end;

  btnPlayListCloseClick(nil);
  try
    if (frmXQWizard<>nil) then frmXQWizard.Release;
    frmXQWizard.Free;
    frmXQWizard := nil;
  except
  end;
try
  frmXQWizard := TfrmXQWizard.Create(Application);
  if (frmXQWizard=nil) then Exit;

  // 打开“向导”窗口
  case frmXQWizard.ShowModal of
    mrOK:
      begin
        dCreateXQTable('');             // 建立一个空的象棋桌
        if (not isCreateTableOK) then Exit;
        if (ActiveXQTable=nil) then Exit;
        with ActiveXQTable do
        begin
          iXQFType   := 0;                      // 棋局类型
          if frmXQWizard.rbtPlayType0.Checked then iXQFType := 0;
          if frmXQWizard.rbtPlayType1.Checked then iXQFType := 1;
          if frmXQWizard.rbtPlayType2.Checked then iXQFType := 2;
          if frmXQWizard.rbtPlayType3.Checked then iXQFType := 3;
          iWhoPlay   := 0;                      // 假定红方先行
          iResult    := 0;                      // 对局结果
          if frmXQWizard.rbtResult0.Checked then iResult := 0;
          if frmXQWizard.rbtResult1.Checked then iResult := 1;
          if frmXQWizard.rbtResult2.Checked then iResult := 2;
          if frmXQWizard.rbtResult3.Checked then iResult := 3;
          sTitle     := Trim(frmXQWizard.edtTitle.Text);
          sMatchName := Trim(frmXQWizard.edtMatchName.Text);
          sMatchTime := Trim(frmXQWizard.edtMatchTime.Text);
          sMatchAddr := Trim(frmXQWizard.edtMatchAddr.Text);
          sRedPlayer := Trim(frmXQWizard.edtRedPlayer.Text);
          sBlkPlayer := Trim(frmXQWizard.edtBlkPlayer.Text);
          sTimeRule  := Trim(frmXQWizard.edtTimeRule.Text);
          sRedTime   := Trim(frmXQWizard.edtRedTime.Text);
          sBlkTime   := Trim(frmXQWizard.edtBlkTime.Text);
          sRMKWriter := Trim(frmXQWizard.edtRMKWriter.Text);
          sAuthor    := Trim(frmXQWizard.edtAuthor.Text);
        end;

        if (frmXQWizard.rbtPlayType2.Checked or    // 中局或残局
            frmXQWizard.rbtPlayType3.Checked)then
        begin
          for i:=1 to 32 do                     // 设置棋子位置
          begin
            ActiveXQTable.XQ.PlayTree.QiziXY[i] := frmXQWizard.QiziXY[i];
          end;
          if frmXQWizard.rbtWhoPlay1.Checked then  // 黑方先行
          begin
            ActiveXQTable.XQ.PlayTree.XYt := $FF;
            ActiveXQTable.iWhoPlay        := 1;
          end;
                                                // 设置对局结果
          if frmXQWizard.rbtRst0.Checked then ActiveXQTable.iResult := 0;
          if frmXQWizard.rbtRst1.Checked then ActiveXQTable.iResult := 1;
          if frmXQWizard.rbtRst2.Checked then ActiveXQTable.iResult := 2;
          if frmXQWizard.rbtRst3.Checked then ActiveXQTable.iResult := 3;
          ActiveXQTable.XQ.dDispQiziAtRecNo(0);
          ActiveXQTable.XQ.dEnablePlayer(ActiveXQTable.XQ.PlayTree);
        end;

        ActiveXQTable.dRefreshXQInfo;
      end;
    else
      begin

      end;
  end;
finally
end; // try;
end;

function TFrmMain.OpenXQF(const Name: String): Boolean;
begin
  Result := False;
  if (MDIChildCount>=10) then
  begin
    Application.MessageBox(
      '打开的窗口个数太多，请先关闭一些没有用的窗口再进行本操作。',
      '系统信息',
      MB_OK + MB_ICONWARNING + MB_DEFBUTTON1);
      Exit;
  end;

  dCreateXQTable(Name);
  if ((not isCreateTableOK) or (MDIChildCount>=11)) then
  begin
    Application.MessageBox(
      '打开文件出错，可能的原因有：'+chr($0D)+chr($0A)+
      '    1.打开文件的个数或窗口太多(最多10个)；'+chr($0D)+chr($0A)+
      '    2.系统内存空间太小。'+chr($0D)+chr($0A)+
      chr($0D)+chr($0A)+
      '按“确定”按钮返回XQStudio。',
      '系统信息',
      MB_OK + MB_ICONERROR + MB_DEFBUTTON1);
      Exit;
  end;
  if (ActiveXQTable<>nil) then ActiveXQTable.dRefreshXQInfo;

  Result := True;
end;

//-------------------------------------------------------------------------
// 打开一个XQF文件并创建象棋桌
//.........................................................................
procedure TfrmMain.actFileOpenExecute(Sender: TObject);
var
  i: dTInt32;
begin
  if (MDIChildCount>=10) then
  begin
    Application.MessageBox(
      '打开的窗口个数太多，请先关闭一些没有用的窗口再进行本操作。',
      '系统信息',
      MB_OK + MB_ICONWARNING + MB_DEFBUTTON1);
      Exit;
  end;
  btnPlayListCloseClick(nil);
  OPenDialog.Filter  := 'Xiangqi files (*.XQF)|*.XQF|All files (*.*)|*.*';
  OpenDialog.Options := OpenDialog.Options + [ofAllowMultiSelect];
  if OpenDialog.Execute then
  begin
    with OpenDialog.Files do
    begin
      for i := 0 to Count - 1 do
      begin
        if (i = 0) then
        begin
          if FileExists(Strings[i]) then
          begin
            FXqfDir := ExtractFilePath(Strings[i]);
          end;
        end;
        dCreateXQTable(Strings[i]);
        if ((not isCreateTableOK) or (MDIChildCount>=11)) then
        begin
          Application.MessageBox(
            '打开文件出错，可能的原因有：'+chr($0D)+chr($0A)+
            '    1.打开文件的个数或窗口太多(最多10个)；'+chr($0D)+chr($0A)+
            '    2.系统内存空间太小。'+chr($0D)+chr($0A)+
            chr($0D)+chr($0A)+
            '按“确定”按钮返回XQStudio。',
            '系统信息',
            MB_OK + MB_ICONERROR + MB_DEFBUTTON1);
          break;
        end;
      end;
    end;
  end;
end;

//-------------------------------------------------------------------------
// 打开一个帮助文件
//.........................................................................
procedure TfrmMain.actHelpAboutExecute(Sender: TObject);
begin
  frmXQAbout.ShowModal;
end;

//-------------------------------------------------------------------------
// 退出系统
//.........................................................................
procedure TfrmMain.actFileExitExecute(Sender: TObject);
begin
  Close;
end;

//-------------------------------------------------------------------------
// 系统初始化
//.........................................................................
procedure TfrmMain.FormCreate(Sender: TObject);
begin
  FIsOpenFromClipBoard := False;
  IsFileListLoaded := False;
  IsBitmapListLoaded:= False;
  FFirstActive     := True;
  Self.Width       := 800;
  Self.Height      := 572;

  If Screen.Width >= 801 then
  begin
    Self.Left := (Screen.Width  - Self.Width ) div 2;
    Self.Top  := (Screen.Height - Self.Height) div 2;
  end
  else
  begin
    Self.Left   := 0;
    Self.Top    := 0;
  end;

  lblVersion.Caption := dCVersionInfo;
  Self.Caption       := dCVersionInfo;

  InitializeReg;

  iAutoPlayTime        := StrToIntDef(ReadRegStr('AutoPlay','Interval','3'),3);
  iAutoPlayTime        := iAutoPlayTime * 1000;
  isAutoPlaySoundOn    := (ReadRegStr('AutoPlay', 'Sound', 'Off')='On');

  FImgXQBitmapList[ 0] := imgXQBoardBmp;
  FImgXQBitmapList[ 1] := imgRed1Bmp;
  FImgXQBitmapList[ 2] := imgRed2Bmp;
  FImgXQBitmapList[ 3] := imgRed3Bmp;
  FImgXQBitmapList[ 4] := imgRed4Bmp;
  FImgXQBitmapList[ 5] := imgRed5Bmp;
  FImgXQBitmapList[ 6] := imgRed6Bmp;
  FImgXQBitmapList[ 7] := imgRed7Bmp;
  FImgXQBitmapList[ 8] := imgBlk1Bmp;
  FImgXQBitmapList[ 9] := imgBlk2Bmp;
  FImgXQBitmapList[10] := imgBlk3Bmp;
  FImgXQBitmapList[11] := imgBlk4Bmp;
  FImgXQBitmapList[12] := imgBlk5Bmp;
  FImgXQBitmapList[13] := imgBlk6Bmp;
  FImgXQBitmapList[14] := imgBlk7Bmp;

  FXQTopLeftX          := 1;            // 左上角X坐标
  FXQTopLeftY          := 19;            // 左上角Y坐标
  FXQColW              := 41;            // 列宽
  FXQRowH              := 41;            // 行高

  FImgXQQiziBmp[01]    := imgRed1Bmp;
  FImgXQQiziBmp[02]    := imgRed2Bmp;
  FImgXQQiziBmp[03]    := imgRed3Bmp;
  FImgXQQiziBmp[04]    := imgRed4Bmp;
  FImgXQQiziBmp[05]    := imgRed5Bmp;
  FImgXQQiziBmp[06]    := imgRed4Bmp;
  FImgXQQiziBmp[07]    := imgRed3Bmp;
  FImgXQQiziBmp[08]    := imgRed2Bmp;
  FImgXQQiziBmp[09]    := imgRed1Bmp;
  FImgXQQiziBmp[10]    := imgRed6Bmp;
  FImgXQQiziBmp[11]    := imgRed6Bmp;
  FImgXQQiziBmp[12]    := imgRed7Bmp;
  FImgXQQiziBmp[13]    := imgRed7Bmp;
  FImgXQQiziBmp[14]    := imgRed7Bmp;
  FImgXQQiziBmp[15]    := imgRed7Bmp;
  FImgXQQiziBmp[16]    := imgRed7Bmp;
  FImgXQQiziBmp[17]    := imgBlk1Bmp;
  FImgXQQiziBmp[18]    := imgBlk2Bmp;
  FImgXQQiziBmp[19]    := imgBlk3Bmp;
  FImgXQQiziBmp[20]    := imgBlk4Bmp;
  FImgXQQiziBmp[21]    := imgBlk5Bmp;
  FImgXQQiziBmp[22]    := imgBlk4Bmp;
  FImgXQQiziBmp[23]    := imgBlk3Bmp;
  FImgXQQiziBmp[24]    := imgBlk2Bmp;
  FImgXQQiziBmp[25]    := imgBlk1Bmp;
  FImgXQQiziBmp[26]    := imgBlk6Bmp;
  FImgXQQiziBmp[27]    := imgBlk6Bmp;
  FImgXQQiziBmp[28]    := imgBlk7Bmp;
  FImgXQQiziBmp[29]    := imgBlk7Bmp;
  FImgXQQiziBmp[30]    := imgBlk7Bmp;
  FImgXQQiziBmp[31]    := imgBlk7Bmp;
  FImgXQQiziBmp[32]    := imgBlk7Bmp;


  dLoadFileList;
  dLoadBitmapList;

  FXqfDir              := ReadRegStr('RecentFileList', 'XqfInitialDir', '');
  OpenDialog.InitialDir:= FXqfDir;
end;

//-------------------------------------------------------------------------
//  保存象棋文件
//.........................................................................
procedure TfrmMain.actFileSaveExecute(Sender: TObject);
begin
  if (ActiveXQTable=nil) then Exit;
  if (ActiveXQTable.XQFileName = 'NoName.XQF') then
  begin
    actFileSaveAsExecute(nil);
  end
  else
  begin
    iSaveXQTable(ActiveXQTable.XQFileName, ActiveXQTable);
  end;
end;

//-------------------------------------------------------------------------
//  换名保存象棋文件
//.........................................................................
procedure TfrmMain.actFileSaveAsExecute(Sender: TObject);
var
  XQFName : string;
begin
  if (ActiveXQTable=nil) then Exit;
  XQFName := ActiveXQTable.XQFileName;
  if (XQFName = 'NoName.XQF') then
  begin
    if (ActiveXQTable.sTitle<>'') then
    begin
      XQFName := ActiveXQTable.sTitle + '.XQF';
    end;
  end;

  dlgSaveDialog.FileName := XQFName;
  if dlgSaveDialog.Execute then
  begin
    XQFName := dlgSaveDialog.FileName;
    if (Pos('.', XQFName)=0) then XQFName := XQFName + '.XQF';