Как известно в Windows реализованы два способа мониторинга изменений буфера обмена (clipboard):

1. Более старый способ, появившийся еще в Windows 2000, на основе создания Clipboard Viewer Window, которое добавляется в Clipboard Viewer Chain. В этом случае в оконной процедуре требуется обработка двух системных сообщений: WM_DRAWCLIPBOARD и WM_CHANGECBCHAIN. Первое сообщение уведомляет окно просмотра об изменении содержимого буфера обмена, второе необходимо для поддержания целостности цепочки окон просмотра буфера обмена. При этом передача сообщений внутри цепочки окон просмотра осуществляется оконными обработчиками с помощью процедуры SendMessage. Нормальное функционирование цепочки может быть нарушено в случае аварийного завершения одного из приложений, которое зарегистрировало свое окно в цепочке.
2. Начиная с Windows Vista, был добавлен механизм Clipboard Format Listener, в котором приложение уведомляется об изменении в буфере обмена с помощью сообщения WM_CLIPBOARDUPDATE. В этом случае система сама распределяет сообщение по listener-окнам.

Так как работать со старыми версиями Windows не предполагалось, то при реализации мониторинга было решено ограничится только вторым способом. Мне уже приходилось работать с обработкой очереди сообщений Windows в приложениях, разработанных в Lazarus. Поэтому по принципу "что тут думать — трясти надо" было написано тестовое приложение с мониторингом буфера обмена. Для этого в обработчики OnCreate и OnDestroy были добавлены функции Windows:

procedure TFrmClipboardMonitor.FormCreate(Sender: TObject);
begin
  AddClipboardFormatListener(Self.Handle)
end;

procedure TFrmClipboardMonitor.FormDestroy(Sender: TObject);
begin
  RemoveClipboardFormatListener(Self.Handle);
end;

Также определяем обработчик сообщения WM_CLIPBOARDUPDATE:

procedure CLIPBOARDUPDATE(var msg: windows.TMessage); message WM_CLIPBOARDUPDATE;

procedure TFrmClipboardMonitor.CLIPBOARDUPDATE(var msg: windows.TMessage); //message WM_CLIPBOARDUPDATE;
begin
  //Do_CLIPBOARDUPDATE_Action;
end;

Первая же компиляция показала, что функции AddClipboardFormatListener и RemoveClipboardFormatListener не определены модуле windows в RTL FreePascal. Добавляем определения:

function AddClipboardFormatListener(hWndNewOwner:HWND):WINBOOL; stdcall; external 'user32' name 'AddClipboardFormatListener';
function RemoveClipboardFormatListener(hWndNewOwner:HWND):WINBOOL; stdcall; external 'user32' name 'RemoveClipboardFormatListener';

Все успешно откомпилировалось, функция AddClipboardFormatListener возвращала TRUE, но обработчик WM_CLIPBOARDUPDATE не отрабатывал.

Более детальный поиск привел меня к материалу, где сообщалось: "The LCL does not pass on Windows messages. It only passes on messages > WM_USER.". Это меня несколько удивило, потому что ранее я вполне успешно обрабатывал сообщение WM_SYSCOMMAND, значение которого WM_SYSCOMMAND = 274 меньше, чем WM_USER = 1024.

В указанном выше материале предлагалось в обработчике OnCreate формы переопределить оконную процедуру для формы:

var
  PrevWndProc:windows.WNDPROC;

PrevWndProc := Windows.WNDPROC(SetWindowLong(Self.Handle, GWL_WNDPROC, PtrInt(@WndCallback)));

В новой оконной процедуре WndCallback выполняется перехват необходимого сообщения Windows и вызов соответствующего обработчика формы. Все остальные сообщения должны обрабатываться предыдущей процедурой PrevWndProc.

Проверка такой схемы в тестовом приложении показало ее работоспособность. Однако использование такого подхода в дальнейшем предполагало что для любой формы, в которой необходим мониторинг изменений содержимого буфера обмена, нужно было повторять описанную схему. А мне хотелось инкапсулировать всю внутреннюю механику мониторинга в функционале некоторого класса, который бы оповещал форму об изменении буфера обмена сообщением через стандартный механизм Dispatch базового класса TObject.

При разработке этого класса нужно было учесть следующие моменты:

1. Для регистрации окна-листенера функцией AddClipboardFormatListener необходим дескриптор окна Windows.
   Поэтому каждый экземпляр класса-монитора создает собственное окно — так называемое message-only window.
2. В оконной процедуре окна-листенера должен быть известен адрес владельца окна.
   Для этого после создания во внутренней структуре окна сохраняется адрес экземпляра класса-монитора, создавшего окно, с помощью функции SetWindowLongPtr.

В итоге получился следующий модуль:

unit ClpbrdMonitor;
{$mode objfpc}{$H+}
interface

uses
  windows,
  Classes, SysUtils,
  Forms,
  myMsgUtils;

const
  cMsgClipBoardChanged = 4321;  //идентификатор сообщения об изменении буфера

type
  TClpbrdMonitor = class(TComponent)
  private
    FClassRegistered: boolean;  static;    //флаг регистрации класса окна
    FWndClassAtom:    ATOM;     static;    //результат RegisterClassEx
    FLastError:       DWORD;    static;    //ошибка регистрации класса окна
    FWndHandle:       HWND;                //дескриптор message-only window

    class procedure RegisterClass; static; //регистрация класса message-only window
    procedure CreateMessageOnlyWnd;        //создание message-only window
  public
    type  
      //исключение при ошибках в RegisterClass и CreateMessageOnlyWnd
      EClpbrdMonitor = class(Exception)
      end;

    constructor Create(aOwner: TComponent);  override;
    destructor  Destroy;                     override;
  end;

Класс-монитор TClpbrdMonitor является наследником класса TComponent, поэтому его владельцем может быть любой наследник класса TComponent в том числе и TForm.

В разделе Implementation модуля определены следующие элементы и методы:

//----------------------------------------------------------------------------------------
// описание функций Windows - отсутствуют в модуле windows!!!
function AddClipboardFormatListener(hWndNewOwner:HWND):WINBOOL; stdcall; external 'user32' name 'AddClipboardFormatListener';
function RemoveClipboardFormatListener(hWndNewOwner:HWND):WINBOOL; stdcall; external 'user32' name 'RemoveClipboardFormatListener';

Оконная callback функция:

//----------------------------------------------------------------------------------------
//оконная процедура
function WndCallback(Ahwnd: HWND; uMsg: UINT; wParam: WParam; lParam: LParam): LRESULT; stdcall;
var cmon: TClpbrdMonitor;
begin
  if uMsg = WM_CLIPBOARDUPDATE then begin
    //определяем адрес монитора создателя окна
    cmon := TClpbrdMonitor(GetWindowLongPtr(ahwnd, GWLP_USERDATA));
    if cmon <> nil then
      //посылка сообщения форме владельцу монитора
      _sendMessage(cmon.Owner, cMsgClipBoardChanged);
    Result := 0;
  end
  else
    Result := DefWindowProc(Ahwnd, uMsg, wParam, lParam);  //default window procedure
end;

Для отсылки сообщения форме владельцу монитора используется процедура _sendMessage — "обертка" над методом Dispatch класса TObject. Процедура _sendMessage определена в модуле myMsgUtils.

Метод RegisterClass определен с ключевым словом class, то есть является общим для всех экземпляров класса-монитора, и предназначен для регистрации класса окна, общего для всех окон, создаваемых отдельными экземплярами класса-монитора. Флаг FClassRegistered необходим для исключения повторной регистрации класса окна.

//----------------------------------------------------------------------------------------
const
  cClassName = 'ClpbrdMonitor'; //имя класса окна

class procedure TClpbrdMonitor.RegisterClass;
var WndClass: WNDClassEx;
begin
  if FClassRegistered then
    exit;

  FillByte(WndClass, sizeOf(WndClass), 0);
  WndClass.cbSize := sizeof(WNDCLASSEX);
  WndClass.lpszClassName := cClassName;
  WndClass.hInstance     := HInstance;
  WndClass.lpfnWndProc   := @WndCallback;
  WndClass.cbWndExtra    := sizeOf(Pointer); //дополнительные байты для хранения адреса монитора владельца окна

  FWndClassAtom := RegisterClassEx(WndClass);
  FClassRegistered := true;

  if FWndClassAtom = 0 then
    FLastError := GetLastError;
end;

Метод CreateMessageOnlyWnd создает окно и сохраняет адрес экземпляра монитора в дополнительных байтах структуры окна. В случае возникновения ошибок генерируется исключение EClpbrdMonitor. Для создания именно message-only window в качестве параметра hWndParent функции CreateWindowEx передается константа WND_MESSAGE:

//----------------------------------------------------------------------------------------
procedure TClpbrdMonitor.CreateMessageOnlyWnd;
var lerr: DWORD;
begin
  FWndHandle := CreateWindowEx(0, cClassName, 'dummy_name', 0, 0, 0, 0, 0, WND_MESSAGE, 0,
                               0, nil);
  if FWndHandle = 0 then begin
    //ошибка создания окна
    lerr := GetLastError;
    raise EClpbrdMonitor.CreateFmt('CreateWindowEx Error - %d', [lerr]);
  end;
  //сохраняем Self в extra data окна
  SetLastError(0);
  if SetWindowLongPtr(FWndHandle, GWLP_USERDATA, LONG_PTR(self)) = 0 then begin
    lerr := GetLastError;
    if lerr <> 0 then begin
      //произошла ошибка сохранения
      DestroyWindow(FWndHandle);
      raise EClpbrdMonitor.CreateFmt('SetWindowLongPtr Error - %d', [lerr]);
    end;
  end;
end;

В конструкторе класса при необходимости выполняется регистрация класса окна и создание окна. При успешном выполнении этих процедур выполняется регистрация окна-листенера функцией AddClipboardFormatListener. В случае ошибок генерируется исключение EClpbrdMonitor.

//----------------------------------------------------------------------------------------
constructor TClpbrdMonitor.Create(aOwner: TComponent);
var lerr: DWORD;
begin
  inherited;
  if not FClassRegistered then
    RegisterClass;
  if FWndClassAtom = 0 then
    raise EClpbrdMonitor.CreateFmt('RegisterClassEx Error - %d', [FLastError]);
  CreateMessageOnlyWnd;
  if not AddClipboardFormatListener(FWndHandle) then begin
    //ошибка регистрации листенера
    lerr := GetLastError;
    raise EClpbrdMonitor.CreateFmt('AddClipboardFormatListener Error - %d', [lerr]);
  end;
end;

Деструктор класса удаляет окно из списка листенеров с помощью RemoveClipboardFormatListener и разрушает message-only window:

//----------------------------------------------------------------------------------------
destructor TClpbrdMonitor.Destroy;
begin
  if FWndHandle <> 0 then begin
    RemoveClipboardFormatListener(FWndHandle);
    DestroyWindow(FWndHandle);
  end;
  inherited Destroy;
end;

В секции Initialization модуля на всякий случай :) выполняется инициализация статических полей класса TClpbrdMonitor:

initialization
  //paranoia ))))
  TClpbrdMonitor.FClassRegistered := false;
  TClpbrdMonitor.FWndClassAtom := 0;
  TClpbrdMonitor.FLastError := 0;
end.

Для организации мониторинга изменений содержимого буфера обмена в какой-либо форме с использованием класса TClpbrdMonitor достаточно:

1. Добавить в секцию uses модуль ClpbrdMonitor.
2. В обработчик OnCreate формы добавить оператор TClpbrdMonitor.Create(Self);
3. Определить обработчик сообщения:
   procedure ClipBoardChanged(var msg: myMsgUtils.TMessage); message cMsgClipBoardChanged;
   в котором реализуется необходимая функциональность.

К началу