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

Delphi , ОС и Железо , Буфер обмена

Оформил: 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, который предоставляет набор процедур для копирования и восстановления содержимого буфера обмена в поток, который может быть сохранен или загружен из файла.

Разбивка кода:

CopyStreamToClipboard

• Он принимает объект TStream S и форматный указатель fmt в качестве входных параметров.
• Он выделяет памятную.handle с помощью GlobalAlloc, блокирует ее с помощью GlobalLock, читает содержимое потока в память, а затем устанавливает буфер обмена с памятной.handle.

CopyStreamFromClipboard

• Он принимает объект TStream S и форматный указатель fmt в качестве входных параметров.
• Он получает памятную.handle из буфера обмена с помощью GetAsHandle, блокирует ее с помощью GlobalLock, записывает содержимое памяти в поток, а затем разблокирует память.

SaveClipboardFormat

• Он принимает форматный указатель fmt и объект TWriter writer в качестве входных параметров.
• Он сохраняет формат буфера обмена с заданным форматом указателя в writer.
• Writer ожидается быть подключенным к файлу или другому потоку.

LoadClipboardFormat

• Он принимает объект TReader reader в качестве входного параметра.
• Он загружает формат буфера обмена из reader и копирует его обратно в буфер обмена.

SaveClipboard

• Он принимает объект TStream S в качестве входного параметра.
• Он сохраняет содержимое буфера обмена в поток с помощью процедуры SaveClipboardFormat.

LoadClipboard

• Он принимает объект TStream S в качестве входного параметра.
• Он загружает содержимое буфера обмена из потока с помощью процедуры LoadClipboardFormat и очищает оригинальное содержимое буфера обмена.

Примеры в конце демонстрируют, как использовать эти процедуры:

1. Save Clipboard: Сохраняет содержимое буфера обмена в файле "ClipBrdSaved.dat".
2. Clear Clipboard: Очищает содержимое буфера обмена.
3. Restore Clipboard: Загружает содержимое буфера обмена из сохраненного файла и восстанавливает его обратно в буфер обмена.

В целом, этот код предоставляет удобный способ работы с буфером обмена в приложениях Delphi.

Обратная связь на код:

• Процедуры хорошо организованы и легко понятны.
• Использование утверждений (Assert) хорошее для обеспечения корректности входных параметров.
• Обработка ошибок приемлема, но может быть улучшена более конкретными сообщениями об ошибках и более надежной обработкой исключений.
• Код может выиграть от добавления комментариев документации, объясняющих цель каждой процедуры и важные детали реализации.

Альтернативное решение - использовать встроенные методы компонента TClipboard для сохранения и загрузки содержимого буфера обмена, такие как SaveToStream и LoadFromStream. Это может упростить код и уменьшить необходимость вручной управления памятью.

Рассмотрено решение задачи копирования буфера в поток и обратно в программе на языке Delphi, а также реализация функций для сохранения и восстановления форматов clipboard.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Буфер обмена ::