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

Delphi-Quellcode:

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:

Zitat von Glados (Beitrag 1383741)

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 :shock:

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.

[Uwe Raabe]

Nur so 'ne Idee: Du könntest auch in der WndProc auf WM_INITMENUPOPUP (Sent when a drop-down menu or submenu is about to become active.) reagieren und das aktuelle PopupMenu anhand des Handles suchen. Dann sparst du dir die Ableitung von TPopupMenu ganz:

Delphi-Quellcode:

    
 case message.msg of
   WM_INITMENUPOPUP: 
   begin
     for I := 0 to Count - 1 do begin
       if TPopupMenu(Items[I]).Handle = TWMInitMenuPopup(Message).MenuPopup then begin
         { sollte nie erreicht werden, wenn ein SubMenu geöffnet wird }
         PopupMenu := TPopupMenu(Items[I]);
         Break;
       end;
     end;
   end;
   WM_ENTERMENULOOP:
   begin
     MenuLoop := True; // Menu sichtbar
   end;
   WM_EXITMENULOOP:
   begin
     MenuLoop := False; // Menu nicht mehr sichtbar
     PopupMenu := nil;
   end;
 end;

[Glados]

Das ist natürlich die elegantere Lösung.

Delphi-Quellcode:

for I := 0 to Count - 1 do

Warum genau denn bis Count-1? Geht man hier einfach auf verdacht bis in einen sehr hohen Bereich?

[Uwe Raabe]

Zitat:

Zitat von Glados (Beitrag 1383789)

Delphi-Quellcode:

for I := 0 to Count - 1 do

Warum genau denn bis Count-1? Geht man hier einfach auf verdacht bis in einen sehr hohen Bereich?

In PopupList registriert sich jede TPopupMenu-Instanz beim Create und meldet sich im Destroy wieder ab. Die aktuelle Anzahl der Einträge einer Liste steht in Count und das erste Element hat den Index 0. Deswegen durchläuft

Delphi-Quellcode:

for I := 0 to Count - 1 do

die gesamte Liste. Da wir in der Message lediglich das Handle des Menüs bekommen, suchen wir die dazu passende Instanz in der For-Schleife. Sobald diese gefunden ist, bricht das Break die Schleife ab.

[Glados]

Danke für die Erklärung!

[Glados]

Es gibt leider ein neues komisches Problem :(

Wenn man das Popupmenu wie folgt sucht sollte es eigentlich der Variablen zugewiesen werden

Delphi-Quellcode:

WM_INITMENUPOPUP: // PopupMenu anhand des Handles finden
   begin
    for i := 0 to Count - 1 do
     begin
      if TPopupMenu(Items[i]).Handle = TWMInitMenuPopup(Message).MenuPopup then
       begin
        PopupMenu := TPopupMenu(Items[i]);
        Break;
       end;
     end;
   end;

Wenn ich in einer anderen Unit nun etwas teste, bekomme ich 'X' nie zu sehen, obwohl die Unit korrekt in den uses steht. Stattdessen sehen ich "nil":

Delphi-Quellcode:

// Steht im OnPopup meines PopupMenus

if TPopupListEx(PopupList).PopupMenu = nil then
 ShowMessage('nil')
else if TPopupListEx(PopupList).PopupMenu = FrmMain.PopupMenu2 then
 showmessage('X');

Selbst mein alter Code mit procedure DoPopup(Sender: TObject); override; funktioniert jetzt nicht mehr und DoPopup wird nie aufgerufen. Das ist mehr als seltsam. Mal funktioniert das, mal nicht, obwohl ich doch nur wissen möchte, welches das aktuell geöffnete PopupMenu ist ...

Noch seltamer: jetzt bekomme ich nicht mal mehr diese Showmessage angezeigt

Delphi-Quellcode:

procedure TForm1.PopupMenu2Popup(Sender: TObject);
begin
 showmessage('Popup');
 ...
end;

[Uwe Raabe]

Prüf doch mal die Reihenfolge der Aufrufe im Debugger. Eventuell kommt die WM_INITMENUPOPUP Message ja erst nach dem DoPopup.

[Glados]

Ich werde mir das gleich mal genau angucken.
Ein Problem habe ich jedenfalls schon gefunden.

Ich verwende ein ListView. Beim Selektieren eines Items wird Prozedur X aufgerufen. Diese prüft gewisse Dinge und passt das dementsprechend eine Toolbar an.

Nun aber das Problem.
das Popup-Event meines PopupMenus ruft diese Prozedur auch auf. In der Reihenfolge kommt aber zuerst ListView > OnSelectItem.
Das heißt hier wird Prozedur X zweimal aufgerufen denn OnSelectItem.

In Prozedur X prüfe ich außerdem, welches PopupMenu gerade geöffnet ist, um unnötigen Code nicht erst auszuführen.
Durch dieses Reihenfolgen-Problem wird X aber zweimal aufgerufen.

Wenn ich in OnSelectItem also herausfinden könnte, ob es einen Rechtsklick der Maus gab bzw ob der Windows-Kontextmenu-Knopf (VK_APPS) gedrückt wurde, könnte ich das verhindern.
Aber wie kommt man in OnSelectItem an diese Infos?
OnMouseDown ist schon zu spät. Das wird erst nach OnSelectItem ausgeführt.

Ich hatte gerade ganz grob das hier im Kopf:

Delphi-Quellcode:

if (GetAsyncKeyState(VK_RBUTTON) = 0) and (GetAsyncKeyState(VK_APPS) = 0) then

Was mir auch bei einem anderen Problem helfen würde, wäre wenn ich das MenuClose von PopupMenu überschreiben könnte. Aber das darf man scheinbar nicht.

[Uwe Raabe]

Keine Ahnung, ob ich das richtig verstanden habe, aber kannst du der Methode X nicht einen zusätzlichen Parameter mitgeben, der das Popupmenü angibt? Im OnSelectItem übergibst du einfach nil und im OnPopup dann (Sender as TPopupMenu). Kannst du dir gesamte Mimik mit WndProc und geerbten Klassen dann nicht einfach sparen?

[Glados]

Ich denke das würde funktionieren.

Ich dachte nur, dass ich diese Unit mit WndProc usw. später gut verwenden könnte, wenn ich mal wissen muss welches PopupMenu denn offen ist.

Ich habe jetzt mal all den PopupMenu WndProc-Kram gelöscht und mache es mit dem Parameter.
Sollte ich irgendwann in Zukunft meine WndProc-Sache brauchen, kann ich sie ja noch immer nutzen.

Jetzt habe ich nur noch das Problem mit GetKeyState.
DAMIT das sauber bleibt mache ich dafür ein eigenes Thema auf.