主题菜单中有可能在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 的图像属性，应用程序如下所示：

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 的图像属性，应用程序如下所示：

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

此外，如果图像在运行时更改（分配或未分配）属性，只有子菜单项更改，根菜单项（我的示例应用程序中的文件，编辑，工具，设置和帮助）永远不会改变 - 如果 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.

所以，我的问题是： / strong>

So, my questions are:

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有一个漫长的错误历史的地区。我在这方面提交了大量的质检报告，所以也许我有点苦。也就是说，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菜单中最棒的水壶。虽然在XP中引入了主题API，但它对菜单没有真正的影响。在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 struct具有位图字段， 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主题菜单的支持。在菜单单元中的原始实现是诚实可怜的。 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员工发表的博客文章，由于某些原因已被从互联网上删除（但由存档。 org ）。但细节很简单。将PARGB32位图放入 hbmpItem 中，让系统绘制菜单。然后这一切都很好。

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 菜单单元并没有使这个容易实现。事实上，这个单位在香草形式是不可能的。为了实现这一点，您需要修改该单元中的代码。您需要更改选择自定义绘制菜单的代码。而是将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.

我不能很容易地共享代码，因为它涉及修改菜单单位在少数地方。而菜单代码不是我的分享。但是要点是：

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.

一个寻找想法的好地方是龟龟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- <2D> -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时间框架中挖出了一些代码e。我确定它仍然适用。

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

在我的修改版本的菜单的界面部分顶部单位我声明这个界面：

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或者以上版本，如果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屋！