5

Here is (more or less) a related question: Delphi - Populate an imagelist with icons at runtime 'destroys' transparency.

I have tested @TOndrej answer. But it seems I need to have visual styles (XP Manifest) enabled for this to work (version 6.0 of Windows common controls will be used - which I don't want right now). I add the Icons at run-time via ExtractIconEx and ImageList_AddIcon.

Apparently setting ImageList.Handle to use System Image-List handle, does not require XP Manifest. so even an old program I wrote back in D3 is showing up with alpha blended icons correctly when I use the System image list to display file listing (with a TListView).

I was wandering What is special about the System Image List and how is it created, so that it supports alpha blending in all cases? I can't figure that out. Here is some sample code:

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.

Visual Styles Disabled:

enter image description here

Visual Styles Enabled:

enter image description here


A Workaround is to use interposer class or subclass TImageList and override DoDraw as shown here, but what I really want to know is how to create my image list same as system Image list.

Note: I know about TPngImageList and don't want to use it in this case.


Edit: @David's answer (and comments) were accurate:

You'll have to explicitly link to ImageList_Create (v6) because otherwise it is implicitly linked at module load time and will be bound to v5.8

Sample code (no use of activation context 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 that shows how it's done correctly via Activation Context API.

Community
  • 1
  • 1
kobik
  • 21,001
  • 4
  • 61
  • 121

1 Answers1

5

There are two versions of the image list controls. The v5.8 version and the v6 version. The system image list is a shared coonent owned by the system and uses the v6 version. It's not special in any other way, it's just a plain v6 images list. In your app, your image list is either v5.8 or v6 depending on whether or not you include the manifest. But the system owned image list is always v6.

I don't know why you don't want to use v6 common controls in your app. But with that constraint you could use the activation context API to locally use v6 common controls just while you create your image list. That would solve your problem and leave the rest of your app with v5.8 common controls.

David Heffernan
  • 601,492
  • 42
  • 1,072
  • 1,490
  • That makes a lot of sense. I never even thought about that the system image list may use a different version control outside my process. based on your answer [here](http://stackoverflow.com/a/5133222/937125) I remove the line `if IsLibrary then`, but I fail to understand how to do it in my EXE. specially the lines: `ActCtx.dwFlags := ACTCTX_FLAG_RESOURCE_NAME_VALID or ACTCTX_FLAG_HMODULE_VALID;` and `ActCtx.lpResourceName := MakeIntResource(2);` – kobik Mar 30 '12 at 13:58
  • I have tried `ActCtx.lpSource` with valid manifest. `ActCtx.dwFlags` is set to 0. that dose not made any difference. the icon is still invalid. – kobik Mar 30 '12 at 14:57
  • 1
    You'll have to explicitly link to `ImageList_Create` because otherwise it is implicitly linked at module load time and will be bound to v5.8. I can't say I've ever tried this. It's not a completely trivial job. You will need to watch under a debugger (e.g. ms depends or process explorer) and be sure that you are making v6 comctl to load. – David Heffernan Mar 30 '12 at 15:15
  • OK, but am I correct in that you don't want v6 comctl32 for your app? You only want a v6 image list? – David Heffernan Mar 30 '12 at 15:45
  • you were correct: "You'll have to explicitly link to ImageList_Create".look at my edit. – kobik Mar 31 '12 at 15:38
  • @kobik If all you actually need is the call to `ImageList_Create` then I can show you how to do that with activation context API. Your code will fail on other machines because of the hard coded path. – David Heffernan Mar 31 '12 at 15:43
  • 1
    I stuck it in a pastebin for you: http://pastebin.com/dvMiGJ78 I'm a bit dubious about it though because when you get the image list handle, the future API calls that use it will be sent to the 5.8 DLL. However, it does seem to work in your test app. Good luck. – David Heffernan Apr 01 '12 at 16:09
  • I have tested your code, and It works as expected. I believe that the key here is only in the `ImageList_Create` handle. the same is done with `Button2Click` -> `ImageList1.Handle := SysImageList` (which works fine without visual styles) as you said the `SysImageList` uses the v6 version. Thanks for a perfect answer! :) – kobik Apr 01 '12 at 17:57
  • There must be some magic behind the scenes in Windows though. Note that TImageList will call Win32 APIs that link explcitly againts v5.8. Anyway, seems that the magic works! – David Heffernan Apr 01 '12 at 18:01