Einzelnen Beitrag anzeigen

Benutzerbild von Jens Schumann
Jens Schumann

Registriert seit: 27. Apr 2003
Ort: Bad Honnef
1.644 Beiträge
 
Delphi 2009 Professional
 
#5

Re: Ableitung von TObject muss Windows Messages Empfangen...

  Alt 17. Okt 2005, 18:29
Hallo,
und hier hätten wir die Lösung
Delphi-Quellcode:
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.
Ich habe etwas bei TTimer abgeguckt
I come from outer space to save the human race
  Mit Zitat antworten Zitat