TPopupMenu with group headers

[aehimself 396]

@David Duffy I have no XE experience (went to 10.0-10.1 from 7) but you can fall back to the idea of @Lars Fosdal safely: TStyleManager is only used here to extract colors of the currently active style so the header will always "fit in" nicely.

[David Duffy 0]

I have it working nicely with fixed colours. Having it theme aware would have been nice but is not a real issue. It was more about learning.

[aehimself 396]

I don't know what causes this, but sometimes (even within the same project) this header menu item won't show correctly - neither of the draw methods are called. By experimenting I found out that turning OwnerDraw on on the popup menu itself fixes it on those affected.

Anyone has any ideas? How come some menus work correctly without and some required OwnerDraw to call the menu items drawing methods?

 

Edit: Also, assigning an imagelist fixes this, even if no menu items are using any image whatsoever.

Edited September 16, 2021 by aehimself

[Uwe Raabe 2057]

This should explain it:

  if (ParentMenu <> nil) and (ParentMenu.OwnerDraw or (ImageList <> nil)) and
    (Assigned(FOnAdvancedDrawItem) or Assigned(FOnDrawItem)) then

 

[Martin Wienold 35]

On 9/10/2021 at 12:32 AM, David Duffy said:

Is TStyleManager available in Delphi XE ?

Maybe the function ThemeServices in unit Themes is what you are looking for.

[dummzeuch 1505]

Just in case anybody is interested, here are two overloaded constructors that make it much more convenient to insert such group headers into a menu:

interface

type
  THeaderMenuItem = class(TMenuItem)
  public
    // default constructor as above
    constructor Create(AOwner: TComponent); overload; override;
    constructor Create(_ParentMenu: TMenuItem; _Idx: Integer; const _Caption: string); reintroduce; overload;
    constructor Create(_ParentMenu: TMenuItem; _InsertBefore: TMenuItem; const _Caption: string); reintroduce; overload;
  end;

implementation

constructor THeaderMenuItem.Create(_ParentMenu: TMenuItem; _Idx: Integer; const _Caption: string);
begin
  Create(_ParentMenu);
  Caption := _Caption;
  _ParentMenu.Insert(_Idx, Self);
end;

constructor THeaderMenuItem.Create(_ParentMenu, _InsertBefore: TMenuItem; const _Caption: string);
var
  Idx: Integer;
begin
  Idx := _ParentMenu.IndexOf(_InsertBefore);
  Create(_ParentMenu, Idx, _Caption);
end;

 

And, as I just found out: Don't forget to set the Style property of the menu to msOwnerDraw set the OwnerDraw property of the menu to True!

Edited January 17, 2022 by dummzeuch

[dummzeuch 1505]

And here is a doAdvancedDrawItem method that works with older Delphi versions (tested with Delphi 2007)

procedure THeaderMenuItem.DoAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
begin
{$IF declared(TStyleManager)}
  ACanvas.Brush.Color := TStyleManager.ActiveStyle.GetStyleColor(scPanelDisabled);
  ACanvas.Font.Color := TStyleManager.ActiveStyle.GetStyleFontColor(sfWindowTextNormal);
{$ELSE}
  ACanvas.Brush.Color := clDkGray;
  ACanvas.Font.Color := clWhite;
{$IFEND}
  ACanvas.Font.Style := [fsBold];
  ACanvas.FillRect(ARect);
  ACanvas.TextRect(ARect, ARect.Left + 3, ARect.Top + 3, StripHotkey(Caption));
end;

To get it to compile with Delphi 2007, just remove the unit namespaces from the uses list. Adjust the colors to your liking.