Code:

unit ClipStrm;

{

This unit is Copyright (c) Alexey Mahotkin 1997-1998

and may be used freely for any purpose. Please mail

your comments to

E-Mail: alexm@hsys.msk.ru

FidoNet: Alexey Mahotkin, 2:5020/433

This unit was developed during incorporating of TP Lex/Yacc

into my project. Please visit ftp://ftp.nf.ru/pub/alexm

or FREQ FILES from 2:5020/433 or mail me to get hacked

version of TP Lex/Yacc which works under Delphi 2.0+.

}

interface uses Classes, Windows;

type

TClipboardStream = class(TStream)

private

   FMemory : pointer;

   FSize : longint;

   FPosition : longint;

   FFormat : word;

public

   constructor Create(fmt : word);

   destructor Destroy; override;

   function Read(var Buffer; Count : Longint) : Longint; override;

   function Write(const Buffer; Count : Longint) : Longint; override;

   function Seek(Offset : Longint; Origin : Word) : Longint; override;

end;

implementation uses SysUtils;

constructor TClipboardStream.Create(fmt : word);

var

tmp : pointer;

FHandle : THandle;

begin

FFormat := fmt;

OpenClipboard(0);

FHandle := GetClipboardData(FFormat);

FSize := GlobalSize(FHandle);

FMemory := AllocMem(FSize);

tmp := GlobalLock(FHandle);

MoveMemory(FMemory, tmp, FSize);

GlobalUnlock(FHandle);

FPosition := 0;

CloseClipboard;

end;

destructor TClipboardStream.Destroy;

begin

FreeMem(FMemory);

end;

function TClipboardStream.Read(var Buffer; Count : longint) : longint;

begin

if FPosition + Count > FSize then

Result := FSize - FPosition

else

Result := Count;

MoveMemory(@Buffer, PChar(FMemory) + FPosition, Result);

Inc(FPosition, Result);

end;

function TClipboardStream.Write(const Buffer; Count : longint) : longint;

var

FHandle : HGlobal;

tmp : pointer;

begin

ReallocMem(FMemory, FPosition + Count);

MoveMemory(PChar(FMemory) + FPosition, @Buffer, Count);

FPosition := FPosition + Count;

FSize := FPosition;

FHandle := GlobalAlloc(GMEM_MOVEABLE or GMEM_SHARE or GMEM_ZEROINIT, FSize);

try

tmp := GlobalLock(FHandle);

try

   MoveMemory(tmp, FMemory, FSize);

   OpenClipboard(0);

   SetClipboardData(FFormat, FHandle);

finally

   GlobalUnlock(FHandle);

end;

CloseClipboard;

except

GlobalFree(FHandle);

end;

Result := Count;

end;

function TClipboardStream.Seek(Offset : Longint; Origin : Word) : Longint;

begin

case Origin of

0 : FPosition := Offset;

1 : Inc(FPosition, Offset);

2 : FPosition := FSize + Offset;

end;

Result := FPosition;

end;

end.