delphi – TActionMainMenuBar菜单中的RadioItems

概述我使用TActionMainMenuBar来显示基于TActions的菜单. 我通过设置相同的GroupIndex对 *** 作进行分组.所以他们可以像RadioGroup一样 *** 作,但问题是有抽取而不是单选按钮. 有什么方法可以改变吗？ 这是我对TPlatformDefaultStyleActionBars的修复. 大多数代码只是从标准单位复制而来,除了TFixedThemedMenuItemStyle. 我使用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;implementationprocedure 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 ITEMSprocedure 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;    endend;function TFixedplatformDefaultStyleActionbars.GetStylename: string;begin  Result := 'My fixed platform style';end;

总结

以上是内存溢出为你收集整理的delphi – TActionMainMenuBar菜单中的RadioItems全部内容，希望文章能够帮你解决delphi – TActionMainMenuBar菜单中的RadioItems所遇到的程序开发问题。

如果觉得内存溢出网站内容还不错，欢迎将内存溢出网站推荐给程序员好友。