///////Begin Source
uses Clipbrd;

type
TDataIdnet = array[0..2] of Char;
TClipboardFileHead = packed record
rIdent: TDataIdnet;
rCount: Word;
end;

TClipboardFileItem = packed record
rFormat: Word;
rSize: Longword;
rData: Pointer;
end;

const rDataIdnet: TDataIdnet = 'cbf';

function ClipboardSaveToStream(mStream: TStream): Boolean;
var
vClipboardFileHead: TClipboardFileHead;
vClipboardFileItem: TClipboardFileItem;
I: Integer;
vData: THandle;
begin
Result := False;
if not Assigned(mStream) then Exit;
vClipboardFileHead.rIdent := rDataIdnet;
vClipboardFileHead.rCount := Clipboard.FormatCount;
mStream.Write(vClipboardFileHead, SizeOf(vClipboardFileHead));
try
Clipboard.Open;
for I := 0 to Clipboard.FormatCount - 1 do begin
vData := GetClipboardData(Clipboard.Formats[I]);
vClipboardFileItem.rFormat := Clipboard.Formats[I];
vClipboardFileItem.rSize := GlobalSize(vData);
vClipboardFileItem.rData := GlobalLock(vData);
try
mStream.Write(vClipboardFileItem, SizeOf(vClipboardFileItem) -
SizeOf(vClipboardFileItem.rData));
mStream.Write(vClipboardFileItem.rData^, vClipboardFileItem.rSize);
finally
GlobalUnlock(vData);
end;
end;
finally
Clipboard.Close;
end;
Result := True;
end; { ClipboardSaveToStream }

function ClipboardLoadFromStream(mStream: TStream): Boolean;
var
vClipboardFileHead: TClipboardFileHead;
vClipboardFileItem: TClipboardFileItem;
I: Integer;
vData: THandle;
begin
Result := False;
if not Assigned(mStream) then Exit;
if mStream.Size <= SizeOf(vClipboardFileHead) then Exit;
mStream.Read(vClipboardFileHead, SizeOf(vClipboardFileHead));
if vClipboardFileHead.rIdent <> rDataIdnet then Exit;
Clipboard.Clear;
Clipboard.Open;
try
for I := 0 to vClipboardFileHead.rCount - 1 do begin
mStream.Read(vClipboardFileItem, SizeOf(vClipboardFileItem) -
SizeOf(vClipboardFileItem.rData));
vData := GlobalAlloc(GMEM_MOVEABLE + GMEM_DDESHARE,
vClipboardFileItem.rSize);
try
vClipboardFileItem.rData := GlobalLock(vData);
try
mStream.Read(vClipboardFileItem.rData^, vClipboardFileItem.rSize);
SetClipboardData(vClipboardFileItem.rFormat, vData);
finally
GlobalUnlock(vData);
end;
finally
GlobalFree(vData);
end;
end;
finally
Clipboard.Close;
end;
Result := True;
end; { ClipboardLoadFromStream }
///////End Source

///////Begin Demo
procedure TFormClipboard.ButtonSaveClick(Sender: TObject);
var
vMemoryStream: TMemoryStream;
begin
if not SaveDialog1.Execute then Exit;
if FileExists(SaveDialog1.FileName) and
(MessageDlg(Format('是否覆盖文件 "%s"？', [SaveDialog1.FileName]),
mtWarning, [mbYes, mbNo], 0) <> mrYes) then Exit;
vMemoryStream := TMemoryStream.Create;
try
ClipboardSaveToStream(vMemoryStream);
vMemoryStream.SaveToFile(SaveDialog1.FileName);
finally
vMemoryStream.Free;
end;
end;

procedure TFormClipboard.ButtonLoadClick(Sender: TObject);
var
vMemoryStream: TMemoryStream;
begin
if not OpenDialog1.Execute then Exit;
if not FileExists(OpenDialog1.FileName) then Exit;
vMemoryStream := TMemoryStream.Create;
try
vMemoryStream.LoadFromFile(OpenDialog1.FileName);
ClipboardLoadFromStream(vMemoryStream);
finally
vMemoryStream.Free;
end;
end;
///////End Demo