如何从Lazarus捕捉剪贴板的变化?

时间:2011-03-22 18:03:39

标签: winapi clipboard lazarus

如何从Windows中的Lazarus程序捕获对剪贴板所做的更改。例如,将剪贴板历史记录保存到文件中。

谢谢,

3 个答案:

答案 0 :(得分:0)

Lazarus和任何Windows开发环境都是一样的。您需要将自己添加到剪贴板查看器链中。

网上有很多文章描述了如何做到这一点。例如:

答案 1 :(得分:0)

我找到了这个,并设法让它工作,但忘了保存它,现在正在努力想象我是如何设法使它工作的:

{{1}}

以上代码来自http://wiki.lazarus.freepascal.org/Clipboard,理论上它应该有用。它会编译并运行,但剪贴板内容更改时不会弹出窗口。也许这里的其他人有更好的眼睛来弄清楚原因。

答案 2 :(得分:0)

在Vista及更高版本中,您应该使用AddClipboardFormatListener()而不是SetClipboardViewer()。
这个工作示例最初由ASerge和Remy发布在Lazarus论坛上:Not reacting to clipboard change - 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.