xqtable.pas

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

         end
         else
         begin
           CanClose := False;  Exit;
         end;
       end;
     IDNO:
       begin
         CanClose:=True; Exit;
       end;
     else
       begin
         CanClose:=False; Exit;
       end;
  end;
end;

procedure TfrmXQTable.memPlayRecKeyPress(Sender: TObject; var Key: Char);
begin
  isXQFileChange := True;
end;

procedure TfrmXQTable.dRefreshXQInfo;
var
  s: string;
begin
  lblTitle.Caption   :=sTitle;
  case iXQFType of
    0:  // 全局
      begin
        s:='';
        if ((sRedPlayer<>'')and(sBlkPlayer<>'')) then
        begin
          s:='(红方) '+sRedPlayer;
          case iResult of
            0: begin s:=s+' 对 '; end;
            1: s:=s+' (红先胜) ';
            2: s:=s+' (红先负) ';
            3: s:=s+' (红先和) ';
          end;
          s:=s+'(黑方) '+sBlkPlayer;
        end;

        lblPlayer.Caption  :=s;

        lblTimeAddr.Caption:=sMatchTime;
        if (sMatchAddr<>'') then
          lblTimeAddr.Caption:=lblTimeAddr.Caption+'弈于'+sMatchAddr;
      end;

    1:  // 开局
      begin
        s:='';
        lblPlayer.Caption  :=s;
        lblTimeAddr.Caption:=s;
      end;

    2:  // 中局
      begin
        s:='';
        if ((sRedPlayer<>'')and(sBlkPlayer<>'')) then
        begin
          s:='(红方) '+sRedPlayer;
          case iResult of
            0: begin s:=s+' 对 '; end;
            1: s:=s+' (胜) ';
            2: s:=s+' (负) ';
            3: s:=s+' (和) ';
          end;
          s:=s+'(黑方) '+sBlkPlayer;
        end;

        lblPlayer.Caption  :=s;

        lblTimeAddr.Caption:=sMatchTime;
        if (sMatchAddr<>'') then
          lblTimeAddr.Caption:=lblTimeAddr.Caption+'弈于'+sMatchAddr;
      end;

    3:  // 残局
      begin
        s:='(着法: ';
        if (iWhoPlay=0) then s:=s+'红先' else s:=s+'黑先';
        case iResult of
          0: begin end;
          1: if (iWhoPlay =0) then s:=s+'胜' else s:=s+'红胜';
          2: if (iWhoPlay<>0) then s:=s+'胜' else s:=s+'黑胜';
          3: s:=s+'和';
        end;
        s:=s+')';
        lblPlayer.Caption := s;
        lblTimeAddr.Caption := '';
      end;
  end;

  if (lblTitle.Caption='') and
     (lblPlayer.Caption='') and
     (lblTimeAddr.Caption='') then
  begin
    pnlPlayerInfo.Caption := 'Welcome to use XQStudio';
  end
  else
    pnlPlayerInfo.Caption := '';
  begin

  end;

  frmMain.actEditChangePos.Enabled := (iXQFType > 1);
end;

procedure TfrmXQTable.imgMovePosToDblClick(Sender: TObject);
begin
  if actPlayRecDelete.Enabled then
  begin
    actPlayRecDeleteExecute(nil);
  end;
end;

procedure TfrmXQTable.dGetHeadInfoFromXQFHead(XQFHead: dTXQFHead);
begin
  iXQFType   := XQFHead.CodeA;
  iWhoPlay   := XQFHead.WhoPlay;
  iResult    := XQFHead.PlayResult;
  sTitle     := XQFHead.TitleA;
  sMatchName := XQFHead.MatchName;
  sMatchTime := XQFHead.MatchTime;
  sMatchAddr := XQFHead.MatchAddr;
  sRedPlayer := XQFHead.RedPlayer;
  sBlkPlayer := XQFHead.BlkPlayer;
  sTimeRule  := XQFHead.TimeRule;
  sRedTime   := XQFHead.RedTime;
  sBlkTime   := XQFHead.BlkTime;
  sRMKWriter := XQFHead.RMKWriter;
  sAuthor    := XQFHead.Author;
end;

procedure TfrmXQTable.dPutHeadInfoIntoXQFHead(Var XQFHead: dTXQFHead);
begin
  XQFHead.CodeA      := iXQFType;
  XQFHead.WhoPlay    := iWhoPlay;
  XQFHead.PlayResult := iResult;
  XQFHead.TitleA     := sTitle;
  XQFHead.MatchName  := sMatchName;
  XQFHead.MatchTime  := sMatchTime;
  XQFHead.MatchAddr  := sMatchAddr;
  XQFHead.RedPlayer  := sRedPlayer;
  XQFHead.BlkPlayer  := sBlkPlayer;
  XQFHead.TimeRule   := sTimeRule;
  XQFHead.RedTime    := sRedTime;
  XQFHead.BlkTime    := sBlkTime;
  XQFHead.RMKWriter  := sRMKWriter;
  XQFHead.Author     := sAuthor;
end;


//-------------------------------------------------------------------------
// 将棋谱转变成文本显示
//.........................................................................
procedure TfrmXQTable.pnlTextToolBarResize(Sender: TObject);
begin
  with Sender as TPanel do
  begin
    Height := 28;
    tlbTextToolBar.Height := 28;
    tlbTextToolBar.Left   :=
      (Width  - tlbTextToolBar.Width - pnlTextStyle.Width ) div 2 +
      pnlTextStyle.Width;
    tlbTextToolBar.Top    := 0;
  end;
end;

procedure TfrmXQTable.tbtSelectAllTextClick(Sender: TObject);
begin
  memText.SetFocus;
  memText.SelectAll;
end;

procedure TfrmXQTable.tbtSaveTextIntoFileClick(Sender: TObject);
var
  sFileName : String;
begin
  dlgSaveDialog.Title := '将棋谱文本保存为';
  if dlgSaveDialog.Execute then
  begin
    sFileName := dlgSaveDialog.FileName;
    if (Pos('.', sFileName)=0) then sFileName := sFileName + '.TXT';
    if FileExists(sFileName) then
    begin
      if (Application.MessageBox(
          PChar(Format('文件“%s”已经存在，要替换吗?', [sFileName])),
          '保存文件',
          MB_OKCANCEL + MB_ICONWARNING + MB_DEFBUTTON1) = IDCANCEL) then
      begin
        Exit;
      end;
    end;
    memText.Lines.SaveToFile(sFileName);
  end;
end;

procedure TfrmXQTable.FormShow(Sender: TObject);
begin
  tstXQInfoA.Show;
  tstRemark.Show;
  lbxPlayRec.SetFocus;
end;

procedure TfrmXQTable.actPlayVarUpExecute(Sender: TObject);
begin
  isXQFileChange := True;
  XQ.dMovePlayVarUp;
  lbxPlayVarClick(lbxPlayVar);
end;

procedure TfrmXQTable.actPlayVarDownExecute(Sender: TObject);
begin
  isXQFileChange := True;
  XQ.dMovePlayVarDown;
  lbxPlayVarClick(lbxPlayVar);
end;

procedure TfrmXQTable.ppmPlayVarPopup(Sender: TObject);
begin
  //dStopAutoPlay;
end;

procedure TfrmXQTable.lbxPlayRecDblClick(Sender: TObject);
begin
  dStartAutoPlay;
end;

procedure TfrmXQTable.ppmAutoPlayStartClick(Sender: TObject);
begin
  dStartAutoPlay;
end;

procedure TfrmXQTable.ppmAutoPlayStopClick(Sender: TObject);
begin
  dStopAutoPlay;
end;

procedure TfrmXQTable.dStartAutoPlay;
begin
  tmrAutoPlay.Interval := iAutoPlayTime;
  tmrAutoPlay.Enabled  := True;
  IsAutoPlaying        := True;
  sleep(1000);
  tmrAutoPlayTimer(tmrAutoPlay);
end;

procedure TfrmXQTable.dStopAutoPlay;
begin
  tmrAutoPlay.Enabled  := False;
  IsAutoPlaying        := False;
end;

procedure TfrmXQTable.ppmAutoPlayTimeClick(Sender: TObject);
begin
  with Sender as TMenuItem do
  begin
    iAutoPlayTime := tag;
  end;
  tmrAutoPlay.Interval := iAutoPlayTime;
end;

procedure TfrmXQTable.ppmPlayRecPopup(Sender: TObject);
begin
  dStopAutoPlay;
  ppmAutoPlayStart.Enabled := not tmrAutoPlay.Enabled;
  ppmAutoPlayStop.Enabled  := tmrAutoPlay.Enabled;
  ppmSoundOn.Checked       := isAutoPlaySoundOn;
  ppmSoundOff.Checked      := not isAutoPlaySoundOn;

  ppmAutoPlay01.Checked    := (ppmAutoPlay01.Tag = iAutoPlayTime);
  ppmAutoPlay02.Checked    := (ppmAutoPlay02.Tag = iAutoPlayTime);
  ppmAutoPlay03.Checked    := (ppmAutoPlay03.Tag = iAutoPlayTime);
  ppmAutoPlay04.Checked    := (ppmAutoPlay04.Tag = iAutoPlayTime);
  ppmAutoPlay05.Checked    := (ppmAutoPlay05.Tag = iAutoPlayTime);
  ppmAutoPlay06.Checked    := (ppmAutoPlay06.Tag = iAutoPlayTime);
  ppmAutoPlay07.Checked    := (ppmAutoPlay07.Tag = iAutoPlayTime);
  ppmAutoPlay08.Checked    := (ppmAutoPlay08.Tag = iAutoPlayTime);

  // 检查是否有棋谱可以粘贴
  ppmPasteQipu.Enabled     := (Clipboard.HasFormat(CF_TEXT) and
                                (XQ.DispStepNo=XQ.PlayStepNo));
end;

procedure TfrmXQTable.ppmSoundOffClick(Sender: TObject);
begin
  isAutoPlaySoundOn := False;
end;

procedure TfrmXQTable.ppmSoundOnClick(Sender: TObject);
begin
  isAutoPlaySoundOn := True;
end;

procedure TfrmXQTable.pnlQiTuTextToolBarResize(Sender: TObject);
begin
  with Sender as TPanel do
  begin
    Height := 28;
    tlbQiTuToolBar.Height := 28;
    tlbQiTuToolBar.Left   :=
      (Width  - tlbQiTuToolBar.Width - pnlQiTuTextStyle.Width) div 2 +
      pnlQiTuTextStyle.Width;
    tlbQiTuToolBar.Top    := 0;
  end;
end;

procedure TfrmXQTable.tbtSaveQiTuTextClick(Sender: TObject);
var
  sFileName : String;
begin
  dlgSaveDialog.Title := '将棋图文本保存为';
  if dlgSaveDialog.Execute then
  begin
    sFileName := dlgSaveDialog.FileName;
    if (Pos('.', sFileName)=0) then sFileName := sFileName + '.TXT';
    if FileExists(sFileName) then
    begin
      if (Application.MessageBox('文件已经存在，要替换吗?', '保存文件',
          MB_OKCANCEL + MB_DEFBUTTON1) = IDCANCEL) then Exit;
    end;
    memQiTuText.Lines.SaveToFile(sFileName);
  end;
end;

// 显示棋图
procedure TfrmXQTable.tstXQInfoBShow(Sender: TObject);
var
  iQiTuMode : Integer;
  wp        : dTWhoPlay;
begin
  pgcQitu.ActivePage := tstQituText;
  memQiTuText.Visible := False;  memQiTuText.Lines.Clear;
  iQiTuMode := 0;  if rbtQiTuStyle02.Checked then iQiTuMode := 1;

  // 判断轮到哪方行棋
  case XQ.DispNode.XYt of
      0: wp := wpRed;
    $FF: wp := wpBlk;
    else
      begin
        case XQ.iQiziIndexAtXY(XQ.DispNode.XYt) of
          01..16: wp := wpBlk;
          17..32: wp := wpRed;
          else    wp := wpRed;
        end;
      end;
  end;

  dMakeQiTuText(memQiTuText, sRedPlayer, sBlkPlayer,
                XQ.DispNode.QiziXY, wp, iQiTuMode, XQ.ReverseH,
                chkBbsColor.Checked);
  memQiTuText.Visible := True;
  memQiTuText.SetFocus;
  memQituText.SelectAll;
end;

procedure TfrmXQTable.tbtSelectQiTuTextClick(Sender: TObject);
begin
  memQiTuText.SetFocus;
  memQiTuText.SelectAll;
end;

////////////////////////////////////////////////////////////////////////////////
// 取关键词后面的字符串
function sGetKeyString(sLine, sKey: string): string;
var
  iPos: Integer;
  i   : Integer;
begin
  Result := '';
  sLine  := Trim(sLine);
  sKey   := Trim(sKey);

  if (Length(sLine) <= Length(sKey)) then Exit;

  iPos := Pos(sKey, sLine);
  if (iPos<>1) then Exit;

  for i:=1 to Length(sKey) do
  begin
    sLine[i]:=' ';
  end;
  Result := Trim(sLine);
end;

////////////////////////////////////////////////////////////////////////////////
// 在StringList中寻找指定的关键词字符串
function sGetStrAfterKeyWord(sl: TStrings; sKey: string): string;
var
  i: Integer;
  s: string;
begin
  s := '';
  for i:=0 to (sl.Count-1) do
  begin
    s := sGetKeyString(sl.Strings[i], sKey);
    if (s<>'') then break;
  end;
  Result := s;
end;

function sGetXQVParam(s: string; sParam: string): string;
var
  sKeyStr, sResult: string;
  b1, b2          : Byte;
  i, iPos, iEnd: Integer;
begin
  Result := '';
  sKeyStr := Format('<PARAM name="%s" value="', [sParam]);
  iPos := Pos(sKeyStr, s);