Lazarus 下让非可视化组件（类）截获事件的方法（转）

bugxiong

• unit uMessageTest;  
•   
• {$mode objfpc}{$H+}  
•   
• interface  
•   
• uses  
•   Windows, LMessages, Classes, SysUtils, FileUtil, Forms, Controls, Graphics,  
•   Dialogs, StdCtrls, ExtCtrls, InterfaceBase;  
•   
• const  
•   WM_MYMESSAGE = WM_USER + 1;  
•   
• type  
•   
•   { TFrmMessageTest }  
•   
•   TFrmMessageTest = class(TForm)  
•     Button1: TButton;  
•     Button2: TButton;  
•     Timer1: TTimer;  
•     procedure Button1Click(Sender: TObject);  
•     procedure Button2Click(Sender: TObject);  
•   private  
•     { private declarations }  
•   public  
•     { public declarations }  
•   end;  
•   
•   { TMyControls }  
•   
•   TMyControls = class(TWinControl)  
•   protected  
•     procedure WndProc(var Message: TLMessage); override;  
•   public  
•     procedure SendMsg;  
•   end;  
•   
•   { TNon_Controls }  
•   
•   TNon_Controls = class(TObject)  
•   private  
•     procedure WndProc(var Message: TLMessage);  
•   public  
•     Hwd: HWND;  
•     procedure SendMsg;  
•     constructor Create;  
•     destructor Destroy; override;  
•   end;  
•   
• var  
•   FrmMessageTest: TFrmMessageTest;  
•   
• implementation  
•   
• { TNon_Controls }  
•   
• procedure TNon_Controls.WndProc(var Message: TLMessage);  
• begin  
•   if Message.msg = WM_MYMESSAGE then  
•      ShowMessage('截获非可视自定义事件！')   ;  
•   Message.msg := 0;  
• end;  
•   
• procedure TNon_Controls.SendMsg;  
• begin  
•   PostMessage(Hwd, WM_MYMESSAGE, 0, 0);  
• end;  
•   
• constructor TNon_Controls.Create;  
• begin  
•   if Hwd = 0 then  //WidgetSet需引用InterfaceBase  
•      Hwd := WidgetSet.AllocateHWnd(@WndProc);  
• end;  
•   
• destructor TNon_Controls.Destroy;  
• begin  
•   if Hwd <> 0 then begin  
•      WidgetSet.DeallocateHWnd(Hwd);  
•      Hwd := 0;  
•   end;  
•   inherited Destroy;  
• end;  
•   
• { TFrmMessageTest }  
•   
• procedure TFrmMessageTest.Button1Click(Sender: TObject);  
• var  
•   mycon: TMyControls;  
• begin  
•   mycon := TMyControls.Create(Self);  
•   mycon.Parent := Self;  
•   mycon.Visible := False;  
•   mycon.SendMsg;  
• end;  
•   
• procedure TFrmMessageTest.Button2Click(Sender: TObject);  
• var  
•   mycon: TNon_Controls;  
• begin  
•   mycon := TNon_Controls.Create;  
•   mycon.SendMsg;  
• end;  
•   
• {$R *.lfm}  
•   
• { TMyControls }  
•   
• procedure TMyControls.WndProc(var Message: TLMessage);  
• begin  
•   if Message.msg = WM_MYMESSAGE then  
•      ShowMessage('截获自定义事件！')  
•   else  
•      inherited WndProc(Message);  
• end;  
•   
• procedure TMyControls.SendMsg;  
• begin  
•   PostMessage(Self.Handle, WM_MYMESSAGE, 0, 0);  
• end;  
•   
• end.  
  

bugxiong

转自：http://blog.csdn.net/love3s/article/details/6745092