Как удобнее работать с буфером обмена как последовательностью байт?

Материал из DRKB

Как удобнее работать с буфером обмена как последовательностью байт?[править | править код]

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.
Alexey Mahotkin alexm@hsys.msk.ru (2:5020/433)
olmal@mail.ru
http://www.chat.ru/~olmal


Source: Взято из FAQ: Delphi and Windows API Tips'n'Tricks
ID: 01874