Tecsitel_FactuGES2/Source/Base/Utiles/ClipboardUtils.pas

{+------------------------------------------------------------
 | Unit ClipboardUtils
 |
 | Version: 1.1  Created: 05/05/96, 12:56:57
 |               Last Modified: 18.3.2001
 | Author : P. Below
 | Project: Common Utilities
 | Description:
 |   Routines to copy string lists and stream to and
 |   from the clipboard.
 +------------------------------------------------------------}
Unit ClipboardUtils;

interface

Uses Classes;

  Procedure CopyStringsToClipboard( fmt: Cardinal; S: TStrings );
  Procedure CopyStreamToClipboard( fmt: Cardinal; S: TStream );
  Procedure CopyStringsFromClipboard( fmt: Cardinal; S: TStrings );
  Procedure CopyStreamFromClipboard( fmt: Cardinal; S: TStream );
  Function  GetClipFmtname( fmt: Word ): String;

Implementation

Uses WinTypes, WinProcs, SysUtils, Clipbrd;

Procedure CopyStringsToClipboard( fmt: Cardinal; S: TStrings );
  Var
    MemStr: TMemoryStream;
  Begin
    MemStr := TMemoryStream.Create;
    try
      S.SaveToStream(MemStr);
      CopyStreamToClipboard( fmt, MemStr );
    finally
      MemStr.Free;
    end;
  End; { CopyStringsToClipboard }

Procedure CopyStreamToClipboard( fmt: Cardinal; S: TStream );
  Var
    hMem: THandle;
    pMem: Pointer;
  Begin
    S.Position := 0;
    hMem := GlobalAlloc( GHND or GMEM_DDESHARE, S.Size );
    If hMem <> 0 Then Begin
      pMem := GlobalLock( hMem );
      If pMem <> Nil Then Begin
        try
          S.Read( pMem^, S.Size );
          S.Position := 0;
        finally
          GlobalUnlock( hMem );
        end;
        Clipboard.Open;
        try
          Clipboard.SetAsHandle( fmt, hMem );
        finally
          Clipboard.Close;
        end;
      End { If }
      Else Begin
        GlobalFree( hMem );
        OutOfMemoryError;
      End;
    End { If }
    Else
      OutOfMemoryError;
  End; { CopyStreamToClipboard }

Procedure CopyStringsFromClipboard( fmt: Cardinal; S: TStrings );
  Var
    MemStr: TMemoryStream;
  Begin
    MemStr:= TMemoryStream.Create;
    try
      CopyStreamFromClipboard( fmt, MemStr );
      MemStr.Position := 0;
      S.LoadFromStream( MemStr );
    finally
      MemStr.Free;
    end;
  End; { CopyStringsFromClipboard }

Procedure CopyStreamFromClipboard( fmt: Cardinal; S: TStream );
  Var
    hMem: THandle;
    pMem: Pointer;
  Begin
    hMem := Clipboard.GetAsHandle( fmt );
    If hMem <> 0 Then Begin
      pMem := GlobalLock( hMem );
      If pMem <> Nil Then Begin
        try
          S.Write( pMem^, GlobalSize( hMem ));
          S.Position := 0;
        finally  
          GlobalUnlock( hMem );
        end;  
      End { If }
      Else
        raise Exception.Create(
          'CopyStreamFromClipboard: could not lock global handle '+
          'obtained from clipboard!');
    End; { If }
  End; { CopyStreamFromClipboard }

Function  GetClipFmtname( fmt: Word ): String;
Var
  buf: Array [0..60] of Char;
Begin
  If GetclipboardFormatName( fmt, buf, Pred(Sizeof(buf))) <> 0 Then
    Result := StrPas(buf)
  Else
    Case fmt of
        1: Result := 'CF_TEXT';
        2: Result := 'CF_BITMAP';
        3: Result := 'CF_METAFILEPICT';
        4: Result := 'CF_SYLK';
        5: Result := 'CF_DIF';
        6: Result := 'CF_TIFF';
        7: Result := 'CF_OEMTEXT';
        8: Result := 'CF_DIB';
        9: Result := 'CF_PALETTE';
       10: Result := 'CF_PENDATA';
       11: Result := 'CF_RIFF';
       12: Result := 'CF_WAVE';
       13: Result := 'CF_UNICODETEXT';
       14: Result := 'CF_ENHMETAFILE';
       15: Result := 'CF_HDROP (Win 95)';
       16: Result := 'CF_LOCALE (Win 95)';
       17: Result := 'CF_MAX (Win 95)';
    $0080: Result := 'CF_OWNERDISPLAY';
    $0081: Result := 'CF_DSPTEXT';
    $0082: Result := 'CF_DSPBITMAP';
    $0083: Result := 'CF_DSPMETAFILEPICT';
    $008E: Result := 'CF_DSPENHMETAFILE';
    $0200..$02FF: Result := 'private format';
    $0300..$03FF: Result := 'GDI object';
    Else
      Result := 'unknown format';
    End; {Case}
End;


End { Unit ClipboardUtils }.