Not reacting to clipboard change - windows

[bdan_13]

Hello,
I try to get the clipboard whenever it changes, but it not trigger in my application.
I try the same piece of code in delphi 7 and works....

If anyone could help me .... please do
I search on the internet....but I did not find a solution.

Thank you.

Here is my code:

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
  clipbrd, StdCtrls, Windows, Messages;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
   FNextClipboardOwner: HWnd;   {handle to the next viewer}
    {Here are the clipboard event handlers}
    procedure WMChangeCBChain(var Msg: TMessage); message WM_CHANGECBCHAIN;
    procedure WMDrawClipboard(var Msg: TMessage); message WM_DRAWCLIPBOARD;
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
    FNextClipboardOwner := SetClipboardViewer(Handle);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
    ChangeClipboardChain(Handle, FNextClipboardOwner);
end;

procedure TForm1.WMChangeCBChain(var Msg: TMessage);
var
   Remove, Next: THandle;
begin
   Remove := Msg.WParam;
   Next := Msg.LParam;
  with Msg do
   if FNextClipboardOwner = Remove then
    FNextClipboardOwner := Next
   else if FNextClipboardOwner <> 0 then
    SendMessage(FNextClipboardOwner, WM_ChangeCBChain, Remove, Next)
end;

procedure TForm1.WMDrawClipboard(var Msg: TMessage);
begin
  if Clipboard.HasFormat(CF_TEXT) Then Begin
    ShowMessage(Clipboard.AsText);
  end;
  SendMessage(FNextClipboardOwner, WM_DRAWCLIPBOARD, 0, 0);   {VERY IMPORTANT!}
  Msg.Result := 0;
end;

end.

[Takeda]

Do you have change {$mode objfpc} to {$mode Delphi}?

Most cases, if your code came from Delphi it's working properly if we use Delphi mode..

BTW, AFAIK, if you want to get notification if clipboard is change or not, you must use hooking technique..
I tested using hooking technique and works fine.. (I'll open my old codes, If you're lucky, you get from me..)

[ludob]

The LCL does not pass on windows messages. It only passes on messages > WM_USER. This means you have to write your own message handler. http://wiki.lazarus.freepascal.org/Win32/64_Interface#Processing_non-user_messages_in_your_window
Your code modified to implement message handler:

Code: [Select]

unit Unit1;

{$mode delphi}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
  clipbrd, StdCtrls, Windows, Messages;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
   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
    { public declarations }
  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.


[bdan_13]

Thank you.

Works like a charm. 
I did not know about {$mode delphi}
And ... I did not know how  to write my own message handler.

Thank you.

Dan

[dcminus]

I know this is an old post, I am trying to see if it works but it does not seem to pick up the changes made to clipboard for me. I am using Version 1.4.4 for Windows 32 bit. Anyone got idea why?

[balazsszekely]

@dcminus
I know this is an old post, I am trying to see if it works but it does not seem to pick up the changes made to clipboard for me. I am using Version 1.4.4 for Windows 32 bit. Anyone got idea why?

It's working fine, just run the project(attachment) and copy something to the clipboard.

[dcminus]

Hi GetMem,

Thank you for your help. However it seems like it only works at times. Sometimes it does not update for a fe seconds, than adds the seem text many times. Any idea why?

Thank you very much in advance.

[balazsszekely]

Sometimes it does not update for a fe seconds, than adds the seem text many times. Any idea why?

Are you sure?

The memo is not updated because you have to change scrollbars property to ssBoth + change WMDrawClipboard function like this(for autoscroll):

Code: Pascal  [Select][+][-]

1. function TForm1.WMDrawClipboard(wParam: WParam; lParam: LParam): LRESULT;
2. begin
3.   if Clipboard.HasFormat(CF_TEXT) then
4.   begin
5.     Memo1.Lines.Add('-----------------------------------------------');
6.     Memo1.Lines.Add(FormatDateTime('YYYY.MM.DD hh:mm:ss', now));
7.     Memo1.Text := Memo1.Text + Clipboard.AsText;
8.     SendMessage(Memo1.Handle, EM_LINESCROLL, 0, Memo1.Lines.Count);  
9.   end;
10.   SendMessage(FNextClipboardOwner, WM_DRAWCLIPBOARD, 0, 0);
11.   Result := 0;
12. end;

[dcminus]

Thank you very much!

The issues is not with the scrolling but I believe the app I am copying from. So for example if I copy something out of a mail from Outlook this gets triggered several times, however when I do the same from notepad all good.

I guess it is due to a different clipboard format.


actually i have tested and it gets triggered many times because I am using a KM LINK Adapter and it has a "clipboard sharing" function. 

However if I copy something to the clipboard from an email in Outlook then switch to a different email i still get to entries in the Memo altough I have only pressed CTRL+C once.

any ideas how to handle this?

Cheers

[balazsszekely]

You press only once, but probably Outlook copies twice to the clipboard, however you can filter it like this(untested):

Code: Pascal  [Select][+][-]

1. var
2.   wHandleOld: THandle;
3.   wTextOld: String;
4.  
5. //....
6.  
7. function TForm1.WMDrawClipboard(wParam: WParam; lParam: LParam): LRESULT;
8. var
9.   wHandle: THandle;
10.   wText: String;
11. begin
12.   if Clipboard.HasFormat(CF_TEXT) then
13.   begin
14.     wHandle :=  GetForegroundWindow;
15.     wText := Clipboard.AsText;
16.     if ((wHandle <> wHandleOld) or ((wHandle = wHandleOld) and (wText <> wTextOld))) then
17.     begin
18.       wHandleOld := wHandle;
19.       wTextOld := wText;
20.       Memo1.Lines.Add('-----------------------------------------------');
21.       Memo1.Lines.Add(FormatDateTime('YYYY.MM.DD hh:mm:ss', now));
22.       Memo1.Text := Memo1.Text + Clipboard.AsText;
23.       SendMessage(Memo1.Handle, EM_LINESCROLL, 0, Memo1.Lines.Count);
24.     end;
25.   end;
26.   SendMessage(FNextClipboardOwner, WM_DRAWCLIPBOARD, 0, 0);
27.   Result := 0;
28. end;

               

[Remy Lebeau]

I try to get the clipboard whenever it changes, but it not trigger in my application.

Just FYI, MSDN says:

The SetClipboardViewer function exists to provide backward compatibility with earlier versions of Windows. The clipboard viewer chain can be broken by an application that fails to handle the clipboard chain messages properly. New applications should use more robust techniques such as the clipboard sequence number or the registration of a clipboard format listener. For further details on these alternatives techniques, see Monitoring Clipboard Contents.

On Vista and later, you should be using AddClipboardFormatListener() instead of SetClipboardViewer().  It doesn't solve your problem of how to handle clipboard window messages, but it does address the issue of you no longer having to manually maintain the viewer chain.

[Remy Lebeau]

Code: [Select]

PrevWndProc:=Windows.WNDPROC(SetWindowLong(Self.Handle,GWL_WNDPROC,PtrInt(@WndCallback)));


SetWindowLong() is 32bit only. If you need to support 64bit systems, you have to use SetWindowLongPtr() instead (as the Wiki example shows).  however, a safer option is to use SetWindowSubclass() instead.  See Safer subclassing on MSDN.

[dcminus]

Thanks GetMem,

I would prefer to filter out only the second "fake" clipboard change, in case the user copies the same text again from another mail the memo have to be updated.

Basicly I am writing an app to sort mails, and if the subject contains a reference number we select and the app will tell what should i do with it. Now if I would copy the same reference twice there will be no popup, so in the end if I cannot figure this it will probably better get triggered twice then none.

I guess there could be a way to know if the outlook really copies something to the clipboard or just duplicates the previous copy.

Hope it makes sense,

Thanks again for all the hep.

[ASerge]

On Vista and later, you should be using AddClipboardFormatListener() instead of SetClipboardViewer(). 

This work example:

Code: Pascal  [Select][+][-]

1. unit ClipboardListener;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Windows, Messages, Classes;
9.  
10. type
11.   { TClipboardListener }
12.  
13.   TClipboardListener = class(TObject)
14.   strict private
15.     FOnClipboardChange: TNotifyEvent;
16.     FWnd: HWND;
17.     class function GetSupported: Boolean; static;
18.     procedure WindowProc(var Msg: TMessage);
19.   public
20.     constructor Create;
21.     destructor Destroy; override;
22.     property OnClipboardChange: TNotifyEvent read FOnClipboardChange write FOnClipboardChange;
23.     class property Supported: Boolean read GetSupported;
24.   end;
25.  
26. implementation
27.  
28. uses SysUtils, LCLIntf;
29.  
30. var
31.   AddClipboardFormatListener: function(Wnd: HWND): BOOL; stdcall;
32.   RemoveClipboardFormatListener: function(Wnd: HWND): BOOL; stdcall;
33.  
34. procedure InitClipboardFormatListener;
35. var
36.   HUser32: HMODULE;
37. begin
38.   HUser32 := GetModuleHandle(user32);
39.   Pointer(AddClipboardFormatListener) :=
40.     GetProcAddress(HUser32, 'AddClipboardFormatListener');
41.   Pointer(RemoveClipboardFormatListener) :=
42.     GetProcAddress(HUser32, 'RemoveClipboardFormatListener');
43. end;
44.  
45. { TClipboardListener }
46.  
47. constructor TClipboardListener.Create;
48. begin
49.   inherited;
50.   if GetSupported then
51.   begin
52.     FWnd := LCLIntf.AllocateHWnd(@WindowProc);
53.     if not AddClipboardFormatListener(FWnd) then
54.       RaiseLastOSError;
55.   end;
56. end;
57.  
58. destructor TClipboardListener.Destroy;
59. begin
60.   if FWnd <> 0 then
61.   begin
62.     RemoveClipboardFormatListener(FWnd);
63.     LCLIntf.DeallocateHWnd(FWnd);
64.   end;
65.   inherited;
66. end;
67.  
68. class function TClipboardListener.GetSupported: Boolean;
69. begin
70.   Result := Assigned(AddClipboardFormatListener) and
71.     Assigned(RemoveClipboardFormatListener);
72. end;
73.  
74. procedure TClipboardListener.WindowProc(var Msg: TMessage);
75. begin
76.   if (Msg.msg = WM_CLIPBOARDUPDATE) and Assigned(FOnClipboardChange) then
77.   begin
78.     Msg.Result := 0;
79.     FOnClipboardChange(Self);
80.   end;
81. end;
82.  
83. initialization
84.   InitClipboardFormatListener;
85. end.

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   ClipboardListener, Classes, Forms, StdCtrls;
9.  
10. type
11.   { TForm1 }
12.  
13.   TForm1 = class(TForm)
14.     Memo1: TMemo;
15.     procedure FormCreate(Sender: TObject);
16.     procedure FormDestroy(Sender: TObject);
17.   private
18.     FListener: TClipboardListener;
19.     procedure ClipboardChanged(Sender: TObject);
20.   end;
21.  
22. var
23.   Form1: TForm1;
24.  
25. implementation
26.  
27. {$R *.lfm}
28.  
29. { TForm1 }
30.  
31. procedure TForm1.ClipboardChanged(Sender: TObject);
32. begin
33.   Memo1.Lines.Append('Clipboard changed');
34. end;
35.  
36. procedure TForm1.FormCreate(Sender: TObject);
37. begin
38.   FListener := TClipboardListener.Create;
39.   FListener.OnClipboardChange := @ClipboardChanged;
40. end;
41.  
42. procedure TForm1.FormDestroy(Sender: TObject);
43. begin
44.   FListener.Free;
45. end;
46.  
47. end.

[dcminus]

ASerge,

Great stuff!

I have tested this new approach that you have just posted, looking good, however I have the same kind of problem with this. If I try to copy something from Outlook 2010  Memo gets two updates one genuine clipboard update and one duplicate which is triggered when click on another mail in the inbox.

Any suggestion for a fix?

Much appreciated.

P.S.: just realised that this has fixed the issue with my KM Link Software  yeeah!