The following works fine for me in Delphi 7:
[pascal]unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TMessageHandler = function(hWnd: HWND; Msg: UINT; wParam:
WPARAM; lParam: LPARAM): LRESULT of object;
TInfo = record
Msg : UINT;
CallMe: TMessageHandler;
end;
PInfo = ^TInfo;
//------------------------------------------------------------------------------
TThing = class(TObject)
private
FInfo: TList;
protected
function PaintProc(hWnd: HWND; Msg: UINT;
wParam: WPARAM; lParam: LPARAM): LRESULT;
function RegisterMessageHandler(Msg: UINT;
Handler: TMessageHandler): TMessageHandler;
procedure ClearInfo;
procedure HandleSomeMessage(Msg: UINT);
public
constructor Create;
destructor Destroy; override;
end;
//----------------------------------------------------------------------------
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
FObject: TThing;
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
//------------------------------------------------------------------------------
function TThing.PaintProc(hWnd: HWND; Msg: UINT;
wParam: WPARAM; lParam: LPARAM): LRESULT;
begin
ShowMessage('In here');
Result := 0;
end;
//------------------------------------------------------------------------------
function TThing.RegisterMessageHandler(Msg: UINT; Handler: TMessageHandler):
TMessageHandler;
var
NewInfo: PInfo;
begin
New(NewInfo);
NewInfo.Msg := Msg;
NewInfo.CallMe := Handler;
FInfo.Add(NewInfo);
Result := Handler;
end;
//------------------------------------------------------------------------------
constructor TThing.Create;
begin
FInfo := TList.Create;
RegisterMessageHandler(WM_PAINT, PaintProc);
end;
//------------------------------------------------------------------------------
destructor TThing.Destroy;
begin
ClearInfo;
FInfo.Free;
end;
//------------------------------------------------------------------------------
procedure TThing.ClearInfo;
var
i: Integer;
begin
for i := 0 to FInfo.Count - 1 do
Dispose(FInfo[i]);
FInfo.Clear;
end;
//------------------------------------------------------------------------------
procedure TThing.HandleSomeMessage(Msg: UINT);
var
i: Integer;
ThisOne: PInfo;
begin
for i := 0 to FInfo.Count - 1 do
begin
ThisOne := FInfo[i];
if ThisOne.Msg = Msg then
begin
if Assigned(ThisOne.CallMe) then
ThisOne.CallMe(Application.Handle, ThisOne.Msg, 0, 0);
end;
end;
end;
//------------------------------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
begin
FObject := TThing.Create;
end;
//------------------------------------------------------------------------------
procedure TForm1.FormDestroy(Sender: TObject);
begin
FObject.Free;
end;
//------------------------------------------------------------------------------
procedure TForm1.Button1Click(Sender: TObject);
begin
FObject.HandleSomeMessage(WM_PAINT);
end;
//------------------------------------------------------------------------------
end.[/pascal]
Bookmarks