TMainMenu: Änderung der Schriftgröße ändert nicht den Abstand der Einträge

[KHJ]

Wenn ich die Schriftgröße des TMainMenu während der Laufzeit ändern will, dann muss ich das über Screen.MenuFont.Assign(EinFont) machen.
Das erfordert auch, dass IM Objektinspektor die Eigenschaft OwnerDraw := true setze.
Das funktioniert auch so weit.

Aber der Abstand zwischen den Menüeinträgen verändert sich nicht und dadurch sieht es unschön aus oder ist nicht mehr vollständig lesbar.

Ist das ein Bug?
Und wie kann ich das beheben?

Karlheinz

[Uwe Raabe]

Zitat:

Zitat von KHJ (Beitrag 1549531)

Ist das ein Bug?

Nein.

Zitat:

Zitat von KHJ (Beitrag 1549531)

Und wie kann ich das beheben?

In dem du die OnMeasureItem-Events der jeweiligen MenuItems sinnvoll implementierst.

[DaCoda]

So wie von Uwe schon angedeutet. Etwa so:

Code:

procedure TForm1.MainMenu1MeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
begin
  // Weite und Höhe vom MenuItem
  Width := ACanvas.TextWidth('Custom Menu Item Text') + 20; // 20px Padding
  Height := ACanvas.TextHeight('Custom Menu Item Text') + 10; // 10px Padding
end;

[jaenicke]

Leider wird das alles nicht aufgerufen. Es kommt gar nicht erst WM_MEASUREITEM, so dass es keinerlei Unterschied macht, ob die Events zugewiesen sind oder nicht.

Auch DrawMenuBar usw. bringt nichts. Und die Möglichkeiten zur Neuerstellung des Handles sind so eingekapselt, dass man da nicht so einfach herankommt. So funktioniert es korrekt (zum Testen einfach die Typdeklaration über das Formular schreiben, damit unser TMenuItem statt dem aus Vcl.Menus verwendet wird):

Delphi-Quellcode:

type
  TMenuItem = class(Vcl.Menus.TMenuItem)
  public
    procedure Rebuild;
  end;

procedure CallByAddress(Instance: TObject; Address: Pointer);
type
  TRebuildHandleProc = procedure of object;
var
  Method: TMethod;
  Proc: TRebuildHandleProc;
begin
  Method.Code := Address;
  Method.Data := Instance;
  Proc := TRebuildHandleProc(Method);
  Proc;
end;

procedure TMenuItem.Rebuild;
begin
{$if CompilerVersion = 36}
  CallByAddress(Self, Pointer(NativeUInt(@TMenuItem.Insert) - $34B4));
{$else}
  {$message error 'Die Adresse muss für diese Delphiversion ggf. angepasst werden!'}
{$ifend}
  MenuChanged(True);
end;

Aufruf:

Delphi-Quellcode:

var
  i: Integer;
begin
  Screen.MenuFont.Size := 16;
  for i := 0 to MainMenu1.Items.Count - 1 do
    TMenuItem(MainMenu1.Items[i]).Rebuild;
end;

[KHJ]

Danke für die Tips.
Der einfachste Weg, der fast alles abdeckt:

Delphi-Quellcode:

  // set the menu font
  Screen.MenuFont.Assign(Self.Font);

  // push and redraw the menu by inserting and deleting a menu item
  lTempItem := TMenuItem.Create(mmuMainMenu);
  try
    lTempItem.Name := 'tempitem';
    mmuMainMenu.Items.Add(lTempItem);
    mmuMainMenu.Items.Remove(lTempItem);
  finally
    lTempItem.Free;
  end;

[KHJ]

Um nicht nur den Toplevel zu ändern, sondern auch alle Submenus:

Delphi-Quellcode:

  procedure RefreshMenuItem(aMenuItem: TMenuItem);
  var
    lTempItem: TMenuItem;
    i: Integer;
  begin

    lTempItem := TMenuItem.Create(aMenuItem);
    try
      lTempItem.Caption := 'tempitem';
      aMenuItem.Add(lTempItem);
      aMenuItem.Delete(aMenuItem.Count - 1);
    finally
      lTempItem.Free
    end;

    // and rekursiv through all sub menus of the current menu item
    for i := 0 to aMenuItem.Count - 1 do
    begin
      RefreshMenuItem(aMenuItem.Items[i]);
    end;
  end;

  procedure RefreshMainMenu(aMenu: TMainMenu);
  var
    i: Integer;
    lTempItem: TMenuItem;
  begin

    // toplevel
    lTempItem := TMenuItem.Create(aMenu);
    try
      lTempItem.Name := 'tempitem';
      aMenu.Items.Add(lTempItem);
      aMenu.Items.Remove(lTempItem);
    finally
      lTempItem.Free;
    end;

    // sublevels
    for i := 0 to aMenu.Items.Count - 1 do
    begin
      RefreshMenuItem(aMenu.Items[i]);
    end;
  end;

[Uwe Raabe]

Zitat:

Zitat von jaenicke (Beitrag 1549560)

Leider wird das alles nicht aufgerufen.

Das kommt schon, wenn man beim Menü das OwnerDraw auf True stellt. Diese Einstellung wurde auch im Eingangspost erwähnt.

[jaenicke]

Zitat:

Zitat von Uwe Raabe (Beitrag 1549572)

Das kommt schon, wenn man beim Menü das OwnerDraw auf True stellt.

Bei mir nicht, das habe ich schon alles versucht. Vermutlich ist das so, weil die Schriftart keine Änderung ist, die Windows kennt. Dementsprechend besteht systemseitig keine Notwendigkeit für eine erneute Größenberechnung.

Ich habe direkt geschaut, ob die Windows Messages ankommen. Das war nicht der Fall. Und entsprechend wurden auch die Haltepunkte in der Methode, die am Ende das Event aufruft, und an anderen Stellen nicht erreicht.

Ist das bei dir anders?

[Uwe Raabe]

Ist es in der Tat (Delphi 12.3 latest Patches, Windows 10 22H2).

[KHJ]

Zitat:

Zitat von Uwe Raabe (Beitrag 1549575)

Ist es in der Tat (Delphi 12.3 latest Patches, Windows 10 22H2).

On start up of the form yes, but not after a change of Screen.MenuFont.

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
begin
 if FontDialog1.Execute then
 begin
   Self.Caption := Fontdialog1.Font.Name;
   Screen.MenuFont.Assign(FontDialog1.Font);
 end;
end;

procedure TForm1.File1MeasureItem(Sender: TObject; ACanvas: TCanvas; var Width,
    Height: Integer);
begin
//
end;