Question

我正在使用 Delphi 7 。在Windows 7上进行测试。

在表单上放置TMainMenu和TImageList。将一些菜单添加到TMainMenu，将一些图像添加到TImageList。如果未将TImageList分配给TMainMenu的{{1}}属性，则应用程序如下所示：

Delphi themed TMainMenu without icons

但是，Images分配给TImageList TMainMenu属性后，应用程序如下所示：

Delphi non-themed TMainMenu with icons

此外，如果在运行时更改（分配或取消分配）Images属性，则仅更改子菜单项，根菜单项（示例中的文件，编辑，工具，设置和帮助）应用程序）永远不会改变 - 如果在设计时没有分配Images属性，它们总是保持主题，或者如果在设计时分配了Images属性，它们总是保持非主题。

最后，无论是否使用Images，所有这一切都在发生。

所以，我的问题是：

1。当使用图标时，为什么主题会消失？我猜测图标是使用像所有者绘图这样的内部绘制的，这会破坏主题，但这只是猜测。

2。即使未使用XPManifest，为什么主菜单会以主题为主？

第3。最重要的是，如何制作带图标的主题菜单？

Answer 1

我希望这个答案不会像太多的咆哮那样出现，但这是一个Embarcadero历史悠久的错误步骤。我在这个领域提交了大量的质量控制报告，所以也许我有点苦。也就是说，最新版本的Delphi似乎以可接受的方式实现了菜单。最近我带他们去旋转时，我无法绊倒XE6菜单。但它需要很长时间才能赶上来。

您的Delphi会在Vista之前发布。 Vista是Windows菜单的最佳选择。尽管主题API是在XP中引入的，但它对菜单没有实际影响。在Vista中改变了。但是Delphi 7就在此之前，并且在编写时考虑了XP。

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

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

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

现代版本的Delphi逐渐增加了对Vista主题菜单的支持。诚实地，Menus单元中的原始实现是可怜的。 Embarcadero设计师选择使用主题API绘制菜单。对于所有意图和目的而言，未记录的API。关于该API的最佳信息来源可能是Delphi源代码（！）和Wine源代码。在这里向MSDN寻求帮助毫无意义。所以，我确实对这里的Embarcadero表示同情，对于那些不得不解决这个问题的可怜的工程师。并使用该软件的5个版本来清除错误。

然而，Embarcadero也应该得到一些辱骂。因为它可以使系统在Vista上向上绘制包含字形的主题菜单。秘密是hbmpItem字段。虽然它在XP上的使用有限，但它在Vista上自成一体。你不会在任何地方找到这方面的文件。唯一一个很好的文档来源，由MS职员在Shell Revealed博客上发布的博客文章，出于某种原因已从互联网上删除（但由archive.org捕获）。但细节很简单。将PARGB32位图放入hbmpItem，然后让系统绘制菜单。然后一切都很好。

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

所以，这就是你如何用Delphi 7中的图标实现主题菜单。我当时实际上是为Delphi 6实现的，但代码是一样的。即使在我目前的XE3代码库中，我仍然使用相同的方法。为什么？因为我相信系统绘制菜单的次数超过了我对VCL代码的信任。

我无法轻松共享代码，因为它涉及在少数几个地方修改Menus单元。 Menus代码不是我要分享的。但要点是：

不是所有者为Vista及更高版本绘制菜单。请注意，您仍需要XP的所有者绘图。
创建图标的PARGB32位图版本。
将这些位图放入hbmpItem并让系统完成剩下的工作。

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

一些链接：

我从Delphi 6时间框架中挖出了一些代码。我确信它仍然适用。

在Menus单元的修改版本的界面部分的顶部，我声明了这个界面：

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

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

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;

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

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中是否可以使用带图标的主题主菜单？

1 个答案: