delphi – TActionMainMenuBar菜单中的RadioItems
发布时间:2020-12-15 09:12:08 所属栏目:大数据 来源:网络整理
导读:我使用TActionMainMenuBar来显示基于TActions的菜单. 我通过设置相同的GroupIndex对操作进行分组.所以他们可以像RadioGroup一样操作,但问题是有抽取而不是单选按钮. 有什么方法可以改变吗? 解决方法 这是我对TPlatformDefaultStyleActionBars的修复. 大多数
我使用TActionMainMenuBar来显示基于TActions的菜单.
我通过设置相同的GroupIndex对操作进行分组.所以他们可以像RadioGroup一样操作,但问题是有抽取而不是单选按钮. 有什么方法可以改变吗? 解决方法
这是我对TPlatformDefaultStyleActionBars的修复.
大多数代码只是从标准单位复制而来,除了TFixedThemedMenuItemStyle.DoDrawMenuCheck. 请注意,如果要在Vista之前的操作系统上运行软件,还必须覆盖TXPStyleMenuItem. uses // ... add these units StdStyleActnCtrls,XPStyleActnCtrls,XPActnCtrls,ImgList,Types,Themes,StdActnMenus,ThemedActnCtrls,ListActns,UxTheme; type TFixedThemedMenuItemStyle = class(TThemedMenuItem) private FCheckRect: TRect; FGutterRect: TRect; FPaintRect: TRect; FSubMenuGlyphRect: TRect; FSeparatorHeight: Integer; procedure DoDrawMenuCheck; procedure DoDrawText(DC: HDC; const Text: string; var Rect: TRect; Flags: Longint); protected procedure DrawGlyph(const Location: TPoint); override; public procedure CalcBounds; override; end; TFixedPlatformDefaultStyleActionBars = class(TPlatformDefaultStyleActionBars) public function GetControlClass(ActionBar: TCustomActionBar; AnItem: TActionClientItem): TCustomActionControlClass; override; function GetStyleName: string; override; end; TForm1 = class(TForm) ActionMainMenuBar1: TActionMainMenuBar; ActionManager1: TActionManager; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private Style: TFixedPlatformDefaultStyleActionBars; public end; implementation procedure TForm1.FormCreate(Sender: TObject); begin Style := TFixedPlatformDefaultStyleActionBars.Create(); ActionManager1.Style := Style; end; procedure TForm1.FormDestroy(Sender: TObject); begin Style.Free(); end; procedure TFixedThemedMenuItemStyle.CalcBounds; const CheckMarkStates: array[Boolean] of Integer = (MC_CHECKMARKDISABLED,MC_CHECKMARKNORMAL); SubMenuStates: array[Boolean] of Integer = (MSM_DISABLED,MSM_NORMAL); var DC: HDC; LFont: HFONT; LTheme: HTheme; LBounds: TRect; LImageSize: TPoint; LHeight,LWidth,Offset: Integer; LGlyphSize,LGutterSize,LSeparatorSize,LSubMenuGlyphSize: TSize; LCheckMargins,LGutterMargins,LMenuItemMargins,LSeparatorMargins,LSubMenuGlyphMargins: TMargins; begin // Fill in parent object's private fields. inherited; DC := CreateCompatibleDC(0); try LFont := SelectObject(DC,Screen.MenuFont.Handle); try Font.Assign(Screen.MenuFont); inherited; LTheme := ThemeServices.Theme[teMenu]; LHeight := 0; LWidth := 0; // Check/Glyph GetThemePartSize(LTheme,DC,MENU_POPUPCHECK,CheckMarkStates[Enabled],nil,TS_TRUE,LGlyphSize); GetThemeMargins(LTheme,TMT_CONTENTMARGINS,LCheckMargins); // Gutter GetThemePartSize(LTheme,MENU_POPUPGUTTER,LGutterSize); GetThemeMargins(LTheme,TMT_SIZINGMARGINS,LGutterMargins); // Menu item GetThemeMargins(LTheme,MENU_POPUPITEM,MPI_NORMAL,LMenuItemMargins); GetThemePartSize(LTheme,MENU_POPUPSUBMENU,SubMenuStates[Enabled],LSubMenuGlyphSize); GetThemeMargins(LTheme,LSubMenuGlyphMargins); // Calculate check/glyph size LImageSize := GetImageSize; if LImageSize.Y > LGlyphSize.cy then LGlyphSize.cy := LImageSize.Y; if LImageSize.X > LGlyphSize.cx then LGlyphSize.cx := LImageSize.X; Inc(LHeight,LGlyphSize.cy); Inc(LWidth,LGlyphSize.cx); // Add margins for check/glyph Inc(LHeight,LCheckMargins.cyTopHeight + LCheckMargins.cyBottomHeight); Inc(LWidth,LCheckMargins.cxLeftWidth + LCheckMargins.cxRightWidth); FCheckRect := Rect(0,LGlyphSize.cx + LCheckMargins.cxRightWidth + LCheckMargins.cxRightWidth,LGlyphSize.cy + LCheckMargins.cyBottomHeight + LCheckMargins.cyBottomHeight); // Add size and margins for gutter Inc(LWidth,LGutterMargins.cxLeftWidth); FGutterRect.Left := LWidth; FGutterRect.Right := FGutterRect.Left + LGutterSize.cx; Inc(LWidth,LGutterSize.cx + LGutterMargins.cxRightWidth); // Add margins for menu item Inc(LWidth,LMenuItemMargins.cxLeftWidth + LMenuItemMargins.cxRightWidth); Offset := LWidth - TextBounds.Left - LMenuItemMargins.cxRightWidth; LBounds := TextBounds; OffsetRect(LBounds,Offset,-1); TextBounds := LBounds; // Add size of potential submenu glyph Inc(LWidth,LSubMenuGlyphSize.cx); Inc(LWidth,LSubMenuGlyphMargins.cxLeftWidth); Inc(LWidth,LSubMenuGlyphMargins.cxRightWidth); // Add Width of menu item to FSubMenuGlyphRect before using FSubMenuGlyphRect := Rect(-LSubMenuGlyphMargins.cxRightWidth - LSubMenuGlyphSize.cx,(Height - LSubMenuGlyphSize.cy) div 2,-LSubMenuGlyphMargins.cxRightWidth,((Height - LSubMenuGlyphSize.cy) div 2) + LSubMenuGlyphSize.cy); // Add margins for menu short cut if ActionClient <> nil then begin LBounds := Rect(0,0); DoDrawText(DC,ActionClient.ShortCutText,LBounds,DT_CALCRECT or DT_NOCLIP); end else LBounds := ShortCutBounds; Offset := FSubMenuGlyphRect.Left - LBounds.Right - LMenuItemMargins.cxRightWidth - LSubMenuGlyphMargins.cxLeftWidth; OffsetRect(LBounds,0); // Add Width of menu item to ShortCutBounds before using ShortCutBounds := LBounds; Inc(LWidth,LMenuItemMargins.cxLeftWidth + LMenuItemMargins.cxRightWidth); // Adjust size if separator if Separator then begin GetThemePartSize(LTheme,MENU_POPUPSEPARATOR,LSeparatorSize); GetThemeMargins(LTheme,LSeparatorMargins); LHeight := LSeparatorSize.cy + LSeparatorMargins.cyBottomHeight; LWidth := LSeparatorSize.cx; FSeparatorHeight := LSeparatorSize.cy; end; FGutterRect.Top := 0; FGutterRect.Bottom := LHeight; SetBounds(Left,Top,LWidth + TextBounds.Right - TextBounds.Left + ShortCutBounds.Right - ShortCutBounds.Left,LHeight); finally SelectObject(DC,LFont); end; finally DeleteDC(DC); end; end; // THE ONLY SERIOUS DIFFERENCE: RENDERING BULLETS INSTEAD OF CHECKMARKS FOR RADIO ITEMS procedure TFixedThemedMenuItemStyle.DoDrawMenuCheck; const CheckMarkBkgs: array[Boolean] of Integer = (MCB_DISABLED,MCB_NORMAL); CheckMarkStates: array[Boolean] of Integer = (MC_CHECKMARKDISABLED,MC_CHECKMARKNORMAL); RadioMarkStates: array[Boolean] of Integer = (MC_BULLETDISABLED,MC_BULLETNORMAL); begin if IsChecked then begin DrawThemeBackground(ThemeServices.Theme[teMenu],Canvas.Handle,MENU_POPUPCHECKBACKGROUND,CheckMarkBkgs[Enabled],FCheckRect,nil); if not HasGlyph then begin if IsGrouped then begin DrawThemeBackground(ThemeServices.Theme[teMenu],RadioMarkStates[Enabled],nil); end else begin DrawThemeBackground(ThemeServices.Theme[teMenu],nil); end; end; end; end; procedure TFixedThemedMenuItemStyle.DoDrawText( DC: HDC; const Text: string; var Rect: TRect; Flags: Integer); const MenuStates: array[Boolean] of Integer = (MPI_DISABLED,MPI_NORMAL); var Options: TDTTOpts; begin // Setup Options {$IF NOT DEFINED(CLR)} FillChar(Options,SizeOf(Options),0); Options.dwSize := SizeOf(Options); {$ELSE} Options.dwSize := Marshal.SizeOf(TypeOf(Options)); {$IFEND} Options.dwFlags := DTT_TEXTCOLOR or DTT_COMPOSITED; if Flags and DT_CALCRECT = DT_CALCRECT then Options.dwFlags := Options.dwFlags or DTT_CALCRECT; // Retrieve text color GetThemeColor(ThemeServices.Theme[teMenu],MenuStates[Enabled or ActionBar.DesignMode],TMT_TEXTCOLOR,Options.crText); // Draw menu item text DrawThemeTextEx(ThemeServices.Theme[teMenu],Text,Length(Text),Flags,Rect,Options); end; procedure TFixedThemedMenuItemStyle.DrawGlyph(const Location: TPoint); var LImageSize,LLocation: TPoint; begin if (Action is TCustomAction) and TCustomAction(Action).Checked then DoDrawMenuCheck; if HasGlyph then begin LImageSize := GetImageSize; LLocation.X := ((FCheckRect.Right - FCheckRect.Left) - LImageSize.X) div 2; LLocation.Y := ((FCheckRect.Bottom - FCheckRect.Top) - LImageSize.Y) div 2; inherited DrawGlyph(LLocation); end; end; type TActionControlStyle = (csStandard,csXPStyle,csThemed); function GetActionControlStyle: TActionControlStyle; begin if Win32MajorVersion >= 6 then begin if ThemeServices.Theme[teMenu] <> 0 then Result := csThemed else Result := csXPStyle; end else if CheckWin32Version(5,1) then Result := csXPStyle else Result := csStandard; end; function TFixedPlatformDefaultStyleActionBars.GetControlClass(ActionBar: TCustomActionBar; AnItem: TActionClientItem): TCustomActionControlClass; begin if ActionBar is TCustomActionToolBar then begin if AnItem.HasItems then case GetActionControlStyle of csStandard: Result := TStandardDropDownButton; csXPStyle: Result := TXPStyleDropDownBtn; else Result := TThemedDropDownButton; end else if (AnItem.Action is TStaticListAction) or (AnItem.Action is TVirtualListAction) then Result := TCustomComboControl else case GetActionControlStyle of csStandard: Result := TStandardButtonControl; csXPStyle: Result := TXPStyleButton; else Result := TThemedButtonControl; end end else if ActionBar is TCustomActionMainMenuBar then case GetActionControlStyle of csStandard: Result := TStandardMenuButton; csXPStyle: Result := TXPStyleMenuButton; else Result := TThemedMenuButton; end else if ActionBar is TCustomizeActionToolBar then begin with TCustomizeActionToolbar(ActionBar) do if not Assigned(RootMenu) or (AnItem.ParentItem <> TCustomizeActionToolBar(RootMenu).AdditionalItem) then case GetActionControlStyle of csStandard: Result := TStandardMenuItem; csXPStyle: Result := TXPStyleMenuItem; else Result := TFixedThemedMenuItemStyle; end else case GetActionControlStyle of csStandard: Result := TStandardAddRemoveItem; csXPStyle: Result := TXPStyleAddRemoveItem; else Result := TThemedAddRemoveItem; end end else if ActionBar is TCustomActionPopupMenu then case GetActionControlStyle of csStandard: Result := TStandardMenuItem; csXPStyle: Result := TXPStyleMenuItem; else Result := TFixedThemedMenuItemStyle; end else case GetActionControlStyle of csStandard: Result := TStandardButtonControl; csXPStyle: Result := TXPStyleButton; else Result := TThemedButtonControl; end end; function TFixedPlatformDefaultStyleActionBars.GetStyleName: string; begin Result := 'My fixed platform style'; end; (编辑:李大同) 【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容! |