Lazarus 下如何让非可视化组件（类）截获事件

最新推荐文章于 2024-05-18 06:10:32 发布

love3s

最新推荐文章于 2024-05-18 06:10:32 发布

阅读量1.6k

点赞数

分类专栏： Lazarus 文章标签： button destructor constructor class forms timer

本文链接：https://blog.csdn.net/love3s/article/details/6745092

版权

Lazarus 专栏收录该内容

8 篇文章 0 订阅

订阅专栏

二话不说直接上源码,很简单,哈哈
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.