Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Копировать буфер в поток и обратно

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

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;
Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.