TPopupMenu Popup überschreiben / DoPopup wird nie aufgerufen

[Glados]

Insgesamt sieht das so aus

Delphi-Quellcode:

unit Utils.PopupMenu;

interface

uses
 Vcl.Menus, Winapi.Messages, System.Classes;

type
 TPopupMenu = class(Vcl.Menus.TPopupMenu)

 private
 protected
 public
  procedure Popup(X, Y: Integer); override;
 end;

type
 TPopupListEx = class(Vcl.Menus.TPopupList)

 private
 protected
  procedure WndProc(var Message: TMessage); override;
 public
  PopupMenu: TPopupMenu;
  MenuLoop: Boolean;
 end;

implementation

procedure TPopupMenu.Popup(X, Y: Integer);
begin
 // Wird benötigt, um an anderen Stellen im Code prüfen zu können, WELCHES PopupMenu gerade geöffnet ist
 TPopupListEx(PopupList).PopupMenu := Self;

 inherited;
end;

procedure TPopupListEx.WndProc(var Message: TMessage);
begin
 case message.msg of
  WM_ENTERMENULOOP:
   begin
    MenuLoop := True; // Menu sichtbar
   end;
  WM_EXITMENULOOP:
   begin
    MenuLoop := False; // Menu nicht mehr sichtbar
    TPopupListEx(PopupList).PopupMenu := nil;
   end;
 end;

 inherited WndProc(message);
end;

initialization

Vcl.Menus.PopupList.Free;
Vcl.Menus.PopupList := TPopupListEx.Create;

end.

Stat WndProc > WM_EXITMENULOOP wollte ich eigentlich TPopupMenu > CloseMenu überschreiben aber das ist nicht erlaubt.