TPopupMenu with group headers

[chkaufmann 17]

Hi,

 

I would like to add group headers in a TPopupmenu. So I can create things like this:

 

Are there any properties I didn't find yet in the standard VCL? Or can I do that with some additional methods in a TPopupMenu subclass?

 

Christian

[Pat Foley 51]

9 minutes ago, chkaufmann said:

Hi,

 

I would like to add group headers in a TPopupmenu. So I can create things like this:

Are there any properties I didn't find yet in the standard VCL? Or can I do that with some additional methods in a TPopupMenu subclass?

 

Christian

Menu.Break := mbBarbreak //mbbreak

 

example

 

      ScreenMenu.Break := mbBarBreak;
      ScreenMenu.Enabled := False;
     // ScreenMenu.Bitmap:= Image1.Picture.Bitmap; 
      ScreenMenu.Bitmap.LoadFromResourceName(HInstance,'BITMAP_3');
 

 

 

[chkaufmann 17]

Ok I added a disabled item ("Bearbeiten") in this case, but it's still aligned with all other items. And setting the Break property just adds a vertical line on the left side:

 

So what do I have to do to align the "Bearbeiten" Text at the left and to change the text color/background?

 

Christian

[Pat Foley 51]

More info.  

 

procedure TpfEngine.AddScreenMenuitems;
var
  tabpageCount: integer;      // used in menuclick handler and tag business
  ScreenMenu: TMenuitem;
begin
  menucount := 0;
  extendedTScount := 0;
  For tabPageCount:= 0 to ComponentCount - 1 do
   if Components[tabpageCount].ClassNameIs('TTabSheet')then
    if (Components[tabpageCount] as TTabSheet).TabVisible then
  begin
    inc(MenuCount);
    ScreenMenu:= TMenuItem.Create(self);
    ScreenMenu.caption:= (Components[tabPageCount]as TTabSheet).Caption;
    ScreenMenu.Tag:= tabPageCount;
    extendedTScount := ScreenMenu.Tag;
    ScreenMenu.onClick:= MenuScreenClick;
    // dirty patch
    if ScreenMenu.caption =  'Prime Mover' then
    begin
      ScreenMenu.Enabled := False;
      ScreenMenu.Bitmap.LoadFromResourceName(HInstance,'BITMAP_ST');//:= Image1.Picture.Bitmap;
    end;

   ....

  Screens.add(screenmenu)    // Screens:TMenuItem

end;

 

Edited August 12, 2021 by Pat Foley
insert code formatted

[Uwe Raabe 2057]

Add an OnDrawItem or OnAdvancedDrawItem event handler to these menu items with something like the following code:

  ACanvas.Font.Style := [TFontStyle.fsBold];
  ACanvas.TextRect(ARect, 1, 1, StripHotkey((Sender as TMenuItem).Caption));

As obviously styles are involved, you might have to take that into account, too.

[Remy Lebeau 1393]

3 hours ago, Pat Foley said:

Menu.Break := mbBarbreak //mbbreak

That does not produce the requested effect.  That is used for creating multi-column menus, not multi-group menus.

17 minutes ago, Uwe Raabe said:

Add an OnDrawItem or OnAdvancedDrawItem event handler to these menu items

This is the correct solution.  Menus simply have no concept of groups, so "group headers" is accomplished by custom-drawing those menu items differently.

Edited August 12, 2021 by Remy Lebeau

[nglthach 23]

@chkaufmann Something like this?

 

 

[chkaufmann 17]

Yes, this is what I need to do (grouping titles).

 

Regards
Christian

[mvanrijnen 123]

Isn't that why we have submenus ? (although they are an extra click away).

 

[David Duffy 0]

I think TMS have a menu that can do that.

[David Duffy 0]

@nglthach what was the component / solution you posted the image of?

[Steku 0]

Maybe this helps...https://edn.embarcadero.com/article/27128

 

Greetings...

[chkaufmann 17]

Thanks for all hints.

 

I created a subclass of TMenuItem and did an override of the AdvancedDrawItem method. In addition I set Enabled=False. Themes are not support, but I don't have that anyway in my application. But so far it looks fine:

 

 

procedure TMenuGroupItem.AdvancedDrawItem(ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState; TopLevel: Boolean);
begin
  ACanvas.Brush.Color := TColors.Silver.Lighten(50);
  ACanvas.FillRect(ARect);
  ACanvas.Font.Color := TColors.SysWindowText;
  ACanvas.TextRect(ARect, ARect.Left + 3, ARect.Top + 3, StripHotkey(Caption));
end;

 

Christian

[Guest]

11 minutes ago, chkaufmann said:

Themes are not support

DO test your implementation with multimonitor DPI. All kinds. Fastidiously!

[aehimself 396]

@chkaufmann This looks awesome!

 

Btw add Vcl.Themes to your uses list and use TStyleManager.ActiveStyle.GetStyleColor and GetStyleFontColor to add VCL style support to your code.

 

Questions, though:

- If you hover your mouse on the header does it get highlighted? I guess not because state is ignored in general but worth to ask...

- This is my bigger issue: clicking on a header will close the menu, right? Maybe this can be fixed by overriding protected methods of the TMenuItem / TPopupMenu

[chkaufmann 17]

Both "problems" are solved by setting Enabled=False for the group header item. Like this the color never changes and clicks on it are ignored.

 

Christian

[Lars Fosdal 1792]

Nice idea, @chkaufmann and nglthach.

I had to change it around a little to get it to work, as I instantiate the menu items at runtime.

Since I don't assign an OnClick handler, I don't need to disable the entry.

I mucked around with colors for a while.
Currently using Bold White on DarkGrey which works "ok" for both light and dark themes.

 

type
  TMenuItemGroup = class(TMenuItem)
  protected
    procedure DoAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
  public
    constructor Create(AOwner: TComponent); override;
  end;

constructor TMenuItemGroup.Create(AOwner: TComponent);
begin
  Inherited;
  OnAdvancedDrawItem := DoAdvancedDrawItem;
end;

procedure TMenuItemGroup.DoAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
begin
  ACanvas.Brush.Color := TColors.Darkgrey; // TColors.SysHighlight; // TColors.Darkblue;
  ACanvas.FillRect(ARect);
  ACanvas.Font.Color := TColors.White; // TColors.SysHighlightText; // TColors.White;
  ACanvas.Font.Style := [fsBold];
  ACanvas.TextRect(ARect, ARect.Left + 3, ARect.Top + 3, StripHotkey(Caption));
end;

 

[0x8000FFFF 22]

4 hours ago, Lars Fosdal said:

Since I don't assign an OnClick handler, I don't need to disable the entry.

Maybe you should disable the item anyway to prevent navigating to it using arrow keys.

[Lars Fosdal 1792]

Good point.

 

[aehimself 396]

I ended up combining the code of @chkaufmann and @Lars Fosdal plus added the always-disabled property. The end result fully supports VCL styles and looks awesome!

 

  

 

The full code became:

Unit uHeaderMenuItem;

Interface

Uses Vcl.Menus, Vcl.Graphics, WinApi.Windows, System.Classes;

Type
 THeaderMenuItem = Class(TMenuItem)
 strict private
  Procedure SetEnabled(Const inEnabled: Boolean);
  Function GetEnabled: Boolean;
 protected
  Procedure AdvancedDrawItem(ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState; TopLevel: Boolean); Override;
  Procedure DoAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
  Procedure Loaded; Override;
 Public
  Constructor Create(AOwner: TComponent); Override;
 published
  Property Enabled: Boolean Read GetEnabled Write SetEnabled;
 End;

Implementation

Uses Vcl.Themes, System.SysUtils;

Procedure THeaderMenuItem.AdvancedDrawItem(ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState; TopLevel: Boolean);
Begin
 Self.DoAdvancedDrawItem(Self, ACanvas, ARect, State);
End;

Constructor THeaderMenuItem.Create(AOwner: TComponent);
Begin
 inherited;

 Self.Enabled := False;
 OnAdvancedDrawItem := DoAdvancedDrawItem;
End;

Procedure THeaderMenuItem.DoAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
Begin
 ACanvas.Brush.Color := TStyleManager.ActiveStyle.GetStyleColor(scPanelDisabled);
 ACanvas.FillRect(ARect);
 ACanvas.Font.Color := TStyleManager.ActiveStyle.GetStyleFontColor(sfWindowTextNormal);
 ACanvas.Font.Style := [fsBold];
 ACanvas.TextRect(ARect, ARect.Left + 3, ARect.Top + 3, StripHotkey(Caption));
End;

Function THeaderMenuItem.GetEnabled: Boolean;
Begin
 Result := inherited Enabled;
End;

Procedure THeaderMenuItem.Loaded;
Begin
 inherited;

 Self.Enabled := False;
End;

Procedure THeaderMenuItem.SetEnabled(Const inEnabled: Boolean);
Begin
 inherited Enabled := False;
End;

End.

[aehimself 396]

Does anyone know what is the name of Delphi's menueditor? I only could find it in FMX but I guess I should be looking at the VCL version.

It would be nice to extend it so it is capable of adding header items.

[Lars Fosdal 1792]

Perhaps post a suggestion on https://quality.embarcadero.com ?

[David Duffy 0]

Is TStyleManager available in Delphi XE ?

Edited September 9, 2021 by David Duffy

[Remy Lebeau 1393]

25 minutes ago, David Duffy said:

Is TStyleManager available in Delphi XE ?

No, it was introduced in XE2.

[David Duffy 0]

OK, is there a way to get the ActiveStyle another way in XE ?