Lazarus 下如何让非可视化组件(类)截获事件
来源:互联网 发布:锁机软件 编辑:程序博客网 时间:2024/05/16 23:50
二话不说直接上源码,很简单,哈哈unit uMessageTest;{$mode objfpc}{$H+}interfaceuses 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.