How to paint standard windows information icon nicely to the index of a pagecontrol's tab

Question

I would like the standard windows information (and warning and error) icons painted to the index of a tab of a pagecontrol. However the result is looking bad if the windows background color is not white.

program Project111;

uses
  Vcl.Forms,
  Vcl.Controls,
  Vcl.Graphics,
  Winapi.Windows,
  Vcl.ComCtrls,
  Vcl.ImgList;

{$R *.res}

var
  mainForm: TForm;
  imageList: TImageList;
  icon: TIcon;
  pageControl: TPageControl;
  tabSheet: TTabSheet;
begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;

  Application.CreateForm(TForm, mainForm);

  imageList := TImageList.Create(mainForm);
  imageList.ColorDepth := cd32bit;
  icon := TIcon.Create;
  try
    icon.Handle := LoadImage( 0, IDI_INFORMATION, IMAGE_ICON, 16, 16, {LR_DEFAULTSIZE or} LR_SHARED );
    imageList.AddIcon(icon);
  finally
    icon.Free;
  end;

  pageControl := TPageControl.Create(mainForm);
  pageControl.Parent := mainForm;
  pageControl.Images := imageList;

  tabSheet := TTabSheet.Create(mainForm);
  tabSheet.Parent := pageControl;
  tabSheet.PageControl := pageControl;
  tabSheet.ImageIndex := 0;

  Application.Run;
end.

Here is a screenshot:

As you can see the white border is fuzzy, I guess it is because of lack of proper alpha transparency by TImageList but I don't know how to fix this.

The solution does not have to use TImageList, I am happy to use any other approach. Note that there will be also captions and not all indexes will have icons and the icons might changed/added/removed as the context changes.

I am using Delphi XE-2, I also have the DevExpress components if that helps.

Answer 1

As @Sertac says what you see is the effect of resize the windows shell icon from 32x32 to 16x16, As workaround starting with Windows Vista you can use the SHGetStockIconInfo function. passing the SHGSI_SMALLICON flag to retrieve the small version of the icon, as specified by the SM_CXSMICON and SM_CYSMICON.

The values of SM_CXSMICON and SM_CYSMICON depends of the current DPI Setting. For DPI 96 is 16x16.

Sample

  LIcon := TIcon.Create;
  try
    LIcon.Handle := 0;
    if TOSVersion.Check(6, 0) then
    begin
      ZeroMemory(@LSHStockIconInfo, SizeOf(LSHStockIconInfo));
      LSHStockIconInfo.cbSize := sizeof(LSHStockIconInfo);
      if SHGetStockIconInfo(SIID_INFO, SHGSI_ICON or SHGSI_SMALLICON, LSHStockIconInfo) = S_OK then
      begin
        LIcon.Handle := LSHStockIconInfo.hIcon;
        imageList.AddIcon(LIcon);
      end;
    end;
  finally
    LIcon.Free;
  end;

Answer 2

What you see is not because of broken alpha transparency but a resizing artifact.

As documented, the default size of an icon LoadImage loads is SM_CXICONxSM_CYICON, which is typically 32x32. Since you are requesting an icon that's shared by the system, this will be the size of the icon that will be given.

You can verify if this is the case in your code:

  ..
  try
    icon.Handle := LoadImage( 0, IDI_INFORMATION, IMAGE_ICON, 16, 16, {LR_DEFAULTSIZE or} LR_SHARED );
    Assert(icon.Width = GetSystemMetrics(SM_CXICON));
    Assert(GetSystemMetrics(SM_CXICON) <> 16);
    ..

What follows is that the icon gets resized to fit the image list probably by nothing better than StretchBlt with COLORONCOLOR mode.

Unfortunately it is not possible to load a system icon with a non-standard size, because, as again documented,

When loading a system icon or cursor, you must use LR_SHARED or the function will fail to load the resource.

What you need to do is to load the shared icon with its default size and then resize it to 16x16 yourself using a better algorithm. StretchBlt with HALFTONE would be probably better but using a more advanced graphics library could produce best results.

A strongly discouraged alternative is to load the resource directly from where it resides. If you don't use the LR_SHARED flag you'll be given the size requested. You need to do some research to find the actual index of the icon since this is not documented. And need to consider that the index or where it lives might change in time. Don't forget to destroy the icon yourself in this case since the system won't do it for a non-shared resource.

icon.Handle := LoadImage(GetModuleHandle(user32), Pointer(104), IMAGE_ICON, 16, 16, 0);