主题菜单中有可能在Delphi中的图标吗？

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

在表单上放一个TMainMenu和一个TImageList.添加一些菜单到TMainMenu和一些图像到TImageList.当TImageList未分配给TMainMenu的Images属性时,应用程序如下所示：

但是,一旦将TImageList分配给TMainMenu的Images属性,应用程序如下所示：

此外,如果在运行时更改(分配或未分配)Images属性,则只会更改子菜单项,根菜单项(我的示例应用程序中的文件,编辑,工具,设置和帮助)从不改变 – 它们如果在设计时没有分配Images属性,则始终保持主题,或者如果在设计时分配了Images属性,则它们始终保持非主题.

最后,无论XPManifest是否使用,所有这些都会发生.

所以我的问题是：

为什么使用图标时主题会消失？我猜这个图标是在内部使用像“Owner Drawing”这样的东西来绘制的,这个打破了主题,但这只是一个猜测.

2.为什么主菜单为主题,即使不使用XPManifest？

最重要的是,如何使用图标的主题菜单？

解决方法

我希望这个答案并没有发生太多的恶化,但是这是Embarcadero历史悠久的一个误区.我在这方面提交了大量的质检报告,所以也许我有点苦.也就是说,Delphi的最新版本似乎以可接受的方式实现菜单.当我最近接手他们的时候,我无法脱身XE6菜单.但是他们花了很长时间赶上了.

您的Delphi预览Vista.而Vista则是Windows菜单中最棒的水壶.虽然在XP中引入了主题API,但它对菜单没有真正的影响.在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员工发表的博客文章,由于某些原因已被从互联网上删除(但被archive.org捕获).但细节很简单.将PARGB32位图放入hbmpItem中,让系统画出菜单.然后这一切都很好.

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

所以,这就是您在Delphi 7中如何实现主题菜单的图标.我实际上在Delphi 6中实现了这一点,但代码是一样的.即使在目前的XE3代码库中,我仍然使用相同的方法.为什么？因为我信任系统来绘制菜单,而不是信任VCL代码.

我不能容易地共享代码,因为它涉及到在少数几个地方修改菜单单元.而菜单代码不是我的分享.但要点是：

>所有者不要画Vista或更高版本的菜单.请注意,您仍然需要XP的所有者绘制.
>创建您的图标的PARGB32位图版本.
>将这些位图放入hbmpItem中,让系统执行其余操作.

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

一些链接：

> @L_403_1@
> 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时间框架中挖出了一些代码.我确定它仍然适用.

在我修改版本的菜单单元的接口部分的顶部,我宣布这个接口：

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,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);
        if Result<>0 then begin
          cbStride := cx*SizeOf(DWORD);
          cbBuffer := cy*cbStride;
          if not Succeeded(Bitmap.CopyPixels(TWICRECT(nil^),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中的图标吗？

解决方法

猜你在找的Delphi相关文章