Delphi中Menu设置Images属性后快捷按键下划线被隐藏解决方法

现象:
MainMenu设置Images属性后,看不到快捷按键的下划线,如:新建(&N)

分析:
VCL中Menus.pas单元的代码,看到如下语句
procedure TMenuItem.AdvancedDrawItem(ACanvas: TCanvas; ARect: TRect;
  State: TOwnerDrawState; TopLevel: Boolean);
//...
if Win2K and (odNoAccel in State) then
  DrawStyle := DrawStyle or DT_HIDEPREFIX;
//...

DT_HIDEPREFIX就是隐藏下划线 //用DrawText()测试一下就知道

在设置Images属性后(odNoAccel in State)为真

看来需要自绘菜单,响应OnAdvancedDrawItem事件

当然,自绘菜单的代码写起来就多了,还好AdvancedDrawItem()声明在protected部分
我们可以通过继承TMenuItem来访问AdvancedDrawItem()
type
  TMenuItemAccess = class(TMenuItem);

现在就要想办法使那个条件不成立,先从Win2K入手
当Images设置后"Win2K and (odNoAccel in State)"这个条件成立

分析单元中Win2K变量是这样得到的
Win2K := (Win32MajorVersion > 4) and (Win32Platform = VER_PLATFORM_WIN32_NT);

那么我们就可以通过修改Win32MajorVersion或者Win32Platform常量使其不成立

参考代码:

type

  TForm1 = class(TForm)

    MainMenu1: TMainMenu;

    ImageList1: TImageList;

    MenuItemFile: TMenuItem;

    MenuItemNew: TMenuItem;

    MenuItemOpen: TMenuItem;

    PopupMenu1: TPopupMenu;

    MenuItemCopy: TMenuItem;

    MenuItemPaste: TMenuItem;

    procedure FormCreate(Sender: TObject);

  private

    { Private declarations }

    procedure MenuItemAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas;

      ARect: TRect; State: TOwnerDrawState);

  public

    { Public declarations }

  end;

 

var

  Form1: TForm1;

 

implementation

 

{$R *.dfm}

 

type

  TMenuItemAccess = class(TMenuItem);

 

procedure TForm1.MenuItemAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas;

  ARect: TRect; State: TOwnerDrawState);

var

  vWin32Platform: Integer;

begin

  vWin32Platform := PInteger(@Win32Platform)^;

  PInteger(@Win32Platform)^ := -1;

  TMenuItemAccess(Sender).OnAdvancedDrawItem := nil;

  try

    TMenuItemAccess(Sender).AdvancedDrawItem(ACanvas, ARect, State,

      TMenuItemAccess(Sender).GetParentComponent is TMainMenu);

  finally

    TMenuItemAccess(Sender).OnAdvancedDrawItem := MenuItemAdvancedDrawItem;

    PInteger(@Win32Platform)^ := vWin32Platform;

  end;

end;

 

procedure TForm1.FormCreate(Sender: TObject);

var

  I: Integer;

begin

  for I := 0 to ComponentCount - 1 do

    if Components[I] is TMenuItem then

      TMenuItem(Components[I]).OnAdvancedDrawItem := MenuItemAdvancedDrawItem

    else if Components[I] is TMenu then

      TMenu(Components[I]).OwnerDraw := True;

end;

 

http://blog.csdn.net/zswang/article/details/1653340

posted @ 2017-01-24 23:29  findumars  Views(588)  Comments(0Edit  收藏  举报