delphi - TActionMainMenuBar のメニューの RadioItems

Question

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

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

Answer 1

これが私の修正ですTPlatformDefaultStyleActionBars。

を除いて、ほとんどのコードは標準単位からコピーされたばかりTFixedThemedMenuItemStyle.DoDrawMenuCheckです。

TXPStyleMenuItemVista以前のOSでソフトウェアを実行する場合も、オーバーライドする必要があることに注意してください。

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;