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.