在Delphi中是否可以使用带图标的主题主菜单？
jed*_*der 15 delphi icons themes menu delphi-7
我正在使用Delphi 7.在Windows 7上进行测试.
在表单上删除a TMainMenu和a TImageList.添加一些菜单TMainMenu和一些图像到TImageList.当TImageList没有分配到TMainMenu的Images属性,应用程序是这样的:
但是,一旦TImageList被分配到TMainMenu的Images属性,应用程序是这样的:
此外,如果Images在运行时更改(分配或取消分配)属性,只有子菜单项更改,根菜单项(我的示例应用程序中的文件,编辑,工具,设置和帮助)永远不会更改 - 它们始终如果Images在设计时没有分配财产,则保持主题,或者如果Images在设计时分配财产,它们始终保持非主题.
最后,所有这一切都在发生,无论是否XPManifest使用.
所以,我的问题是:
1.当使用图标时,为什么主题消失了？我猜这些图标是使用像所有者绘图这样的内部绘制的,它打破了主题,但这只是猜测.
2.为什么主菜单主题,即使XPManifest不使用？
3.最重要的是,我如何才能拥有带图标的主题菜单？
Dav*_*nan 18
我希望这个答案不会像太多的咆哮那样出现,但这是一个Embarcadero历史悠久的错误步骤.我在这个领域提交了大量的质量控制报告,所以也许我有点苦.也就是说,最新版本的Delphi似乎以可接受的方式实现了菜单.最近我带他们去旋转时,我无法绊倒XE6菜单.但它需要很长时间才能赶上来.
您的Delphi会在Vista之前发布.Vista是Windows菜单的最佳选择.尽管主题API是在XP中引入的,但它对菜单没有实际影响.在Vista中改变了.但是Delphi 7就是在它之前,并且在编写时考虑到了XP.
在XP中,带有字形的绘图菜单并不容易.该MENUITEMINFOstruct有一个位图字段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源代码.这使用这种未记录的技术来绘制其主题字形重菜单.
一些链接:
- 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-添加图标 -对标准menus.aspx
我从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;