WindowsのLazarusプログラムからクリップボードに加えられた変更をどのように取得できますか?たとえば、クリップボードの履歴をファイルに保存する場合などです。Lazarusからのクリップボードの変更をキャプチャするには?
ありがとう、
WindowsのLazarusプログラムからクリップボードに加えられた変更をどのように取得できますか?たとえば、クリップボードの履歴をファイルに保存する場合などです。Lazarusからのクリップボードの変更をキャプチャするには?
ありがとう、
すべてのWindows開発環境と同じです。クリップボードビューアのチェーンに自分自身を追加する必要があります。
ウェブ上には、その方法を説明する記事が多数あります。たとえば:
私はこれを発見し、それが仕事を得るために管理し、それを保存するのを忘れて、今私が作るために管理方法を理解するのに苦労していますそれは働く:
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と理論的にはうまくいくはずです。コンパイルして実行しますが、クリップボードの内容が変更されたときにウィンドウがポップアップしません。たぶん誰か他の誰かが理由を理解するためのより良い目を持っています。
Vista以降では、SetClipboardViewer()の代わりにAddClipboardFormatListener()を使用する必要があります。
もともと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.