TPopupMenu Popup überschreiben / DoPopup wird nie aufgerufen

[Glados]

Ich habe mir mit Hilfe des Forums und Google folgende Klasse gebaut. Somit bin ich in der Lage herauszufinden, wann ein PopupMenu sichtbar ist und wann nicht

Delphi-Quellcode:

unit Utils.PopupListEx;

interface

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

type
 TPopupListEx = class(TPopupList)
 private
  procedure WndProc(var Message: TMessage); override;
 public
  PopupMenu: TPopupMenu;
  MenuLoop: Boolean;
 end;

type
 TPopupMenu = class(Vcl.Menus.TPopupMenu)
 private
 public
  // procedure Popup(X, Y: Integer); override; 
  procedure DoPopup(Sender: TObject); override;
 end;

implementation

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;

{*
procedure TPopupMenu.Popup(X, Y: Integer);
begin
 // TPopupListEx(PopupList).PopupMenu := Sender as TPopupMenu; // wie komme ich hier an den Sender?

 inherited;
end;
*}

procedure TPopupMenu.DoPopup(Sender: TObject);
begin
 TPopupListEx(PopupList).PopupMenu := Sender as TPopupMenu;

 inherited;
end;

end.

In jedes PopupMenuXPopup-Even müsste ich händisch eigentlich TPopupListEx(PopupList).PopupMenu := Sender as TPopupMenu; schreiben.
Da man das aber schnell vergessen kann, möchte ich das gerne automatisiert erledigen und das Popup-Event überschreiben.

Nur wie komme ich an den Sender?

Edit ich weiß nicht, ob ich das richtig gelößt habe. Aber statt Popup() überschreibe ich jetzt DoPopup(Sender: TObject);. Dann habe ich den Sender.

Jetzt bekomme ich nur die Meldung

Zitat:

[dcc32 Hinweis] Utils.PopupListEx.pas(10): H2269 Durch das Überschreiben erhält die virtuelle Methode 'TPopupListEx.WndProc' eine geringere Sichtbarkeit (private) als die Basisklasse 'TPopupList' (protected)

Wie bekomme ich diese Meldung denn korrekt weg?

[stahli]

Du musst die genannte Methode in einer protected-Sektion deklarieren:

Delphi-Quellcode:

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

[Glados]

Edit: Problem nicht gelößt!

Danke.

Bei der Gelegenheit habe ich daraus eine Interposer-Klasse gemacht. Ich mag solche "Ex"-Anhängsel an Namen nicht:

Delphi-Quellcode:

type
 TPopupList = class(Vcl.Menus.TPopupList)

Und in der dpr-Datei

Delphi-Quellcode:

Vcl.Menus.PopupList.Free;
Vcl.Menus.PopupList := TPopupList.Create;
TPopupList(PopupList).PopupMenu := nil;

UND bei der Gelegenheit merke ich, dass DoPopup gar nicht funktioniert!
Ich weiß nicht genau warum, aber DoUpdate wird nie aufgerufen.

[Glados]

Weiß niemand warum?

[Fritzew]

Zitat von Glados:

Weiß niemand warum?

eventuell solltest Du die geerbte WndProc in Deiner Ableitung aufrufen?

[Glados]

Ich lerne gerade erst was Ableiten überhaupt bedeutet.

Das Problem ist, dass DoPopup grundsätzlich nicht aufgerufen wird, obwohl ich das Event doch überschrieben habe (Interposer-Klasse).

Ich möchte mit DoPopup das aktuell sichtbare Popupmenu in TPopupListEx(PopupList).PopupMenu speichern.
In WndProc > WM_EXITMENULOOP wird es dânn auf nil gesetzt.

Ich würde ja zum Setzen des aktuell sichtbaren Menus WM_ENTERMENULOOP nutzen aber ich brauche den Sender und den habe ich in WndProc nicht.

Delphi-Quellcode:

type
 TPopupMenu = class(Vcl.Menus.TPopupMenu)
 private
 protected
  procedure DoPopup(Sender: TObject); override;
 public
 end;

implementation

procedure TPopupMenu.DoPopup(Sender: TObject); // WIRD NIE AUFGERUFEN. WARUM?!
begin
 ShowMessage('ABC');
 TPopupListEx(PopupList).PopupMenu := Sender as TPopupMenu;

 inherited;
end;

[DeddyH]

Steht der Code in einer eigenen Unit? Wenn ja, ist diese im interface-Teil nach Menus eingebunden?

[Glados]

Zitat:

Wenn ja, ist diese im interface-Teil nach Menus eingebunden?

War sie nicht

Ich wusste nicht, dass das so sein muss. Danke! Gibt es denn eine Möglichkeit das irgendwie eleganter zu machen? Beispielsweise ohne ein überschriebenes DoPopup?
In procedure TPopupListEx.WndProc(var Message: TMessage); kann ich TPopupListEx(PopupList).PopupMenu auf Nil setzen. Aber umgekehrt beim Enter kann ich kein PopupMenu zuweisen, da ich keinen Sender habe. Deswegen habe ich aktuell die Lösung mit DoPopup. Aber geht das auch ohne?

[Uwe Raabe]

Delphi-Quellcode:

procedure TPopupMenu.Popup(X, Y: Integer);
begin
// TPopupListEx(PopupList).PopupMenu := Sender as TPopupMenu; // wie komme ich hier an den Sender?

  TPopupListEx(PopupList).PopupMenu := Self; // So! Schau mal in den Original-Code von TPopupMenu.Popup...

  inherited;
end;

Du müsstest nur noch erklären, wie du aus PopupList ein TPopupListEx machst. Das geht aus deinem Code-Beispiel nicht hervor.

[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.