xqtable.pas

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

    isXQFileChange  : dTBoolean;
    isXQFileSaveOk  : dTBoolean;

    isDemoTable     : dTBoolean;                // 是推演棋盘吗？
    //---------------------------------------------------------------------
    iXQFType        : dTInt32;                  // 文件类型
                                                // 0-全局, 1-开局
                                                // 2-中局, 3-残局
    iWhoPlay        : dTInt32;                  // 谁先行
                                                // 0-红先, 1-黑先
    iResult         : dTInt32;                  // 比赛结果
                                                // 0-未知, 1-红胜
                                                // 2-黑胜, 3-和棋
    sTitle          : String[63];               // 标题
    sMatchName      : String[63];               // 比赛名称
    sMatchTime      : String[15];               // 比赛时间
    sMatchAddr      : String[15];               // 比赛地点
    sRedPlayer      : String[15];               // 红方姓名
    sBlkPlayer      : String[15];               // 黑方姓名
    sTimeRule       : String[63];               // 用时规则
    sRedTime        : String[15];               // 红方用时
    sBlkTime        : String[15];               // 黑方用时
    sRMKWriter      : String[15];               // 棋谱评论员
    sAuthor         : STring[15];               // 文件的作者
    //---------------------------------------------------------------------

    procedure dReverseBoardV;
    procedure dReverseBoardH;
    procedure dShowBoardOnly(tf: dTBoolean);
    procedure dBeforeSave;
    procedure dRefreshXQInfo;
    procedure dGetHeadInfoFromXQFHead(XQFHead: dTXQFHead);
    procedure dPutHeadInfoIntoXQFHead(var XQFHead: dTXQFHead);

    procedure dStartAutoPlay;
    procedure dStopAutoPlay;

    procedure dMakeJavaAppletCode;

    procedure dAddPlayRecordFromString(sLineStr: String);
    procedure dClearAllStep;
    function  dImportQipuFromFile(sFileName: String): Boolean;
  end;

procedure dPlayRecHook;
procedure dRefreshHook;

///////////////////////////////////////////////////////////////////////////

implementation

uses XQMain, XQWizard, XQSearch;

{$R *.DFM}

//-------------------------------------------------------------------------
//
//.........................................................................
procedure TfrmXQTable.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
  frmMain.ActiveXQTable := nil;
  if (frmMain.MDIChildCount<=1) then frmMain.pnlXQStudioLogo.Visible:=True;
  frmMain.dEnableXQTableMenuItem(False);
  frmMain.Caption := dCVersionInfo;

  if rbtTextStyle01.Checked then  WriteRegStr('XqTable', 'TextColumn', '1');
  if rbtTextStyle02.Checked then  WriteRegStr('XqTable', 'TextColumn', '2');
  if rbtTextStyle03.Checked then  WriteRegStr('XqTable', 'TextColumn', '3');

  if isSetAutoPlayList then
  begin
    frmMain.dAutoPlayNextFile;
  end
  else
  begin
    if ((sImportFileName <> '')and(XQ.PlayStepNo>0)) then
    begin
      sImportFileName := '';
      frmMain.dAutoPlayNextFile;
    end;
  end;
end;

//-------------------------------------------------------------------------
// 取得坐标X, Y处'兵站'的坐标
//.........................................................................
function TfrmXQTable.imgGetImgXY(X, Y: Integer): TImage;
var
  i, j: Integer;
begin
  for i:=0 to 8 do for j:= 0 to 9 do    // 搜索所有的兵站
  begin
    if (X>imgXY[i,j].Left+4)and(X<imgXY[i,j].Left+imgXY[i,j].Width-4) and
       (Y>imgXY[i,j].Top+4)and(Y<imgXY[i,j].Top +imgXY[i,j].Height-4) then
    begin
      imgGetImgXY := imgXY[i, j];  Exit;
    end;
  end;
  imgGetImgXY := nil;
end;

//-------------------------------------------------------------------------
// 设置象棋盘
//.........................................................................
procedure TfrmXQTable.dSetupXQBoard;
var
  picQZ : dTXQZPIC;
  i, j  : dTInt32;
begin
  // 将所有棋子的原形关闭
  for i:=1 to 7 do
  begin
    with FindComponent('imgRed'+IntToStr(i)) as TImage do Visible := False;
    with FindComponent('imgBlk'+IntToStr(i)) as TImage do Visible := False;
  end;

  // 正在移动的棋子的变为不可以显示
  imgQZMove.Visible := False;

  // 设置 9 x 10 个'兵站'
  for i:=0 to 8 do for j:=0 to 9 do
  begin
    imgXY[i,j] := FindComponent('imgXY'+IntToStr(i)+IntToStr(j)) as TImage;
    if (imgXY[i,j]=nil) then ShowMessage('imgXY Error');
  end;

  for i:=0 to 8 do for j:=0 to 9 do
  begin
    imgXY[i,j].Left   := 4   + i*40;
    imgXY[i,j].Top    := 376 - j*40;
    imgXY[i,j].Width  := 34;
    imgXY[i,j].Height := 34;
    imgXY[i,j].PopupMenu := ppmPlayRec;
  end;
  imgXQBoard.PopupMenu   := ppmPlayRec;

  imgRedNum.Visible   := False;
  imgRedNum.Left      := imgXQBoard.Left;
  imgRedNum.Top       := imgXQBoard.Top;
  imgBlkNum.Visible   := False;
  imgBlkNum.Left      := imgXQBoard.Left;
  imgBlkNum.Top       := imgXQBoard.Top + 409;

  imgQZMove.Width      := 34;
  imgQZMove.Height     := 34;
  imgMovePosTo.Width   := 34;
  imgMovePosTo.Height  := 34;
  imgMovePosFrom.Width := 34;
  imgMovePosFrom.Height:= 34;


  // 设置所有棋子的图片
  picQZ[ 1] := ImgRed1.Picture;  picQZ[ 8] := ImgBlk1.Picture;
  picQZ[ 2] := ImgRed2.Picture;  picQZ[ 9] := ImgBlk2.Picture;
  picQZ[ 3] := ImgRed3.Picture;  picQZ[10] := ImgBlk3.Picture;
  picQZ[ 4] := ImgRed4.Picture;  picQZ[11] := ImgBlk4.Picture;
  picQZ[ 5] := ImgRed5.Picture;  picQZ[12] := ImgBlk5.Picture;
  picQZ[ 6] := ImgRed6.Picture;  picQZ[13] := ImgBlk6.Picture;
  picQZ[ 7] := ImgRed7.Picture;  picQZ[14] := ImgBlk7.Picture;

  // 建立象棋类
  XQ:=dTXIANGQI.Create(imgXQBoard,imgXY,imgQZMove,
                       imgMovePosFrom,imgMovePosTo,
                       picQZ,lbxPlayRec,lbxPlayVar,memPlayRec);
  if (XQ=nil) then Self.Close;
end;

//-------------------------------------------------------------------------
// 创建象棋桌
//.........................................................................
procedure TfrmXQTable.FormCreate(Sender: TObject);
begin
  isDemoTable        := False;

  isPasteMsgEnabled  := True;
  
  imgXQBoard.Picture := frmMain.imgXQBoard.Picture;

  // 设置棋桌的大小
  Self.Left   := 0;                 Self.Top := 0;
  Self.Height := dCXQTableHeight; Self.Width := dCXQTableWidth;

  imgXQBoard.Left := 0;
  imgXQBoard.Top  := 0;
  pnlLeft.Width        := imgXQBoard.Left + imgXQBoard.Width + 8;
  pnlRightMargin.Width := 3;

  XQ := nil;

  // 设置象棋盘
  dSetupXQBoard;

  tmrAutoPlay.Interval := iAutoPlayTime;

  case StrToIntDef(ReadRegStr('XqTable', 'TextColumn', '2'), 2) of
    1:   rbtTextStyle01.Checked := True;
    3:   rbtTextStyle03.Checked := True;
    else rbtTextStyle02.Checked := True;
  end;

  if (XQ=nil) then
  begin
    Self.Close;
    Exit;
  end;

  isXQFileChange := False;
  XQ.PlayRecHook := dPlayRecHook;
  XQ.RefreshHook := dRefreshHook;

  if isSetAutoPlayList then
  begin
    tmrAutoPlay.Interval := iAutoPlayTime;
    tmrAutoPlay.Enabled  := True;
    IsAutoPlaying        := True;
  end
  else
  begin
    if (sImportFileName <> '') then
    begin
      tmrAutoPlay.Interval := 1;
      tmrAutoPlay.Enabled  := True;
    end;
  end;

  FDragImgXY     := nil;
  FReverseBoardH := False;

  if (not frmMain.IsBitmapListLoaded) then
  begin
    tstQituBitmap.TabVisible   := False;
    ppmBitmapCopy.Enabled      := False;
    ppmBitmapSaveAsBmp.Enabled := False;
  end;
end;

//-------------------------------------------------------------------------
// imgXY 的事件处理程序
//.........................................................................
// Click
procedure TfrmXQTable.imgXYClick(Sender: TObject);
begin
  if (Sender=nil) then Exit;
  with Sender as TImage do
  begin

  end;
end;

// DblClick
procedure TfrmXQTable.imgXYDblClick(Sender: TObject);
var
  img: TImage;
begin
  if not imgMovePosTo.Visible then Exit;
  if (Sender=nil) then Exit;
  if not (Sender is TImage) then Exit;
  img := Sender as TImage;
  if img.Left <> imgMovePosTo.Left then Exit;
  if img.Top  <> imgMovePosTo.Top  then Exit;
  imgMovePosToDblClick(imgMovePosTo);
end;

// DragDrop
procedure TfrmXQTable.imgXYDragDrop(Sender, Source: TObject; X,
  Y: Integer);
begin
  if (Sender=nil) then Exit;
  with Sender as TImage do
  begin

  end;
end;

// DragOver
procedure TfrmXQTable.imgXYDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
  if (Sender=nil) then Exit;
  Accept := True;
  with Sender as TImage do
  begin
    if (XQ.QiziMove <> nil) then        // 棋子跟着光标移动
    begin
      imgQZMove.Left := Left + X - 17;
      imgQZMove.Top  := Top  + Y - 17;
    end;
  end;
end;

// EndDock
procedure TfrmXQTable.imgXYEndDock(Sender, Target: TObject; X,
  Y: Integer);
begin
  if (Sender=nil) then Exit;
  with Sender as TImage do
  begin

  end;
end;

// EndDrag
procedure TfrmXQTable.imgXYEndDrag(Sender, Target: TObject; X,
  Y: Integer);
var
  imgQZTo     : TImage;                 // 棋子移动的终点位置
  iPlayStepNo : dTInt32;
begin
  tmrMoveBlink.Enabled := False;
  iPlayStepNo := XQ.PlayStepNo;
  imgQZTo     := nil;
  if (Target <> nil) then               // 搜索终点'兵站'
    with Target as TImage do begin imgQZTo:=imgGetImgXY(X+Left,Y+Top); end;

  if (imgQZTo = nil) then
    XQ.dUndoMove                        // 最后棋子不在'兵站'上，取消移动
  else
    XQ.dStopMoveAtXY(imgQZTo.Tag);      // 将棋子移动到'兵站'上
  if (iPlayStepNo <> XQ.PlayStepNo) then
  begin
    tmrMoveBlink.Enabled := False;
    isXQFileChange := True;
    if XQ.isAddVarStep then dSetAddVarStepMode(False);
  end
  else
  begin
    if (Sender = nil) then
    begin
      lbxPlayRecClick(lbxPlayRec);
    end
    else
    begin
      tmrMoveBlink.Enabled := True;
    end;
  end;
end;

// MouseDown
procedure TfrmXQTable.imgXYMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (Sender=nil) then Exit;
  tmrMoveBlink.Enabled := False;
  if (FDragImgXY <> nil) and Assigned(FDragImgXY) then
  begin
    try
      imgMovePosTo.Visible := False;
      XQ.dStartMoveFromXY(FDragImgXY.Tag);
      imgXYEndDrag(nil, Sender, 16, 16); //X, Y);
    except
    end;
  end;
  FDragImgXY := nil;
end;

// MouseMove
procedure TfrmXQTable.imgXYMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  if (Sender=nil) then Exit;
  with Sender as TImage do
  begin

  end;
end;

// MouseUp
procedure TfrmXQTable.imgXYMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (Sender=nil) then Exit;
  with Sender as TImage do
  begin

  end;
end;

// Progress
procedure TfrmXQTable.imgXYProgress(Sender: TObject;
  Stage: TProgressStage; PercentDone: Byte; RedrawNow: Boolean;
  const R: TRect; const Msg: String);
begin
  if (Sender=nil) then Exit;
  with Sender as TImage do
  begin

  end;
end;

// StartDock
procedure TfrmXQTable.imgXYStartDock(Sender: TObject;
  var DragObject: TDragDockObject);
begin
  if (Sender=nil) then Exit;
  with Sender as TImage do
  begin

  end;
end;

// StartDrag
procedure TfrmXQTable.imgXYStartDrag(Sender: TObject;
  var DragObject: TDragObject);
begin
  if (Sender=nil) then Exit;
  // 从本'兵站'开始移动棋子
  tmrMoveBlink.Enabled := False;
  FDragImgXY := Sender as TImage;
  with Sender as TImage do begin XQ.dStartMoveFromXY(tag); end;
end;


//-------------------------------------------------------------------------