Spero che questa risposta non sembri un errore, ma questa è un'area in cui Embarcadero ha una lunga storia di passaggi errati. Ho presentato un gran numero di rapporti di QC in quest'area, quindi forse sono un po 'amareggiato. Detto questo, le versioni più recenti di Delphi sembrano implementare i menu in modo accettabile. Non sono stato in grado di far scattare i menu XE6 quando li ho presi di recente. Ma ci sono voluti molto tempo per recuperare.
Il tuo Delphi pre-data Vista. E Vista era il grande acquedotto per i menu di Windows. Sebbene l'API del tema sia stata introdotta in XP, non ha avuto alcun impatto reale sui menu. Questo è cambiato in Vista. Ma Delphi 7 era prima di tutto questo ed era codificato con XP in mente.
In XP, disegnare menu con glifi non era facile. La struttura MENUITEMINFO
ha un campo bitmap, hbmpItem
. Ma in XP è di uso limitato. Un menu XP disegnato dal sistema non disegnerà una bitmap alpha pulita su un menu. Tali menu richiedono il disegno del proprietario. E così nel codice Delphi 7, se il tuo menu ha qualche glifo, sarà disegnato dal proprietario. E proprietario disegnato usando le API XP.
Questo spiega la differenza tra i due screenshot nella domanda. Lo screenshot a tema è un menu senza glifi. Il codice dei menu di Delphi 7 chiede al sistema di disegnare il menu. E disegna menu a tema. Con o senza manifest di comctl32.Questo è il menu standard su Vista e successivi.
E quando si aggiungono glifi, il codice VCL che conosce solo XP, decide di aprire i menu dal proprietario. E lo fa usando la funzionalità di XP. Dopo tutto, non ci si può aspettare che utilizzi le API del menu a tema Vista. Il codice è precedente a quelli.
Le versioni moderne di Delphi hanno gradualmente aggiunto il supporto per i menu a tema Vista. Le implementazioni originali nell'unità Menus
erano, in tutta onestà, pietose. I designer Embarcadero hanno scelto di disegnare i menu utilizzando l'API del tema. Un'API che è, a tutti gli effetti, non documentata. Probabilmente la migliore fonte di informazioni su tale API è il codice sorgente Delphi (!) E il codice sorgente del vino. Inutile cercare su MSDN aiuto qui. Quindi, ho simpatia per Embarcadero qui, per il povero ingegnere che ha dovuto risolvere questo problema. E prendi 5 versioni del software per eliminare gli errori.
Tuttavia, anche l'Embarcadero merita un'infarinatura di diffamazione. Perché è possibile ottenere il sistema per disegnare menu a tema su Vista e su che contengono glifi. Il segreto è il campo hbmpItem
. Anche se è stato utilizzato in modo limitato su XP, è disponibile in Vista. Non troverai documentazione di questo ovunque. L'unica buona fonte di documentazione, un articolo del blog pubblicato da uno staff di MS sul blog di Shell Revealed, è stato rimosso per qualche motivo da Internet (ma è stato acquisito da archive.org). Ma i dettagli sono abbastanza semplici. Inserisci una bitmap PARGB32 in hbmpItem
e lascia che il sistema disegni il menu. E poi va tutto bene.
Ovviamente l'unità Delphi Menus
non lo rende facile da raggiungere. In realtà non è possibile con quella unità in forma di vaniglia. Per far sì che ciò accada, è necessario modificare il codice in quell'unità. È necessario modificare il codice che sceglie di disegnare il menu personalizzato. E invece create le bitmap PARGB32 da inserire in hbmpItem
e chiedete al sistema di dipingerle. Questo richiede un certo grado di abilità, non ultimo perché è necessario gestire la durata delle bitmap PARGB32 per evitare perdite di risorse.
Quindi, è così che si ottiene un menu a tema con icone in Delphi 7. In realtà l'ho implementato per Delphi 6 al momento, ma il codice è lo stesso. E anche nel mio attuale codebase che è in XE3, utilizzo ancora lo stesso approccio. Perché? Perché mi fido del sistema per disegnare i menu più di quanto mi fidi del codice VCL.
Impossibile condividere il codice facilmente perché comporta modifiche all'unità Menus
in una manciata di posti. E il codice Menus
non è il mio da condividere. Ma gli elementi essenziali sono:
- Non possedere il menu per Vista e versioni successive. Nota che hai ancora bisogno di disegnare il proprietario per XP.
- Crea versioni bitmap PARGB32 delle tue icone.
- Metti questi bitmap in
hbmpItem
e lascia che il sistema faccia il resto.
Un buon posto per cercare idee su questo è il codice sorgente Tortoise SVN. Questo usa questa tecnica non documentata per dipingere i suoi menù pesanti con glifi a tema.
Alcuni link:
ho tirato fuori un po 'del mio codice dal lasso di tempo Delphi 6. Sono sicuro che è ancora applicabile.
destra nella parte superiore della sezione di interfaccia della mia versione modificata del gruppo Menus
ho dichiarato questa interfaccia:
type
IImageListConvertIconToPARGB32Bitmap = interface
['{4D3E7D64-1288-4D0D-98FC-E61501573204}']
function GetPARGB32Bitmap(ImageIndex: Integer): HBITMAP;
end;
Questo viene implementato da una classe elenco di immagini e viene utilizzato per fornire bitmap PARGB32. Quindi, in TMenuItem.AppendTo
, se la versione è Vista o superiore, e se il codice VCL prevede di disegnare il proprietario, imposto lo IsOwnerDraw
su False
. Quindi utilizzare IImageListConvertIconToPARGB32Bitmap
per ottenere una bitmap 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;
L'implementazione della lista di immagini assomiglia a questo:
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;
Interessante lettura; grazie –
@David Heffernan, Embarcadero sta esaltando i nuovi menu in stile in XE6. Sono curioso di sapere se questo risolva i problemi discussi qui. –
@David I menu in stile fanno qualcos'altro. Disegnano i menu in stile non di sistema. Il codice per lo stile di sistema è lo stesso di sempre. Per essere onesti, Emba ha appianato i difetti con i menu in stile del sistema ormai. Ma penso ancora che lo facciano nel modo sbagliato dal disegno del proprietario. Preferirei che il sistema disegnasse i menu. –