. . .

{ TWinForm }

destructor TWinForm.Destroy;
begin
  UnregisterClass(FClass, HInstance);
  inherited;
end;

procedure TWinForm.WMDestroy(var Msg: TMessage);
begin
  Quit;
  Msg.Result:= 0;
end;

procedure TWinForm.WMLButtonDown(var Msg: TMessage);
begin
  ShowMessage('TWinForm');
  Msg.Result:= 0;
end;

function WndProc(Wnd: HWND; Msg: UINT; wP, lP: LongInt): LRESULT; stdcall; forward;

procedure TWinForm.Init;
var
  Desc: TWndClassEx;
begin
  FClass:= 'WinForm';

  ZeroMemory(@Desc, SizeOf(Desc));
  Desc.cbSize       := SizeOf(Desc);
  Desc.Style        := (CS_DBLCLKS or CS_OWNDC or CS_HREDRAW or CS_VREDRAW);
  Desc.lpfnWndProc  := @WndProc;
  Desc.lpszClassName:= FClass;
  Desc.hbrBackground:= GetStockObject(BLACK_BRUSH);
  Desc.hCursor      := LoadCursor(HInstance, IDC_ARROW);

  If (RegisterClassEx(Desc) = 0) then Exit;

  FWnd:= CreateWindowEx(0, FClass, nil, WS_CAPTION or WS_SYSMENU or WS_MINIMIZEBOX,
  100, 100, 800, 600, GetDesktopWindow, 0, HInstance, nil);

  ShowWindow(FWnd, SW_SHOW);
  SetForegroundWindow(FWnd);
end;

procedure TWinForm.Update;
var
  Msg: TMsg;
  IsQuit: boolean;
begin
  IsQuit:= False;

  while not IsQuit do
  begin
    if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
    begin
      if Msg.Message = WM_QUIT
      then IsQuit:= True
      else begin
        TranslateMessage(Msg);
        DispatchMessage(Msg);
      end;

    end else
    begin
      //

    end;
  end;
end;

procedure TWinForm.Quit;
begin
  PostQuitMessage(0);
end;

function WndProc(Wnd: HWND; Msg: UINT; wP, lP: LongInt): LRESULT; stdcall;
var
  i: LongInt;
begin
  Result:= 0;

  For i:= 0 to List.Count - 1 do      // Это замедлит код?
  with TEventHandler(List[i]) do
    Result:= DispatchEx(Msg, wP, lP); // Как тут правильно возвращать значение?
end;

var
  WinForm: TWinForm;
  Dummy  : TDummy;

function GetWnd: HWND;
begin
  Result:= WinForm.FWnd;
end;

begin
  List:= TObjectList.Create;

  WinForm:= TWinForm.Create;
  Dummy:= TDummy.Create;

  WinForm.Init;
  WinForm.Update;

  List.Free;
end.

program my_project_2;

uses
  Dialogs,
  Contnrs,
  HE_Utils,
  Messages,
  Windows;

type
  TEventHandler = class
    constructor Create;
  public
    procedure DefaultHandler(var Message); override;
    function  DispatchEx(Id: UINT; wP, lP: LongInt): LongInt;
  end;

  TDummy = class (TEventHandler)
  protected
    procedure WMLButtonDown(var Msg: TMessage); message WM_LBUTTONDOWN;
  end;

  TWinForm = class (TEventHandler)
    destructor Destroy; override;
  private
    FWnd  : HWND;
    FQuit : boolean;
    FClass: PChar;
  protected
    procedure WMDestroy    (var Msg: TMessage); message WM_DESTROY;
    procedure WMLButtonDown(var Msg: TMessage); message WM_LBUTTONDOWN;
  public
    procedure Init;
    procedure Update;
    procedure Update2;
    procedure Quit;
  end;

var
  List: TObjectList;

function GetWnd: HWND; forward;

{ TEventHandler }

constructor TEventHandler.Create;
begin
  inherited;
  List.Add(Self);
end;

procedure TEventHandler.DefaultHandler(var Message);
begin
  with TMessage(Message) do
    Result:= DefWindowProc(GetWnd, Msg, WParam, lParam)
end;

function TEventHandler.DispatchEx(Id: UINT; wP, lP: LongInt): LongInt;
var
  Msg: TMessage;
begin
  Msg.Msg   := Id;
  Msg.wParam:= wP;
  Msg.lParam:= lP;
  Msg.Result:= 0;
  Dispatch(Msg);

  Result:= Msg.Result;
end;

{ TDummy }

procedure TDummy.WMLButtonDown(var Msg: TMessage);
begin
  ShowMessage('TDummy');
  Msg.Result:= 0;
end;

. . .

type
  TEventHandler = class
    constructor Create;
  public
    procedure DefaultHandler(var Message); override;
    function  DispatchEx(Id: UINT; wP, lP: LongInt): LongInt;
  end;

var
  List: TObjectList; // Глобальный контейнер TEventHandler'ов.


{ TEventHandler }

constructor TEventHandler.Create;
begin
  inherited;
  List.Add(Self);
end;

procedure TEventHandler.DefaultHandler(var Message);
begin
  with TMessage(Message) do
    Result:= DefWindowProc(GetWnd, Msg, WParam, lParam); // 1 окно.
end;

function TEventHandler.DispatchEx(Id: UINT; wP, lP: LongInt): LongInt;
var
  Msg: TMessage;
begin
  Msg.Msg   := Id;
  Msg.wParam:= wP;
  Msg.lParam:= lP;
  Msg.Result:= 0;
  Dispatch(Msg);

  Result:= Msg.Result;
end;

function WndProc(Wnd: HWND; Msg: UINT; wP, lP: LongInt): LRESULT; stdcall;
var
  i: LongInt;
begin
  Result:= 0;

  For i:= 0 to List.Count - 1 do
  with TEventHandler(List[i]) do
    Result:= DispatchEx(Msg, wP, lP);
end;

procedure WMMouseDown(var msg:TWMMouseDown);message WM_MOUSEDOWN;

procedure TObj.WMMouseDown(var msg:TWMMouseDown);
begin
  if Asigned(OnMouseDown) then begin
    OnMouseDown(self,...);
  end;
end;

• OnMouseDown может вообще не заполняться а место в объекте на неё выделено
  
• код WMMouseDown обязательно вставится в итоговый файл программы (правда для создания класса окна очень удобно, и уместно - там всё надо предусматривать, но этот код можно в dll-ку выкинуть)
  

procedure TObj.WMMouseDown(var msg:TWMMessage;OnMouseDown:TMouseEvent);
begin
  if Asigned(OnMouseDown) then begin
    OnMouseDown(self,...);
  end;
end;

procedure Tobj.SetOnMouseDown(Evn:TMouseEvent);
begin
  setWMAction(WM_MOUSEDOWN,@WMMouseDown,Evn);
end;

procedure App_Run;
function IsAccel(hDlg: HWND; lpMsg: TMsg): boolean;
begin
  Result:=isKeyCombination(lpMsg); //
  if Result then begin
    Result:=BOOL(SendMessage(hDlg, APPM_TRANSLATEACCEL, 0, LPARAM(@Message)));
  end;

end;


var
    msg: TMsg;
    MainWindow:HWND;
begin
   while GetMessage(msg, 0, 0, 0) do
     begin
       MainWindow:=GetMainWnd(msg.hwnd);
       if IsAccel(MainWindow,msg) then continue;
       if IsDialogMessage(MainWindow,msg) then continue;
       TranslateMessage(msg);
       DispatchMessage(msg);
     end;
end;

APPM_TRANSLATEACCEL = WM_APP + 123;
function TranslateAccel(var Message: TMsg): Boolean;
begin
  Result := BOOL(SendMessage(Message.hwnd, APPM_TRANSLATEACCEL, 0, LPARAM(@Message)));
end;

  function GetMainWinOf(p:HWND):HWND;
  var s:DWORD;
  begin
    repeat
      Result:=p;
      s:=Windows.GetWindowLongW(p,GWL_STYLE);
      s :=s and (WS_CHILD or WS_POPUP);
      if(s=0)then break;
      p:=Windows.GetParent(Result);
    until (p=0);
  end;

// CreateWindow(Ex):
function WndProcStub(Wnd: HWnd; Msg, wParam, lParam: DWord): Integer; stdcall;
var
  Window: TWinAPIWindow;
begin
  Result := 0;

  if Msg = WM_INITDIALOG then
    SetWindowLong(Wnd, GWL_USERDATA, TCreateStruct(lParam^).lpCreateParams);

  Window := TWinAPIWindow(Pointer(GetWindowLong(Wnd, GWL_USERDATA)));
  if Assigned(Window) then
  begin
    if Window.FHandle = 0 then
      Window.FHandle := Wnd
    else
      if Dialog.FHandle <> Wnd then
        Exit;

    Result := Window.DialogProc(Msg, wParam, lParam);
  end;
end;

CreateWindowEx(..., Self);

// DialogBox(Param/Indirect/IndirectParam):
function DialogProcStub(Wnd: HWnd; Msg, wParam, lParam: DWord): Integer; stdcall;
var
  Dialog: TWinAPIDialog;
begin
  Result := 0;

  if Msg = WM_INITDIALOG then
    SetWindowLong(Wnd, GWL_USERDATA, lParam);

  Dialog := TWinAPIDialog(Pointer(GetWindowLong(Wnd, GWL_USERDATA)));
  if Assigned(Dialog) then
  begin
    if Dialog.FHandle = 0 then
      Dialog.FHandle := Wnd
    else
      if Dialog.FHandle <> Wnd then
        Exit;

    Result := Dialog.DialogProc(Msg, wParam, lParam);
  end;
end;

DialogBoxParam(..., Integer(Self));

 Александр Алексеев

function WndProc(handle: HWND; Msg: Cardinal; wPrm: WPARAM; lPrm: LPARAM): integer; stdcall;
var wnd: TBaseWindow;
    wndMsg: TWindowMsg;
begin
  wnd:=TBaseWindow(GetProp(handle, PROP_OBJDATA));
  if assigned(wnd) then
  begin
    wndMsg.Msg:=Msg;
    wndMsg.wParam:=wPrm;
    wndMsg.lParam:=lPrm;
    wndMsg.Result:=-1;

    wnd.Dispatch(wndMsg);
    Result:=wndMsg.Result;
  end
  else
  begin
    Result:=DefWindowProc(handle, msg, wPrm, lPrm);
  end;
end;

  TWindowMsg = packed record
    Msg   : Cardinal;
    wParam: WPARAM;
    lParam: LPARAM;
    Result: Integer;
    DefProc:function (handle: HWND; Msg: Cardinal; wPrm: WPARAM; lPrm: LPARAM): integer;stdcall;
  end;

//переопределить у нашего объекта стандартный обработчик
    procedure DefaultHandler(var Message);override;

function WndProc(handle: HWND; Msg: Cardinal; wPrm: WPARAM; lPrm: LPARAM): integer; stdcall;
var O: TObject;
    wnd: TWindow;
    wndMsg: TWindowMsg;
begin
  O:=GetOBJ(Handle);
  wndMsg.Msg:=Msg;
  wndMsg.wParam:=wPrm;
  wndMsg.lParam:=lPrm;
  wndMsg.Result:=-1;
  wndMsg.DefProc:=DefWindowProc;

  O.Dispatch(wndMsg);
  Result:=wndMsg.Result;
end;
procedure T~~~.DefaultHandler(var Message);
var P:^TWindowMsg;
begin
  P:=@Message;
  P.Result:=P.DefProc(Handle,P.Msg,P.wParam,P.lParam);
end;

Ctl3DStyles: array[Boolean] of Integer = (BF_MONO, 0);

DrawEdge(DC, RW, InnerStyles[BevelInner] or OuterStyles[BevelOuter],
  Byte(BevelEdges) or EdgeStyles[BevelKind] or Ctl3DStyles[Ctl3D] or BF_ADJUST);

if ThemeControl(Self) and (csNeedsBorderPaint in ControlStyle) then
  ThemeServices.PaintBorder(Self, False);

function IsDialogMessage(var Message: TMsg): Boolean;
var
  wnd: HWND;
begin
  wnd := GetActiveWindow;
  if wnd = 0 then Exit(false);
  if GetWindowThreadProcessId(wnd, nil) <> GetCurrentThreadId then Result := false
    else Result := Windows.IsDialogMessage(wnd, Message);
end;

function GetMainWnd(h:HWND):HWND;
begin
  repeat
    Result:=h;
    h:=GetParent(h);
  until h=0;
end;

procedure App_Run;
var
   msg: TMsg;
   MainWindow:HWND;
begin
  while GetMessage(msg, 0, 0, 0) do
    begin
      MainWindow:=GetMainWnd(msg.hwnd);
      if IsDialogMessage(MainWindow,msg) then continue;
      TranslateMessage(msg);
      DispatchMessage(msg);
    end;
end;

   WM_DESTROY:
    begin
      EnterCriticalSection(FSection);
      try
        b:=HandleList.FindKey(Handle,P);
      finally
        LeaveCriticalSection(FSection);
      end;
      if b then begin
        O:=P;
        EnterCriticalSection(FSection);
        try
          HandleList.Remove(handle);
        finally
          LeaveCriticalSection(FSection);
        end;
        FreeAndNil(O);
      end;
      // дадим удалиться такому же глюканутому предку как и мы
      Result:=Params.DefProc(handle,Msg,wPrm,lPrm);
    end;

TMyNewForm = class (TWindow)
// а тут пишем всякие обработчики, свойства, методы и прочую требуху.
end;

  asm
   pop EAX    //адресс возврат
   push $FFFF //здесь заменяется на адресса объекта
   push EAX   //вернём адресс возврата
   push $FFFE //здесь на адресс функции метода класса
   ret 0      // переход на него, с джампами возиться муторно
  end;
Type
// если призвести замену адрессов, этот код будет вызывать метод с таким прототипом
  TClassWndProc=function (handle: HWND; Msg: Cardinal; wPrm: WPARAM; lPrm: LPARAM): integer of object; stdcall;
  

function ConcreteWindowProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM;
  lParam: LPARAM): LRESULT; stdcall;
var
  Inst: TObject;
  Msg: TMessage;
begin
  if uMsg = WM_DESTROYWND then
  begin
    DestroyWindow(hWnd);
    Result := 0;
    Exit;
  end;
  if uMsg = WM_NCCREATE then ...

*  *  *
procedure TWindow.WMDestroy(var msg: TWindowMsg);
begin
  PostMessage(Handle, WM_DESTROYWND, 0, 0);
  msg.Result:=0;
end;

function ConcreteWindowProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM;
  lParam: LPARAM): LRESULT; stdcall;
var
  Inst: TObject;
  Msg: TMessage;
begin
  if uMsg = WM_NCCREATE then
  begin
    Inst := TMyConcreteWindowClass.Create;
    TMyConcreteWindowClass(Inst).FHandle := hwnd;
    SetWindowLongPtr(hWnd, GWL_USERDATA, Inst);
  end;

  Obj := Pointer(GetClassLong(hWnd, GWL_USERDATA));
  if Assigned(Obj) then
  begin
    Msg.Msg := uMsg;
    Msg.WParam := wParam;
    Msg.LParam := lParam;
    Msg.Result := 0;
    Obj.Dispatch(Msg);
    Result := Msg.Result;
  end else Result := DefWindowProc(hWnd, uMsg, wParam, lParam);

  if uMsg = WM_NCDESTROY then
  begin
    Inst := Pointer(SetWindowLongPtr(hWnd, GWL_USERDATA, NativeInt(nil)));
    FreeAndNil(Inst);
  end;
end;

const
  WM_DESTROYWND = WM_APP + 11;

procedure TApp.Run;
var
  msg: TMsg;
begin
  while GetMessage(msg, 0, 0, 0) do
  begin
    if (Msg.message = WM_DESTROYWND) and (Msg.hwnd = 0) then
      DestroyWindow(Msg.wParam);
    TranslateMessage(msg);
  *   *   *
end;

procedure TWindow.WMDestroy(var msg: TWindowMsg);
begin
  PostThreadMessage(GetCurrentThreadId, WM_DESTROYWND, Handle, 0);
  msg.Result:=0;
end;

      for i := 0 to Length(FDestroyArr) - 1 do FDestroyArr[i].Free;
      SetLength(FDestroyArr, 0);

library m1;
type

TMySuperComponent=class(TAnyComponent)
  ...
end;

begin
TMySuperComponent.RegisterAs('MySuperComponent');
end;

TMyWin1=class(TWin)
end;

TMyWin2=class(TWin)
end;

TMyApp1=class(TApp)
w1:TMyWin1;
w2:TMyWin1;  
constructor Create;
destructor Destroy;
end;
...
constructor TMyApp1.Create;
begin
   inherited;
   w1:=TMyWin1.Create;
   w2:=TMyWin1.Create;  
  
end;
destructor TMyApp1.Destroy;
begin
   w1.free;
   w2.free;
   inherited;
end;
...

  if wndMsg.Result<>0 then
    Result:=DefWindowProc(handle, msg, wPrm, lPrm)
  else
    Result:=0;