È un menu principale a tema con icone possibili in Delphi?

Question

Sto usando Delphi 7. Provalo su Windows 7.

Lascia un TMainMenu e un TImageList su un modulo. Aggiungi alcuni menu allo TMainMenu e alcune immagini allo TImageList. Quando il TImageList non è assegnato al TMainMenu 's proprietà Images, l'applicazione si presenta così:

Ma una volta che il TImageList è assegnato al TMainMenu' Images proprietà s, l'applicazione si presenta così:

ulteriormente più, se la proprietà Images viene modificata (assegnato o non assegnato) in fase di esecuzione, solo il sottomenu si modifica di ems, le voci del menu radice (File, Modifica, Strumenti, Impostazioni e Guida nella mia applicazione di esempio) non cambiano mai: rimangono sempre a tema se la proprietà Images non è stata assegnata in fase di progettazione, o rimangono sempre senza tema se la proprietà Images è stata assegnata in fase di progettazione.

E infine, tutto questo sta accadendo o meno XPManifest utilizzato.

Quindi, le mie domande sono:

1. Perché la tematizzazione sparire quando si utilizzano le icone? Direi che le icone sono disegnate internamente usando qualcosa come il disegno del proprietario, che rompe il tema, ma è solo un'ipotesi.

2. Perché il menu principale è a tema, anche se XPManifest non viene utilizzato?

3. E, soprattutto, come posso avere un menu a tema con icone?

Answer 1

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:

1. Non possedere il menu per Vista e versioni successive. Nota che hai ancora bisogno di disegnare il proprietario per XP.
2. Crea versioni bitmap PARGB32 delle tue icone.
3. 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:

• 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-Adding-icons-to-standard-menus.aspx

---

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;