Forum > LCL

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

(1/4) > >>

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  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,  mytrayapp, Windows; type   { TForm1 }   TForm1 = class(TForm)    Button1: TButton;    procedure Button1Click(Sender: TObject);  private    procedure TrayMessage(var Msg: TMessage); message WM_ICONTRAY;  public   end; var  Form1: TForm1;  MyTray : TMyTrayApp; implementation {$R *.lfm} { TForm1 } procedure TForm1.Button1Click(Sender: TObject);begin  MyTray := TMyTrayApp.Create(Self);end; procedure TForm1.TrayMessage(var Msg: TMessage);begin  case Msg.lParam of      WM_LBUTTONDOWN : begin                         Show;                       end;      WM_RBUTTONDOWN : begin                         Hide;                       end;    end;end; end. 
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  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---type  TMyComponent = class(TComponent)  private    procedure CMHitTest(var Message: TCMHittest); message CM_HITTEST;  end; implementation procedure TMyComponent.CMHitTest(var Message: TCMHittest);begin  // Do somethingend;

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  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit Unit1;  {$mode objfpc}{$H+}  interface  uses   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,   mytrayapp, Windows;  type    { TForm1 }    TForm1 = class(TForm)     Button1: TButton;     procedure Button1Click(Sender: TObject);   private     procedure TrayMessage(var Msg: TMessage); message WM_ICONTRAY;   end;  var   Form1: TForm1;   MyTray : TMyTrayApp;  implementation  {$R *.lfm}  { TForm1 }  procedure TForm1.Button1Click(Sender: TObject); begin   MyTray := TMyTrayApp.Create(Self); end;  procedure TForm1.TrayMessage(var Msg: TMessage); begin   MyTray.TrayMessage(Msg);   Exit;    // Disable this function   case Msg.lParam of       WM_LBUTTONDOWN : begin                          Show;                        end;       WM_RBUTTONDOWN : begin                          Hide;                        end;     end; end;  end.
The message handling in the component unit:

--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---procedure TMyTrayApp.TrayMessage(var Msg: TMessage); begin   if not(Owner is TForm) then Exit;   case Msg.lParam of       WM_LBUTTONDOWN : begin                          (Owner as TForm).Show;                        end;       WM_RBUTTONDOWN : begin                          (Owner as TForm).Hide;                        end;     end; 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.

Navigation

[0] Message Index

[#] Next page