Measure/Units/BGLClipboard.pas

unit BGLClipboard;

interface

uses
  Classes, Clipbrd, BGLDm, ZhAPI, XmlDoc, XmlIntf, Windows, DB, SysUtils;

Type
  TInnerClipboard = class(TClipboard);

  TBGBillsNode = class
  private
    FB_Code: string;
    FName: string;
    FUnits: string;
    FPrice: Double;
    FQuantity: Double;
    FTotalPrice: Double;
  public
    procedure SaveToXmlNode(AXmlNode: IXMLNode);
    procedure LoadFromXmlNode(AXmlNode: IXMLNode);

    property B_Code: string read FB_Code write FB_Code;
    property Name: string read FName write FName;
    property Units: string read FUnits write FUnits;
    property Price: Double read FPrice write FPrice;
    property Quantity: Double read FQuantity write FQuantity;
    property TotalPrice: Double read FTotalPrice write FTotalPrice;
  end;

  TBGLNode = class
  private
    FBGBills: TList;

    FCode: string;
    FName: string;
    FTotalPrice: Double;
    FPos_Reason: string;
    FDirection: string;
    FDrawingCode: string;
    FApprovalCode: string;
    FBGLType: string;
  public
    constructor Create;
    destructor Destroy; override;

    procedure SaveToXmlNode(AXmlNode: IXMLNode);
    procedure LoadFromXmlNode(AXmlNode: IXmlNode);
  end;

  TBGLClipboard = class
  private
    FStream: TMemoryStream;
    FBGLData: TBGLData;
    FBGLList: TList;

    procedure CopyBGBills(ABGL: TBGLNode; ABGLID: Integer);
    procedure CopyBGL;
    procedure CopyData(ACount: Integer);

    procedure SaveBGLsToXml(AXmlNode: IXMLNode);
    procedure SaveToStream;
    procedure SaveToClipboard(AFormat: Word);

    procedure PasteBGBills(ABGLID: Integer; ABGL: TBGLNode);
    function ValidBGLCode(ACode: string): string;
    procedure PasteBGL(ANewID: Integer; ABGL: TBGLNode);
    procedure PasteData;

    procedure LoadBGLsFromXml(AXmlNode: IXMLNode);
    procedure LoadFromStream;
    procedure LoadFromClipboard(AFormat: Word);

    procedure Clear;
  public
    constructor Create(ABGLData: TBGLData);
    destructor Destroy; override;

    procedure Copy(ACount: Integer);
    procedure Paste;
  end;

function HasBGLBlockFormat: Boolean;

implementation

uses
  ProjectData;

var
  CF_BGLBlock: Word;

function HasBGLBlockFormat: Boolean;
begin
  Result := Clipboard.HasFormat(CF_BGLBlock);
end;

{ TBGBillsNode }

procedure TBGBillsNode.LoadFromXmlNode(AXmlNode: IXMLNode);
begin
  FB_Code := AXmlNode.Attributes['B_Code'];
  FName := AXmlNode.Attributes['Name'];
  FUnits := AXmlNode.Attributes['Units'];
  FPrice := AXmlNode.Attributes['Price'];
  FQuantity := AXmlNode.Attributes['Quantity'];
  FTotalPrice := AXmlNode.Attributes['TotalPrice'];
end;

procedure TBGBillsNode.SaveToXmlNode(AXmlNode: IXMLNode);
begin
  AXmlNode.Attributes['B_Code'] := FB_Code;
  AXmlNode.Attributes['Name'] := FName;
  AXmlNode.Attributes['Units'] := FUnits;
  AXmlNode.Attributes['Price'] := FPrice;
  AXmlNode.Attributes['Quantity'] := FQuantity;
  AXmlNode.Attributes['TotalPrice'] := FTotalPrice;
end;

{ TBGLNode }

constructor TBGLNode.Create;
begin
  FBGBills := TList.Create;
end;

destructor TBGLNode.Destroy;
begin
  ClearObjects(FBGBills);
  FBGBills.Free;
  inherited;
end;

procedure TBGLNode.LoadFromXmlNode(AXmlNode: IXmlNode);
var
  i: Integer;
  Child: IXMLNode;
  BGBill: TBGBillsNode;
begin
  FCode := AXmlNode.Attributes['Code'];
  FName := AXmlNode.Attributes['Name'];
  FTotalPrice := AXmlNode.Attributes['TotalPrice'];
  FPos_Reason := AXmlNode.Attributes['Pos_Reason'];
  FDirection := AXmlNode.Attributes['Direction'];
  FDrawingCode := AXmlNode.Attributes['DrawingCode'];
  FApprovalCode := AXmlNode.Attributes['ApprovalCode'];
  FBGLType := AXmlNode.Attributes['BGLType'];

  for i := 0 to AXmlNode.ChildNodes.Count - 1 do
  begin
    Child := AXmlNode.ChildNodes.Nodes[i];
    BGBill := TBGBillsNode.Create;
    BGBill.LoadFromXmlNode(Child);
    FBGBills.Add(BGBill);
  end;
end;

procedure TBGLNode.SaveToXmlNode(AXmlNode: IXMLNode);
var
  i: Integer;
begin
  AXmlNode.Attributes['Code'] := FCode;
  AXmlNode.Attributes['Name'] := FName;
  AXmlNode.Attributes['TotalPrice'] := FTotalPrice;
  AXmlNode.Attributes['Pos_Reason'] := FPos_Reason;
  AXmlNode.Attributes['Direction'] := FDirection;
  AXmlNode.Attributes['DrawingCode'] := FDrawingCode;
  AXmlNode.Attributes['ApprovalCode'] := FApprovalCode;
  AXmlNode.Attributes['BGLType'] := FBGLType;

  for i:= 0 to FBGBills.Count - 1 do
    TBGBillsNode(FBGBills.Items[i]).SaveToXmlNode(AXmlNode.AddChild('BGBill'));
end;

{ TBGLClipboard }

procedure TBGLClipboard.Clear;
begin
  ClearObjects(FBGLList);
  FBGLList.Clear;
end;

procedure TBGLClipboard.Copy(ACount: Integer);
begin
  Clear;
  CopyData(ACount);
  SaveToStream;
  SaveToClipboard(CF_BGLBlock);
end;

procedure TBGLClipboard.CopyBGBills(ABGL: TBGLNode; ABGLID: Integer);
var
  BGBill: TBGBillsNode;
begin
  with FBGLData do
  begin
    cdsBGBills.Filter := Format('BGID = %d', [ABGLID]);
    cdsBGBills.Filtered := True;
    try
      if cdsBGBills.RecordCount = 0 then Exit;
      cdsBGBills.First;
      while not cdsBGBills.Eof do
      begin
        BGBill := TBGBillsNode.Create;
        ABGL.FBGBills.Add(BGBill);
        BGBill.FB_Code := cdsBGBillsB_Code.AsString;
        BGBill.FName := cdsBGBillsName.AsString;
        BGBill.FUnits := cdsBGBillsUnits.AsString;
        BGBill.FPrice := cdsBGBillsPrice.AsFloat;
        BGBill.FQuantity := cdsBGBillsQuantity.AsFloat;
        BGBill.FTotalPrice := cdsBGBillsTotalPrice.AsFloat;
        cdsBGBills.Next;
      end;
    finally
      cdsBGBills.Filtered := False;
    end;
  end;
end;

procedure TBGLClipboard.CopyBGL;
var
  vBGL: TBGLNode;
begin
  vBGL := TBGLNode.Create;
  FBGLList.Add(vBGL);
  vBGL.FCode := FBGLData.cdsBGLViewCode.AsString;
  vBGL.FName := FBGLData.cdsBGLViewName.AsString;
  vBGL.FTotalPrice := FBGLData.cdsBGLViewTotalPrice.AsFloat;
  vBGL.FPos_Reason := FBGLData.cdsBGLViewPos_Reason.AsString;
  vBGL.FDirection := FBGLData.cdsBGLViewDirection.AsString;
  vBGL.FDrawingCode := FBGLData.cdsBGLViewDrawingCode.AsString;
  vBGL.FApprovalCode := FBGLData.cdsBGLViewApprovalCode.AsString;
  vBGL.FBGLType := FBGLData.cdsBGLViewBGLType.AsString;
  CopyBGBills(vBGL, FBGLData.cdsBGLViewID.AsInteger);
end;

procedure TBGLClipboard.CopyData(ACount: Integer);
var
  iCount: Integer;
  vBM: TBookmark;
begin
  FBGLData.cdsBGLView.DisableControls;
  vBM := FBGLData.cdsBGLView.GetBookmark;
  try
    iCount := 0;
    while iCount < ACount do
    begin
      CopyBGL;
      FBGLData.cdsBGLView.Next;
      Inc(iCount);
    end;
  finally
    FBGLData.cdsBGLView.GotoBookmark(vBM);
    FBGLData.cdsBGLView.FreeBookmark(vBM);
    FBGLData.cdsBGLView.EnableControls;
  end;
end;

constructor TBGLClipboard.Create(ABGLData: TBGLData);
begin
  FStream := TMemoryStream.Create;
  FBGLData := ABGLData;
  FBGLList := TList.Create;
end;

destructor TBGLClipboard.Destroy;
begin
  Clear;
  FBGLList.Free;
  FStream.Free;
  inherited;
end;

procedure TBGLClipboard.LoadBGLsFromXml(AXmlNode: IXMLNode);
var
  vBGL: TBGLNode;
  iNum: Integer;
  ParentXmlNode, CurXmlNode: IXMLNode;
begin
  ParentXmlNode := AXmlNode.ChildNodes.FindNode('BGLBlockNodes');
  for iNum := 0 to ParentXmlNode.ChildNodes.Count - 1 do
  begin
    CurXmlNode := ParentXmlNode.ChildNodes.Nodes[iNum];
    vBGL := TBGLNode.Create;
    FBGLList.Add(vBGL);
    vBGL.LoadFromXmlNode(CurXmlNode);
  end;
end;

procedure TBGLClipboard.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 TBGLClipboard.LoadFromStream;
var
  FXmlDocument: IXMLDocument;
  I: Integer;
begin
  FXmlDocument := TXMLDocument.Create(nil) as IXMLDocument;
  try
    FXmlDocument.LoadFromStream(FStream);
    FXmlDocument.Options := [doNodeAutoCreate,doNodeAutoIndent,doAutoPrefix,doNamespaceDecl];
    LoadBGLsFromXml(FXmlDocument.DocumentElement);
  finally
    FXmlDocument := nil;
  end;
end;

procedure TBGLClipboard.Paste;
begin
  Clear;
  LoadFromClipboard(CF_BGLBlock);
  LoadFromStream;
  PasteData;
end;

procedure TBGLClipboard.PasteBGBills(ABGLID: Integer; ABGL: TBGLNode);
var
  i, iNewID: Integer;
  vBGBills: TBGBillsNode;
begin
  with FBGLData do
  begin
    iNewID := GetNewIDOfIndex(cdsBGBills);
    for i := 0 to ABGL.FBGBills.Count - 1 do
    begin
      vBGBills := TBGBillsNode(ABGL.FBGBills.Items[i]);
      cdsBGBills.Append;
      cdsBGBillsID.AsInteger := iNewID+i;
      cdsBGBillsBGID.AsInteger := ABGLID;
      cdsBGBillsB_Code.AsString := vBGBills.FB_Code;
      cdsBGBillsName.AsString := vBGBills.FName;
      cdsBGBillsUnits.AsString := vBGBills.FUnits;
      cdsBGBillsPrice.AsFloat := vBGBills.FPrice;
      cdsBGBillsQuantity.AsFloat := vBGBills.FQuantity;
      cdsBGBillsTotalPrice.AsFloat := vBGBills.FTotalPrice;
      cdsBGBills.Post;
    end;
  end;
end;

procedure TBGLClipboard.PasteBGL(ANewID: Integer; ABGL: TBGLNode);
var
  sNewCode: string;
begin
  sNewCode := ValidBGLCode(ABGL.FCode);
  with FBGLData do
  begin
    cdsBGL.Append;
    cdsBGLID.AsInteger := ANewID;
    cdsBGLTotalPrice.AsFloat := ABGL.FTotalPrice;
    cdsBGLCode.AsString := sNewCode;
    cdsBGLName.AsString := ABGL.FName;
    cdsBGLPos_Reason.AsString := ABGL.FPos_Reason;
    cdsBGLDirection.AsString := ABGL.FDirection;
    cdsBGLDrawingCode.AsString := ABGL.FDrawingCode;
    cdsBGLApprovalCode.AsString := ABGL.FApprovalCode;
    cdsBGLBGLType.AsString := ABGL.FBGLType;
    cdsBGLCreatePhaseID.AsInteger := TProjectData(ProjectData).ProjProperties.PhaseCount;
    cdsBGL.Post;
    PasteBGBills(ANewID, ABGL);
  end;
end;

procedure TBGLClipboard.PasteData;
var
  vBGL: TBGLNode;
  iNewID, iIndex: Integer;
begin
  iNewID := GetNewIDOfIndex(FBGLData.cdsBGL);
  FBGLData.cdsBGLView.DisableControls;
  try
    for iIndex := 0 to FBGLList.Count - 1 do
      PasteBGL(iNewID+iIndex, TBGLNode(FBGLList.Items[iIndex]));
  finally
    FBGLData.cdsBGLView.EnableControls;
  end;
end;

procedure TBGLClipboard.SaveBGLsToXml(AXmlNode: IXMLNode);
var
  ParentXmlNode, CurXmlNode: IXMLNode;
  iNum: Integer;
  vBGL: TBGLNode;
begin
  ParentXmlNode := AXmlNode.AddChild('BGLBlockNodes');
  for iNum := 0 to FBGLList.Count - 1 do
  begin
    vBGL := TBGLNode(FBGLList.Items[iNum]);
    CurXmlNode := ParentXmlNode.AddChild('BGLNode');
    vBGL.SaveToXmlNode(CurXmlNode);
  end;
end;

procedure TBGLClipboard.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 TBGLClipboard.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('BGLBlock_M');
    SaveBGLsToXml(FXmlDocument.DocumentElement);
    FXmlDocument.SaveToStream(FStream);
  finally
    FXmlDocument := nil;
  end;
end;

function TBGLClipboard.ValidBGLCode(ACode: string): string;
var
  iIncrement: Integer;
begin
  Result := ACode;
  iIncrement := 1;
  while FBGLData.cdsBGL.Locate('Code', Result, []) do
  begin
    Result := Format('%s[%d]', [ACode, iIncrement]);
    Inc(iIncrement);
  end;
end;

initialization
  CF_BGLBlock := RegisterClipboardFormat('Zh.BGLBlock');

end.