WMContextMenu-Apokalpse

[TiGü]

Hi Gemeinde,

ich programmiere jetzt über 10 Jahre in dieser Sprache und Umgebung, aber manche Dinge überraschen mich dann doch.

Ein Kollege bemerkte etwas Merkwürdiges:
Wenn in meinen neu geschaffenen Frame rechtsgeklickt wird, friert die Applikation ein.
Die CPU-Auslastung eines Kerns geht hoch und der VCL-Mainthread rödelt sich einen Wolf, hört dann nach einiger Zeit aber auf.
"Sch***e!", dachte ich mir, "Oberflächenprogrammierung ist hart und eigentlich nicht so mein Steckenpferd, was habe ich denn jetzt kaputt gemacht, uff..."

Das Problem ist sowohl in unseren XE5, als auch Sydney (10.4.2) Kompilaten zu finden.

Einiges hin und her mit AQtime und tiefes Debugging in den VCL-Sourcen brachte dann folgende Erkenntnis zu Tage:
Unsere Schachtelungstiefe für Komponenten scheint (zu) hoch zu sein oder der Weg, wie ein Popup-/Contextmenu in der VCL ermittelt wird, ist Mist.



Im Problemfall habe ich beispielsweise eine Verschachtelungstiefe von 18 bis 19: Mainform | Panel | Panel | Panel | Frame | Panel | Pagecontrol | TabSheet | Pagecontrol | TabSheet | ScrollBox | Frame | Panel | Panel | Frame | Frame | Frame | Panel | Panel
Das Problem lässt sich auch mit simplen geschachtelten TPanels nachvollziehen.
Siehe dazu angehängte Beispielapplikation.

RightClickTestProject2_2021-07-06.zip

Bei einem Klick auf das unterste visuelle Element in der Verschachtelung fängt die VCL an einen tierischen Aufwand zu betreiben, um ein Popupmenu zu finden.

Beispiel-Callstack:

Code:

... // geht hier weiter und weiter
Vcl.Controls.TControl.WMContextMenu((1700976, (), 1700880, -3468, 25, (), (-3468, 25), (), 5568898))
Vcl.Controls.TWinControl.WMContextMenu((123, (), 1514020, 1053, 543, (), (1053, 543), (), 0))
Vcl.Controls.TControl.WndProc((123, 1514020, 35587101, 0, 6692, 23, (), 1053, 543, (), 0, 0, ()))
Vcl.Controls.TWinControl.WndProc((123, 1514020, 35587101, 0, 6692, 23, (), 1053, 543, (), 0, 0, ()))
Vcl.Controls.TControl.Perform(???,???,35587101)
Vcl.Controls.TWinControl.DefaultHandler((no value))
Vcl.Controls.TControl.WMContextMenu((123, (), 1514020, 1053, 543, (), (1053, 543), (), 0))
Vcl.Controls.TWinControl.WMContextMenu((123, (), 1514020, 1053, 543, (), (1053, 543), (), 0))
Vcl.Controls.TControl.WndProc((123, 1514020, 35587101, 0, 6692, 23, (), 1053, 543, (), 0, 0, ()))
Vcl.Controls.TWinControl.WndProc((123, 1514020, 35587101, 0, 6692, 23, (), 1053, 543, (), 0, 0, ()))
Vcl.Controls.TWinControl.MainWndProc(???)
System.Classes.StdWndProc(1514020,123,1514020,35587101)

Meine Messungen der Durchläufe durch TControl.WMContextMenu ergab, dass pro Verschachtelungsschicht n sich folgende Formel ergibt:
WMContextMenu_Call_Count := (2^n) - 1;

Bei einem Rechtsklick auf die Form kommen wir nur einmal durch.
Bei einem Panel auf der Form dreimal.
Bei einem Panel im Panel auf der Form insgesamt 7 mal.
Panel im Panel im Panel auf der Form sind es 15 Durchläufe.

Ich vermute, die VCL sucht im aktuellen rechtsgeklickten Control nach einen Popupmenu, findet nichts und fragt den Parent und der guckt und fragt alle seine Children.
Dann wird nichts gefunden und der Aufruf weiter nach oben gereicht, wo dieser übergeordnete Parent erstmal alle Children fragt usw. usf.

Hier spielen eine Menge Aufrufe von mit dynamic; gekennzeichneten Methoden mit rein, so dass es teuer wird, die über die Dynamic Method Table (DMT -> http://hallvards.blogspot.com/2006/0...structure.html) aufzulösen.

Kennt ihr das auch und wenn ja, wie war/wäre euer Lösungsansatz für das Problem?
Einfach leere Popupmenus zwischendurch einfügen, damit nicht hoch zur Mainform nach etwas gesucht wird, was ggf. gar nicht da ist oder
die TControl.WMContextMenu geschickt irgendwo überschreiben?
Gibt vielleicht eine noch einfachere Möglichkeit (die eine Property im Objekt-Inspektor, die man immer übersieht oder so?).

[Uwe Raabe]

Das scheint in der Tat ein Designfehler zu sein. Das angeklickte Control gibt in TWinControl.DefaultHandler erstmal an den jeweiligen Parent weiter (Panel10, Panel9, ... Panel1, Form2).

Delphi-Quellcode:

      if (Msg = WM_CONTEXTMENU) and (Parent <> nil) then
      begin
        Result := Parent.Perform(Msg, WParam, LParam);
        if Result <> 0 then Exit;
      end;

Bis auf Form2, bei dem es ja keinen Parent gibt, wird danach aber noch ein CallWindowProc-Aufuf durchgeführt, der aber am Ende wiederum im WMContextMenu des Controls landet und dort wieder die Leiter der Controls hinaufklettert, was dann zu diesem exponentiellen Wachstum der Durchläufe führt.

Delphi-Quellcode:

          Result := CallWindowProc(FDefWndProc, WindowHandle, Msg, WParam, LParam);

Beispielhaft hier mal die Liste der Aufrufe für einen Klick in Panel3:
Panel3, Panel2, Panel1, Form2, Form2, Panel1, Form2, Form2, Panel2, Panel1, Form2, Form2, Panel1, Form2, Form2

Eigentlich sollte das anfängliche Hochhängeln zum Form ausreichen und die Überprüfung auf Result <> 0 vor dem Exit entfallen. Mit dieser Code-Änderung in TWinControl.DefaultHandler wird das Laufzeitverhalten auch wieder akzeptabel.

Delphi-Quellcode:

      if (Msg = WM_CONTEXTMENU) and (Parent <> nil) then
      begin
        Result := Parent.Perform(Msg, WParam, LParam);
        Exit;
      end;

Als Workaround kannst du z.B. im Form die WM_CONTEXTMENU Message abfangen und den Result auf 1 setzen.

Delphi-Quellcode:

    procedure WMContextMenu(var Message: TWMContextMenu); message WM_CONTEXTMENU;
...

procedure TForm2.WMContextMenu(var Message: TWMContextMenu);
begin
  inherited;
  Message.Result := 1;
end;

[Uwe Raabe]

Right Click extremely slow when no context menu is available

[TiGü]

Vielen Dank Uwe für das Bestätigen des Problems und das Erstellen des hervorragenden Jira-Vorgangs.
Kann erst am Montag testen, ob Dummy-Popup oder Überschreiben des WMContextMenu-Handlers der für mich passende Weg ist.

Interessant wäre noch, ob es eine Regression ist und es vor Urzeiten noch passabel funktioniert hat.

[Uwe Raabe]

Zitat von TiGü:

Interessant wäre noch, ob es eine Regression ist und es vor Urzeiten noch passabel funktioniert hat.

Ich habe es in allen aktuell hier installierten Delphi-Versionen (D5, D7, D2007 bis 10.4 Sydney) nachgesehen und die Abfrage ist immer vorhanden. Kann natürlich sein, dass es zwischenzeitlich Versionen gab, wo das nicht so war, das aber in einem Update wieder zurückgenommen wurde.

Einen Performancetest habe ich allerdings noch nicht vorgenommen. Dafür ist mein Testprogramm wegen der Memo-Ausgaben auch weniger geeignet.

Zitat von TiGü:

Kann erst am Montag testen, ob Dummy-Popup oder Überschreiben des WMContextMenu-Handlers der für mich passende Weg ist.

Dritte Möglichkeit wäre auch den OnContextPopup des Forms zu verdrahten und dort das Handled auf True zu setzen.