[CLOSED] How to capture messages sent to the parent form of a TComponent

[pcurtis]

Can a component derived from TComponent receive messages? Answered, subject changed.

How to capture user messages sent to the parent form (from the system) of a TComponent and handle them in that component.

Consider this small app

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

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
9.   mytrayapp, Windows;
10.  
11. type
12.  
13.   { TForm1 }
14.  
15.   TForm1 = class(TForm)
16.     Button1: TButton;
17.     procedure Button1Click(Sender: TObject);
18.   private
19.     procedure TrayMessage(var Msg: TMessage); message WM_ICONTRAY;
20.   public
21.  
22.   end;
23.  
24. var
25.   Form1: TForm1;
26.   MyTray : TMyTrayApp;
27.  
28. implementation
29.  
30. {$R *.lfm}
31.  
32. { TForm1 }
33.  
34. procedure TForm1.Button1Click(Sender: TObject);
35. begin
36.   MyTray := TMyTrayApp.Create(Self);
37. end;
38.  
39. procedure TForm1.TrayMessage(var Msg: TMessage);
40. begin
41.   case Msg.lParam of
42.       WM_LBUTTONDOWN : begin
43.                          Show;
44.                        end;
45.       WM_RBUTTONDOWN : begin
46.                          Hide;
47.                        end;
48.     end;
49. end;
50.  
51. end.
52.  

This works fine (complete project attached). I want to move the message handling to the component.
How do I do that?

I can make the component generate events so that's not an issue.

PLEASE DO NOT SUGGEST TRAYICON. It has issues.

[Handoko]

Yes, it can. This code below has no compile time error:

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

1. type
2.   TMyComponent = class(TComponent)
3.   private
4.     procedure CMHitTest(var Message: TCMHittest); message CM_HITTEST;
5.   end;
6.  
7. implementation
8.  
9. procedure TMyComponent.CMHitTest(var Message: TCMHittest);
10. begin
11.   // Do something
12. end;

[pcurtis]

Thanks - Ive changed the question

[Handoko]

This code below does what you want. The message handling is handled inside the component but the message activation is activated on the main form. See line #19 and #39.

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

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
9.   mytrayapp, Windows;
10.  
11. type
12.  
13.   { TForm1 }
14.  
15.   TForm1 = class(TForm)
16.     Button1: TButton;
17.     procedure Button1Click(Sender: TObject);
18.   private
19.     procedure TrayMessage(var Msg: TMessage); message WM_ICONTRAY;
20.   end;
21.  
22. var
23.   Form1: TForm1;
24.   MyTray : TMyTrayApp;
25.  
26. implementation
27.  
28. {$R *.lfm}
29.  
30. { TForm1 }
31.  
32. procedure TForm1.Button1Click(Sender: TObject);
33. begin
34.   MyTray := TMyTrayApp.Create(Self);
35. end;
36.  
37. procedure TForm1.TrayMessage(var Msg: TMessage);
38. begin
39.   MyTray.TrayMessage(Msg);
40.   Exit;
41.  
42.   // Disable this function
43.   case Msg.lParam of
44.       WM_LBUTTONDOWN : begin
45.                          Show;
46.                        end;
47.       WM_RBUTTONDOWN : begin
48.                          Hide;
49.                        end;
50.     end;
51. end;
52.  
53. end.

The message handling in the component unit:

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

1. procedure TMyTrayApp.TrayMessage(var Msg: TMessage);
2. begin
3.   if not(Owner is TForm) then Exit;
4.   case Msg.lParam of
5.       WM_LBUTTONDOWN : begin
6.                          (Owner as TForm).Show;
7.                        end;
8.       WM_RBUTTONDOWN : begin
9.                          (Owner as TForm).Hide;
10.                        end;
11.     end;
12. end;

[pcurtis]

Close, but no cigar :-)

It works, but it my copy of the project the message comes from the system. Not the program. The messages are a callback for the Shell_NotifyIconW function.

[jamie]

use "Dispatch" of the class. That directly pumps a message through the component.

if your code has a TCONTROL and up in it you can use the "Perform"

etc

I hope that was what you were asking for? Your header is a little miss leading comparing to your post responses.

If you are looking to interview a message loop you can over ride the WinProc or at the system level change the destination window handler.

[pcurtis]

I'm not sure what you mean

[jamie]

If you have a component that stems from a TCONTROL you can use Perform(TheMessage, WParam, LParam);

If you don't have a component that is based from a TCONTROL then you can directly send a message to a class via the Dispatch where all the messages end up anyways

 MyCOmponent.Dispatch(TheMessageObect)

The Message record must have the proper format ocourse.

this will directly call the method assigned to that Message index.
you most likely can use the TLmesasge for this.

[pcurtis]

Fine, but I want to receive system messages in a control based on TComponent.

I'm supposing I have to hook into the components parent forms message chain. The question is how.
 

[howardpc]

There is a Windows-only example here which may be what you are looking for (or it may not).

[pcurtis]

I'm looking. Thanks.

[Remy Lebeau]

Fine, but I want to receive system messages in a control based on TComponent.

I'm supposing I have to hook into the components parent forms message chain. The question is how.

If the parent Form is the one receiving the messages, then yes, you would need to use a hook.  You can have the component either:

- subclass the parent Form's WindowProc property.

- subclass the parent Form's HWND directly using SetWindowSubclass() or SetWindowLongPtr(GWL_WNDPROC).  See Subclassing Controls on MSDN.

- use a Win32 message hook via SetWindowsHookEx(WH_CALLWNDPROC), looking for messages targeting the desired HWND.

On the other hand, if the component is the one calling Shell_NotifyIcon() to begin with, then it should not be using someone else's HWND to receive system messages for the icon.  It should be creating its own HWND instead.  So, either derive the component from TWinControl, or just create a hidden HWND using CreateWindow/Ex() directly.

[pcurtis]

@howardpc It works. Just one small unrelated problem. How do I call class procedures from function WndCallback. See lines
87 / 90?

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

1. unit MyTrayApp;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls,
9.   StdCtrls, ComCtrls, Windows, ShellAPI, LazUTF8;
10.  
11. const
12.   uIDTrayIcon = 25;
13.   WM_ICONTRAY = WM_USER + uIDTrayIcon;
14.  
15. type
16.  
17.   TNotifyIconDataW2 = record
18.     cbSize: DWORD;
19.     hWnd: HWND;
20.     uID: UINT;
21.     uFlags: UINT;
22.     uCallbackMessage: UINT;
23.     hIcon: HICON;
24.     szTip: array [0..127] of WideChar;
25.     dwState: DWORD;
26.     dwStateMask: DWORD;
27.     szInfo: array [0..255] of WideChar;
28.     u: record
29.          case longint of
30.            0 : ( uTimeout : UINT );
31.            1 : ( uVersion : UINT );
32.           end;
33.     szInfoTitle: array[0..63] of WideChar;
34.     dwInfoFlags: DWORD;
35.   end;
36.  
37.  
38.   { TMyTestComponent }
39.  
40.   TMyTrayApp = class(TComponent)
41.   private
42.     fNotifyIcon : TNotifyIconDataW2;
43.   protected
44.  
45.   public
46.     constructor Create(AOwner : TComponent); override;
47.     destructor Destroy; override;
48.     function AddIcon : Boolean;
49.     procedure HideMe;
50.     procedure ShowMe;
51.   published
52.   end;
53.  
54. procedure Register;
55.  
56. var
57.   fPrevWndProc : WndProc;
58.  
59. implementation
60.  
61. //{$R myselectdialog.res}
62.  
63. function WideStrLCopy(dest, source: PWideChar; maxlen: SizeInt): PWideChar;
64. var
65.   counter: SizeInt;
66. begin
67.   counter := 0;
68.  
69.   while (Source[counter] <> #0)  and (counter < MaxLen) do
70.   begin
71.     Dest[counter] := Source[counter];
72.     Inc(counter);
73.   end;
74.  
75.   Dest[counter] := #0;
76.   Result := Dest;
77. end;
78.  
79. function WndCallback(Ahwnd: HWND; uMsg: UINT; wParam: WParam; lParam: LParam):LRESULT; stdcall;
80. begin
81.   if uMsg = WM_ICONTRAY then
82.   begin
83.     result := DefWindowProc(Ahwnd, uMsg, WParam, LParam);  //not sure about this one
84.  
85.     case lParam of
86.       WM_LBUTTONDOWN : begin
87.                          // TMyTrayApp.HideMe;
88.                        end;
89.       WM_RBUTTONDOWN : begin
90.                          // TMyTrayApp.ShowMe;
91.                        end;
92.     end;
93.     exit;
94.   end;
95.   result := CallWindowProc(fPrevWndProc , Ahwnd, uMsg, WParam, LParam);
96. end;
97.  
98. constructor TMyTrayApp.Create(AOwner : TComponent);
99. begin
100.   inherited Create(AOwner);
101.   if not (csDesigning in ComponentState) then
102.     begin
103.       fPrevWndProc := Windows.WNDPROC(SetWindowLongPtr((Self.Owner as TForm).Handle,
104.                                      GWL_WNDPROC,
105.                                      PtrUInt(@WndCallback)));
106.       AddIcon;
107.     end;
108. end;
109.  
110. destructor TMyTrayApp.Destroy;
111. begin
112.   Shell_NotifyIconW(NIM_DELETE, @fNotifyIcon);
113.   inherited;
114. end;
115.  
116. procedure TMyTrayApp.HideMe;
117. begin
118.   (Self.Owner as TForm).Hide;
119. end;
120.  
121. procedure TMyTrayApp.ShowMe;
122. begin
123.   (Self.Owner as TForm).Show;
124. end;
125.  
126. function TMyTrayApp.AddIcon : Boolean;
127. var
128.   WideBuffer: widestring;
129. begin
130.   FillChar(fNotifyIcon, SizeOf(fNotifyIcon), 0);
131.   fNotifyIcon.cbSize := SizeOf(fNotifyIcon);
132.   fNotifyIcon.hWnd := (Self.Owner as TForm).Handle;
133.   fNotifyIcon.uID := uIDTrayIcon;
134.   fNotifyIcon.uFlags := NIF_MESSAGE or NIF_ICON;
135.   fNotifyIcon.uFlags := fNotifyIcon.uFlags or NIF_TIP;
136.   fNotifyIcon.uCallbackMessage := WM_USER + uIDTrayIcon;
137.   fNotifyIcon.hIcon := Application.Icon.Handle;
138.  
139.   WideBuffer := UTF8ToUTF16('TrayIconHint');
140.   WideStrLCopy(@fNotifyIcon.szTip, PWideChar(WideBuffer), 127);
141.  
142.   Result := Shell_NotifyIconW(NIM_ADD, @fNotifyIcon);
143. end;
144.  
145. procedure Register;
146.  
147. begin
148.   RegisterComponents('Misc',[TMyTrayApp]);
149. end;
150.  
151. end.
152.  

[Remy Lebeau]

@howardpc It works.

Perhaps, but from a design standpoint, you should NOT be using the parent Form's HWND in this situation.  Your Tray component should be creating its own HWND instead, so the OS can send messages directly to the component itself.  Look at TTimer as an example. It is a non-visual component that has to receive WM_TIMER messages from the OS.  You should do the same thing in your Tray component.

[pcurtis]

fNotifyIcon needs the form handle.

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

1. function TMyTrayApp.AddIcon : Boolean;
2. var
3.   WideBuffer: widestring;
4. begin
5.   FillChar(fNotifyIcon, SizeOf(fNotifyIcon), 0);
6.   fNotifyIcon.cbSize := SizeOf(fNotifyIcon);
7. [b]  fNotifyIcon.hWnd := (Self.Owner as TForm).Handle;[/b]
8.   fNotifyIcon.uID := uIDTrayIcon;
9.   fNotifyIcon.uFlags := NIF_MESSAGE or NIF_ICON;
10.   fNotifyIcon.uFlags := fNotifyIcon.uFlags or NIF_TIP;
11.   fNotifyIcon.uCallbackMessage := WM_USER + uIDTrayIcon;
12.   fNotifyIcon.hIcon := Application.Icon.Handle;
13.  
14.   WideBuffer := UTF8ToUTF16('TrayIconHint');
15.   WideStrLCopy(@fNotifyIcon.szTip, PWideChar(WideBuffer), 127);
16.  
17.   Result := Shell_NotifyIconW(NIM_ADD, @fNotifyIcon);
18. end;        
19.