unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
const
PM_MyMessage = WM_USER+1000;
type
TMessageObject =
class(TObject)
private
FWindowHandle: THandle;
FOnMessage: TNotifyEvent;
protected
procedure DoMessage;
virtual;
procedure WndProc(
var Msg: TMessage);
public
constructor Create;
destructor Destroy;
override;
property Handle : THandle
read FWindowHandle;
property OnMessage : TNotifyEvent
read FOnMessage
write FOnMessage;
end;
TForm1 =
class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
FMessageObject : TMessageObject;
procedure OnMessage(Sender : TObject);
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TMessageObject }
constructor TMessageObject.Create;
begin
inherited Create;
FWindowHandle:=AllocateHWnd(WndProc);
end;
destructor TMessageObject.Destroy;
begin
DeallocateHWnd(FWindowHandle);
inherited Destroy;
end;
procedure TMessageObject.DoMessage;
begin
If Assigned(FOnMessage)
then
FOnMessage(Self);
end;
procedure TMessageObject.WndProc(
var Msg: TMessage);
begin
With Msg
do
If Msg = PM_MyMessage
then
Try
DoMessage;
Except
Application.HandleException(Self);
end
else
Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
end;
{ TForm1 }
procedure TForm1.OnMessage(Sender: TObject);
begin
ShowMessage('
Yes');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FMessageObject:=TMessageObject.Create;
FMessageObject.OnMessage:=OnMessage;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FMessageObject.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
SendMessage(FMessageObject.Handle,PM_MyMessage,0,0);
end;
end.