paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-11 07:01:17 +01:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: trunk@51466 -
This commit is contained in:
ondrej 2016-01-31 20:11:28 +00:00
parent 1aef9cf770
commit 62ef2702b3
3 changed files with 138 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
lcl/include/menu.inc
View File

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

166
lcl/interfaces/win32/win32wsmenus.pp
View File

@ -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;
oldFont: HFONT;
newFont: HFONT;
AvgCharSize: TSize;
CC: TControlCanvas;
ParentMenu: TMenu;
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])
end
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
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);
ClassicMenuItemSize(AMenuItem, AHDC);
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

18
lcl/menus.pp
View File

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