lcl: add ownerdrawn menu support (for now win32 only). Issue #26969

git-svn-id: trunk@51466 -

lcl/include/menu.inc

@@ -53,7 +53,7 @@ begin
   FItems.UpdateImages;
 end;
 
-procedure TMenu.SetBidiMode(const AValue: TBidiMode);
+procedure TMenu.SetBiDiMode(const AValue: TBiDiMode);
 begin
   if FBidiMode=AValue then exit;
   FBidiMode:=AValue;
@@ -62,7 +62,7 @@ begin
     BidiModeChanged;
 end;
 
-procedure TMenu.SetParentBidiMode(const AValue: Boolean);
+procedure TMenu.SetParentBiDiMode(const AValue: Boolean);
 begin
   if FParentBiDiMode = AValue then exit;
   FParentBiDiMode := AValue;
@@ -275,7 +275,7 @@ end;
 
   The handle will be created if not already allocated.
  ------------------------------------------------------------------------------}
-function TMenu.GetHandle: HMenu;
+function TMenu.GetHandle: HMENU;
 begin
   HandleNeeded();
   Result := FItems.Handle;
@@ -358,7 +358,7 @@ begin
   end;
 end;
 
-function TMenu.IsBiDiModeStored: boolean;
+function TMenu.IsBiDiModeStored: Boolean;
 begin
   Result := not FParentBidiMode;
 end;

lcl/interfaces/win32/win32wsmenus.pp

@@ -28,7 +28,7 @@ uses
 // To get as little as posible circles,
 // uncomment only when needed for registration
 ////////////////////////////////////////////////////
-  Graphics, GraphType, ImgList, Menus, Forms,
+  LCLType, Graphics, GraphType, ImgList, Menus, Forms,
 ////////////////////////////////////////////////////
   WSMenus, WSLCLClasses, WSProc,
   Windows, Controls, Classes, SysUtils, Win32Int, Win32Proc, Win32WSImgList,
@@ -79,6 +79,7 @@ type
   function FindMenuItemAccelerator(const ACharCode: word; const AMenuHandle: HMENU): integer;
   procedure DrawMenuItemIcon(const AMenuItem: TMenuItem; const AHDC: HDC;
     const ImageRect: TRect; const ASelected: Boolean);
+  function ItemStateToDrawState(const ItemState: UINT): LCLType.TOwnerDrawState;
 
 implementation
 
@@ -486,6 +487,58 @@ begin
   Result.cx := Result.cx + Metrics.TextMargins.cxLeftWidth + Metrics.TextMargins.cxRightWidth;
 end;
 
+function ClassicMenuItemSize(AMenuItem: TMenuItem; ADC: HDC): TSize;
+var
+  LeftSpace, RightSpace: Integer;
+  oldFont: HFONT;
+  newFont: HFONT;
+  AvgCharSize: TSize;
+begin
+  if AMenuItem.Default then
+    newFont := GetMenuItemFont([cfBold])
+  else
+    newFont := GetMenuItemFont([]);
+  oldFont := SelectObject(ADC, newFont);
+  AvgCharSize := GetAverageCharSize(ADC);
+
+  Result := StringSize(CompleteMenuItemCaption(AMenuItem, EmptyStr), ADC);
+
+  // Space between text and shortcut.
+  if AMenuItem.ShortCut <> scNone then
+    inc(Result.cx, AvgCharSize.cx);
+
+  GetNonTextSpace(AMenuItem, AvgCharSize.cx, LeftSpace, RightSpace);
+  inc(Result.cx, LeftSpace + RightSpace);
+
+  // Windows adds additional space to value returned from WM_MEASUREITEM
+  // for owner drawn menus. This is to negate that.
+  Dec(Result.cx, AvgCharSize.cx * 2);
+
+  // As for height of items in menu bar, regardless of what is set here,
+  // Windows seems to always use SM_CYMENUSIZE (space for a border is included).
+
+  if AMenuItem.IsLine then
+    Result.cy := GetSystemMetrics(SM_CYMENUSIZE) div 2 // it is a separator
+  else
+  begin
+    if AMenuItem.IsInMenuBar then
+    begin
+      Result.cy := Max(Result.cy, GetSystemMetrics(SM_CYMENUSIZE));
+      if AMenuItem.hasIcon then
+        Result.cy := Max(Result.cy, aMenuItem.GetIconSize.y);
+    end
+    else
+    begin
+      Result.cy := Max(Result.cy + 2, AvgCharSize.cy + 4);
+      if AMenuItem.hasIcon then
+        Result.cy := Max(Result.cy, aMenuItem.GetIconSize.y + 2);
+    end;
+  end;
+
+  SelectObject(ADC, oldFont);
+  DeleteObject(newFont);
+end;
+
 procedure ThemeDrawElement(DC: HDC; Details: TThemedElementDetails; const R: TRect; ClipRect: PRect); inline;
 begin
   with Details do
@@ -785,63 +838,30 @@ end;
 
 function MenuItemSize(AMenuItem: TMenuItem; AHDC: HDC): TSize;
 var
-  LeftSpace, RightSpace: Integer;
+  CC: TControlCanvas;
-  oldFont: HFONT;
+  ParentMenu: TMenu;
-  newFont: HFONT;
-  AvgCharSize: TSize;
 begin
+  ParentMenu := AMenuItem.GetParentMenu;
+  if (ParentMenu<>nil) and ParentMenu.OwnerDraw and Assigned(AMenuItem.OnMeasureItem) then
+  begin
+    CC := TControlCanvas.Create;
+    try
+      CC.Handle := AHDC;
+      AMenuItem.OnMeasureItem(AMenuItem, CC, Result.cx, Result.cy);
+    finally
+      CC.Free;
+    end;
+  end
+  else
   if IsVistaMenu then
   begin
     if AMenuItem.IsInMenuBar then
       Result := VistaBarMenuItemSize(AMenuItem, AHDC)
     else
       Result := VistaPopupMenuItemSize(AMenuItem, AHDC);
-    Exit;
-  end;
-
-  if AMenuItem.Default then
-    newFont := GetMenuItemFont([cfBold])
-  else
-    newFont := GetMenuItemFont([]);
-  oldFont := SelectObject(aHDC, newFont);
-  AvgCharSize := GetAverageCharSize(AHDC);
-
-  Result := StringSize(CompleteMenuItemCaption(AMenuItem, EmptyStr), AHDC);
-
-  // Space between text and shortcut.
-  if AMenuItem.ShortCut <> scNone then
-    inc(Result.cx, AvgCharSize.cx);
-
-  GetNonTextSpace(AMenuItem, AvgCharSize.cx, LeftSpace, RightSpace);
-  inc(Result.cx, LeftSpace + RightSpace);
-
-  // Windows adds additional space to value returned from WM_MEASUREITEM
-  // for owner drawn menus. This is to negate that.
-  Dec(Result.cx, AvgCharSize.cx * 2);
-
-  // As for height of items in menu bar, regardless of what is set here,
-  // Windows seems to always use SM_CYMENUSIZE (space for a border is included).
-
-  if AMenuItem.IsLine then
-    Result.cy := GetSystemMetrics(SM_CYMENUSIZE) div 2 // it is a separator
-  else
-  begin
-    if AMenuItem.IsInMenuBar then
-    begin
-      Result.cy := Max(Result.cy, GetSystemMetrics(SM_CYMENUSIZE));
-      if AMenuItem.hasIcon then
-        Result.cy := Max(Result.cy, aMenuItem.GetIconSize.y);
   end
   else
-    begin
+    ClassicMenuItemSize(AMenuItem, AHDC);
-      Result.cy := Max(Result.cy + 2, AvgCharSize.cy + 4);
-      if AMenuItem.hasIcon then
-        Result.cy := Max(Result.cy, aMenuItem.GetIconSize.y + 2);
-    end;
-  end;
-
-  SelectObject(aHDC, oldFont);
-  DeleteObject(newFont);
 end;
 
 function IsFlatMenus: Boolean; inline;
@@ -1084,6 +1104,33 @@ begin
     AImageList.Free;
 end;
 
+function ItemStateToDrawState(const ItemState: UINT): LCLType.TOwnerDrawState;
+begin
+  Result := [];
+  if ItemState and ODS_SELECTED <> 0 then
+    Include(Result, LCLType.odSelected);
+  if ItemState and ODS_GRAYED <> 0 then
+    Include(Result, LCLType.odGrayed);
+  if ItemState and ODS_DISABLED <> 0 then
+    Include(Result, LCLType.odDisabled);
+  if ItemState and ODS_CHECKED <> 0 then
+    Include(Result, LCLType.odChecked);
+  if ItemState and ODS_FOCUS <> 0 then
+    Include(Result, LCLType.odFocused);
+  if ItemState and ODS_DEFAULT <> 0 then
+    Include(Result, LCLType.odDefault);
+  if ItemState and ODS_HOTLIGHT <> 0 then
+    Include(Result, LCLType.odHotLight);
+  if ItemState and ODS_INACTIVE <> 0 then
+    Include(Result, LCLType.odInactive);
+  if ItemState and ODS_NOACCEL <> 0 then
+    Include(Result, LCLType.odNoAccel);
+  if ItemState and ODS_NOFOCUSRECT <> 0 then
+    Include(Result, LCLType.odNoFocusRect);
+  if ItemState and ODS_COMBOBOXEDIT <> 0 then
+    Include(Result, LCLType.odComboBoxEdit);
+end;
+
 procedure DrawClassicMenuItemIcon(const AMenuItem: TMenuItem; const AHDC: HDC;
   const ARect: TRect; const ASelected, AChecked: boolean);
 var
@@ -1161,6 +1208,8 @@ procedure DrawMenuItem(const AMenuItem: TMenuItem; const AHDC: HDC; const ARect:
 var
   ASelected, ANoAccel: Boolean;
   B: Bool;
+  ParentMenu: TMenu;
+  CC: TControlCanvas;
 begin
   ASelected := (ItemState and ODS_SELECTED) <> 0;
   ANoAccel := (ItemState and ODS_NOACCEL) <> 0;
@@ -1170,6 +1219,23 @@ begin
     else
   else
     ANoAccel := False;
+
+  ParentMenu := AMenuItem.GetParentMenu;
+  if (ParentMenu<>nil) and ParentMenu.OwnerDraw
+  and (Assigned(AMenuItem.OnDrawItem) or Assigned(AMenuItem.OnAdvancedDrawItem)) then
+  begin
+    CC := TControlCanvas.Create;
+    try
+      CC.Handle := AHDC;
+      if Assigned(AMenuItem.OnDrawItem) then
+        AMenuItem.OnDrawItem(AMenuItem, CC, ARect, ASelected);
+      if Assigned(AMenuItem.OnAdvancedDrawItem) then
+        AMenuItem.OnAdvancedDrawItem(AMenuItem, CC, ARect, ItemStateToDrawState(ItemState));
+    finally
+      CC.Free;
+    end;
+  end
+  else
   if IsVistaMenu then
   begin
     if AMenuItem.IsInMenuBar then

lcl/menus.pp

@@ -108,6 +108,13 @@ type
     mihtDestroy
     );
 
+  TMenuDrawItemEvent = procedure(Sender: TObject; ACanvas: TCanvas;
+    ARect: TRect; ASelected: Boolean) of object;
+  TAdvancedMenuDrawItemEvent = procedure(Sender: TObject; ACanvas: TCanvas;
+    ARect: TRect; AState: TOwnerDrawState) of object;
+  TMenuMeasureItemEvent = procedure(Sender: TObject; ACanvas: TCanvas;
+    var AWidth, AHeight: Integer) of object;
+
   TMenuItem = class(TLCLComponent)
   private
     FActionLink: TMenuActionLink;
@@ -121,8 +128,11 @@ type
     FImageIndex: TImageIndex;
     FItems: TList; // list of TMenuItem
     FMenu: TMenu;
+    FOnAdvancedDrawItem: TAdvancedMenuDrawItemEvent;
     FOnChange: TMenuChangeEvent;
     FOnClick: TNotifyEvent;
+    FOnDrawItem: TMenuDrawItemEvent;
+    FOnMeasureItem: TMenuMeasureItemEvent;
     FParent: TMenuItem;
     FMenuItemHandlers: array[TMenuItemHandlerType] of TMethodList;
     FSubMenuImages: TCustomImageList;
@@ -283,6 +293,9 @@ type
     property Visible: Boolean read FVisible write SetVisible
                               stored IsVisibleStored default True;
     property OnClick: TNotifyEvent read FOnClick write FOnClick;
+    property OnDrawItem: TMenuDrawItemEvent read FOnDrawItem write FOnDrawItem;
+    property OnAdvancedDrawItem: TAdvancedMenuDrawItemEvent read FOnAdvancedDrawItem write FOnAdvancedDrawItem;
+    property OnMeasureItem: TMenuMeasureItemEvent read FOnMeasureItem write FOnMeasureItem;
   end;
   TMenuItemClass = class of TMenuItem;
 
@@ -297,7 +310,11 @@ type
     FImageChangeLink: TChangeLink;
     FImages: TCustomImageList;
     FItems: TMenuItem;
+    FOnAdvancedDrawItem: TAdvancedMenuDrawItemEvent;
     FOnChange: TMenuChangeEvent;
+    FOnDrawItem: TMenuDrawItemEvent;
+    FOnMeasureItem: TMenuMeasureItemEvent;
+    FOwnerDraw: Boolean;
     FParent: TComponent;
     FParentBiDiMode: Boolean;
     FShortcutHandled: boolean;
@@ -350,6 +367,7 @@ type
     property ParentBidiMode:Boolean read FParentBidiMode write SetParentBidiMode default True;
     property Items: TMenuItem read FItems;
     property Images: TCustomImageList read FImages write SetImages;
+    property OwnerDraw: Boolean read FOwnerDraw write FOwnerDraw;
   end;