xqmain.pas

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

    if FileExists(XQFName) then
    begin
      if (Application.MessageBox(
          PChar(Format('文件“%s”已经存在，要替换吗?', [XQFName])),
          '另存为',
          MB_OKCANCEL + MB_ICONWARNING + MB_DEFBUTTON1) = IDCANCEL) then
      begin
        Exit;
      end;
    end;

    case iSaveXQTable(XQFName, ActiveXQTable) of
      0:
        begin
          ActiveXQTable.Caption    := ChangeFileExt(ExtractFileName(XQFName), '');
          ActiveXQTable.XQFileName := XQFName;
          ActiveXQTable.isXQFileChange := False;
          frmMain.Caption := dCVersionInfo+' - '+ChangeFileExt(ExtractFileName(XQFName), '');
          dAddFileListItem(XQFName);
        end;
      else
        begin

        end;
    end;
  end;
end;

//-------------------------------------------------------------------------
//  查看/设置象棋文件属性
//.........................................................................
procedure TfrmMain.actFilePExecute(Sender: TObject);
var
  XQFileP : TfrmXQFileP;
begin
  if (ActiveXQTable=nil) then Exit;

  XQFileP := TfrmXQFileP.Create(Application);
  if (XQFileP=nil) then Exit;

  with ActiveXQTable do
  begin
    XQFileP.edtTitle.Text := sTitle;

    case iXQFType of
      0: XQFileP.lblType.Caption := '全局或对局';
      1: XQFileP.lblType.Caption := '布局或开局';
      2: XQFileP.lblType.Caption := '实战中局或残局';
      3: XQFileP.lblType.Caption := '中局或残局';
      else XQFileP.lblType.Caption := '';
    end;

    case iResult of
      0: XQFileP.rbtResult0.Checked := True;
      1: XQFileP.rbtResult1.Checked := True;
      2: XQFileP.rbtResult2.Checked := True;
      3: XQFileP.rbtResult3.Checked := True;
    end;

    XQFileP.edtMatchName.Text  := sMatchName;
    XQFileP.edtMatchTime.Text  := sMatchTime;
    XQFileP.edtMatchAddr.Text  := sMatchAddr;
    XQFileP.edtRedPlayer.Text  := sRedPlayer;
    XQFileP.edtBlkPlayer.Text  := sBlkPlayer;
    XQFileP.edtTimeRule.Text   := sTimeRule;
    XQFileP.edtRedTime.Text    := sRedTime;
    XQFileP.edtBlkTime.Text    := sBlkTime;
    XQFileP.edtRMKWriter.Text  := sRMKWriter;
    XQFileP.edtAuthor.Text     := sAuthor;
  end;

  XQFileP.isUpdate := False;

  case XQFileP.ShowModal of
    mrOK:
      begin
        if XQFileP.isUpdate then
        begin
          with ActiveXQTable do
          begin
            sTitle := Trim(XQFileP.edtTitle.Text);

            if XQFileP.rbtResult0.Checked then iResult := 0;
            if XQFileP.rbtResult1.Checked then iResult := 1;
            if XQFileP.rbtResult2.Checked then iResult := 2;
            if XQFileP.rbtResult3.Checked then iResult := 3;

            sMatchName := Trim(XQFileP.edtMatchName.Text);
            sMatchTime := Trim(XQFileP.edtMatchTime.Text);
            sMatchAddr := Trim(XQFileP.edtMatchAddr.Text);
            sRedPlayer := Trim(XQFileP.edtRedPlayer.Text);
            sBlkPlayer := Trim(XQFileP.edtBlkPlayer.Text);
            sTimeRule  := Trim(XQFileP.edtTimeRule.Text);
            sRedTime   := Trim(XQFileP.edtRedTime.Text);
            sBlkTime   := Trim(XQFileP.edtBlkTime.Text);
            sRMKWriter := Trim(XQFileP.edtRMKWriter.Text);
            sAuthor    := Trim(XQFileP.edtAuthor.Text);

            isXQFileChange := True;

            dRefreshXQInfo;
          end;
        end;
      end;
    else
      begin

      end;
  end;

  XQFileP.Release;
  XQFileP.Free;
end;

//-------------------------------------------------------------------------
// 棋盘倒置
//.........................................................................
procedure TfrmMain.actViewReverseVExecute(Sender: TObject);
begin
  if (ActiveXQTable = nil) then Exit;
  ActiveXQTable.dReverseBoardV;
end;

//-------------------------------------------------------------------------
// 左右调换
//.........................................................................
procedure TfrmMain.actViewReverseHExecute(Sender: TObject);
begin
  if (ActiveXQTable = nil) then Exit;
  ActiveXQTable.dReverseBoardH;
end;

//-------------------------------------------------------------------------
// 调整窗口
//.........................................................................
procedure TfrmMain.FormResize(Sender: TObject);
var
  iTop : dTInt32;
begin
  with Sender as TForm do
  begin
    pnlXQStudioLogo.Left := (Width  - pnlXQStudioLogo.Width ) div 2;
    iTop := (Height - pnlXQStudioLogo.Height) div 2 - 64;
    if (iTop < 64) then iTop := 64;
    pnlXQStudioLogo.Top  := iTop;

    pnlPlayList.Left := (Width  - pnlPlayList.Width ) div 2;
    iTop := (Height - pnlPlayList.Height) div 2 - 32;
    if (iTop < 64) then iTop := 64;
    pnlPlayList.Top  := iTop;
  end;
end;

//-------------------------------------------------------------------------
//  只显示棋盘
//.........................................................................
procedure TfrmMain.actViewBoardOnlyExecute(Sender: TObject);
begin
  if (ActiveXQTable = nil) then Exit;
  ActiveXQTable.dShowBoardOnly(not actViewBoardOnly.Checked);
  actViewBoardOnly.Checked := not actViewBoardOnly.Checked;
end;


//-------------------------------------------------------------------------
//  查看/设置象棋文件属性
//.........................................................................
procedure TfrmMain.ContentsItemClick(Sender: TObject);
begin
  TfrmXQReadme.Create(Application);
end;

//-------------------------------------------------------------------------
//  保存象棋文件
//.........................................................................
function TfrmMain.iSaveXQTable(sFName:String; XQTable:TFrmXQTable):dTInt32;
var
  XQFile : dTXQFILE;
begin
  iSaveXQTable := -1;

  if (XQTable=nil) then Exit;

  XQFile := dTXQFILE.Create(sFName, XQTable.XQ.PlayTree);
  XQFile.isReverseH := XQTable.XQ.ReverseH;
  XQTable.dPutHeadInfoIntoXQFHead(XQFile.XQFHead);
  XQTable.dBeforeSave;

  case XQFile.iSaveXQFile of
    0: // ok
      begin
        XQTable.isXQFileChange := False;
        iSaveXQTable           := 0;
        XQTable.isXQFileSaveOK := True;
      end;
    else
      begin

      end;
  end;
  XQFile.Free;
end;

//-------------------------------------------------------------------------
//  检查命令行，自动打开文件
//.........................................................................
procedure TfrmMain.FormShow(Sender: TObject);
var
  s       : string;
  sCmdLine: String;
  iPos    : Integer;
begin
   s := ParamStr(1);
   if (s<>'') then
   begin
     if FileExists(s) then
     begin
       dCreateXQTable(s);
     end
     else
     begin
       sCmdLine := UpperCase(CmdLine);
       iPos := Pos('.EXE', sCmdLine);
       if (iPos > 0) then
       begin
         s := Trim(Copy(sCmdLine, iPos + 4, 512));
         s := StringReplace(s, '"', '', [rfReplaceAll]);
         if FileExists(s) then
         begin
           dCreateXQTable(s);
         end;
       end;
     end;
     Exit;
   end
   else // s='';
   begin
     if IsClipBoardTextQipu then
     begin
       FIsOpenFromClipBoard := True;
       OpenXQF('');
       FIsOpenFromClipBoard := False;
     end;
   end;

   if FileExists('AutoPlay.Lst') then
   begin
     FilePlayListItemClick(nil);
   end;
end;

//-------------------------------------------------------------------------
//  自动播放列表
//.........................................................................
procedure TfrmMain.dAutoPlayNextFile;
var
  f1, f2: String;
begin
  if (pnlPlayList.Tag = 1) then
  begin
    if (not isSetAutoImport) then Exit;
    if ((lbxPlayList.ItemIndex >=0) and (lbxPlayList.ItemIndex < lbxPlayList.Items.Count)) then
    begin
      f1 := lbxPlayList.Items[lbxPlayList.ItemIndex];
      f2 := ChangeFileExt(f1, '.xqf');
      if (FileExists(f2)) then
      begin
        lbxPlayList.Items[lbxPlayList.ItemIndex] := '> OK! ' + f2;
      end;
    end;
  end;

  pnlPlayList.Visible := True;
  pnlPlayList.Refresh;
  If (lbxPlayList.ItemIndex>=(lbxPlayList.Items.Count-1)) then
  begin
    isSetAutoPlayList := False;
    tmrPlayList.Enabled := False;
    btnStopAutoPlay.Enabled := False;
    btnAutoPlay.Enabled := True;

    btnStopImport.Enabled  := False;
    btnImport.Enabled      := True;

    btnAddFile.Enabled       := True;
    btnDelFile.Enabled       := True;
    btnClearPlayList.Enabled := True;
    btnSavePlayList.Enabled := True;
    lbxPlayListClick(lbxPlayList);
    Exit;
  end;
  tmrPlayList.Enabled := True;
  lbxPlayList.ItemIndex := lbxPlayList.ItemIndex + 1;
  if (pnlPlayList.Tag = 1) then btnImportClick(btnImport);
end;

//-------------------------------------------------------------------------
//  关闭，退出系统
//.........................................................................
procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
{
var
  XQStudioAtom : ATOM;
}
begin
  WriteRegStr('AutoPlay','Interval',IntToStr(iAutoPlayTime div 1000));
  if isAutoPlaySoundOn then
    WriteRegStr('AutoPlay','Sound', 'On')
  else
    WriteRegStr('AutoPlay','Sound', 'Off');

  dSaveFileList;
  dSaveBitmapList;

  WriteRegStr('RecentFileList', 'XqfInitialDir', FXqfDir);  

  FinalizeReg;
{
  XQStudioAtom := GlobalFindAtom('XQStudio is writen by Mr. Dong Shiwei.');
  if (XQStudioAtom <> 0) then
  begin
    GlobalDeleteAtom(XQStudioAtom);
  end;
}
end;

procedure TfrmMain.btnPlayListCloseClick(Sender: TObject);
begin
  if (pnlPlayList.Tag <> 0) then
  begin
    isSetAutoImport := False;
    sImportFileName := '';
    btnImport.Enabled := True;
    btnStopImport.Enabled := False;
  end;
  pnlPlayList.Visible := False;
  isSetAutoPlayList   := False;
end;

procedure TfrmMain.FilePlayListItemClick(Sender: TObject);
var
  ABool: Boolean;
begin
  sImportFileName := '';
  isSetAutoImport := False;
  lblTextLine0.Caption := StringReplace(lblTextLine0.Caption, '转换', '播放', [rfReplaceAll]);
  lblTextLine1.Caption := StringReplace(lblTextLine1.Caption, '转换', '播放', [rfReplaceAll]);
  lblTextLine2.Caption := StringReplace(lblTextLine2.Caption, '转换', '播放', [rfReplaceAll]);
  lblTextLine3.Caption := StringReplace(lblTextLine3.Caption, '转换', '播放', [rfReplaceAll]);
  lbxPlayList.Height   := 129;

  pnlPlayList.Visible  := True;
  pnlPlayList.Tag      := 0;

  ABool := (pnlPlayList.Tag = 0);
  gbxAutoPlaySetup.Visible := ABool;
  btnAutoPlay.Visible      := ABool;
  btnStopAutoPlay.Visible  := ABool;
  btnImport.Visible        := not ABool;
  btnStopImport.Visible    := not ABool;

  btnAddFile.Enabled       := True;
  btnDelFile.Enabled       := False;
  btnClearPlayList.Enabled := False;

  case (iAutoPlayTime div 1000) of
    1..5: cbxAutoPlayTime.ItemIndex := (iAutoPlayTime div 1000) - 1;
    10  : cbxAutoPlayTime.ItemIndex := 5;
    15  : cbxAutoPlayTime.ItemIndex := 6;
    20  : cbxAutoPlayTime.ItemIndex := 7;
  end;

  case isAutoPlaySoundOn of
    True : cbxAutoPlaySound.ItemIndex := 0;
    False: cbxAutoPlaySound.ItemIndex := 1;
  end;

  lbxPlayList.Items.Clear;
  
  if FileExists('AutoPlay.Lst') then
  begin
    lbxPlayList.Items.LoadFromFile('AutoPlay.Lst');
    lbxPlayList.ItemIndex := 0;
    lbxPlayListClick(nil);
    lbxPlayList.ItemIndex := 0;
  end;
end;

procedure TfrmMain.btnAddFileClick(Sender: TObject);
var
  i: dTInt32;
begin
  if (pnlPlayList.Tag = 0) then
  begin
    OPenDialog.Filter  := 'Xiangqi files (*.XQF)|*.XQF|All files (*.*)|*.*';
  end
  else
  begin
    OPenDialog.Filter  := '文本文件 (*.txt)|*.TXT|QQ游戏存盘文件 (*.che)|*.CHE|联众象棋存盘文件 (*.chn)|*.CHN|弈天象棋存盘文件 (*.mxq)|*.MXQ|中国游戏中心象棋存盘文件 (*.ccm)|*.CCM|All files (*.*)|*.*';