unit ClipUtl;
{ Windows Clipboard utility functions }
{
  (C) 2000 - 2002 Jindrich Jindrich, Pavel Pisa, PiKRON Ltd.

  Originators of the CHROMuLAN project:

  Jindrich Jindrich - http://www.jindrich.com
                      http://orgchem.natur.cuni.cz/Chromulan/
                      software developer, project coordinator
  Pavel Pisa        - http://cmp.felk.cvut.cz/~pisa
                      embeded software developer
  PiKRON Ltd.       - http://www.pikron.com
                      project initiator, sponsor, instrument developer

  The CHROMuLAN project is distributed under the GNU General Public Licence.
  See file COPYING for details.

  Originators reserve the right to use and publish sources
  under different conditions too. If third party contributors
  do not accept this condition, they can delete this statement
  and only GNU license will apply.
}

interface
uses Windows, SysUtils, Classes, Clipbrd;

{ 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.
  If OpenClip is true, then the StreamToClip also opens/close the clipboard,
  otherwise assumes that the clipboard is already opened.

  If f = CF_TEXT, then the size of the stream is not written to to clip. data,
  assumes that the buffer is zero terminated. }
function StreamToClip(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. Don't use it
  for CF_TEXT. }
function ClipToStream(f: UINT; s: TStream): integer;

implementation

function StreamToClip(f: UINT; s: TStream): integer;
var
  {v0.31}
  rh: THandle;
  {res:integer;}
  {/v0.31}

  mh: THandle;
  m: PByteArray;
  msize, ssize: longint;
{  i: integer;}
begin
  Result := 0;
  mh := 0;
  {v0.31}Clipboard.Open;{/v0.31 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);
      s.Position := 0;
      FillChar(m^, msize, 0);
      {v0.31}
      if f = CF_TEXT then begin
        s.ReadBuffer(m^, ssize);
      end else
      {/v0.31}
      begin
        move(ssize, m^, sizeof(ssize));
        s.ReadBuffer(m^[sizeof(ssize)], ssize);
      end;
    finally
      GlobalUnlock(mh);
      {v0.31}
      rh := SetClipboardData(f, mh);
      if rh = mh then begin
        mh := 0
      end else begin
        Result := GetLastError;
      end;
      {/v0.31
      SetClipboardData(f, mh);
      mh := 0;}
    end;
  finally
    {v0.31}
    Clipboard.Close;
    {/v0.31 CloseClipboard;}
    if mh <> 0 then
      GlobalFree(mh);
  end;
  {v0.31}{/v0.31
  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 := integer(DV_E_CLIPFORMAT);{windows}
  end;
end;

end.
