Code: |
unit ClipStrm;
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. |
Alexey Mahotkin Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра. (2:5020/433)
Взято из FAQ: Delphi and Windows API Tips'n'Tricks
Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра.
Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.
ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!