clipboardutils.pas

类似Wor剪切板收集器的功能。由于时间关系只做了部分剪切板数据的收集

unit ClipBoardUtils;

interface

uses
  Clipbrd, Classes, Contnrs;

type
  TFormatData = record
    f: Cardinal;
    DataSize: Integer;
    Data: PChar;
  end;

  TSuperClipData = class(TClipboard)
  public
    procedure GetDataWithFormat(AFormatData: TFormatData);
  end;

  function SuperClipData: TSuperClipData;
type

  TClipData = class
  private
    FormatList: array of TFormatData;
    function GetFormat(index: Integer): TFormatData;
    procedure LoadFromClip;
    function GetFormatCount: Integer;
    procedure SetFormat(index: Integer; const Value: TFormatData);
  public
    procedure WriteToStream(Stream: TStream);
    constructor Create(Tag: Integer);
    destructor Destroy; override;
    property FormatCount: Integer read GetFormatCount;
    property Format[index: Integer]: TFormatData read GetFormat write SetFormat;
  end;

implementation

uses
  Windows;

{ TSuperClipData }

procedure TSuperClipData.GetDataWithFormat(AFormatData: TFormatData);
var
  G: HGLOBAL;
  Data: PChar;
begin
  Open;
  try
    if HasFormat(AFormatData.f) then
    begin
      G := GetClipboardData(AFormatData.f);
      if g <> 0 then
      begin
        Data := GlobalLock(G);
        AFormatData.DataSize := GlobalSize(G);
        if Data <> nil then
        begin
          GetMem(AFormatData.Data, AFormatData.DataSize);
          Move(Data^, AFormatData.Data^, AFormatData.DataSize);
        end;
      end;
    end;
  finally
    Close;
  end;
end;

var
  FClipboard: TSuperClipData;

function SuperClipData: TSuperClipData;
begin
  if FClipboard = nil then
    FClipboard := TSuperClipData.Create;
  Result := FClipboard;
end;

{ TClipData }

constructor TClipData.Create(Tag: Integer);
begin
  LoadFromClip;
end;

destructor TClipData.Destroy;
begin

  inherited;
end;

function TClipData.GetFormat(index: Integer): TFormatData;
begin
  if (index >= 0) and (index < FormatCount) then
    Result := FormatList[index];
end;

function TClipData.GetFormatCount: Integer;
begin
  Result := Length(FormatList);
end;

procedure TClipData.LoadFromClip;
var
  I: Integer;
begin
  SetLength(FormatList, SuperClipData.FormatCount);
  for I := 0 to SuperClipData.FormatCount - 1 do
  begin
    FormatList[I].f := SuperClipData.Formats[I];
    SuperClipData.GetDataWithFormat(FormatList[I]);
  end;
end;

procedure TClipData.SetFormat(index: Integer; const Value: TFormatData);
begin

end;

procedure TClipData.WriteToStream(Stream: TStream);
begin

end;

end.