Measure/Units/BaseClipboard.pas

unit BaseClipboard;

interface

uses
  Clipbrd, Classes, Windows, XmlDoc, XmlIntf, SysUtils;

type
  TInnerClipboard = class(TClipboard);

  TBaseClipboard = class
  private
    FStream: TMemoryStream;
  protected
    procedure LoadXmlData(AXmlDoc: IXMLDocument); virtual; abstract;
    procedure SaveXmlData(AXmlDoc: IXMLDocument); virtual; abstract;

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

    procedure SaveToStream;
    procedure LoadFromStream;
    procedure SaveToXmlFile(const AFileName: string);
    procedure LoadFromXmlFile(const AFileName: string);
  public
    constructor Create;
    destructor Destroy; override;
  end;

function HasClipboardFormat(AFormat: Word): Boolean;

implementation

function HasClipboardFormat(AFormat: Word): Boolean;
begin
  Result := Clipboard.HasFormat(AFormat);  
end;

{ TBaseClipboard }

constructor TBaseClipboard.Create;
begin
  FStream := TMemoryStream.Create;
end;

destructor TBaseClipboard.Destroy;
begin
  FStream.Free;
  inherited;
end;

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

procedure TBaseClipboard.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);
    LoadXmlData(FXmlDocument);
  finally
    FXmlDocument := nil;
  end;
end;

procedure TBaseClipboard.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 TBaseClipboard.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');
    SaveXmlData(FXmlDocument);
    FXmlDocument.SaveToStream(FStream);
  finally
    FXmlDocument := nil;
  end;
end;

procedure TBaseClipboard.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');
    SaveXmlData(FXmlDocument);
    FXmlDocument.SaveToFile(AFileName);
  finally
    FXmlDocument := nil;
  end;
end;

end.