Копировать буфер в поток и обратно |
Previous Top Next |
Code: |
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; |
©Drkb::01890
Взято с сайта: http://www.swissdelphicenter.ch