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:\temp\ClipBrdSaved.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:\temp\ClipBrdSaved.dat',
fmopenread
or fmsharedenynone);
try
LoadClipboard(fs);
finally
fs.Free;
end;
{ Finally }
end;