TMainMenu/TMenuItem problem mit Vcl.Themes

[KodeZwerg]

Hallo liebe DP!

Ich bin mal wieder auf ein Problem gestoßen, an dem, so hoffe ich jedenfalls, ich keine Schuld habe.

Folgendes mache ich, ich erstelle auf einer Form ein MainMenu, per Designer erstelle ich einen Menupunkt.
Im FormCreate rufe ich dann eine mehode auf die diesen Menupunkt füllt.

Das klappt auch alles sehr gut.

Nun das Problem, wenn ich vom jetzigen in ein anderes Vcl.Theme wechsle wird das Menu immer oberhalb der Form dargestellt.
Das nervt aber ist noch nicht das eigentliche Problem.
Wenn oberhalb der Form kein Platz ist (Monitor begrenzt den Spielraum) schließt sich das Menu automatisch wieder.

Kann man das ändern bzw ist das ein Bug?

Hier der Code wie ich das Menu fülle und das entsprechende OnClick-Event:

Delphi-Quellcode:

procedure kzTheme.AddNativeStyle(const AMenuItem: TMenuItem);
  procedure AddMenuEntry(const ACaption: string; const AValue: Integer);
  var
    Item: TMenuItem;
  begin
    Item := TMenuItem.Create(FMenuItem);
    Item.Caption := ACaption;
    Item.OnClick := NativeStyleClick;
    if TStyleManager.ActiveStyle.Name = ACaption then
      Item.Checked := True;
    if ((AValue) mod 10) = 0 then
      Item.Break := mbBarBreak;
    FMenuItem.Add(Item);
  end;
var
  Arr: TArray<string>;
  SystemStyle: string;
  FoundStyle: String;
  i: Integer;
begin
  FMenuItem := AMenuItem;
  FMenuItem.Clear;
  FMenuItem.AutoLineReduction := maAutomatic;

  arr := TStyleManager.StyleNames;
  TArray.Sort<string>(arr);
  SystemStyle := TStyleManager.SystemStyle.Name;
  AddMenuEntry(SystemStyle, 0);

  i := 1;
  for FoundStyle in arr do
  begin
    if FoundStyle <> SystemStyle then
    begin
      AddMenuEntry(FoundStyle, i);
      Inc(i);
    end;
  end;
end;

procedure kzTheme.NativeStyleClick(Sender: TObject);
var
  StyleName: String;
  i: Integer;
begin
  StyleName := StringReplace(TMenuItem(Sender).Caption, '&', '',
    [rfReplaceAll, rfIgnoreCase]);
  TStyleManager.SetStyle(StyleName);
  (Sender as TMenuItem).Checked := true;
  for i := 0 to Pred(FMenuItem.Count) do
    if (not FMenuItem.Items[i].Equals(Sender)) then
      FMenuItem.Items[i].Checked := false;
end;

Im OnCreate des Hauptformulars steht halt nur MyTheme.AddNativeStyle(mnuVcl); . (mnuVcl ist der von mir per Designer erzeugte Menupunkt)

Danke fürs Lesen!

[himitsu]

Man kann auch irgendwie selbst festlegen, wo das Popup auf geht.

Beim manuellen Anzeigen, als Parameter im PopupMenu.Popup(X, Y);,
aber wie das beim auomatischen Öffnen ging, also z.B. im OnPopup, weiß ich grad nicht. (glaub aber das ging auch irgendwie)

Oder im OnMouseUp/OnKeyUp selbst das Popup öffnen.






StringReplace?

StripHotkey

Zitat:

Delphi-Quellcode:

  (Sender as TMenuItem).Checked := true;
  for i := 0 to Pred(FMenuItem.Count) do
    if (not FMenuItem.Items[i].Equals(Sender)) then
      FMenuItem.Items[i].Checked := false;

?

Delphi-Quellcode:

  for i := 0 to Pred(FMenuItem.Count) do
      FMenuItem.Items[i].Checked := FMenuItem.Items[i].Equals(Sender);

Oder einfach ganz weg damit und die Automatik arbeiten lassen.
Bei all diesen Items AutoCheck:=True; und GroupIndex:=1; (oder welche Gruppe halt noch frei ist)

[KodeZwerg]

Delphi-Quellcode:

procedure kzTheme.AddNativeStyle(const AMenuItem: TMenuItem);
  procedure AddMenuEntry(const ACaption: string; const AValue: Integer);
  var
    Item: TMenuItem;
  begin
    Item := TMenuItem.Create(FMenuItem);
    Item.Caption := ACaption;
    Item.OnClick := NativeStyleClick;
    Item.AutoCheck := True;
    Item.GroupIndex := 1;
    if TStyleManager.ActiveStyle.Name = ACaption then
      Item.Checked := True;
    if ((AValue) mod 10) = 0 then
      Item.Break := mbBarBreak;
    FMenuItem.Add(Item);
  end;
var
  Arr: TArray<string>;
  SystemStyle: string;
  FoundStyle: String;
  i: Integer;
begin
  FMenuItem := AMenuItem;
  FMenuItem.Clear;
  FMenuItem.AutoLineReduction := maAutomatic;

  arr := TStyleManager.StyleNames;
  TArray.Sort<string>(arr);
  SystemStyle := TStyleManager.SystemStyle.Name;
  AddMenuEntry(SystemStyle, 0);

  i := 1;
  for FoundStyle in arr do
  begin
    if FoundStyle <> SystemStyle then
    begin
      AddMenuEntry(FoundStyle, i);
      Inc(i);
    end;
  end;
end;

procedure kzTheme.NativeStyleClick(Sender: TObject);
var
  StyleName: String;
begin
  StyleName := StripHotkey(TMenuItem(Sender).Caption);
  TStyleManager.SetStyle(StyleName);
end;

Danke für diese Hinweise, aber nun bleibt der Haken (checked) an, je mehr ich rumspiele um so mehr Haken sind gesetzt?!
StripHotkey kannte ich noch nicht, Danke für diese Perle!

(das hauptmenu besitzt nur die grundeinstellungen die delphi setzt wenn man es auf Form platziert, da habe ich weder fürs menu noch für den menupunkt irgendwas verändert, abgesehen vom Namen.)


Also ist es ein Bug das der das Menu ab einem wechsel oben malt bzw automatisch schließt wenn kein platz über dem Formular frei ist?

[himitsu]

Hmmmm, Items in der selben Gruppe (<>0) da sollte eigentlich nur ein Item aktiv sein.
Wird Einer AutoChecked, müsten die Anderen ausgehn, ähnlich den RadioButton/RadioGroup.

[add]
Ahhh .RadioItem noch auf True.
Mir ist so, als wenn (ganz) früher mal nur das Setzen von GroupIndex für die RadioButton-Funktion ausgereicht hat.

[Delphi.Narium]

Versteh' ich nicht:

Delphi-Quellcode:

   if TStyleManager.ActiveStyle.Name = ACaption then
      Item.Checked := True;

Warum nicht:   Item.Checked := TStyleManager.ActiveStyle.Name = ACaption;

[KodeZwerg]

Danke Delphi.Narium, recht hast Du, wozu ein "If" wenn es auch ohne geht
Danke himitsu, nun sind es zwar keine Haken mehr sondern Punkte (Radio halt) aber zumindest ist es nur einer

Bleibt der Bug mit der Positionierung.
Ich probiere mal ein kleines Demo-Projekt abzukapseln ob es sich da auch so verhält oder ob in meiner Anwendung irgendwas dazwischen funkt.

[KodeZwerg]

Delphi-Quellcode:

unit Unit14;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.Themes, System.Generics.Collections;

type
  TForm14 = class(TForm)
    MainMenu1: TMainMenu;
    mnuStyles: TMenuItem;
    procedure FormCreate(Sender: TObject);
  strict private
    FMenuItem: TMenuItem;
  private
    procedure NativeStyleClick(Sender: TObject);
  public
    procedure AddNativeStyle(const AMenuItem: TMenuItem);
  end;

var
  Form14: TForm14;

implementation

{$R *.dfm}

procedure TForm14.AddNativeStyle(const AMenuItem: TMenuItem);
  procedure AddMenuEntry(const ACaption: string; const AValue: Integer);
  var
    Item: TMenuItem;
  begin
    Item := TMenuItem.Create(FMenuItem);
    Item.Caption := ACaption;
    Item.OnClick := NativeStyleClick;
    Item.RadioItem := True;
    Item.AutoCheck := True;
    Item.GroupIndex := 1;
    Item.Checked := TStyleManager.ActiveStyle.Name = ACaption;
    if ((AValue) mod 10) = 0 then
      Item.Break := mbBarBreak;
    FMenuItem.Add(Item);
  end;
var
  Arr: TArray<string>;
  SystemStyle: string;
  FoundStyle: String;
  i: Integer;
begin
  FMenuItem := AMenuItem;
  FMenuItem.Clear;
  FMenuItem.AutoLineReduction := maAutomatic;

  arr := TStyleManager.StyleNames;
  TArray.Sort<string>(arr);
  SystemStyle := TStyleManager.SystemStyle.Name;
  AddMenuEntry(SystemStyle, 0);

  i := 1;
  for FoundStyle in arr do
  begin
    if FoundStyle <> SystemStyle then
    begin
      AddMenuEntry(FoundStyle, i);
      Inc(i);
    end;
  end;
end;

procedure TForm14.NativeStyleClick(Sender: TObject);
var
  StyleName: String;
begin
  StyleName := StripHotkey(TMenuItem(Sender).Caption);
  TStyleManager.SetStyle(StyleName);
end;

procedure TForm14.FormCreate(Sender: TObject);
begin
  AddNativeStyle(mnuStyles);
end;

end.

Im Anhang das was bei mir passiert.

Und ich werde das NativeStyleClick wieder auf meinen Original-Zustand bringen auch wenn vom Code her falsch ausschaut.
Mit himitsus Verbesserungen funktioniert es, aber noch buggy.
Wählt man nun ein Item aus = alles super.
Wählt man das gleiche nochmal aus = verschwindet der RadioButton. Also es ist nichts visuell selektiert.

Sollte man diesen Bug melden oder ist der bereits bekannt?

[Delphi.Narium]

Zitat von KodeZwerg:

Danke Delphi.Narium, recht hast Du, wozu ein "If" wenn es auch ohne geht

Bei dem If fehlte aber auch die Else. Checked hätte eigentlich bei allen Items, bei denen das If nicht zutraf, auf false gesetzt werden müssen

Checked und Co. arbeiten nun mal halt als Flipflop. Klick = If Checked then Not Checked else Checked.

Klick <> ich bin nicht gechecked und werde durch Klick gecheckt und damit alle anderen ungechecked

Es könnte sein, dass Dir der GroupIndex dort gewaltig zwischenfunkt.

Setze den mal bei allen auf -1 (oder sonstwas < 0) und dann eine Ereignisroutine auf's Klick, die beim Geklickten Checked setzt (und alles damit zusammenhängende veranlasst) und bei allen anderen entfernt.

Ist Checked beim Klick schon gesetzt, passiert genau nix.

Sprich:

Zitat:

Wählt man das gleiche nochmal aus = verschwindet der RadioButton. Also es ist nichts visuell selektiert.

Sollte man diesen Bug melden oder ist der bereits bekannt?

Ist kein Bug sondern defniniertes Verhalten.

Delphi-Quellcode:

// Klick auf Item ergibt sinngemäß:
case Item.Checked of
  true : Item.Checked := false;
  false : Item.Checked := true;
end;

Gibt es weitere Abhängigkeiten, muss man die im zugehörigen Ereignis selbst implementieren.

Die an den Itmes erforderlichen Änderungen (Checked := false o. ä.) wird Dir TStyleManager.SetStyle(StyleName); nicht abnehmen. Wie auch, es weiß doch nichtmal, dass es aufgrund eines Menüklicks aufgerufen wurde.

Wird's mit sowas besser?

Delphi-Quellcode:

procedure TForm14.NativeStyleClick(Sender: TObject);
var
  StyleName: String;
  i        : Integer;
begin
  for i := 0 to AMenuItem.Count - 1 do AMenuItem.Items[i].Checked := false;
  TMenuItem(Sender).Checked := true;
  StyleName := StripHotkey(TMenuItem(Sender).Caption);
  TStyleManager.SetStyle(StyleName);
end;

[himitsu]

Oberhalb des Buttons ist per se nicht "falsch",
aber auch bei normalen Popups wundere ich mich manchmal.

z.B. die Contextmenüs in der Delphi-IDE.
Obwohl rechts noch mehr als genug Platz ist, gehen SubMenüs oftmals links auf. Oder nach oben, obwohl unten noch genug Platz wäre.

[Uwe Raabe]

Zitat von himitsu:

z.B. die Contextmenüs in der Delphi-IDE.
Obwohl rechts noch mehr als genug Platz ist, gehen SubMenüs oftmals links auf. Oder nach oben, obwohl unten noch genug Platz wäre.

Kann das an einer Auflösung <> 100% liegen?