xqsystem.pas

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

    RecMemo.Text := PN.Remark.Text;
    RecMemo.SelStart := 0;  RecMemo.SelLength := 0;
  end;
end;

//-------------------------------------------------------------------------
// 变着记录是当前记录吗？
//.........................................................................
function dTXiangQi.isHighlightVarStepActive: Boolean;
var
  iRec : dTInt32;
  iVar : dTInt32;
begin
  Result := False;
  iRec := RecListBox.ItemIndex;
  iVar := VarListBox.ItemIndex;
  if ((iRec<1)or(iRec>dCMaxRecNo)) then Exit;
  if ((iVar<0)or(iVar>dCMaxVarNo)) then Exit;
  if PlayRec[iRec] = nil then Exit;
  if PlayVar[iVar] = nil then Exit;
  Result := (PlayRec[iRec] = PlayVar[iVar]);
end;


procedure dExchangePlayVar(var upNode, dnNode: dTXQPlayNode);
var
  tmpRChild: dTXQPlayNode;
begin
  if ((upNode=nil)or(dnNode=nil)) then Exit;

  tmpRChild  := dnNode.RChild;

  dnNode.LParent := upNode.LParent;
  dnNode.RParent := upNode.RParent;
  if (dnNode.RChild <> nil) then dnNode.RChild.LParent:=upNode;
  dnNode.RChild  := upNode;
  if (upNode.LParent <> nil) then upNode.Lparent.RChild := dnNode;
  if (upNode.RParent <> nil) then upNode.RParent.LChild := dnNode;

  upNode.LParent := dnNode;
  upNode.RParent := nil;  //tmpRParent;
  upNode.RChild  := tmpRChild;
end;

//-------------------------------------------------------------------------
//
//.........................................................................
procedure dTXiangQi.dMovePlayVarUp;
var
  iVar : dTInt32;
begin
  iVar := VarListBox.ItemIndex;
  if (iVar<1) then Exit;
  dExchangePlayVar(PlayVar[iVar-1], PlayVar[iVar]);
  dDispVarStepAtRecNo(RecListBox.ItemIndex);
  VarListBox.ItemIndex := (iVar-1);
end;

//-------------------------------------------------------------------------
//
//.........................................................................
procedure dTXiangQi.dMovePlayVarDown;
var
  iVar : dTInt32;
begin
  iVar := VarListBox.ItemIndex;
  if (iVar>=(VarListBox.Items.Count-1)) then Exit;
  dExchangePlayVar(PlayVar[iVar], PlayVar[iVar+1]);
  dDispVarStepAtRecNo(RecListBox.ItemIndex);
  VarListBox.ItemIndex := (iVar+1);
end;

//-------------------------------------------------------------------------
//
//.........................................................................
procedure dTXiangQi.dDispVarStepAtRecNo(iRec:dTInt32);
var
  PN    : dTXQPlayNode;
  n     : dTInt32;
  s     : string;
begin
  VarListBox.Items.Clear;

  if ((iRec<1)or(iRec>dCMaxRecNo)) then Exit;
  if PlayRec[iRec] = nil then Exit;

  // 在棋谱记录中找到当前的节点的上一步棋的节点的第一步应着
  PN := PlayRec[iRec].LastStepNode.LChild;  n := 0;
  while (PN <> nil) do
  begin
    s := '  A. ';  s[3] := chr(ord(s[3])+n);
    s := s + PN.StrRec;
    if (PN = PlayRec[iRec]) then  s := s + ' <--';
    VarListBox.Items.Add(s);
    PlayVar[n] := PN;
    n := n + 1;

    PN := PN.RChild;
  end;
  if n<>0 then
  begin
    RecListBox.Items[iRec]:=sGetFMTRecStr(PlayRec[iRec]);
  end;
end;

//-------------------------------------------------------------------------
//
//.........................................................................
procedure dTXiangQi.dLoadAllRecForPlayNode(PN:dTXQPlayNode);
var
  i, iDispStepNo :  dTInt32;
begin
  // 先删除原来的走法(从显示的当前状况开始)
  if (PN=nil) then Exit;
  iDispStepNo := DispStepNo;
  if (iDispStepNo<PN.StepNo) then iDispStepNo:=PN.StepNo;

  dMoveMemoToRecNo(DispStepNo);
  dLoadMemoFromRecNo(DispStepNo);

  for i:=PlayStepNo downto iDispStepNo do
  begin
    //为修正变着中注解显示的错误
    if i = iDispStepNo then
    begin
      dDeleteOnePlayRec;
    end
    else
    begin
      dDeleteOnePlayRec(False);
    end;
  end;
  if PN = PlayTree then
  begin
    iDispStepNo:=0; RecListBox.Items.Clear;
  end;
  while PN <> nil do
  begin
    dAddPlayNodeIntoPlayRec(PN);
    PlayStepNo := PN.StepNo;
    PlayNode   := PN;
    PN := PN.LChild;
  end;

  dDispQiziAtRecNo(iDispStepNo);
  dEnablePlayer(PlayNode);
end;

//-------------------------------------------------------------------------
// 将走棋节点加入棋谱列表
//.........................................................................
procedure dTXiangQi.dAddPlayNodeIntoPlayRec(PN:dTXQPlayNode);
begin
  if (PN=nil) then Exit;

  if (PN.StepNo <= dCMaxRecNo) then
  begin
    PlayRec[PN.StepNo] := PN;
    RecListBox.Items.Add(sGetFMTRecStr(PN));    // 显示本步棋
  end;
end;

//-------------------------------------------------------------------------
//
//.........................................................................
procedure dTXIANGQI.dOnRecListBoxClick;
begin
  if (RecListBox.Items.Count=0) then Exit;
  if (RecListBox.ItemIndex<0) then Exit;
  dDispQiziAtRecNo(RecListBox.ItemIndex);
  dEnablePlayer(DispNode);
end;

//-------------------------------------------------------------------------
//
//.........................................................................
procedure dTXIANGQI.dOnVarListBoxDblClick;
begin
  if (VarListBox.Items.Count=0) then Exit;
  if (VarListBox.ItemIndex<0) then Exit;
  if isHighlightVarStepActive then Exit;
  dLoadAllRecForPlayNode(PlayVar[VarListBox.ItemIndex]);
end;

//-------------------------------------------------------------------------
//
//.........................................................................
procedure dTXIANGQI.dOnRecMemoChange;
begin
  isMemoEdit := True;
end;

//-------------------------------------------------------------------------
//
//.........................................................................
procedure dTXIANGQI.dDeleteOnePlayNode;
var
  PN : dTXQPlayNode;
begin
  if ((PlayStepNo=0)or(PlayStepNo<>DispStepNo)) then Exit;
  PN := PlayRec[PlayStepNo];
  if (PN=nil) then Exit;
  if (not ((PN.LParent=nil)and(PN.RChild=nil))) then // 有变着
  begin
    case Application.MessageBox(
          '本步棋的记录有变着存在，如果您删除了本记录，所有的变着以及后'+
          '续变化都会被删除。'#13#10#13#10'真的要删除吗？',
          '删除棋谱记录',
          MB_OKCANCEL + MB_ICONQUESTION + MB_DEFBUTTON2) of
      IDOK:
        begin end;
      else
        Exit;
    end;
  end;
  dDeleteOnePlayRec;
  if (PN <> nil) then PN.Free;
end;

//-------------------------------------------------------------------------
//
//.........................................................................
procedure dTXiangQi.dDeletePlayVar(PN:dTXQPlayNode);
begin
  if (PN=nil) then Exit;

  if (not (PN.LChild=nil)) then // 有后续变化
  begin
    case Application.MessageBox(
          '本步变着有后续变化，如果您删除了本记录，所有的后'+
          '续变化都会被删除。'#13#10#13#10'真的要删除吗？',
          '删除变着',
          MB_OKCANCEL + MB_ICONQUESTION + MB_DEFBUTTON2) of
      IDOK:
        begin end;
      else
        Exit;
    end;
  end;

  if(PN.RParent<>nil) then
  begin
    PN.RParent.dSetLChild(PN.RChild);
  end;
  if(PN.LParent<>nil) then
  begin
    PN.LParent.dSetRChild(PN.RChild);
  end;
  PN.LParent:=nil;  PN.RParent:=nil; PN.LChild:=nil; PN.RChild:=nil;
  PN.Free;
end;

//-------------------------------------------------------------------------
// 删除一个棋谱记录，在RecListBox中
//.........................................................................
procedure dTXIANGQI.dDeleteOnePlayRec(bRefresh: Boolean);
begin
  if (PlayStepNo = 0) then Exit;
  RecListBox.Items.Delete(RecListBox.Items.Count-1);
  PlayStepNo := RecListBox.Items.Count - 1;    // 走棋步数-1
  PlayNode   := PlayNode.LastStepNode;
  RecListBox.ItemIndex := -1;
  if (bRefresh) then dDispQiziAtRecNo(PlayStepNo);
  RecListBox.ItemIndex := 0;
  RecListBox.ItemIndex := PlayStepNo;
  if (bRefresh) then dEnablePlayer(PlayNode);
end;

//-------------------------------------------------------------------------
//
//.........................................................................
procedure dTXIANGQI.dRefreshBoard(ReStart:Boolean);
var
  i, j, m, n: Integer;
begin
  if ReStart then
  begin
    for i:=1 to 32 do
    begin
      Qizi[i].XY := Qizi[i].XYStart;
    end;
    RecListBox.Items.Clear;
    PlayStepNo          := 0;
    DispStepNo          := 0;
    MovePosTo.Visible   := False;
    MovePosFrom.Visible := False;
  end;

  for i:=0 to 8 do for j:=0 to 9 do
  begin
    BoardXY[i, j].Picture  := nil;
    BoardXY[i, j].Cursor   := crDefault;
    BoardXY[i, j].DragMode := dmManual;
  end;

  for i:=1 to 32 do
  begin
    if (Qizi[i].XY = $FF) then Continue;
    m := Qizi[i].XY div 10;  n := Qizi[i].XY mod 10;
    BoardXY[m, n].Picture  := Qizi[i].Picture;
  end;
end;
{
//-------------------------------------------------------------------------
//
//.........................................................................
procedure dTXIANGQI.dReverseBoard;
var
  i, j, iLeft, iTop: dTINT32;
begin
  MovePosTo.Visible   := False;
  MovePosFrom.Visible := False;
  for i:=0 to 8 do for j:=0 to 4 do
  begin
    iLeft                  := BoardXY[i, j].Left;
    iTop                   := BoardXY[i, j].Top;
    BoardXY[i, j].Left     := BoardXY[8-i, 9-j].Left;
    BoardXY[i, j].Top      := BoardXY[8-i, 9-j].Top;
    BoardXY[8-i, 9-j].Left := iLeft;
    BoardXY[8-i, 9-j].Top  := iTop;
  end;
  dDispQiziAtRecNo(DispStepNo);         // 为了显示最后移动棋子的标记
end;
}

procedure dTXIANGQI.dRefreshRecStr;
var
  i: Integer;
procedure RefreshPNodeRecStr(APNode: dTXQPlayNode);
begin
  if APNode = nil then Exit;
  if APNode.LastStepNode = nil then
  begin
    APnode.StrRec := '';
  end
  else
  begin
    APNode.StrRec := sGetPlayRecStr(APNode.LastStepNode.QiZiXY,
       APNode.XYf, APNode.XYt, ReverseH, False);
  end;
  RefreshPNodeRecStr(APNode.LChild);
  RefreshPNodeRecStr(APNode.RChild);
end;
begin
  RefreshPNodeRecStr(PlayTree);
  for i:=1 to RecListBox.Items.Count do
  begin
    RecListBox.Items[i-1]:=sGetFMTRecStr(PlayRec[i-1]);
  end;
end;

end.
///////////////////////////////////////////////////////////////////////////