Clipboard/ru

From Free Pascal wiki
Jump to navigationJump to search

│ Deutsch (de) │ English (en) │ magyar (hu) │ русский (ru) │


Предопределенные типы

TPredefinedClipboardFormat тип MIME
pcfText text/plain
pcfBitmap image/bmp
pcfPixmap image/xpm
pcfIcon image/lcl.icon
pcfPicture image/lcl.picture
pcfMetaFilePict image/lcl.metafilepict
pcfObject application/lcl.object
pcfComponent application/lcl.component
pcfCustomData application/lcl.customdata

Текст

Для использования с простым текстом объект Clipboard предоставляет свойство AsText, которое может быть использовано для чтения и записи текста.

Запись текста: 

Clipboard.AsText := 'Hello clipboard!';

Чтение текста: 

ShowMessage('Clipboard content: ' + Clipboard.AsText);

Clipboard является объектом класса TClipboard и для его использования необходимо подключить модуль Clipbrd в разделе uses: 

uses
..., Clipbrd;

Текстовые элементы управления

Некоторые визуальные компоненты, такие как TEdit, TMemo, TStringGrid, TLabeledEdit, TMaskEdit, TSpinEdit и TFloatSpinEdit обладают возможностью выделения части текста, находящегося в них, и предоставляют дополнительные функциональные возможности для выделенного текста при работе с буфером обмена. 

  
procedure CopyToClipboard; 
  procedure CutToClipboard; 
  procedure PasteFromClipboard;

Текст в формате HTML

Объект ClipBoard поддерживает чтение и запись текста в формате HTML.

Пример чтения из буфера обмена и записи в буфер обмена текста в формате HTML: 

uses
  Clipbrd, ...;
var
  Html, PlainText: String;
...
begin
  Html := ClipBoard.GetAsHtml;
  ...
  Html := '<b>Formatted</b> text';
  PlainText := 'Simple Text';
  ClipBoard.SetAsHtml(Html, PlainText);
end.

Windows

Для обработки Html-текста в буфере обмена Windows требуется подключение заголовочных файлов.
В то время, как раньше пользователям необходимо было делать это вручную, теперь это прозрачно делается с помощью подключения модуля ClipBrd.

Изображения

Загрузка из буфера обмена

uses 
  Clipbrd, LCLIntf, LCLType, ...;

procedure LoadBitmapFromClipboard(Bitmap: TBitmap);
begin
  if Clipboard.HasFormat(PredefinedClipboardFormat(pcfDelphiBitmap)) then
    Bitmap.LoadFromClipboardFormat(PredefinedClipboardFormat(pcfDelphiBitmap));
  if Clipboard.HasFormat(PredefinedClipboardFormat(pcfBitmap)) then
    Bitmap.LoadFromClipboardFormat(PredefinedClipboardFormat(pcfBitmap));
end;

Сохранение в буфере обмена

uses 
  Clipbrd, ...;

procedure SaveBitmapToClipboard(Bitmap: TBitmap);
begin
  Clipboard.Assign(Bitmap);
end;

Пользовательский формат

Multiple objects

Получение уведомления об изменении буфера обмена

LCL не передает сообщения Windows (передаются только сообщения WM_USER). Это означает, что вы должны написать свой обработчик сообщения.

Пример кода для реализации обработчика сообщения: 

unit Unit1;

{$mode delphi}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
  Clipbrd, StdCtrls, Windows, Messages;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FNextClipboardOwner: HWnd;   // хэндл на следующий вьювер в цепочке
    // обработчики события буфера обмена
    function WMChangeCBChain(wParam: WParam; lParam: LParam):LRESULT;
    function WMDrawClipboard(wParam: WParam; lParam: LParam):LRESULT;
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}
var
  PrevWndProc:windows.WNDPROC;

function WndCallback(Ahwnd: HWND; uMsg: UINT; wParam: WParam; lParam: LParam): LRESULT; stdcall;
begin
  if uMsg = WM_CHANGECBCHAIN then begin
    Result := Form1.WMChangeCBChain(wParam, lParam);
    Exit;
  end 
  else if uMsg=WM_DRAWCLIPBOARD then begin
    Result := Form1.WMDrawClipboard(wParam, lParam);
    Exit;
  end;
  Result := CallWindowProc(PrevWndProc, Ahwnd, uMsg, WParam, LParam);
end;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  PrevWndProc := Windows.WNDPROC(SetWindowLong(Self.Handle, GWL_WNDPROC, PtrInt(@WndCallback))); // для x64 необходимо использовать SetWindowLongPtr
  FNextClipboardOwner := SetClipboardViewer(Self.Handle);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ChangeClipboardChain(Handle, FNextClipboardOwner);
end;

function TForm1.WMChangeCBChain(wParam: WParam; lParam: LParam): LRESULT;
var
  Remove, Next: THandle;
begin
  Remove := WParam;
  Next := LParam;
  if FNextClipboardOwner = Remove then FNextClipboardOwner := Next
    else if FNextClipboardOwner <> 0 then
      SendMessage(FNextClipboardOwner, WM_ChangeCBChain, Remove, Next)
end;

function TForm1.WMDrawClipboard(wParam: WParam; lParam: LParam): LRESULT;
begin
  if Clipboard.HasFormat(CF_TEXT) Then Begin
    ShowMessage(Clipboard.AsText);
  end;
  SendMessage(FNextClipboardOwner, WM_DRAWCLIPBOARD, 0, 0);   // ВАЖНО!
  Result := 0;
end;

end.

Просмотр содержимого буфера обмена

Иногда бывает полезно посмотреть, что находится в данный момент в буфере обмена. Вот несколько методов, которые я использую (на форме расположен элемент TMemo и один таймер с интервалом 1 секунда) - 

procedure TForm1.CheckClipboard();
var
    I : integer;
    List : TStringList;
begin
    memo1.clear;
    Memo1.Append('[' + Clipboard.AsText + ']');
    List := TStringList.Create;
    try
        ClipBoard.SupportedFormats(List);
        for i := 0 to List.Count-1 do begin
            //Memo1.Append(List.Strings[i]);        // раскомментируйте, чтобы увидеть все доступные форматы
            case List.Strings[i] of                 // показать конкретные форматы
                'Rich Text Format', 'text/plain', 'UTF8_STRING' :
                    ReadClip(List.Strings[i]);
            end;
        end;
    finally
      List.Free;
    end;
end;

function TForm1.ReadClip(TheFormat : ANSIString) : ANSIString;
var
  Stream: TMemoryStream;
  Fmt : TClipboardFormat;
  List : TStringList;
begin
    if TheFormat = '' then exit;
    Stream := TMemoryStream.Create;
    List := TStringList.Create;
  try
    if Clipboard.HasFormatName(TheFormat) then begin
        Memo1.Append(#10+TheFormat);
        Fmt := ClipBoard.FindFormatID(TheFormat);
        ClipBoard.GetFormat(Fmt, Stream);
        if Stream.Size > 0 then begin
            Stream.Seek(0, soFromBeginning);
            List.LoadFromStream(Stream);
            Memo1.Lines.AddStrings(List, False);
        end;
    end;
  finally
    List.Free;
    Stream.Free;
  end;
end;

Как исправить пустой буфер обмена GTK2 при выходе

Обычно, когда ваше GTK2-приложение заверщается, его буфер обмена становится пустым. Для обычного пользователя это плохо. Этот модуль - грубое исправление, добавьте его где-нибудь в uses. 

unit fix_gtk_clipboard;

{$mode objfpc}{$H+}

interface

uses
  gtk2, gdk2, Clipbrd;

implementation

var
  c: PGtkClipboard;
  t: string;

finalization
  c := gtk_clipboard_get(GDK_SELECTION_CLIPBOARD);
  t := Clipboard.AsText;
  gtk_clipboard_set_text(c, PChar(t), Length(t));
  gtk_clipboard_store(c);
end.

В мае 2018 года я (dbannon) обнаружил, что помещение этого фрагмента кода в раздел finalization решает проблему, когда содержимое буфера обмена пришло из самого приложения, но если оно было там до запуска приложения, то есть приложение не записывало в буфер обмена, он представляет другую, похожую проблему. В этом случае содержимое буфера обмена снова очищается. И, похоже, это происходит потому, что к моменту выполнения условия завершения буфер обмена уже очищен.

Простое решение - поместить этот же код в событие OnClose основной формы. Достаточно рано, чтобы содержимое из любого источника все еще было там, и достаточно поздно, чтобы впоследствии его не очистить. 

uses .... 
{$ifdef LINUX}gtk2, gdk2, Clipbrd{$endif};
.....
procedure TMainForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
var
  c: PGtkClipboard;
  t: string;
begin
    {$ifdef LINUX}
    c := gtk_clipboard_get(GDK_SELECTION_CLIPBOARD);
    t := Clipboard.AsText;
    gtk_clipboard_set_text(c, PChar(t), Length(t));
    gtk_clipboard_store(c);
    {$endif}
end;

Внешние ссылки

Retrieved from "http://wiki.freepascal.org/index.php?title=Clipboard/ru&oldid=137745"