TActionMainMenuBarのメニューのラジオアイテム

Question

TActionMainMenuBarを使用して、TActionに基づいてメニューを表示します。 同じGroupIndexを設定してアクションをグループ化しました。だから彼らはRadioGroupのように動作することができますが、問題はラジオボタンの代わりにチェックが描かれていることです。

これを変更する方法はありますか？

Answer 1

ここは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, DC, MENU_POPUPCHECK, 
     CheckMarkStates[Enabled], TMT_CONTENTMARGINS, nil, LCheckMargins); 
     // Gutter 
     GetThemePartSize(LTheme, DC, MENU_POPUPGUTTER, 0, nil, TS_TRUE, LGutterSize); 
     GetThemeMargins(LTheme, DC, MENU_POPUPGUTTER, 0, TMT_SIZINGMARGINS, nil, LGutterMargins); 
     // Menu item 
     GetThemeMargins(LTheme, DC, MENU_POPUPITEM, MPI_NORMAL, TMT_SIZINGMARGINS, nil, LMenuItemMargins); 
     GetThemePartSize(LTheme, DC, MENU_POPUPSUBMENU, SubMenuStates[Enabled], nil, TS_TRUE, LSubMenuGlyphSize); 
     GetThemeMargins(LTheme, DC, MENU_POPUPSUBMENU, SubMenuStates[Enabled], TMT_CONTENTMARGINS, nil, 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, 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, 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, Offset, 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, DC, MENU_POPUPSEPARATOR, 0, nil, TS_TRUE, LSeparatorSize); 
     GetThemeMargins(LTheme, DC, MENU_POPUPSEPARATOR, 0, TMT_SIZINGMARGINS, nil, 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], Canvas.Handle, 
      MENU_POPUPCHECK, RadioMarkStates[Enabled], FCheckRect, nil); 
     end 
     else 
     begin 
     DrawThemeBackground(ThemeServices.Theme[teMenu], Canvas.Handle, 
      MENU_POPUPCHECK, CheckMarkStates[Enabled], FCheckRect, 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], MENU_POPUPITEM, 
    MenuStates[Enabled or ActionBar.DesignMode], TMT_TEXTCOLOR, Options.crText); 

    // Draw menu item text 
    DrawThemeTextEx(ThemeServices.Theme[teMenu], DC, MENU_POPUPITEM, 
    MenuStates[Enabled or ActionBar.DesignMode], 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;