unit ClipUtl;
interface
uses Windows, SysUtils, Classes;

function StreamToClip(f: UINT; s: TStream): integer;
{ Copy all content of stream s to the clipboard for user defined clipboard
  format f (get the f by calling RegisterClipboardFormat(FormatName) first).
  First 4 bytes in clipboard will contain size of the stream the remaining
  bytes contain the stream content. Returns 0 if succeded, error code if fails }

function ClipToStream(f: UINT; s: TStream): integer;
{ Copy content of the clipboard stored there by StreamToClip call back to
  the stream. Returns 0 if succeded, error code if failed. }

implementation

function StreamToClip(f: UINT; s: TStream): integer;
{ Copy all content of stream s to the clipboard for user defined clipboard
  format f (get the f by calling RegisterClipboardFormat(FormatName) first).
  First 4 bytes in clipboard will contain size of the stream the remaining
  bytes contain the stream content. Returns 0 if succeded, error code if fails }
var
  mh: THandle;
  m: PByteArray;
  msize, ssize: longint;
  i: integer;
begin
  Result := 0;
  mh := 0;
  m := nil;
  if OpenClipboard(0) then begin
    try
      ssize := s.Size;
      mh := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE, sizeof(ssize) + ssize);
      if mh = 0 then begin
        Result := GetLastError;
        exit;
      end;
      m := GlobalLock(mh);
      if m = nil then begin
        Result := GetLastError;
        exit;
      end;
      try
        msize := GlobalSize(mh);
        FillChar(m^, msize, 0);
        move(ssize, m^, sizeof(ssize));
        s.Position := 0;
        s.ReadBuffer(m^[sizeof(ssize)], ssize);
      finally
        GlobalUnlock(mh);
        SetClipboardData(f, mh);
        mh := 0;
      end;
    finally
      CloseClipboard;
      if mh <> 0 then
        GlobalFree(mh);
    end;
  end else begin
    Result := GetLastError;
  end;
end;

function ClipToStream(f: UINT; s: TStream): integer;
var
  mh: THandle;
  m: PByteArray;
  msize, ssize: longint;
  i: integer;
begin
  Result := 0;
  if IsClipboardFormatAvailable(f){Clipboard.HasFormat(f)} then begin
    mh := 0;
    m := nil;
    if OpenClipboard(0) then begin
      try
        mh := GetClipboardData(f);
        if mh = 0 then begin
          Result := GetLastError;
        end else begin
          m := GlobalLock(mh);
          if m = nil then begin
            Result := GetLastError;
          end else begin
            msize := GlobalSize(mh);
            move(m^, ssize, sizeof(ssize));
            s.Size := 0;
            s.WriteBuffer(m^[sizeof(ssize)], ssize);
            s.Position := 0;
          end;
        end;
      finally
        if m <> nil then
          GlobalUnlock(mh);
        if not CloseClipboard then
          Result := GetLastError;
      end;
    end else begin
      Result := GetLastError;
    end;
  end else begin
    Result := DV_E_CLIPFORMAT;{windows}
  end;
end;

end.
