Ecco (più o meno) una domanda correlata: Delphi - Populate an imagelist with icons at runtime 'destroys' transparency.Imagelist con le icone di fusione alfa perde trasparenza
Ho provato @TOndrej answer. Ma sembra che sia necessario che gli stili di visualizzazione (XP Manifest) siano abilitati affinché funzioni (verrà utilizzata la versione 6.0 dei controlli comuni di Windows, cosa che non desidero in questo momento). Aggiungo le icone in fase di esecuzione tramite ExtractIconEx
e ImageList_AddIcon
.
Apparentemente l'impostazione di ImageList.Handle
per utilizzare l'handle Elenco immagini di sistema, non richiede richiedere XP Manifest. quindi anche un vecchio programma che ho scritto in D3 viene visualizzato correttamente con icone alfa quando utilizzo l'elenco delle immagini di sistema per visualizzare l'elenco dei file (con un TListView
).
mi aggiravo Qual è la particolarità della lista immagine di sistema e come viene creato, in modo che esso supporta alpha blending in tutti i casi? Non riesco a capirlo. Ecco alcuni esempi di codice:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, ImgList, StdCtrls, ShellAPI, ExtCtrls, Commctrl;
type
TForm1 = class(TForm)
ImageList1: TImageList;
PopupMenu1: TPopupMenu;
MenuItem1: TMenuItem;
Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
FileName: string;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
// {$R WindowsXP.res}
procedure TForm1.FormCreate(Sender: TObject);
begin
PopupMenu1.Images := ImageList1;
FileName := 'C:\Program Files\Mozilla Firefox\firefox.exe';
end;
procedure TForm1.Button1Click(Sender: TObject);
var
IconPath: string;
IconIndex: Integer;
hIconLarge, hIconSmall: HICON;
begin
IconPath := FileName;
IconIndex := 0; // index can be other than 0
ExtractIconEx(PChar(IconPath), IconIndex, hIconLarge, hIconSmall, 1);
Self.Refresh; // erase form
DrawIconEx(Canvas.Handle, 10, 10, hIconSmall, 0, 16, 16, 0,
DI_IMAGE or DI_MASK); // this will draw ok on the form
// ImageList1.DrawingStyle := dsTransparent;
ImageList1.Handle := ImageList_Create(ImageList1.Width, ImageList1.Height,
{ILC_COLORDDB} ILC_COLOR32 or ILC_MASK, 0, ImageList1.AllocBy);
ImageList_AddIcon(ImageList1.Handle, hIconSmall);
MenuItem1.ImageIndex := 0;
DestroyIcon(hIconSmall);
DestroyIcon(hIconLarge);
PopupMenu1.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);
end;
procedure TForm1.Button2Click(Sender: TObject);
// using sys image-list will work with or without Manifest
type
DWORD_PTR = DWORD;
var
ShFileINfo :TShFileInfo;
SysImageList: DWORD_PTR;
FileName: string;
begin
SysImageList := ShGetFileInfo(nil, 0, ShFileInfo, SizeOf(ShFileInfo),
SHGFI_SYSICONINDEX OR SHGFI_SMALLICON);
if SysImageList = 0 then Exit;
ImageList1.Handle := SysImageList;
ImageList1.ShareImages := True;
if ShGetFileInfo(PChar(FileName), 0, ShFileInfo, SizeOf(ShFileInfo),
SHGFI_SYSICONINDEX OR SHGFI_ICON OR SHGFI_SMALLICON) <> 0 then
begin
MenuItem1.ImageIndex := ShFileInfo.IIcon;
Self.Refresh; // erase form
DrawIconEx(Canvas.Handle, 10, 10, ShFileInfo.hIcon, 0, 16, 16, 0,
DI_IMAGE or DI_MASK);
DestroyIcon(ShFileInfo.hIcon); // todo: do I need to destroy here?
PopupMenu1.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);
end;
end;
end.
stili visivi disabili:
stili visivi Abilitato:
Una soluzione è quella di utilizzare la classe di interposizione o sottoclasse TImageList
e sovrascrivere DoDraw
as shown here, ma quello che veramente voglio sapere è come creare la mia lista immagine stessa lista di sistema Immagine.
Nota: so di TPngImageList
e non voglio usarlo in questo caso.
Edit: @ risposta di David (e commenti) erano accurate:
dovrete collegare esplicitamente ImageList_Create (V6) a causa altrimenti è implicitamente legata a carico del modulo tempo e sarà vincolato a v5.8
codice campione (senza uso del contesto di attivazione API):
function ImageList_Create_V6(CX, CY: Integer; Flags: UINT; Initial, Grow: Integer): HIMAGELIST;
var
h: HMODULE;
_ImageList_Create: function(CX, CY: Integer; Flags: UINT;
Initial, Grow: Integer): HIMAGELIST; stdcall;
begin
// TODO: find comctl32.dll v6 path programmatically
h := LoadLibrary('C:\WINDOWS\WinSxS\x86_Microsoft.Windows.Common-Controls_6595b64144ccf1df_6.0.2600.5512_x-ww_35d4ce83\comctl32.dll');
if h <> 0 then
try
_ImageList_Create := GetProcAddress(h, 'ImageList_Create');
if Assigned(_ImageList_Create) then
Result := _ImageList_Create(CX, CY, Flags, Initial, Grow);
finally
FreeLibrary(h);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
...
ImageList1.Handle := ImageList_Create_V6(ImageList1.Width, ImageList1.Height,
ILC_COLOR32 or ILC_MASK, 0, ImageList1.AllocBy);
...
end;
Edi2:A sample code by @David che mostra come è fatto correttamente tramite l'attivazione di contesto API.
Questo ha molto senso. Non ho mai nemmeno pensato che l'elenco delle immagini di sistema possa utilizzare un controllo di versione diverso al di fuori del mio processo. in base alla risposta [qui] (http://stackoverflow.com/a/5133222/937125) rimuovo la riga 'if IsLibrary then', ma non riesco a capire come farlo nel mio EXE. specialmente le linee: 'ActCtx.dwFlags: = ACTCTX_FLAG_RESOURCE_NAME_VALID o ACTCTX_FLAG_HMODULE_VALID;' e 'ActCtx.lpResourceName: = MakeIntResource (2);' – kobik
Ho provato 'ActCtx.lpSource' con manifest valido. 'ActCtx.dwFlags' è impostato su 0. quella dose non ha fatto alcuna differenza. l'icona non è ancora valida. – kobik
Dovrai linkare esplicitamente a 'ImageList_Create' perché altrimenti è implicitamente collegato al tempo di caricamento del modulo e sarà associato alla v5.8. Non posso dire di aver mai provato questo. Non è un lavoro completamente banale. Dovrai guardare sotto un debugger (ad esempio ms dipende o process explorer) ed essere sicuro che stai facendo caricare v6 comctl. –