Delphi - объектно-ориентированный язык программирования, разработанный компанией Borland в 1995 году. Он основан на языке программирования Pascal, но имеет более расширенные возможности и добавлены новые функции.
Delphi является интегрированной средой разработки (IDE), которая позволяет разрабатывать программное обеспечение для различных платформ, включая Windows, macOS, Android и iOS. Delphi достигает многоплатформенности с помощью...
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.