unit uSaveClipboard;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, RichEdit, Clipbrd,
  registry, ActiveX, ShellAPI, ShlObj;

type

  TSaveClipboard = class(TObject)
  private
    FTxt, FRTF, FHTML, FOEMText, FCSV : string;
    FUnicodeText : WideString;
    FBitmap : TBitmap;
    FMetafile : TMetafile;
    CF_RTF, CF_HTML, CF_CSV : UINT;
    FFiles : TStringList;
    procedure ClearBuffer;
  public
    constructor Create;reintroduce;
    destructor Destroy;override;
    procedure Save;
    procedure Restore;

    property PlainText : String read FTxt write FTxt;
    property RTFText : String read FRTF write FRTF;
    property CSVText : String read FCSV write FCSV;
    property HTMLText : String read FHTML write FHTML;
    property OEMText : String read FOEMText write FOEMText;
    property UnicodeText : WideString read FUnicodeText write FUnicodeText;
    property Bitmap : TBitmap read FBitmap write FBitmap;
    property Metafile : TMetafile read FMetafile write FMetafile;
  end;

implementation

uses
  Dialogs;

{ TSaveClipboard }

procedure TSaveClipboard.ClearBuffer;
begin
  FTxt:='';
  FRTF:='';
  FHTML:='';
  FCSV := '';
  FOEMText:='';
  FUnicodeText:='';
  FBitmap.Free;
  FBitmap:=nil;
  FMetafile.Free;
  FMetafile:=nil;
  FFiles.Clear;
end;

constructor TSaveClipboard.Create;
begin
  inherited Create;
  FFiles := TStringList.Create;
  ClearBuffer;
  CF_RTF := RegisterClipboardFormat(RichEdit.CF_RTF);
  CF_HTML := {16;//}RegisterClipboardFormat('HTML Format');
  CF_CSV := RegisterClipboardFormat('CSV');
end;

destructor TSaveClipboard.Destroy;
begin
  ClearBuffer;
  FFiles.Free;
  inherited;
end;

procedure CopyClipboardData(Format : UINT; Buffer : pointer; Length : 
integer);
var Data:THandle;
    DataPtr: Pointer;
begin
  Data := GlobalAlloc(GMEM_MOVEABLE+GMEM_DDESHARE, Length);
  try
    DataPtr := GlobalLock(Data);
    try
      CopyMemory(DataPtr, Buffer, Length);
      SetClipboardData(Format, Data);
    finally
      GlobalUnlock(Data);
    end;
  except
    GlobalFree(Data);
    raise;
  end;
end;

procedure TSaveClipboard.Restore;
const NULL : Char = #0;
var //Data:THandle;
    //DataPtr: Pointer;
    DF : TDropFiles;
    i : integer;
begin
  try
    Clipboard.Clear;
    Clipboard.Open;
    //text
    if Length(FTxt) > 0 then Clipboard.AsText:=FTxt;
    //OEM text
    if Length(FOEMText) > 0 then CopyClipboardData(CF_OEMTEXT, 
PChar(FOEMText), Length(FOEMText)+1);
    //HTML text
    if Length(FHTML) > 0 then CopyClipboardData(CF_HTML, PChar(FHTML), 
Length(FHTML)+1);

    //CSV text
    if Length(FCSV) > 0 then
      CopyClipboardData(CF_CSV, PChar(FCSV), Length(FCSV)+1);

    //Unicode text
    if Length(FUnicodeText) > 0 then CopyClipboardData(CF_UNICODETEXT, 
PWideChar(FUnicodeText), 2*Length(FUnicodeText)+2);
    //RTF
    if Length(FRTF) > 0 then CopyClipboardData(CF_RTF, PChar(FRTF), 
Length(FRTF)+1);
    //BMP
    if FBitmap <> nil then Clipboard.Assign(FBitmap);
    //Metafile
    if FMetafile <> nil then Clipboard.Assign(FMetafile);
    //files
    if FFiles.Count > 0 then begin
      DF.pFiles:=SizeOf(DF);
      DF.pt.x:=0;
      DF.pt.y:=0;
      DF.fNC:=false;
      DF.fWide:=false;
      with TMemoryStream.Create do
        try
          Write(DF, SizeOf(DF));
          for i:=0 to FFiles.Count-1 do begin
            Write(FFiles[i][1], Length(FFiles[i]));
            Write(NULL, SizeOf(NULL));
          end;
          Write(NULL, SizeOf(NULL));
          CopyClipboardData(CF_HDROP, Memory, Size);
        finally
          Free;
        end;
    end;
  finally
    Clipboard.Close;
  end;
end;

procedure TSaveClipboard.Save;
var Data:THandle;
    p : pointer;
    Count, i : integer;
    Buffer : array[0..MAX_PATH] of Char;
//    AList : TStringLIst;
begin

{  AList := TStringList.Create;
  try
    AList.Add('Lista ----------');
    //GetClipboardFormatName(CF_HTML, @Buffer, SizeOf(Buffer));
    for i:=0 to Clipboard.FormatCount-1 do begin
      if Clipboard.Formats[i] = 0 then beep;
      GetClipboardFormatName(Clipboard.Formats[i], @Buffer, SizeOf(Buffer));
      AList.Add(Buffer);
    end;
    ShowMessage(AList.Text);
  finally
    FreeANDNIL(AList);
  end;}


  ClearBuffer;
  //text
  if Clipboard.HasFormat(CF_TEXT) then FTxt:=Clipboard.AsText;
  //RTF
  if Clipboard.HasFormat(CF_RTF) then
  begin
    Clipboard.Open;
    Data := GetClipboardData(CF_RTF);
    if Data <> 0 then begin
      FRTF := PChar(GlobalLock(Data));
      GlobalUnlock(Data);
    end;
    Clipboard.Close;
  end;

  //CSV
  if Clipboard.HasFormat(CF_CSV) then
  begin
    Clipboard.Open;
    Data := GetClipboardData(CF_CSV);
    if Data <> 0 then begin
      FCSV := PChar(GlobalLock(Data));
      GlobalUnlock(Data);
    end;
    Clipboard.Close;
  end;


  //HTML
  if Clipboard.HasFormat(CF_HTML) then begin
    Clipboard.Open;
    Data := GetClipboardData(CF_HTML);
    if Data <> 0 then begin
      FHTML := PChar(GlobalLock(Data));
      GlobalUnlock(Data);
    end;
    Clipboard.Close;
  end;

  //OEM Text
  if Clipboard.HasFormat(CF_OEMTEXT) then begin
    Clipboard.Open;
    Data := GetClipboardData(CF_OEMTEXT);
    if Data <> 0 then begin
      FOEMText := PChar(GlobalLock(Data));
      GlobalUnlock(Data);
    end;
    Clipboard.Close;
  end;
  //Unicode
  if Clipboard.HasFormat(CF_UNICODETEXT) then begin
    Clipboard.Open;
    Data := GetClipboardData(CF_UNICODETEXT);
    if Data <> 0 then begin
      FUnicodeText := PWideChar(GlobalLock(Data));
      GlobalUnlock(Data);
    end;
    Clipboard.Close;
  end;
  //Bitmap
  if Clipboard.HasFormat(CF_BITMAP) then
    try
      FBitmap:=TBitmap.Create;
      FBitmap.Assign(Clipboard);
    except
      FBitmap.Free;
    end;
  //metafile
  if Clipboard.HasFormat(CF_METAFILEPICT) then
    try
      FMetafile:=TMetafile.Create;
      FMetafile.Assign(Clipboard);
    except
      FMetafile.Free;
    end;
  //files
  if Clipboard.HasFormat(CF_HDROP) then begin
    Clipboard.Open;
    Data := GetClipboardData(CF_HDROP);
    if Data <> 0 then begin
      p := PChar(GlobalLock(Data));
      Count:=DragQueryFile(HDROP(p), $FFFFFFFF, nil, 0);
      for i:=0 to Count-1 do begin
        DragQueryFile(HDROP(p), i, @Buffer, SizeOf(Buffer));
        if strlen(PChar(@Buffer)) > 0 then FFiles.Add(PChar(@Buffer));
      end;
      GlobalUnlock(Data);
    end;
    Clipboard.Close;
  end;
end;


end.