winapi - Lazarus からクリップボードの変更をキャプチャするには?

Question

Windows の Lazarus プログラムからクリップボードに加えられた変更をキャプチャするにはどうすればよいですか。たとえば、クリップボードの履歴をファイルに保存します。

ありがとう、

Answer 1

Windows 開発環境と同様に、Lazarus でも同じです。クリップボード ビューアーのチェーンに自分自身を追加する必要があります。

それを行う方法を説明する Web 上の多くの記事があります。例えば：

• http://delphi.about.com/od/windowsshellapi/a/clipboard_spy_2.htm
• http://www.developer.com/net/csharp/article.php/3359891/C-Tip-Monitoring-Clipboard-Activity-in-C.htm
• http://www.radsoftware.com.au/articles/clipboardmonitor.aspx

Answer 2

Vista 以降では、SetClipboardViewer() の代わりに AddClipboardFormatListener() を使用する必要があります。
ASerge と Remy によって Lazarus フォーラムに最初に投稿されたこの作業例:クリップボードの変更に反応しない - Windows

unit ClipboardListener;

{$mode objfpc}{$H+}

interface

uses
  Windows, Messages, Classes;

type
  { TClipboardListener }

  TClipboardListener = class(TObject)
  strict private
    FOnClipboardChange: TNotifyEvent;
    FWnd: HWND;
    class function GetSupported: Boolean; static;
    procedure WindowProc(var Msg: TMessage);
  public
    constructor Create;
    destructor Destroy; override;
    property OnClipboardChange: TNotifyEvent read FOnClipboardChange
      write FOnClipboardChange;
    class property Supported: Boolean read GetSupported;
  end;

implementation

uses SysUtils, LCLIntf;

var
  AddClipboardFormatListener: function(Wnd: HWND): BOOL; stdcall;
  RemoveClipboardFormatListener: function(Wnd: HWND): BOOL; stdcall;

procedure InitClipboardFormatListener;
var
  HUser32: HMODULE;
begin
  HUser32 := GetModuleHandle(user32);
  Pointer(AddClipboardFormatListener) :=
    GetProcAddress(HUser32, 'AddClipboardFormatListener');
  Pointer(RemoveClipboardFormatListener) :=
    GetProcAddress(HUser32, 'RemoveClipboardFormatListener');
end;

{ TClipboardListener }

constructor TClipboardListener.Create;
begin
  inherited;
  if GetSupported then
  begin
    FWnd := LCLIntf.AllocateHWnd(@WindowProc);
    if not AddClipboardFormatListener(FWnd) then
      RaiseLastOSError;
  end;
end;

destructor TClipboardListener.Destroy;
begin
  if FWnd <> 0 then
  begin
    RemoveClipboardFormatListener(FWnd);
    LCLIntf.DeallocateHWnd(FWnd);
  end;
  inherited;
end;

class function TClipboardListener.GetSupported: Boolean;
begin
  Result := Assigned(AddClipboardFormatListener) and
    Assigned(RemoveClipboardFormatListener);
end;

procedure TClipboardListener.WindowProc(var Msg: TMessage);
begin
  if (Msg.msg = WM_CLIPBOARDUPDATE) and Assigned(FOnClipboardChange) then
  begin
    Msg.Result := 0;
    FOnClipboardChange(Self);
  end;
end;

initialization
  InitClipboardFormatListener;
end.

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  ClipboardListener, Classes, Forms, StdCtrls;

type
  { TForm1 }

  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FListener: TClipboardListener;
    procedure ClipboardChanged(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.ClipboardChanged(Sender: TObject);
begin
   Memo1.Lines.Append(timetostr(Now)+' ['+Clipboard.AsText+']')   
// Memo1.Lines.Append('Clipboard changed');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FListener := TClipboardListener.Create;
  FListener.OnClipboardChange := @ClipboardChanged;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FListener.Free;
end;

end.