在 Delphi 中可以使用带有图标的主题主菜单吗? [英] Is a themed Main Menu with icons possible in Delphi?

问题描述

我使用的是 Delphi 7.在 Windows 7 上对此进行测试.

I'm using Delphi 7. Testing this on Windows 7.

在表单上放置一个 TMainMenu 和一个 TImageList.将一些菜单添加到 TMainMenu 和一些图像到 TImageList.当 TImageList 没有分配给 TMainMenu 的 Images 属性时，应用程序看起来像这样:

Drop a TMainMenu and a TImageList on a form. Add some menus to the TMainMenu and some images to the TImageList. When the TImageList is NOT assigned to the TMainMenu's Images property, the application looks like this:

但是一旦将 TImageList 分配给 TMainMenu 的 Images 属性，应用程序看起来像这样:

But once the TImageList is assigned to the TMainMenu's Images property, the application looks like this:

此外，如果 Images 属性在运行时更改(已分配或​​未分配)，则只有子菜单项会更改，根菜单项(文件、编辑、工具、设置和帮助在我的示例应用程序中)永远不会改变——如果 Images 属性在设计时没有分配，它们总是保持主题，或者如果 Images 属性被分配，它们总是保持非主题在设计时分配.

Further more, if the Images property is changed (assigned or unassigned) at run-time, only the submenu items change, the root menu items (File, Edit, Tools, Settings, and Help in my example application) never change -- they always stay themed if the Images property was not assigned at design time, or they always stay non-themed if the Images property was assigned at design time.

最后，无论是否使用 XPManifest，这一切都会发生.

And finally, all of this is happening whether or not XPManifest is used.

所以，我的问题是:

1.为什么在使用图标时主题会消失? 我猜想图标是使用像所有者绘图这样的东西在内部绘制的，这打破了主题，但这只是一个猜测.

1. Why is the theming disappearing when icons are used? I would guess that icons are drawn internally using something like Owner Drawing, which breaks the theming, but that's just a guess.

2.为什么即使没有使用 XPManifest，主菜单也是主题?

2. Why is the main menu themed, even when XPManifest is not used?

3.最重要的是，我怎样才能拥有带有图标的主题菜单?

推荐答案

我希望这个答案不会让人觉得过于咆哮，但 Embarcadero 在这方面有着悠久的错误步骤.我在这方面提交了大量的QC报告，所以也许我有点苦.也就是说，Delphi 的最新版本似乎以可接受的方式实现菜单.我最近带 XE6 菜单兜风时，我没能把它们绊倒.但他们花了很长时间才赶上.

I hope this answer does not come across as too much of a rant, but this is an area where Embarcadero have a long history of mis-steps. I have submitted a large number of QC reports in this area so perhaps I am a little bitter. That said, the most recent releases of Delphi seem to implement menus in an acceptable way. I wasn't able to trip up XE6 menus when I took them for a spin recently. But it has taken them a long time to catch up.

您的 Delphi 早于 Vista.Vista 是 Windows 菜单的分水岭.虽然主题 API 是在 XP 中引入的，但它对菜单没有真正的影响.这在 Vista 中发生了变化.但 Delphi 7 在这一切之前，并在编写时考虑到了 XP.

Your Delphi pre-dates Vista. And Vista was the great water-shed for Windows menus. Although the theme API was introduced in XP, it had no real impact on menus. That changed in Vista. But Delphi 7 was before all that and was coded with XP in mind.

在 XP 中，使用字形绘制菜单并不容易.MENUITEMINFO 结构有一个位图字段，hbmpItem.但在 XP 中它的用途有限.系统绘制的 XP 菜单不会在菜单上绘制干净的 alpha 位图.此类菜单需要所有者绘图.因此在 Delphi 7 代码中，如果您的菜单有任何字形，那么它将被所有者绘制.所有者使用 XP API 绘制.

In XP, drawing menus with glyphs was not easy. The MENUITEMINFO struct has a bitmap field, hbmpItem. But in XP it is of limited use. A system drawn XP menu will not draw a clean alpha bitmap on a menu. Such menus require owner drawing. And so in the Delphi 7 code, if your menu has any glyphs then it will be owner drawn. And owner drawn using the XP APIs.

这解释了您问题中两个屏幕截图之间的区别.主题截图是一个没有字形的菜单.Delphi 7 菜单代码要求系统绘制菜单.它绘制主题菜单.有或没有 comctl32 清单.这是 Vista 及更高版本的标准菜单.

That explains the difference between the two screenshots in your question. The themed screenshot is a menu with no glyphs. The Delphi 7 menus code asks the system to draw the menu. And it draws themed menus. With or without the comctl32 manifest. That's the standard menu on Vista and later.

当你添加字形时，只知道 XP 的 VCL 代码决定拥有者绘制菜单.并且使用 XP 功能这样做.毕竟，不能期望使用 Vista 主题菜单 API.代码早于这些.

And when you add glyphs, the VCL code which only knows about XP, decides to owner draw the menus. And does so using XP functionality. After all, it cannot be expected to use the Vista themed menu APIs. The code pre-dates those.

现代版本的 Delphi 逐渐增加了对 Vista 主题菜单的支持.Menus 单元中的原始实现，老实说，很可怜.Embarcadero 设计师选择使用主题 API 绘制菜单.从所有意图和目的来看，都没有记录的 API.有关该 API 的最佳信息来源可能是 Delphi 源代码 (!) 和 Wine 源代码.在这里向 MSDN 寻求帮助毫无意义.因此，我确实对这里的 Embarcadero 表示同情，对不得不解决这个问题的可怜的工程师表示同情.并使用 5 个版本的软件来清除错误.

Modern versions of Delphi have gradually added support for Vista themed menus. The original implementations in the Menus unit were, in all honesty, pitiful. The Embarcadero designers elected to draw the menus using the theme API. An API that is, to all intents and purposes, undocumented. Probably the best source of information on that API is the Delphi source code (!), and the Wine source code. It is pointless looking to MSDN for help here. So, I do have sympathy for Embarcadero here, for the poor engineer who had to work this out. And take 5 releases of the software to flush out the bugs.

然而，Embarcadero 也确实应该受到一些谴责.因为可以让系统在 Vista 及更高版本上绘制包含字形的主题菜单.秘密在于 hbmpItem 字段.尽管它在 XP 上的使用有限，但它在 Vista 上发挥了自己的作用.你不会在任何地方找到这方面的文档.唯一很好的文档来源，MS 工作人员在 Shell Revealed 博客上发表的一篇博客文章，由于某种原因已从互联网上删除(但被 存档.组织).但细节很简单.在hbmpItem中放入一张PARGB32位图，让系统绘制菜单.然后一切都很好.

However, Embarcadero do also deserve a smattering of opprobrium. For it is possible to get the system to draw themed menus on Vista and up that contain glyphs. The secret is the hbmpItem field. Although it was of limited use on XP, it comes into its own on Vista. You won't find documentation of this anywhere. The only good source of documentation, a blog article published by an MS staffer on the Shell Revealed blog, has for some reason been removed from the internet (but captured by archive.org). But the details are simple enough. Put a PARGB32 bitmap into hbmpItem, and let the system draw the menu. And then it's all good.

当然，Delphi Menus 单元并不容易实现这一点.事实上，该单元不可能以香草形式出现.为了实现这一点，您需要修改该单元中的代码.您需要更改选择自定义绘制菜单的代码.而是创建 PARGB32 位图以放置在 hbmpItem 中，并要求系统绘制它们.这需要一定程度的技巧，尤其是因为您需要管理 PARGB32 位图的生命周期以避免资源泄漏.

Of course the Delphi Menus unit doesn't make this easy to achieve. In fact it is not possible with that unit in vanilla form. In order to make this happen you need to modify the code in that unit. You need to change the code which elects to custom draw the menu. And instead create PARGB32 bitmaps to be placed in hbmpItem, and ask the system to paint them. This takes a degree of skill, not least because you need to manage the lifetime of the PARGB32 bitmaps to avoid resource leaks.

所以，这就是在 Delphi 7 中实现带有图标的主题菜单的方法.我当时实际上是为 Delphi 6 实现的，但代码是相同的.即使在我当前的 XE3 代码库中，我仍然使用相同的方法.为什么?因为我更信任系统绘制菜单而不是 VCL 代码.

So, that's how you achieve a themed menu with icons in Delphi 7. I actually implemented this for Delphi 6 at the time, but the code is the same. And even in my current codebase which is in XE3, I still use the same approach. Why? Because I trust the system to draw the menus more than I trust the VCL code.

我不能轻易分享代码，因为它涉及对Menus 单元在少数地方的修改.Menus 代码不是我要分享的.但要点是:

I cannot share the code easily because it involves modifications to the Menus unit in a handful of places. And the Menus code is not mine to share. But the essentials are:

1. 不要为 Vista 及更高版本绘制菜单.请注意，您仍然需要为 XP 提供所有者抽奖.
2. 为您的图标创建 PARGB32 位图版本.
3. 将这些位图放入 hbmpItem 中，让系统完成剩下的工作.

1. Don't owner draw the menu for Vista and later. Note that you still need owner draw for XP.
2. Create PARGB32 bitmap versions of your icons.
3. Put these bitmaps into hbmpItem and let the system do the rest.

寻找这方面想法的好地方是 Tortoise SVN 源代码.它使用这种未记录的技术来绘制其主题字形重菜单.

A good place to look for ideas on this is the Tortoise SVN source code. That uses this undocumented technique to paint its themed glyph heavy menus.

一些链接:

• http://www.nanoant.com/programming/themed-menus-icons-a-complete-vista-xp-solution
• http://tortoisesvn.tigris.org/ds/viewMessage.do?dsForumId=757&dsMessageId=892948
• http://web.archive.org/web/20080422080614/http://shellrevealed.com/blogs/shellblog/archive/2007/02/06/Vista-Style-Menus_2C00_-Part-1-2D00-Adding-icons-to-standard-menus.aspx

• http://www.nanoant.com/programming/themed-menus-icons-a-complete-vista-xp-solution
• http://tortoisesvn.tigris.org/ds/viewMessage.do?dsForumId=757&dsMessageId=892948
• http://web.archive.org/web/20080422080614/http://shellrevealed.com/blogs/shellblog/archive/2007/02/06/Vista-Style-Menus_2C00_-Part-1-2D00-Adding-icons-to-standard-menus.aspx

我从 Delphi 6 时间框架中挖掘出我的一些代码.我确定它仍然适用.

I dug out some of my code from the Delphi 6 time frame. I'm sure it is still applicable.

就在我修改过的 Menus 单元的界面部分的顶部，我声明了这个界面:

Right at the top of the interface section of my modified version of the Menus unit I declared this interface:

type
  IImageListConvertIconToPARGB32Bitmap = interface
    ['{4D3E7D64-1288-4D0D-98FC-E61501573204}']
    function GetPARGB32Bitmap(ImageIndex: Integer): HBITMAP;
  end;

这是由图像列表类实现的，用于提供 PARGB32 位图.然后在TMenuItem.AppendTo中，如果版本是Vista或up，如果VCL代码计划所有者绘制，我将IsOwnerDraw设置为False.然后使用 IImageListConvertIconToPARGB32Bitmap 得到一个 PARGB32 位图.

This is implemented by an image list class and is used to provide PARGB32 bitmaps. Then in TMenuItem.AppendTo, if the version is Vista or up, and if the VCL code is planning to owner draw, I set IsOwnerDraw to False. And then use IImageListConvertIconToPARGB32Bitmap to get a PARGB32 bitmap.

if Supports(GetImageList, IImageListConvertIconToPARGB32Bitmap, Intf) then 
begin
  BitmapHandle := Intf.GetPARGB32Bitmap(ImageIndex);
  if BitmapHandle<>0 then 
  begin
    MenuItemInfo.fMask := MenuItemInfo.fMask or MIIM_BITMAP;
    MenuItemInfo.hbmpItem := BitmapHandle;
  end;
end;

图像列表的实现如下所示:

The implementation of the image list looks like this:

type
  TMyImageList = class(TImageList, IImageListConvertIconToPARGB32Bitmap)
  private
    FPARGB32BitmapHandles: array of HBITMAP;
    procedure DestroyPARGB32BitmapHandles;
    function CreatePARGB32BitmapFromIcon(ImageIndex: Integer): HBITMAP;
  protected
    procedure Change; override;
  public
    destructor Destroy; override;
    function GetPARGB32Bitmap(ImageIndex: Integer): HBITMAP;
  end;

destructor TMyImageList.Destroy;
begin
  DestroyPARGB32BitmapHandles;
  inherited;
end;

function TMyImageList.GetPARGB32Bitmap(ImageIndex: Integer): HBITMAP;
begin
  if InRange(ImageIndex, 0, Count-1) then begin
    SetLength(FPARGB32BitmapHandles, Count);
    if FPARGB32BitmapHandles[ImageIndex]=0 then begin
      FPARGB32BitmapHandles[ImageIndex] := CreatePARGB32BitmapFromIcon(ImageIndex);
    end;
    Result := FPARGB32BitmapHandles[ImageIndex];
  end else begin
    Result := 0;
  end;
end;

procedure TMyImageList.Change;
begin
  inherited;
  DestroyPARGB32BitmapHandles;
end;

procedure TMyImageList.DestroyPARGB32BitmapHandles;
var
  i: Integer;
begin
  for i := 0 to high(FPARGB32BitmapHandles) do begin
    if FPARGB32BitmapHandles[i]<>0 then begin
      DeleteObject(FPARGB32BitmapHandles[i]);
    end;
  end;
  Finalize(FPARGB32BitmapHandles);
end;

type
  TWICRect = record
    X, Y, Width, Height: Integer;
  end;

  IWICBitmapSource = interface//only GetSize and CopyPixels have been correctly defined
    ['{00000120-A8F2-4877-BA0A-FD2B6645FB94}']
    function GetSize(out Width, Height: UINT): HResult; stdcall;
    function GetPixelFormat: HResult; stdcall;
    function GetResolution: HResult; stdcall;
    function CopyPalette: HResult; stdcall;
    function CopyPixels(const rc: TWICRect; cbStride, cbBufferSize: UINT; Buffer: Pointer): HResult; stdcall;
  end;

  IWICImagingFactory = interface//only CreateBitmapFromHICON has been correctly defined
    ['{EC5EC8A9-C395-4314-9C77-54D7A935FF70}']
    function CreateDecoderFromFileName: HRESULT; stdcall;
    function CreateDecoderFromStream: HRESULT; stdcall;
    function CreateDecoderFromFileHandle: HRESULT; stdcall;
    function CreateComponentInfo: HRESULT; stdcall;
    function CreateDecoder: HRESULT; stdcall;
    function CreateEncoder: HRESULT; stdcall;
    function CreatePalette: HRESULT; stdcall;
    function CreateFormatConverter: HRESULT; stdcall;
    function CreateBitmapScaler: HRESULT; stdcall;
    function CreateBitmapClipper: HRESULT; stdcall;
    function CreateBitmapFlipRotator: HRESULT; stdcall;
    function CreateStream: HRESULT; stdcall;
    function CreateColorContext: HRESULT; stdcall;
    function CreateColorTransformer: HRESULT; stdcall;
    function CreateBitmap: HRESULT; stdcall;
    function CreateBitmapFromSource: HRESULT; stdcall;
    function CreateBitmapFromSourceRect: HRESULT; stdcall;
    function CreateBitmapFromMemory: HRESULT; stdcall;
    function CreateBitmapFromHBITMAP: HRESULT; stdcall;
    function CreateBitmapFromHICON(Icon: HICON; out Bitmap: IWICBitmapSource): HRESULT; stdcall;
    function CreateComponentEnumerator: HRESULT; stdcall;
    function CreateFastMetadataEncoderFromDecoder: HRESULT; stdcall;
    function CreateFastMetadataEncoderFromFrameDecode: HRESULT; stdcall;
    function CreateQueryWriter: HRESULT; stdcall;
    function CreateQueryWriterFromReader: HRESULT; stdcall;
  end;

var
  ImagingFactory: IWICImagingFactory;
  ImagingFactoryCreationAttempted: Boolean;

function TMyImageList.CreatePARGB32BitmapFromIcon(ImageIndex: Integer): HBITMAP;
const
  CLSID_WICImagingFactory: TGUID = '{CACAF262-9370-4615-A13B-9F5539DA4C0A}';
var
  Icon: THandle;
  Bitmap: IWICBitmapSource;
  cx, cy, cbStride, cbBuffer: UINT;
  bmi: TBitmapInfo;
  bits: Pointer;
begin
  Try
    Result := 0;
    if not Assigned(ImagingFactory) then begin
      if ImagingFactoryCreationAttempted then begin
        exit;
      end;
      ImagingFactoryCreationAttempted := True;
      if not Succeeded(CoCreateInstance(CLSID_WICImagingFactory, nil, CLSCTX_INPROC_SERVER, IWICImagingFactory, ImagingFactory)) then begin
        exit;
      end;
    end;
    Icon := ImageList_GetIcon(Handle, ImageIndex, ILD_NORMAL);
    if Icon<>0 then begin
      if Succeeded(ImagingFactory.CreateBitmapFromHICON(Icon, Bitmap)) and Succeeded(Bitmap.GetSize(cx, cy)) then begin
        ZeroMemory(@bmi, SizeOf(bmi));
        bmi.bmiHeader.biSize := SizeOf(bmi.bmiHeader);
        bmi.bmiHeader.biPlanes := 1;
        bmi.bmiHeader.biCompression := BI_RGB;
        bmi.bmiHeader.biWidth := cx;
        bmi.bmiHeader.biHeight := -cy;
        bmi.bmiHeader.biBitCount := 32;
        Result := CreateDIBSection(0, bmi, DIB_RGB_COLORS, bits, 0, 0);
        if Result<>0 then begin
          cbStride := cx*SizeOf(DWORD);
          cbBuffer := cy*cbStride;
          if not Succeeded(Bitmap.CopyPixels(TWICRECT(nil^), cbStride, cbBuffer, bits)) then begin
            DeleteObject(Result);
            Result := 0;
          end;
        end;
      end;
      DestroyIcon(Icon);
    end;
  Except
    //none of the methods called here raise exceptions, but we still adopt a belt and braces approach
    Result := 0;
  End;
end;

这篇关于在 Delphi 中可以使用带有图标的主题主菜单吗?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！