Jump to content
chkaufmann

TPopupMenu with group headers

Recommended Posts

@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.

Share this post


Link to post

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.

Share this post


Link to post

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 by aehimself

Share this post


Link to post

This should explain it:

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

 

  • Thanks 1

Share this post


Link to post
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.

  • Like 1

Share this post


Link to post

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 by dummzeuch
  • Like 1
  • Thanks 1

Share this post


Link to post

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.

  • Like 1
  • Thanks 2

Share this post


Link to post

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×