Копировать буфер в поток и обратно

Советы » Буфер обмена » Копировать буфер в поток и обратно

uses

clipbrd; procedure

CopyStreamToClipboard(fmt: Cardinal; S: TStream); var

hMem: THandle; pMem: Pointer; begin

Assert(Assigned(S)); 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

CopyStreamFromClipboard(fmt: Cardinal; S: TStream); var

hMem: THandle; pMem: Pointer; begin

Assert(Assigned(S)); 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 } procedure

SaveClipboardFormat(fmt: Word; writer: TWriter); var

fmtname: array

[0..128] of

Char; ms: TMemoryStream; begin

Assert(Assigned(writer)); if

0 = GetClipboardFormatName(fmt, fmtname, SizeOf(fmtname)) then

fmtname[0] := #0; ms := TMemoryStream.Create; try

CopyStreamFromClipboard(fmt, ms); if

ms.Size > 0 then

begin

writer.WriteInteger(fmt); writer.WriteString(fmtname); writer.WriteInteger(ms.Size); writer.Write

(ms.Memory^, ms.Size); end

; { If } finally

ms.Free end

; { Finally } end

; { SaveClipboardFormat } procedure

LoadClipboardFormat(reader: TReader); var

fmt: Integer; fmtname: string

; Size: Integer; ms: TMemoryStream; begin

Assert(Assigned(reader)); fmt := reader.ReadInteger; fmtname := reader.ReadString; Size := reader.ReadInteger; ms := TMemoryStream.Create; try

ms.Size := Size; reader.Read

(ms.memory^, Size); if

Length(fmtname) > 0 then

fmt := RegisterCLipboardFormat(PChar(fmtname)); if

fmt <> 0 then

CopyStreamToClipboard(fmt, ms); finally

ms.Free; end

; { Finally } end

; { LoadClipboardFormat } procedure

SaveClipboard(S: TStream); var

writer: TWriter; i: Integer; begin

Assert(Assigned(S)); writer := TWriter.Create(S, 4096); try

Clipboard.Open; try

writer.WriteListBegin; for

i := 0 to

Clipboard.formatcount - 1 do

SaveClipboardFormat(Clipboard.Formats[i], writer); writer.WriteListEnd; finally

Clipboard.Close; end

; { Finally } finally

writer.Free end

; { Finally } end

; { SaveClipboard } procedure

LoadClipboard(S: TStream); var

reader: TReader; begin

Assert(Assigned(S)); reader := TReader.Create(S, 4096); try

Clipboard.Open; try

clipboard.Clear; reader.ReadListBegin; while

not

reader.EndOfList do

LoadClipboardFormat(reader); reader.ReadListEnd; finally

Clipboard.Close; end

; { Finally } finally

reader.Free end

; { Finally } end

; { LoadClipboard } // Examples: { Save Clipboard } procedure

TForm1.Button1Click(Sender: TObject); var

ms: TMemoryStream; begin

ms := TMemoryStream.Create; try

SaveClipboard(ms); ms.SaveToFile('c: empClipBrdSaved.dat'); finally

ms.Free; end

; { Finally } end

; { Clear Clipboard } procedure

TForm1.Button2Click(Sender: TObject); begin

clipboard.Clear; end

; { Restore Clipboard } procedure

TForm1.Button3Click(Sender: TObject); var

fs: TfileStream; begin

fs := TFilestream.Create('c: empClipBrdSaved.dat', fmopenread or

fmsharedenynone); try

LoadClipboard(fs); finally

fs.Free; end

; { Finally } end

;

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com