BillsEditor/CU/ScCopyBills.pas

unit ScCopyBills;

interface

uses
  Classes, SysUtils, XMLDoc, XMLIntf, Math, Controls, ScProjectManager,
  DB, DBClient, Contnrs, Windows, ScBillsTree, ConstVarUnit, DataBase,
  ConstTypeUnit;

var
  CF_Bills: Word;
  CF_Rations: Word;

type

  TScXMLSaver = class(TObject)
  private
    FMajorID: Integer;
    FPasteCount: Integer;
    FBillsData: TDMDataBase;
    FBillIDsList: TObjectList;

    procedure LoadBillsItem(ABillRec: TBillIDRecord; ANode: IXMLNode;
      var ANewDQID: Integer; ABillsQty, ADQQty: Boolean);
    procedure InternalAddBillRecd(xNode: IXMLNode; var ABillsID, ANewDQID: Integer;
      ABillsQty, ADQQty: Boolean);
    procedure RepairTreeStruct(var ALastNextNewID, ALastNextOldID: Integer;
      AParentID: Integer; AIsNew: Boolean);
    {复制方法}
    procedure SaveDrawingQuantity(ANode: IXMLNode; ABillID: Integer);
    procedure SaveExprsInXMLNode(ANode: IXMLNode);
    procedure SaveBillsExprs(ANode: IXMLNode; ABillsID: Integer);
    procedure SaveDrawingItemExprs(ANode: IXMLNode; ADrawingID: Integer);
    {粘贴方法}
    procedure LoadBillsForpaste(ANode: IXMLNode; var ABillID: Integer; AIsNew: Boolean;
      AItem: TScBillsItem; ABillsQty, ADQQty: Boolean);

    procedure LoadBillsExprs(ANode: IXMLNode; ABillsID: Integer);
    procedure LoadDrawingItemExprs(ANode: IXMLNode; ADrawingID: Integer);

    procedure LoadDrawingQuantityForPaste(ANode: IXMLNode; var ANewID: Integer;
      ABillID: Integer; AClearQty: Boolean; AClearBillsQty: Boolean = False);
  protected
    function CreateXMLDoc: IXMLDocument;
  public
    constructor Create(ABillsData: TDMDataBase); virtual;
    destructor Destroy; override;

    property BillsData: TDMDataBase read FBillsData;
  end;

  TScCopyType = (ctBills, ctRations);

  TScXMLClipboard = class(TScXMLSaver)
  private
    function SelectPastePos(var ABillsQty, ADQQty, ANew: Boolean; var ANewID, APos: Integer; var AItem: TScBillsItem): Boolean;
    function GetFirstLevelCount(aRoot: IXMLNode): Integer;
    procedure LocateNew(aPos, aIndex, aCount: Integer);
    procedure CollapseNew(aPos, aCount: Integer; aItem: TScBillsItem);
  private
    function SaveBillsItemForCopy(AItem: TScBillsItem; ANode: IXMLNode): IXMLNode;
    procedure SaveBillsForCopy(AIndex1, AIndex2: Integer; ANode: IXMLNode);

    procedure CopyBillsToXml(AXmlDoc: IXMLDocument; AIndex1, AIndex2: Integer);
    procedure PasteBillsFromXml(AXmlDoc: IXMLDocument; AIndex: Integer);
  protected
    procedure SaveXMLToClipboard(AFormat: Word; AXMLDoc: IXMLDocument);
    procedure LoadXMLFromClipboard(AFormat: Word; AXMLDoc: IXMLDocument);

  public
    constructor Create(aBillsData: TDMDataBase); override;
    {复制清单}
    procedure CopyBillsToClipboard(Index1, Index2: Integer);
    {粘贴清单}
    procedure PasteBillsFromClipboard(aIndex: Integer);

    {复制清单保存成文件}
    procedure CopyBillsToFile(const AFileName: string; AIndex1, AIndex2: Integer);
    {从文件中粘贴清单}
    procedure PasteBillsFromFile(const AFileName: string; AIndex: Integer);
  end;


implementation

uses
  Forms, Variants, Clipbrd, ZjIDTree, CheckPosForm, ConstMethodUnit, ScConfig,
  ScExprsDM;


{ TScXMLSaver }

constructor TScXMLSaver.Create(ABillsData: TDMDataBase);
begin
  FBillsData := ABillsData;
  FBillIDsList := TObjectList.Create;
end;

function TScXMLSaver.CreateXMLDoc: IXMLDocument;
begin
  Result := TXMLDocument.Create(nil) as IXMLDocument;
  Result.Active := True;

  Result.Encoding := 'gb2312';
  Result.Options := Result.Options + [doNodeAutoIndent];
  Result.AddChild('SmartCost');
end;

destructor TScXMLSaver.Destroy;
begin
  FBillIDsList.Free;
  inherited;
end;

procedure TScXMLSaver.InternalAddBillRecd(xNode: IXMLNode;
  var ABillsID, ANewDQID: Integer; ABillsQty, ADQQty: Boolean);
var
  bRec: TBillIDRecord;
begin
  if not Assigned(xNode) then Exit;

  if SameText(xNode.NodeName, c_BillsItem) then
  begin
    bRec := TBillIDRecord.Create;
    bRec.OldID := xNode.Attributes[c_ID];
    bRec.ParentID := xNode.Attributes[c_ParentID];
    bRec.NextSiblingID := xNode.Attributes[c_NextSiblingID];
    bRec.NewID := ABillsID;
    LoadBillsItem(bRec, xNode, ANewDQID, ABillsQty, ADQQty);
    FBillIDsList.Add(bRec);
    Inc(ABillsID);
  end;

  if xNode.HasChildNodes then
    InternalAddBillRecd(xNode.ChildNodes[0], ABillsID, ANewDQID, ABillsQty, ADQQty);
  if Assigned(xNode.NextSibling) then
    InternalAddBillRecd(xNode.NextSibling, ABillsID, ANewDQID, ABillsQty, ADQQty);
end;

procedure TScXMLSaver.LoadBillsExprs(ANode: IXMLNode; ABillsID: Integer);

  procedure LoadExprs(AXMLNode: IXMLNode);
  begin
    with FBillsData.DMExprs do
    begin
      cdsOrgExprs.Append;
      cdsOrgExprsMajorID.Value := AXMLNode.Attributes[c_MajorID];
      cdsOrgExprsMinorID.Value := AXMLNode.Attributes[c_MinorID];
      cdsOrgExprsRecdID.Value := ABillsID;
      cdsOrgExprsExprs.Value := AXMLNode.Attributes[c_Exprs];
      cdsOrgExprsExprs1.Value := AXMLNode.Attributes[c_Exprs1];
      cdsOrgExprsFlag.Value := AXMLNode.Attributes[c_Flag];
      cdsOrgExprsExprsValue.Value := AXMLNode.Attributes[c_ExprsValue];
      cdsOrgExprs.Post;
    end;
  end;

var
  I: Integer;
  xmlNode: IXMLNode;
begin
  xmlNode := ANode.ChildNodes.FindNode(c_BillsExprs);
  if xmlNode <> nil then
  begin
    for I := 0 to xmlNode.ChildNodes.Count - 1 do
      LoadExprs(xmlNode.ChildNodes[I]);
  end;
end;

procedure TScXMLSaver.LoadBillsForpaste(ANode: IXMLNode;
  var ABillID: Integer; AIsNew: Boolean; AItem: TScBillsItem;
  ABillsQty, ADQQty: Boolean);
var
  iNewDQID: Integer;
  vNode: IXMLNode;
  iOldNextSiblingID, iParentID, iCurID: Integer;
  iLastNextSiblingNewID, iLastNextSiblingOldID: Integer;
begin
  if not Assigned(AItem) then Exit;

  iNewDQID := FBillsData.GetMaxDrawingQuangtiyID;
  iOldNextSiblingID := -1;

  with FBillsData do
  begin
    iCurID := AItem.ID;
    if not ModifyNextSiblingID(iCurID, ABillID, iParentID, iOldNextSiblingID)
      then Exit;

    DisconnectBillsTree;
    try
      ANode := ANode.ChildNodes.FindNode(c_BillsList);

      if Assigned(ANode) and (ANode.ChildNodes.Count > 0) then
      begin
        vNode := ANode.ChildNodes[0];
        iLastNextSiblingOldID := vNode.Attributes[c_ID];
        iLastNextSiblingNewID := ABillID;
        InternalAddBillRecd(vNode, ABillID, iNewDQID, ABillsQty, ADQQty);
      end;

      FPasteCount := FBillIDsList.Count;
      
      RepairTreeStruct(iLastNextSiblingNewID, iLastNextSiblingOldID, iParentID, AIsNew);
      WriteRecIntoDB(FBillIDsList);

      if (iLastNextSiblingNewID <> iOldNextSiblingID) then
        ModifyNextSiblingID(iLastNextSiblingNewID, iOldNextSiblingID);

      if AIsNew then DeleteBills(iCurID);

    finally
      ConnectionBillsTree;
    end;
  end;

end;

procedure TScXMLSaver.LoadBillsItem(ABillRec: TBillIDRecord;
  ANode: IXMLNode; var ANewDQID: Integer; ABillsQty, ADQQty: Boolean);
begin
  ABillRec.Code := VarToStr(ANode.Attributes[c_Code]);
  ABillRec.Name := VarToStr(ANode.Attributes[c_Name]);
  ABillRec.Units := VarToStr(ANode.Attributes[c_Units]);

  if ABillsQty then
  begin
    ABillRec.Quantity := 0;
    ABillRec.DesignQuantity := 0;
    ABillRec.DesignQuantity2 := 0;
    ABillRec.DesignPrice := 0;
    ABillRec.UnitPrice := 0;
    ABillRec.TotalPrice := 0;
  end
  else
  begin
    ABillRec.Quantity := ANode.Attributes[c_Quantity];
    ABillRec.DesignQuantity := ANode.Attributes[c_DesignQuantity1];
    ABillRec.DesignQuantity2 := ANode.Attributes[c_DesignQuantity2];
    ABillRec.DesignPrice := ANode.Attributes[c_DesignPrice];
    ABillRec.UnitPrice := ANode.Attributes[c_UnitPrice];
    ABillRec.TotalPrice := ANode.Attributes[c_TotalPrice];
  end;

  ABillRec.B_Code := ANode.Attributes[c_BCode];
  ABillRec.MemoStr := ANode.Attributes[c_MemoString];

  LoadDrawingQuantityForPaste(ANode, ANewDQID, ABillRec.NewID, ADQQty, ABillsQty);
  LoadBillsExprs(ANode, ABillRec.NewID);
end;

procedure TScXMLSaver.LoadDrawingItemExprs(ANode: IXMLNode;
  ADrawingID: Integer);

  procedure LoadExprs(AXMLNode: IXMLNode);
  begin
    with FBillsData.DMExprs do
    begin
      cdsOrgExprs.Append;
      cdsOrgExprsMajorID.Value := AXMLNode.Attributes[c_MajorID];
      cdsOrgExprsMinorID.Value := AXMLNode.Attributes[c_MinorID];
      cdsOrgExprsRecdID.Value := ADrawingID;
      cdsOrgExprsExprs.Value := AXMLNode.Attributes[c_Exprs];
      cdsOrgExprsExprs1.Value := AXMLNode.Attributes[c_Exprs1];
      cdsOrgExprsFlag.Value := AXMLNode.Attributes[c_Flag];
      cdsOrgExprsExprsValue.Value := AXMLNode.Attributes[c_ExprsValue];
      cdsOrgExprs.Post;
    end;
  end;

var
  I: Integer;
  xmlNode: IXMLNode;
begin
  xmlNode := ANode.ChildNodes.FindNode(c_DrawingExprs);
  if xmlNode <> nil then
  begin
    for I := 0 to xmlNode.ChildNodes.Count - 1 do
      LoadExprs(xmlNode.ChildNodes[I]);
  end;
end;

procedure TScXMLSaver.LoadDrawingQuantityForPaste(ANode: IXMLNode;
  var ANewID: Integer; ABillID: Integer; AClearQty: Boolean; AClearBillsQty: Boolean);
var
  I, iSerinalNo: Integer;
  vNode: IXMLNode;
begin
  ANode := ANode.ChildNodes.FindNode(c_DrawQList);
  if ANode = nil then Exit;
  
  with FBillsData do
  begin
    iSerinalNo := 1;
    for I := 0 to ANode.ChildNodes.Count - 1 do
    begin
      vNode := ANode.ChildNodes[I];
      
      cdsDrawingQuantity.Insert;
      cdsDrawingQuantityID.Value := ANewID;
      cdsDrawingQuantityBillsID.Value := ABillID;
      cdsDrawingQuantitySerinalNo.Value := iSerinalNo;
      cdsDrawingQuantityName.Value := vNode.Attributes[c_Name];
      cdsDrawingQuantityUnits.Value := vNode.Attributes[c_Units];
      if AClearBillsQty then
        cdsDrawingQuantityIsGatherQ.AsBoolean := False 
      else
        cdsDrawingQuantityIsGatherQ.Value := vNode.Attributes[c_IsGatherQty];
      if AClearQty then
      begin
        cdsDrawingQuantityDQuantity1.Value := 0;
        cdsDrawingQuantityDQuantity2.Value := 0;
      end
      else
      begin
        cdsDrawingQuantityDQuantity1.Value := vNode.Attributes[c_DesignQuantity1];
        cdsDrawingQuantityDQuantity2.Value := vNode.Attributes[c_DesignQuantity2];
      end;
      cdsDrawingQuantityMemoContext.Value := vNode.Attributes[c_MemoString];
      cdsDrawingQuantity.Post;

      LoadDrawingItemExprs(vNode, ANewID);
      
      Inc(ANewID);
      Inc(iSerinalNo);
    end;
  end;
end;

procedure TScXMLSaver.RepairTreeStruct(var ALastNextNewID, ALastNextOldID: Integer;
  AParentID: Integer; AIsNew: Boolean);
var
  I, J: Integer;
  billIDRecd, billRec: TBillIDRecord;
begin
  for I := 0 to FBillIDsList.Count - 1 do
  begin
    billIDRecd := TBillIDRecord(FBillIDsList[I]);
    if (billIDRecd.OldID = ALastNextOldID) then
    begin
      if (billIDRecd.NextSiblingID <> -1) or AIsNew then
      begin
        ALastNextOldID := billIDRecd.NextSiblingID;
      end;
      ALastNextNewID := billIDRecd.NewID;
      billIDRecd.ParentID := AParentID;
      billIDRecd.ParentChanged := True;
    end;

    for J := 0 to FBillIDsList.Count - 1 do
    begin
      billRec := TBillIDRecord(FBillIDsList[J]);
      if (billRec.ParentID = billIDRecd.OldID) and (not billRec.ParentChanged) then
      begin
        billRec.ParentID := billIDRecd.NewID;
        billRec.ParentChanged := True;
      end
      else if (billRec.NextSiblingID = billIDRecd.OldID) and (not billRec.NextSiblingChanged) then
      begin
        billRec.NextSiblingID := billIDRecd.NewID;
        billRec.NextSiblingChanged := True;
      end;
    end;
  end;
end;

procedure TScXMLSaver.SaveBillsExprs(ANode: IXMLNode; ABillsID: Integer);
var
  xmlExprs: IXMLNode;
begin
  with FBillsData.DMExprs do
  begin
    xmlExprs := ANode.AddChild(c_BillsExprs);
    cdsOrgExprs.SetRange([1, ABillsID], [1, ABillsID]);
    cdsOrgExprs.First;
    while not cdsOrgExprs.Eof do
    begin
      SaveExprsInXMLNode(xmlExprs.AddChild(c_BillsExprsItem));
      cdsOrgExprs.Next;
    end;
    cdsOrgExprs.CancelRange;
  end;
end;

procedure TScXMLSaver.SaveDrawingItemExprs(ANode: IXMLNode;
  ADrawingID: Integer);
var
  xmlExprs: IXMLNode;
begin
  with FBillsData.DMExprs do
  begin
    xmlExprs := ANode.AddChild(c_DrawingExprs);
    cdsOrgExprs.SetRange([2, ADrawingID], [2, ADrawingID]);
    cdsOrgExprs.First;
    while not cdsOrgExprs.Eof do
    begin
      SaveExprsInXMLNode(xmlExprs.AddChild(c_DrawingExprsItem));
      cdsOrgExprs.Next;
    end;
    cdsOrgExprs.CancelRange;
  end;
end;

procedure TScXMLSaver.SaveDrawingQuantity(ANode: IXMLNode;
  ABillID: Integer);
var
  xmlDrawItem: IXMLNode;
begin
  with FBillsData do
  begin
    cdsDQForLocate.SetRange([ABillID], [ABillID]);
    if cdsDQForLocate.RecordCount > 0 then
      ANode := ANode.AddChild(c_DrawQList);
    cdsDQForLocate.First;
    while not cdsDQForLocate.Eof do
    begin
      xmlDrawItem := ANode.AddChild(c_DQItem);
      xmlDrawItem.Attributes[c_BillsID] := cdsDQForLocateBillsID.AsInteger;
      xmlDrawItem.Attributes[c_Name] := cdsDQForLocateName.AsString;
      xmlDrawItem.Attributes[c_Units] := cdsDQForLocateUnits.AsString;
      xmlDrawItem.Attributes[c_DesignQuantity1] := cdsDQForLocateDQuantity1.AsFloat;
      xmlDrawItem.Attributes[c_DesignQuantity2] := cdsDQForLocateDQuantity2.AsFloat;
      xmlDrawItem.Attributes[c_MemoString] := cdsDQForLocateMemoContext.AsString;
      xmlDrawItem.Attributes[c_IsGatherQty] := cdsDQForLocateIsGatherQ.AsBoolean;
      SaveDrawingItemExprs(xmlDrawItem, cdsDQForLocateID.AsInteger);
      cdsDQForLocate.Next;
    end;
    cdsDQForLocate.CancelRange;
  end;
end;

procedure TScXMLSaver.SaveExprsInXMLNode(ANode: IXMLNode);
begin
  with FBillsData.DMExprs do
  begin
    ANode.Attributes[c_MajorID] := cdsOrgExprsMajorID.AsInteger;
    ANode.Attributes[c_MinorID] := cdsOrgExprsMinorID.AsInteger;
    ANode.Attributes[c_RecdID] := cdsOrgExprsRecdID.AsInteger;
    ANode.Attributes[c_Exprs] := cdsOrgExprsExprs.AsString;
    ANode.Attributes[c_Exprs1] := cdsOrgExprsExprs1.AsString;
    ANode.Attributes[c_Flag] := cdsOrgExprsFlag.AsInteger;
    ANode.Attributes[c_ExprsValue] := cdsOrgExprsExprsValue.AsFloat;
  end;
end;

{ TScXMLClipboard }

procedure TScXMLClipboard.CollapseNew(aPos, aCount: Integer; aItem: TScBillsItem);
begin
  case aPos of
    cp_Next:
             begin
                while Assigned(aItem) and (aCount > 0) do
                begin
                  aItem.Collapse;
                  aItem := TScBillsItem(aItem.NextSibling);
                  Dec(aCount);
                end;
             end;
    cp_Font, cp_Child:
             begin
                while Assigned(aItem) and (aCount > 0) do
                begin
                  aItem.Collapse;
                  aItem := TScBillsItem(aItem.PrevSibling);
                  Dec(aCount);
                end;
             end;
  end;
end;

procedure TScXMLClipboard.CopyBillsToClipboard(Index1, Index2: Integer);
var
  xmlDoc: IXMLDocument;
begin
  xmlDoc := CreateXMLDoc;
  try
    CopyBillsToXml(xmlDoc, Index1, Index2);
    // 将XML文件流按照CF_Rations格式保存到剪贴板中
    SaveXMLToClipboard(CF_Bills, xmlDoc);
  finally
    xmlDoc := nil;
  end;
end;

procedure TScXMLClipboard.CopyBillsToFile(const AFileName: string; AIndex1,
  AIndex2: Integer);
var
  xmlDoc: IXMLDocument;
begin
  xmlDoc := CreateXMLDoc;
  try
    CopyBillsToXml(xmlDoc, AIndex1, AIndex2);
    if not DirectoryExists(ExtractFilePath(AFileName)) then
      ForceDirectories(ExtractFilePath(AFileName));
    xmlDoc.SaveToFile(AFileName);
  finally
    xmlDoc := nil;
  end;
end;

procedure TScXMLClipboard.CopyBillsToXml(AXmlDoc: IXMLDocument; AIndex1,
  AIndex2: Integer);
var
  xmlBillsList, xmlRoot: IXMLNode;
begin
  if AIndex1 > AIndex2 then Exit;

  xmlRoot := AXmlDoc.DocumentElement;

  // 增加清单列表接点
  xmlBillsList := xmlRoot.AddChild(c_BillsList);

  AIndex1 := Max(0, AIndex1);
  AIndex2 := Min(FBillsData.BillsTree.Count - 1, AIndex2);

  SaveBillsForCopy(AIndex1, AIndex2, xmlBillsList);
end;

constructor TScXMLClipboard.Create(aBillsData: TDMDataBase);
begin
  inherited Create(aBillsData);

end;

function TScXMLClipboard.GetFirstLevelCount(aRoot: IXMLNode): Integer;
var
  cNode: IXMLNode;
begin
  cNode := aRoot.ChildNodes.FindNode(c_BillsList);
  Result := cNode.ChildNodes.Count;
end;

procedure TScXMLClipboard.LoadXMLFromClipboard(AFormat: Word;
  AXMLDoc: IXMLDocument);
var
  MemStrm: TMemoryStream;
  Data: THandle;
  DataPtr: Pointer;
begin
  with Clipboard do
  begin
    Open;
    try
      Data := GetClipboardData(AFormat);
      if Data = 0 then Exit;

      DataPtr := GlobalLock(Data);
      try
        MemStrm := TMemoryStream.Create;
        try
          MemStrm.WriteBuffer(DataPtr^, GlobalSize(Data));
          MemStrm.Position := 0;
          AXMLDoc.LoadFromStream(MemStrm);
        finally
          MemStrm.Free;
        end;
      finally
        GlobalUnlock(Data);
      end;
    finally
      Close;
    end;
  end;
end;

procedure TScXMLClipboard.LocateNew(aPos, aIndex, aCount: Integer);
var
  cItem: TScBillsItem;
begin
  cItem := FBillsData.BillsTree[aIndex];
  case aPos of
    cp_Next:
            begin
              cItem := TScBillsItem(cItem.NextSibling);
              if Assigned(cItem) then
                cItem.LocateDBRecord;
            end;
    cp_Font:
            begin
              cItem := TScBillsItem(cItem.PrevSibling);
              if Assigned(cItem) then
                cItem.LocateDBRecord;
            end;
    cp_Child:
            begin
              cItem := TScBillsItem(cItem.LastChild);
              if Assigned(cItem) then
                cItem.LocateDBRecord;
            end;
  end;

  if ScConfigInfo.AutoCollapse then
    CollapseNew(aPos, aCount, cItem);
end;

procedure TScXMLClipboard.PasteBillsFromClipboard(aIndex: Integer);
var
  xmlDoc: IXMLDocument;
begin
  if (aIndex >= FBillsData.BillsTree.Count) or (aIndex < -1) then Exit; 

  xmlDoc := CreateXMLDoc;
  try
    LoadXMLFromClipboard(CF_Bills, xmlDoc);
    PasteBillsFromXml(xmlDoc, aIndex);
  finally
    xmlDoc := nil;
  end;
end;

procedure TScXMLClipboard.PasteBillsFromFile(const AFileName: string;
  AIndex: Integer);
var
  xmlDoc: IXMLDocument;
begin
  if (AIndex >= FBillsData.BillsTree.Count) or (AIndex < -1) then Exit; 

  xmlDoc := CreateXMLDoc;
  try
    xmlDoc.LoadFromFile(AFileName);
    PasteBillsFromXml(xmlDoc, AIndex);
  finally
    xmlDoc := nil;
  end;
end;

procedure TScXMLClipboard.PasteBillsFromXml(AXmlDoc: IXMLDocument;
  AIndex: Integer);
var
  vRoot: IXMLNode;
  vItem: TScBillsItem;
  bBillsQty: Boolean;
  bDQQty: Boolean;
  bNew: Boolean;
  bIsPPBills: Boolean;
  iNewBillID, iPos, iCount: Integer;
begin
  bNew       := False;
  bBillsQty  := False;
  bDQQty     := False;
  bIsPPBills := False;

  vItem := FBillsData.BillsTree.Items[aIndex];
  if vItem = nil then Exit;

  vRoot := AXmlDoc.DocumentElement;
  if vRoot = nil then Exit;
  iCount := GetFirstLevelCount(vRoot);
  iNewBillID := FBillsData.GetMaxBillsID;

  aIndex := vItem.ID;
  FBillsData.SaveStatus;

  if not SelectPastePos(bBillsQty, bDQQty, bNew, iNewBillID, iPos, vItem) then Exit;

  Screen.Cursor := crHourGlass;
  if FBillsData.IsProjectBills then
  begin
    bIsPPBills := True;
    FBillsData.IsProjectBills := False;
  end;
  FBillsData.EnabledUITreeEvt(False, False);
  try
    LoadBillsForpaste(vRoot, iNewBillID, bNew, vItem, bBillsQty, bDQQty);
  finally
    FBillsData.ReadStatus(FMajorID, FPasteCount);
    FBillsData.EnabledUITreeEvt(True, False);
    LocateNew(iPos, aIndex, iCount);
    Screen.Cursor := crDefault;
    if bIsPPBills then
      FBillsData.IsProjectBills := bIsPPBills;
  end;
end;

procedure TScXMLClipboard.SaveBillsForCopy(AIndex1, AIndex2: Integer;
  ANode: IXMLNode);
var
  vChildNode: IXMLNode;
  vItem: TScBillsItem;
  iIndex: Integer;
begin
  if AIndex1 > AIndex2 then Exit;

  vItem := FBillsData.BillsTree.Items[AIndex1];

  while Assigned(vItem) and (vItem.MajorIndex <= AIndex2) do
  begin

    vChildNode := SaveBillsItemForCopy(vItem, ANode);

    if vItem.HasChildren then
    begin
      iIndex := vItem.FirstChild.MajorIndex;
      // 用AIndex2则只复制到选择范围内，用MaxInt表示复制所有子项，即使不在选择范围内
      SaveBillsForCopy(iIndex, MaxInt, vChildNode);
    end;

    vItem := TScBillsItem(vItem.NextSibling);
  end;
end;

function TScXMLClipboard.SaveBillsItemForCopy(AItem: TScBillsItem;
  ANode: IXMLNode): IXMLNode;

  procedure SaveXMLBillsItem(AXMLNode: IXMLNode);
  begin
    with FBillsData do
    begin
      AXMLNode.Attributes[c_ID] := cdsBillsID.Value;
      AXMLNode.Attributes[c_ParentID] := cdsBillsParentID.Value;
      AXMLNode.Attributes[c_NextSiblingID] := cdsBillsNextSiblingID.Value;
      AXMLNode.Attributes[c_Code] := cdsBillsCode.AsString;
      AXMLNode.Attributes[c_Name] := cdsBillsName.AsString;
      AXMLNode.Attributes[c_Units] := cdsBillsUnits.AsString;

      AXMLNode.Attributes[c_BCode] := cdsBillsB_Code.AsString;
      AXMLNode.Attributes[c_DesignQuantity1] := cdsBillsDesignQuantity.AsFloat;
      AXMLNode.Attributes[c_DesignQuantity2] := cdsBillsDesignQuantity2.AsFloat;
      AXMLNode.Attributes[c_DesignPrice] := cdsBillsDesignPrice.AsFloat;

      AXMLNode.Attributes[c_Quantity] := cdsBillsQuantity.AsFloat;
      AXMLNode.Attributes[c_UnitPrice] := cdsBillsUnitPrice.AsFloat;
      AXMLNode.Attributes[c_TotalPrice] := cdsBillsTotalPrice.AsFloat;
      AXMLNode.Attributes[c_MemoString] := cdsBillsMemoStr.AsString;
    end;
  end;

begin
  Result := nil;
  if FBillsData.cdsBills.FindKey([AItem.ID]) then
  begin
    Result := ANode.AddChild(c_BillsItem);
    SaveXMLBillsItem(Result);
    SaveDrawingQuantity(Result, AItem.ID);
    SaveBillsExprs(Result, AItem.ID);
  end;
end;

Type
  TClipboardAccess = class(TClipboard);

procedure TScXMLClipboard.SaveXMLToClipboard(AFormat: Word;
  AXMLDoc: IXMLDocument);
var
  MemStrm: TMemoryStream;
begin
  MemStrm := TMemoryStream.Create;
  try
    AxmlDoc.SaveToStream(MemStrm);
    MemStrm.Position := 0;
    TClipboardAccess(Clipboard).SetBuffer(AFormat, MemStrm.Memory^, MemStrm.Size);
  finally
    MemStrm.Free;
  end;
end;

function TScXMLClipboard.SelectPastePos(var ABillsQty, ADQQty,
  ANew: Boolean; var ANewID, APos: Integer; var AItem: TScBillsItem): Boolean;
begin
  Result := False;
  APos := CheckBillsPastePosition(ABillsQty, ADQQty);
  case APos of
    -1: Exit;
    // 后兄弟无需处理，始终插在选中节点的后兄弟位置。
    cp_Next: FMajorID := AItem.MajorIndex;
    cp_Font:
    begin
      if AItem.PrevSibling = nil then
      begin
        FMajorID := AItem.Parent.MajorIndex;
        AItem := FBillsData.BillsTree.AddBillsItem(ANewID, AItem.ParentID, AItem.ID);
        Inc(ANewID);
        ANew := True;
      end
      else
      begin
        FMajorID := AItem.PrevNode.MajorIndex;
        AItem := FBillsData.BillsTree[AItem.PrevSiblingID];
      end;
    end;
    cp_Child:
    begin
      {if AItem.HasDrawingQuantity then
      begin
        MessageHint(0, '该清单下有图纸工程量，不允许插入子项。');
        Exit;
      end;   }
      if AItem.ChildCount = 0 then
      begin
        FMajorID := AItem.MajorIndex;
        AItem := FBillsData.BillsTree.AddBillsItem(ANewID, AItem.ID, -1);
        Inc(ANewID);
        ANew := True;
      end
      else
      begin
        AItem := TScBillsItem(AItem.LastChild);
        FMajorID := AItem.MajorIndex;
      end;
    end;
  end;
  Result := True;
end;

initialization
  { The following strings should not be localized }
  CF_Bills := RegisterClipboardFormat('SmartCost Bills');
  CF_Rations := RegisterClipboardFormat('SmartCost Rations');
finalization


end.