Является ли тематическое Главное меню с иконками в Delphi?

163
22

Я использую Delphi 7. Тестирование этого на Windows 7.


Отбросьте a TMainMenu и a TImageList в форме. Добавьте несколько меню в TMainMenu и некоторые изображения в TImageList. Если TImageList НЕ присваивается свойству TMainMenu Images, приложение выглядит следующим образом:


Delphi themed TMainMenu without icons


Но как только TImageList присваивается свойству TMainMenu Images, приложение выглядит следующим образом:


Delphi non-themed TMainMenu with icons


Кроме того, если свойство Images изменяется (назначено или не назначено) во время выполнения, изменяются только элементы подменю, элементы корневого меню (Файл, Редактировать, Инструменты, Настройки и Справка в моем примере приложения) никогда не меняются - они всегда остаются тематическими, если свойство Images не было назначено во время разработки или они всегда остаются не-тематическими, если свойство Images было назначено во время разработки.


И, наконец, все это происходит независимо от того, используется ли XPManifest.


Итак, мои вопросы:


1. Почему тематика исчезает, когда используются значки? Я бы предположил, что значки нарисованы внутри, используя что-то вроде "Чертеж владельца", которое разбивает тематику, но это просто предположение.


2. Почему основное меню используется, даже если XPManifest не используется?


3. И самое главное, как я могу создать тематическое меню с иконками?

спросил(а) 2014-04-23T22:45:00+04:00 6 лет, 6 месяцев назад
1
Решение
177

Я надеюсь, что этот ответ не назовешь слишком большим количеством напыщенности, но это та область, где Embarcadero имеет долгую историю ошибочных шагов. Я представил большое количество отчетов по контролю качества в этой области, поэтому, возможно, я немного горький. Тем не менее, последние выпуски Delphi, похоже, реализуют меню приемлемым образом. Мне не удалось отключить меню XE6, когда я взял их за спину. Но им потребовалось много времени, чтобы наверстать упущенное.


Предварительная дата Delphi Vista. И Vista была отличным водоемом для меню Windows. Хотя API-интерфейс темы был введен в XP, он не оказал реального влияния на меню. Это изменилось в Vista. Но Delphi 7 был до этого и был закодирован с XP в виду.


В XP рисование меню с помощью глифов было непростым. Структура MENUITEMINFO имеет поле растрового изображения, hbmpItem. Но в XP это ограниченное использование. Системное графическое меню XP не отображает чистый альфа-растровый рисунок в меню. Такие меню требуют рисования владельца. И поэтому в коде Delphi 7, если в вашем меню есть какие-либо глифы, тогда он будет нарисован владельцем. И владелец обращается с использованием API-интерфейсов XP.


Это объясняет разницу между двумя скриншотами в вашем вопросе. Тематический скриншот - это меню без глифов. Меню меню Delphi 7 требует, чтобы система рисовала меню. И он рисует тематические меню. С манифестом comctl32 или без него. Это стандартное меню в Vista и позже.


И когда вы добавляете глифы, код VCL, который знает только о XP, решает владелец рисовать меню. И делает это с использованием функциональности XP. В конце концов, нельзя ожидать использования API-интерфейсов Vista с тематическим меню. Код предшествует этому.


Современные версии Delphi постепенно добавили поддержку тематических меню Vista. Первоначальные реализации в блоке Menus были, честно говоря, жалкими. Дизайнеры Embarcadero решили нарисовать меню, используя API-интерфейс темы. API, который, во всех смыслах и целях, недокументирован. Вероятно, лучшим источником информации об этом API является исходный код Delphi (!) И исходный код Wine. Здесь бессмысленно искать MSDN. Итак, у меня есть симпатия к Embarcadero здесь, для плохого инженера, который должен был это обработать. И возьмите 5 выпусков программного обеспечения, чтобы очистить ошибки.


Тем не менее, Эмбаркадеро также заслуживает небольшого количества прозрений. Для этого можно заставить систему рисовать тематические меню на 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. Я уверен, что он по-прежнему применим.


В верхней части раздела интерфейса моей измененной версии модуля 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;

ответил(а) 2014-04-23T23:22:00+04:00 6 лет, 6 месяцев назад
Ваш ответ
Введите минимум 50 символов
Чтобы , пожалуйста,
Выберите тему жалобы:

Другая проблема