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. 


原创粉丝点击