xqmain.pas

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

  end;

  OpenDialog.Options := OpenDialog.Options + [ofAllowMultiSelect];
  if (OpenDialog.Execute) then
  begin
    with OpenDialog.Files do
    begin
      for i := 0 to Count - 1 do
      begin
        if (pnlPlayList.Tag = 0) then
        begin
          lbxPlayList.Items.Add(ChangeFileExt(ExtractFileName(Strings[i]),''));
        end
        else
        begin
          lbxPlayList.Items.Add(ExtractFileName(Strings[i]));
        end;
      end;
    end;
    lbxPlayList.SetFocus;
    if (lbxPlayList.ItemIndex < 0) then lbxPlayList.ItemIndex := 0;
    lbxPlayList.ItemIndex := lbxPlayList.ItemIndex;
    lbxPlayList.Refresh;
    btnDelFile.Enabled := True;
    btnClearPlayList.Enabled := True;
    btnSavePlayList.Enabled := True;
    btnAutoPlay.Enabled := not isSetAutoPlayList;
    btnStopAutoPlay.Enabled := False;
    btnImport.Enabled := True;
    btnStopImport.Enabled := False;
  end;
  lbxPlayListClick(lbxPlayList);
end;

procedure TfrmMain.btnDelFileClick(Sender: TObject);
var
  iIdx : integer;
begin
  iIdx := lbxPlayList.ItemIndex;
  lbxPlayList.Items.Delete(iIdx);
  if (lbxPlayList.Items.Count > 0) then
  begin
    lbxPlayList.SetFocus;
    iIdx := iIdx - 1;
    if iIdx < 0 then iIdx := 0;
    lbxPlayList.ItemIndex := iIdx;
    lbxPlayList.Refresh;
    Exit;
  end;
  btnDelFile.Enabled := False;
  btnClearPlayList.Enabled := False;
  btnSavePlayList.Enabled := False;
end;

procedure TfrmMain.btnAutoPlayClick(Sender: TObject);
begin
  if (lbxPlayList.Items.Count < 1) then Exit;
  if (lbxPlayList.ItemIndex < 0) then lbxPlayList.ItemIndex := 0;
  btnAutoPlay.Enabled      := False;
  btnStopAutoPlay.Enabled  := True;
  btnAddFile.Enabled       := False;
  btnDelFile.Enabled       := False;
  btnClearPlayList.Enabled := False;
  btnSavePlayList.Enabled  := False;


  iAutoPlayTime     := StrToInt(cbxAutoPlayTime.Text)*1000;
  isAutoPlaySoundOn := (cbxAutoPlaySound.Text = '有');

  isSetAutoPlayList := True;
  dCreateXQTable(lbxPlayList.Items[lbxPlayList.ItemIndex]+'.XQF');
  pnlPlayList.Visible := False;
end;

procedure TfrmMain.btnStopAutoPlayClick(Sender: TObject);
begin
  tmrPlayList.Enabled     := False;
  btnAutoPlay.Enabled     := True;
  btnStopAutoPlay.Enabled := False;
  isSetAutoPlayList       := False;

  btnAddFile.Enabled       := True;
  btnDelFile.Enabled       := True;
  btnClearPlayList.Enabled := True;
  btnSavePlayList.Enabled  := True;
end;

procedure TfrmMain.tmrPlayListTimer(Sender: TObject);
begin
  if not isSetAutoPlayList then
  begin
    tmrPlayList.Enabled := False;
    Exit;
  end;
  pnlPlayList.Visible := False;
  dCreateXQTable(lbxPlayList.Items[lbxPlayList.ItemIndex]+'.XQF');
  tmrPlayList.Enabled := False;
end;

procedure TfrmMain.btnClearPlayListClick(Sender: TObject);
begin
  lbxPlayList.Items.Clear;
  btnDelFile.Enabled := False;
  btnClearPlayList.Enabled := False;
  btnSavePlayList.Enabled := False;
  btnAutoPlay.Enabled := False;
  btnStopAutoPlay.Enabled := False;
  btnImport.Enabled := False;
  btnStopImport.Enabled := False;
end;

procedure TfrmMain.lbxPlayListClick(Sender: TObject);
var
  s: String;
begin
  if lbxPlayList.ItemIndex < 0 then Exit;
  btnDelFile.Enabled := True;
  btnClearPlayList.Enabled := True;
  btnSavePlayList.Enabled := True;
  btnAutoPlay.Enabled := not isSetAutoPlayList;;

  s := UpperCase(lbxPlayList.Items[lbxPlayList.ItemIndex]);
  btnImport.Enabled   := (pos('> OK', s) = 0);
end;

procedure TfrmMain.btnSavePlayListClick(Sender: TObject);
begin
  lbxPlayList.Items.SaveToFile('AutoPlay.Lst');
end;

procedure TfrmMain.cbxAutoPlayTimeChange(Sender: TObject);
begin
  iAutoPlayTime     := StrToInt(cbxAutoPlayTime.Text)*1000;
end;

procedure TfrmMain.cbxAutoPlaySoundChange(Sender: TObject);
begin
  isAutoPlaySoundOn := (cbxAutoPlaySound.Text = '有');
end;

procedure TfrmMain.lbxPlayListDblClick(Sender: TObject);
begin
  if (pnlPlayList.Tag <> 0) then Exit;
  if btnAutoPlay.Enabled then
  begin
    btnAutoPlayClick(nil);
  end;
end;

procedure TfrmMain.dUpgradeXQFFile(sFileName: string);
var
  XQFile : dTXQFile;
begin
  XqfPlayTree := nil;
  XqfPlayTree := dTXQPlayNode.Create(0,'========= ',0,0,XqfQzXY,
                                     nil,nil,nil,nil);
  if (XqfPlayTree = nil) then Exit;

  XQFile := dTXQFILE.Create(sFileName, XqfPlayTree);
  if (XQFile=nil) then Exit;

  case XQFile.iLoadXQFile of          // 读入XQF文件
    0:
      begin
        XQFile.isDisableRmk := cbxDisableRemark.Checked;
        XQFile.iSaveXQFile;
      end;
  end;
  XQFile.Free;
  XqfPlayTree.Free;
  XqfPlayTree := nil;
end;

procedure TfrmMain.btnUpgradeClick(Sender: TObject);
var
  i: integer;
begin
  if (lbxPlayList.Items.Count < 1) then Exit;
  lbxPlayList.Visible := False;
  for i:= 0 to (lbxPlayList.Items.Count - 1) do
  begin
    lbxPlayList.ItemIndex := i;
    dUpgradeXQFFile(lbxPlayList.Items[lbxPlayList.ItemIndex]+'.XQF');
  end;
  lbxPlayList.Visible := True;
end;

procedure TfrmMain.imgXQstudioMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if ((ssLeft in Shift) and (ssCtrl in Shift) and (ssAlt in Shift) and
     (ssShift in Shift)) then
  begin
    btnSavePlayList.Visible  := not btnSavePlayList.Visible;
    btnUpgrade.Visible       := not btnUpgrade.Visible;
    cbxDisableRemark.Visible := not cbxDisableRemark.Visible;
  end;
end;


procedure TfrmMain.actFileSearchExecute(Sender: TObject);
begin
  if not isCreateSearchOk then
  begin
    if Assigned(frmXQSearch) then
    begin
      frmXQSearch.Free;
      frmXQSearch := nil;
    end;
    Application.CreateForm(TfrmXQSearch, frmXQSearch);
    isCreateSearchOk := True;
  end
  else
  begin
    if not Assigned(frmXQSearch) then Exit;
    frmXQSearch.BringToFront;
  end;
end;

procedure TfrmMain.FormActivate(Sender: TObject);
begin
  if FFirstActive then
  begin
    FFirstActive := False;
    if (ReadRegStr('Help', 'ShowTips', 'Yes')='Yes') then
    begin
      frmXQTipsDlg.ShowModal;
    end;
  end;
end;

procedure TfrmMain.HelpTipsClick(Sender: TObject);
begin
  frmXQTipsDlg.ShowModal;
end;

procedure TFrmMain.dEnableXQTableMenuItem(ABool: Boolean);
begin
  actFileSave.Enabled           := ABool;
  actFileSaveAs.Enabled         := ABool;
  actFileP.Enabled              := ABool;
  actFileSend.Enabled           := ABool;
  actToolsNewCopy.Enabled       := ABool;

  actEditChangePos.Enabled      := ABool;
  actEditPasteQipu.Enabled      := ABool;
  actEditOpenQipu.Enabled       := ABool;
  actEditMergeXqf.Enabled       := ABool;

  actViewReverseV.Enabled       := ABool;
  actViewReverseH.Enabled       := ABool;
  actViewBoardOnly.Enabled      := ABool;

  actToolsAutoPlay.Enabled      := ABool;
  actToolsStopPlay.Enabled      := ABool;
  actToolsImgToClip.Enabled     := ABool;
  actToolsImgToFile.Enabled     := ABool;
  actToolsBmpToClip.Enabled     := ABool and IsBitmapListLoaded;
  actToolsBmpToFile.Enabled     := ABool and IsBitmapListLoaded;
  actToolsText.Enabled          := ABool;
  actToolsApplet.Enabled        := ABool;
  actToolsPosSearch.Enabled     := ABool;

  if ActiveXQTable <> nil then
  begin
    actViewBoardOnly.Checked    := ActiveXQTable.isShowBoardOnly;
  end;
end;

procedure TfrmMain.actToolsAutoPlayExecute(Sender: TObject);
begin
  if (ActiveXQTable = nil) then Exit;
  ActiveXQTable.ppmAutoPlayStartClick(nil);
end;

procedure TfrmMain.actToolsStopPlayExecute(Sender: TObject);
begin
  if (ActiveXQTable = nil) then Exit;
  ActiveXQTable.ppmAutoPlayStopClick(nil);
end;

procedure TfrmMain.actEditPasteQipuExecute(Sender: TObject);
begin
  if (ActiveXQTable = nil) then Exit;
  if ActiveXQTable.ppmPasteQipu.Enabled then
  begin
    ActiveXQTable.ppmPasteQipuClick(ActiveXQTable.ppmPasteQipu);
  end;
end;

procedure TfrmMain.actEditOpenQipuExecute(Sender: TObject);
begin
  if (ActiveXQTable = nil) then Exit;
  ActiveXQTable.ppmImportQipuClick(ActiveXQTable.ppmImportQipu);
end;

procedure TfrmMain.actToolsImgToClipExecute(Sender: TObject);
begin
  if (ActiveXQTable = nil) then Exit;
  ActiveXQTable.ppmCopyClick(nil);
end;

procedure TfrmMain.actToolsImgToFileExecute(Sender: TObject);
begin
  if (ActiveXQTable = nil) then Exit;
  ActiveXQTable.ppmSaveAsBmpClick(nil);
end;

procedure TfrmMain.actToolsPosSearchExecute(Sender: TObject);
begin
  if (ActiveXQTable = nil) then Exit;
  ActiveXQTable.ppmSearcnFileClick(nil);
end;

procedure TfrmMain.actFileNewBlankExecute(Sender: TObject);
begin
  OpenXQF('');
end;

procedure TfrmMain.actToolsNewCopyExecute(Sender: TObject);
var
  CurrentXQTable : TfrmXQTable;
begin
  if (ActiveXQTable = nil) then Exit;
  CurrentXQTable := ActiveXQTable;
  OpenXQF('');
  if (ActiveXQTable = CurrentXQTable) then Exit;
  ActiveXQTable.XQ.PlayTree.QiziXY := CurrentXQTable.XQ.DispNode.QiziXY;
  ActiveXQTable.iWhoPlay           := CurrentXQTable.iWhoPlay;
  ActiveXQTable.XQ.WhoPlay         := CurrentXQTable.XQ.WhoPlay;
  ActiveXQTable.XQ.PlayTree.XYf    := CurrentXQTable.XQ.DispNode.XYf;
  ActiveXQTable.XQ.PlayTree.XYt    := CurrentXQTable.XQ.DispNode.XYt;
  ActiveXQTable.dShowBoardOnly(True);
  ActiveXQTable.lbxPlayRecClick(ActiveXQTable.lbxPlayRec);
  ActiveXQTable.Left  := 406;
  ActiveXQTable.Caption     := '推演棋盘 - ' + CurrentXQTable.Caption;
  ActiveXQTable.isDemoTable := True;
  ActiveXQTable.FormActivate(ActiveXQTable);  
end;

procedure TfrmMain.actToolsAppletExecute(Sender: TObject);
begin
  if (ActiveXQTable = nil) then Exit;
  ActiveXQTable.ppmJavaXQClick(nil);
end;

procedure TfrmMain.actFileSendExecute(Sender: TObject);
var
  MapiMessage: TMapiMessage;
begin
  ActiveXQTable.ppmTextXQClick(nil);
  with MapiMessage do
  begin
    ulReserved := 0;
    lpszSubject := nil;
    lpszNoteText := PChar(ActiveXQTable.memText.Text);
    lpszMessageType := nil; 
    lpszDateReceived := nil; 
    lpszConversationID := nil; 
    flFlags := 0;
    lpOriginator := nil; 
    nRecipCount := 0;
    lpRecips := nil; 
    nFileCount := 0;
    lpFiles := nil; 
  end;
  
  MapiSendMail(0, 0, MapiMessage,
    MAPI_DIALOG or MAPI_LOGON_UI or MAPI_NEW_SESSION, 0);
end;

procedure TfrmMain.actHelpHttpXQStudioExecute(Sender: TObject);
begin
  ShellExecute(Self.Handle, nil, PChar('http://www.qipaile.net/xqstudio'),
      nil, nil, SW_SHOWNORMAL);
end;

procedure TfrmMain.actHelpMailToXQStudioExecute(Sender: TObject);
begin
  ShellExecute(Self.Handle, nil, PChar('mailto:[e-mail]'),
      nil, nil, SW_SHOWNORMAL);
end;

procedure TfrmMain.dLoadFileList;
var
  i: Integer;
begin
  if not IsFileListLoaded then
  begin
    for i:=1 to 9 do
    begin
      FFileList[i] := ReadRegStr('RecentFileList',
          Format('XqfListItem%d', [i]), '');
    end;
    IsFileListLoaded := True;
  end;
  FileList1.Caption := '&1. ' + ChangeFileExt(ExtractFileName(FFileList[1]), '');
  FileList1.Hint    := FFileList[1];