Measure/Units/BillsClipboard.pas

unit BillsClipboard;

interface

uses
  Clipbrd, Classes, BillsDm, ZhAPI, XmlDoc, XmlIntf, Windows, sdIDTree;

type
  TInnerClipboard = class(TClipboard);

  TBillsBlockNode = class
  private
    FID: Integer;
    FParentID: Integer;
    FNextSiblingID: Integer;
    FCode: string;
    FB_Code: string;
    FName: string;
    FUnits: string;
    FPrice: Double;
    FOrgQuantity: Double;
    FMisQuantity: Double;
    FOthQuantity: Double;
    FQuantity: Double;
    FDrawingCode: string;
    FAlias: string;
    FDgnQuantity1: Double;
    FDgnQuantity2: Double;
    FMemoStr: string;
    FDealCode: string;
    FDealCompany: string;
  public
    procedure SaveToXmlNode(AXmlNode: IXMLNode);
    procedure LoadFromXmlNode(AXmlNode: IXMLNode);
  end;

  TBillsClipboard = class
  private
    FStream: TMemoryStream;
    FBillsData: TBillsData;
    FNodeList: TList;

    procedure SaveToClipboard(AFormat: Word);
    procedure LoadFromClipboard(AFormat: Word);

    procedure SaveToStream;
    procedure LoadFromStream;
    procedure SaveToXmlFile(const AFileName: string);
    procedure LoadFromXmlFile(const AFileName: string);

    procedure SaveNodesToXml(AXmlNode: IXMLNode);
    procedure LoadNodesFromXml(AXmlNode: IXMLNode);

    procedure CopyBillsNodeData(ANode: TsdIDTreeNode);
    procedure CopyBillsNode(ANode: TsdIDTreeNode);
    procedure CopyData(ANode: TsdIDTreeNode; ACount: Integer);

    function AddBillsNode(ANode: TsdIDTreeNode; APos: Integer): TsdIDTreeNode;
    procedure PasteBillsNodeData(ANode: TsdIDTreeNode; APasteNode: TBillsBlockNode);
    procedure PasteChildren(AParentNode: TsdIDTreeNode; APasteParentID: Integer);
    procedure PasteNextSibling(APreSibling: TsdIDTreeNode; APasteNodeID: Integer);
    procedure PasteBillsNode(ANode: TsdIDTreeNode; APos: Integer; APasteNode: TBillsBlockNode);
    procedure PasteData(ANode: TsdIDTreeNode; APos: Integer);

    procedure Clear;
  public
    constructor Create(ABillsData: TBillsData);
    destructor Destroy; override;

    procedure Copy(ANode: TsdIDTreeNode; ACount: Integer);
    // APos: 0[×ÓÏî] 1[ºóÏî] 2[Ç°Ïî]
    procedure Paste(ANode: TsdIDTreeNode; APos: Integer);
  end;

function HasBillsBlockFormat: Boolean;

implementation

uses sdDB, Math, SysUtils, UtilMethods;

var
  CF_BillsBlock: Word;


function HasBillsBlockFormat: Boolean;
begin
  Result := Clipboard.HasFormat(CF_BillsBlock);
end;

{ TBillsClipboard }

function TBillsClipboard.AddBillsNode(ANode: TsdIDTreeNode;
  APos: Integer): TsdIDTreeNode;
begin
  // ×ÓÏî²åÈë
  if APos = 0 then
    Result := ANode.Owner.Add(ANode.ID, -1)
  // ºóÏî²åÈë
  else if APos = 1 then
    Result := ANode.Owner.Add(ANode.ParentID, ANode.NextSiblingID)
  // Ç°Ïî²åÈë
  else if APos = 2 then
    Result := ANode.Owner.Add(ANode.ParentID, ANode.ID);
end;

procedure TBillsClipboard.Clear;
begin
  ClearObjects(FNodeList);
  FNodeList.Clear;
end;

procedure TBillsClipboard.Copy(ANode: TsdIDTreeNode; ACount: Integer);
begin
  Clear;
  CopyData(ANode, ACount);
  SaveToStream;
  SaveToClipboard(CF_BillsBlock);
end;

procedure TBillsClipboard.CopyBillsNode(ANode: TsdIDTreeNode);
var
  iChild: Integer;
begin
  if Assigned(ANode) then
  begin
    CopyBillsNodeData(ANode);
    for iChild := 0 to ANode.ChildCount - 1 do
      CopyBillsNode(ANode.ChildNodes[iChild]);
  end;
end;

procedure TBillsClipboard.CopyBillsNodeData(ANode: TsdIDTreeNode);
var
  vNode: TBillsBlockNode;
begin
  vNode := TBillsBlockNode.Create;
  FNodeList.Add(vNode);
  vNode.FID := ANode.Rec.ValueByName('ID').AsInteger;
  vNode.FParentID := ANode.Rec.ValueByName('ParentID').AsInteger;
  vNode.FNextSiblingID := ANode.Rec.ValueByName('NextSiblingID').AsInteger;
  vNode.FCode := ANode.Rec.ValueByName('Code').AsString;
  vNode.FB_Code := ANode.Rec.ValueByName('B_Code').AsString;
  vNode.FName := ANode.Rec.ValueByName('Name').AsString;
  vNode.FUnits := ANode.Rec.ValueByName('Units').AsString;
  vNode.FPrice := ANode.Rec.ValueByName('Price').AsFloat;
  vNode.FOrgQuantity := ANode.Rec.ValueByName('OrgQuantity').AsFloat;
  vNode.FMisQuantity := ANode.Rec.ValueByName('MisQuantity').AsFloat;
  vNode.FOthQuantity := ANode.Rec.ValueByName('OthQuantity').AsFloat;
  vNode.FQuantity := ANode.Rec.ValueByName('Quantity').AsFloat;
  vNode.FDrawingCode := ANode.Rec.ValueByName('DrawingCode').AsString;
  vNode.FAlias := ANode.Rec.ValueByName('Alias').AsString;
  vNode.FDgnQuantity1 := ANode.Rec.ValueByName('DgnQuantity1').AsFloat;
  vNode.FDgnQuantity2 := ANode.Rec.ValueByName('DgnQuantity2').AsFloat;
  vNode.FMemoStr := ANode.Rec.ValueByName('MemoStr').AsString;
  vNode.FDealCode := ANode.Rec.ValueByName('DealCode').AsString;
  vNode.FDealCompany := ANode.Rec.ValueByName('DealCompany').AsString;
end;

procedure TBillsClipboard.CopyData(ANode: TsdIDTreeNode; ACount: Integer);
begin
  while Assigned(ANode) and (ACount > 0) do
  begin
    CopyBillsNode(ANode);
    Dec(ACount, ANode.PosterityCount + 1);
    ANode := ANode.NextSibling;
  end;
end;

constructor TBillsClipboard.Create(ABillsData: TBillsData);
begin
  FStream := TMemoryStream.Create;
  FBillsData := ABillsData;
  FNodeList := TList.Create;
end;

destructor TBillsClipboard.Destroy;
begin
  ClearObjects(FNodeList);
  FNodeList.Free;
  FStream.Free;
  inherited;
end;

procedure TBillsClipboard.LoadFromClipboard(AFormat: Word);

  procedure LockAndLoadData(AData: THandle);
  var
    DataPtr: Pointer;
  begin
    DataPtr := GlobalLock(AData);
    try
      FStream.WriteBuffer(DataPtr^, GlobalSize(AData));
      FStream.Position := 0;
    finally
      GlobalUnlock(AData);
    end;
  end;

var
  Data: THandle;
begin
  Clipboard.Open;
  try
    Data := GetClipboardData(AFormat);
    if Data <> 0 then
      LockAndLoadData(Data);
  finally
    Clipboard.Close;
  end;
end;

procedure TBillsClipboard.LoadFromStream;
var
  FXmlDocument: IXMLDocument;
  I: Integer;
begin
  FXmlDocument := TXMLDocument.Create(nil) as IXMLDocument;
  try
    FXmlDocument.LoadFromStream(FStream);
    FXmlDocument.Options := [doNodeAutoCreate,doNodeAutoIndent,doAutoPrefix,doNamespaceDecl];
    LoadNodesFromXml(FXmlDocument.DocumentElement);
  finally
    FXmlDocument := nil;
  end;
end;

procedure TBillsClipboard.LoadFromXmlFile(const AFileName: string);
var
  FXmlDocument: IXMLDocument;
  I: Integer;
begin
  FXmlDocument := TXMLDocument.Create(nil) as IXMLDocument;
  try
    FXmlDocument.Options := [doNodeAutoCreate,doNodeAutoIndent,doAutoPrefix,doNamespaceDecl];
    if not FileExists(AFileName) then Exit;
    FXmlDocument.LoadFromFile(AFileName);
    LoadNodesFromXml(FXmlDocument.DocumentElement);
  finally
    FXmlDocument := nil;
  end;
end;

procedure TBillsClipboard.LoadNodesFromXml(AXmlNode: IXMLNode);
var
  BillsBlockNode: TBillsBlockNode;
  iNum: Integer;
  ParentXmlNode, CurXmlNode: IXMLNode;
begin
  ParentXmlNode := AXmlNode.ChildNodes.FindNode('BillsBlockNodes');
  for iNum := 0 to ParentXmlNode.ChildNodes.Count - 1 do
  begin
    CurXmlNode := ParentXmlNode.ChildNodes.Nodes[iNum];
    BillsBlockNode := TBillsBlockNode.Create;
    FNodeList.Add(BillsBlockNode);
    BillsBlockNode.LoadFromXmlNode(CurXmlNode);
  end;
end;

procedure TBillsClipboard.Paste(ANode: TsdIDTreeNode; APos: Integer);
begin
  Clear;
  LoadFromClipboard(CF_BillsBlock);
  LoadFromStream;
  PasteData(ANode, APos);
end;

procedure TBillsClipboard.PasteBillsNode(ANode: TsdIDTreeNode;
  APos: Integer; APasteNode: TBillsBlockNode);
var
  stnCurrent: TsdIDTreeNode;
begin
  stnCurrent := AddBillsNode(ANode, APos);
  PasteBillsNodeData(stnCurrent, APasteNode);
  PasteChildren(stnCurrent, APasteNode.FID);
  PasteNextSibling(stnCurrent, APasteNode.FNextSiblingID);
end;

procedure TBillsClipboard.PasteBillsNodeData(ANode: TsdIDTreeNode;
  APasteNode: TBillsBlockNode);
begin
  ANode.Rec.ValueByName('Code').AsString := APasteNode.FCode;
  ANode.Rec.ValueByName('B_Code').AsString := APasteNode.FB_Code;
  ANode.Rec.ValueByName('Name').AsString := APasteNode.FName;
  ANode.Rec.ValueByName('Units').AsString := APasteNode.FUnits;
  ANode.Rec.ValueByName('Price').AsFloat := APasteNode.FPrice;
  ANode.Rec.ValueByName('OrgQuantity').AsFloat := QuantityRoundTo(APasteNode.FOrgQuantity);
  ANode.Rec.ValueByName('MisQuantity').AsFloat := QuantityRoundTo(APasteNode.FMisQuantity);
  ANode.Rec.ValueByName('OthQuantity').AsFloat := QuantityRoundTo(APasteNode.FOthQuantity);
  ANode.Rec.ValueByName('Quantity').AsFloat := QuantityRoundTo(APasteNode.FQuantity);
  ANode.Rec.ValueByName('DrawingCode').AsString := APasteNode.FDrawingCode;
  ANode.Rec.ValueByName('Alias').AsString := APasteNode.FAlias;
  ANode.Rec.ValueByName('DgnQuantity1').AsFloat := QuantityRoundTo(APasteNode.FDgnQuantity1);
  ANode.Rec.ValueByName('DgnQuantity2').AsFloat := QuantityRoundTo(APasteNode.FDgnQuantity2);
  ANode.Rec.ValueByName('MemoStr').AsString := APasteNode.FMemoStr;
  ANode.Rec.ValueByName('DealCode').AsString := APasteNode.FDealCode;
  ANode.Rec.ValueByName('DealCompany').AsString := APasteNode.FDealCompany;
end;

procedure TBillsClipboard.PasteChildren(AParentNode: TsdIDTreeNode;
  APasteParentID: Integer);
var
  iNode: Integer;
begin
  for iNode := 0 to FNodeList.Count - 1 do
    if TBillsBlockNode(FNodeList.Items[iNode]).FParentID = APasteParentID then
    begin
      PasteBillsNode(AParentNode, 0, TBillsBlockNode(FNodeList.Items[iNode]));
      Break;
    end;
end;

procedure TBillsClipboard.PasteData(ANode: TsdIDTreeNode; APos: Integer);
var
  I: Integer;
  vPasteNode: TBillsBlockNode;
begin
  PasteBillsNode(ANode, APos, TBillsBlockNode(FNodeList.First));
end;

procedure TBillsClipboard.PasteNextSibling(APreSibling: TsdIDTreeNode;
  APasteNodeID: Integer);
var
  iNode: Integer;
begin
  if APasteNodeID = -1 then Exit;
  for iNode := 0 to FNodeList.Count - 1 do
    if TBillsBlockNode(FNodeList.Items[iNode]).FID = APasteNodeID then
    begin
      PasteBillsNode(APreSibling, 1, TBillsBlockNode(FNodeList.Items[iNode]));
      Break;
    end;
end;

procedure TBillsClipboard.SaveNodesToXml(AXmlNode: IXMLNode);
var
  ParentXmlNode, CurXmlNode: IXMLNode;
  iNum: Integer;
  BillsBlockNode: TBillsBlockNode;
begin
  ParentXmlNode := AXmlNode.AddChild('BillsBlockNodes');
  for iNum := 0 to FNodeList.Count - 1 do
  begin
    BillsBlockNode := TBillsBlockNode(FNodeList.Items[iNum]);
    CurXmlNode := ParentXmlNode.AddChild('BillsBlockNode');
    BillsBlockNode.SaveToXmlNode(CurXmlNode);
  end;
end;

procedure TBillsClipboard.SaveToClipboard(AFormat: Word);
begin
  Clipboard.Open;
  try
    EmptyClipboard;
    FStream.Position := 0;
    TInnerClipboard(Clipboard).SetBuffer(AFormat, FStream.Memory^, FStream.Size);
  finally
    Clipboard.Close;
  end;
end;

procedure TBillsClipboard.SaveToStream;
var
  FXmlDocument: IXMLDocument;
  I: Integer;
begin
  FXmlDocument := TXMLDocument.Create(nil) as IXMLDocument;
  try
    FXmlDocument.Options := [doNodeAutoCreate,doNodeAutoIndent,doAttrNull,doAutoPrefix,doNamespaceDecl];
    FXmlDocument.Active := True;
    FXmlDocument.Encoding := 'GB2312';
    FXmlDocument.AddChild('BillsBlock_M');
    SaveNodesToXml(FXmlDocument.DocumentElement);
    FXmlDocument.SaveToStream(FStream);
  finally
    FXmlDocument := nil;
  end;
end;

procedure TBillsClipboard.SaveToXmlFile(const AFileName: string);
var
  FXmlDocument: IXMLDocument;
  I: Integer;
begin
  FXmlDocument := TXMLDocument.Create(nil) as IXMLDocument;
  try
    FXmlDocument.Options := [doNodeAutoCreate,doNodeAutoIndent,doAttrNull,doAutoPrefix,doNamespaceDecl];
    FXmlDocument.Active := True;
    FXmlDocument.Encoding := 'GB2312';
    FXmlDocument.AddChild('BillsBlock_M');
    SaveNodesToXml(FXmlDocument.DocumentElement);
    FXmlDocument.SaveToFile(AFileName);
  finally
    FXmlDocument := nil;
  end;
end;

{ TBillsBlockNode }

procedure TBillsBlockNode.LoadFromXmlNode(AXmlNode: IXMLNode);
begin
  FID := AXmlNode.Attributes['ID'];
  FParentID := AXmlNode.Attributes['ParentID'];
  FNextSiblingID := AXmlNode.Attributes['NextSiblingID'];
  FCode := AXmlNode.Attributes['Code'];
  FB_Code := AXmlNode.Attributes['B_Code'];
  FName := AXmlNode.Attributes['Name'];
  FUnits := AXmlNode.Attributes['Units'];
  FPrice := AXmlNode.Attributes['Price'];
  FOrgQuantity := AXmlNode.Attributes['OrgQuantity'];
  FMisQuantity := AXmlNode.Attributes['MisQuantity'];
  FOthQuantity := AXmlNode.Attributes['OthQuantity'];
  FQuantity := AXmlNode.Attributes['Quantity'];
  FDrawingCode := AXmlNode.Attributes['DrawingCode'];
  FAlias := AXmlNode.Attributes['Alias'];
  FDgnQuantity1 := AXmlNode.Attributes['DgnQuantity1'];
  FDgnQuantity2 := AXmlNode.Attributes['DgnQuantity2'];
  FMemoStr := AXmlNode.Attributes['MemoStr'];
  FDealCode := AXmlNode.Attributes['DealCode'];
  FDealCompany := AXmlNode.Attributes['DealCompany'];
end;

procedure TBillsBlockNode.SaveToXmlNode(AXmlNode: IXMLNode);
begin
  AXmlNode.Attributes['ID'] := FID;
  AXmlNode.Attributes['ParentID'] := FParentID;
  AXmlNode.Attributes['NextSiblingID'] := FNextSiblingID;
  AXmlNode.Attributes['Code'] := FCode;
  AXmlNode.Attributes['B_Code'] := FB_Code;
  AXmlNode.Attributes['Name'] := FName;
  AXmlNode.Attributes['Units'] := FUnits;
  AXmlNode.Attributes['Price'] := FPrice;
  AXmlNode.Attributes['OrgQuantity'] := FOrgQuantity;
  AXmlNode.Attributes['MisQuantity'] := FMisQuantity;
  AXmlNode.Attributes['OthQuantity'] := FOthQuantity;
  AXmlNode.Attributes['Quantity'] := FQuantity;
  AXmlNode.Attributes['DrawingCode'] := FDrawingCode;
  AXmlNode.Attributes['Alias'] := FAlias;
  AXmlNode.Attributes['DgnQuantity1'] := FDgnQuantity1;
  AXmlNode.Attributes['DgnQuantity2'] := FDgnQuantity2;
  AXmlNode.Attributes['MemoStr'] := FMemoStr;
  AXmlNode.Attributes['DealCode'] := FDealCode;
  AXmlNode.Attributes['DealCompany'] := FDealCompany;
end;

initialization
  CF_BillsBlock := RegisterClipboardFormat('Zh.BillsBlock');

end.