How to capture the clipboard changes from Lazarus? - winapi

Question

How can I capture the changes made to the clipboard from a Lazarus program in windows. For example, to save a clipboard history to a file.
Thanks,

Answer 1

It's the same in Lazarus as in any Windows development environment. You need to add yourself into the chain of clipboard viewers.
There are many articles on the web describing how to do it. For example:
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

I have found this and managed to get it work, but forgot to save it and now struggling to figure how i managed to make it work:
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.
Above code is from http://wiki.lazarus.freepascal.org/Clipboard and in theory it should work. It compiles and runs but no window pops up when the clipboard content changes. Maybe someone else here have got better eyes to figure out why.

Answer 3

On Vista and later, you should be using AddClipboardFormatListener() instead of SetClipboardViewer().
This working example originally posted on Lazarus Forums by ASerge and Remy: 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.