2011-03-22 34 views

回答

0

我发现这一点,并设法得到它的工作,却忘了将它保存到现在努力想我如何设法使它的工作原理:

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; // handle to the next viewer 
    // Here are the clipboard event handlers 
    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))); 
    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); // VERY IMPORTANT 
    Result := 0; 
end; 

end. 

上面的代码是从http://wiki.lazarus.freepascal.org/Clipboard,理论上它应该起作用。它可以编译和运行,但是没有窗口弹出的剪贴板中的内容发生变化时。也许这里的其他人有更好的目光弄清楚为什么。

0

在Vista和更高版本,您应该使用AddClipboardFormatListener()而不是SetClipboardViewer()。
本工作实施例最初由ASerge和雷米张贴在拉撒路论坛: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.