Question

I have a GUI application which includes a number of icons used for toolbar buttons, menu glyphs, notification icons etc. These icons are linked to the application as resources and a variety of different sizes are available. Typically, for toolbar button images I have available 16px, 24px and 32px versions. My icons are 32bpp with partial transparency.

The application is high DPI aware and adjusts the size of all visual elements according to the prevailing font scaling. So, for example, at 100% font scaling, 96dpi, the toolbar icon size is 16px. At 125% scaling, 120dpi, the toolbar icon size is 20px. I need to be able to load an icon of size 20px without any aliasing effects. How can I do this? Note that I would like to support Windows 2000 and later.

Answer 1

On Vista and up a number of new functions were added that make this task trivial. The function that is most appropriate here is LoadIconWithScaleDown.

This function will first search the icon file for an icon having exactly the same size. If a match is not found, then unless both cx and cy match one of the standard icon sizes—16, 32, 48, or 256 pixels— the next largest icon is selected and then scaled down to the desired size. For example, if an icon with an x dimension of 40 pixels is requested by the callign application, the 48-pixel icon is used and scaled down to 40 pixels. In contrast, the LoadImage function selects the 32-pixel icon and scales it up to 40 pixels.

If the function is unable to locate a larger icon, it defaults to the standard behavior of finding the next smallest icon and scaling it up to the desired size.

In my experience this function does an excellent job of scaling and the results show no signs of aliasing.

For earlier versions of Windows there is, to the very best of my knowledge, no single function that can perform this task adequately. The results obtained from LoadImage are of very poor quality. Instead the best approach I have found is as follows:

1. Examine the available images in the resource to find the image with the largest size that is less than desired icon size.
2. Create a new icon of the desired size and initialise it to be fully transparent.
3. Place the smaller icon from the resource in the centre of the new (larger) icon.

This means that there will be a small transparent border around the icon, but typically this is small enough to be insignificant. The ideal option would be to use code that could scale down just as LoadIconWithScaleDown does, but that is non-trivial to write.

So, without further ado here is the code I use.

unit uLoadIconResource;

interface

uses
  SysUtils, Math, Classes, Windows, Graphics, CommCtrl;

function LoadIconResourceSize(const ResourceName: string; IconSize: Integer): HICON;//will not throw an exception
function LoadIconResourceMetric(const ResourceName: string; IconMetric: Integer): HICON;

implementation

function IconSizeFromMetric(IconMetric: Integer): Integer;
begin
  case IconMetric of
  ICON_SMALL:
    Result := GetSystemMetrics(SM_CXSMICON);
  ICON_BIG:
    Result := GetSystemMetrics(SM_CXICON);
  else
    raise EAssertionFailed.Create('Invalid IconMetric');
  end;
end;

procedure GetDIBheaderAndBits(bmp: HBITMAP; out bih: BITMAPINFOHEADER; out bits: Pointer);
var
  pbih: ^BITMAPINFOHEADER;
  bihSize, bitsSize: DWORD;
begin
  bits := nil;
  GetDIBSizes(bmp, bihSize, bitsSize);
  pbih := AllocMem(bihSize);
  Try
    bits := AllocMem(bitsSize);
    GetDIB(bmp, 0, pbih^, bits^);
    if pbih.biSize<SizeOf(bih) then begin
      FreeMem(bits);
      bits := nil;
      exit;
    end;
    bih := pbih^;
  Finally
    FreeMem(pbih);
  End;
end;

function CreateIconFromSmallerIcon(IconSize: Integer; SmallerIcon: HICON): HICON;

  procedure InitialiseBitmapInfoHeader(var bih: BITMAPINFOHEADER);
  begin
    bih.biSize := SizeOf(BITMAPINFOHEADER);
    bih.biWidth := IconSize;
    bih.biHeight := 2*IconSize;//height of xor bitmap plus height of and bitmap
    bih.biPlanes := 1;
    bih.biBitCount := 32;
    bih.biCompression := BI_RGB;
  end;

  procedure CreateXORbitmap(const sbih, dbih: BITMAPINFOHEADER; sptr, dptr: PDWORD);
  var
    line, xOffset, yOffset: Integer;
  begin
    xOffset := (IconSize-sbih.biWidth) div 2;
    yOffset := (IconSize-sbih.biHeight) div 2;
    inc(dptr, xOffset + IconSize*yOffset);
    for line := 0 to sbih.biHeight-1 do begin
      Move(sptr^, dptr^, sbih.biWidth*SizeOf(DWORD));
      inc(dptr, IconSize);//relies on the fact that no padding is needed for RGBA scanlines
      inc(sptr, sbih.biWidth);//likewise
    end;
  end;

var
  SmallerIconInfo: TIconInfo;
  sBits, xorBits: PDWORD;
  xorScanSize, andScanSize: Integer;
  xorBitsSize, andBitsSize: Integer;
  sbih: BITMAPINFOHEADER;
  dbih: ^BITMAPINFOHEADER;
  resbitsSize: DWORD;
  resbits: Pointer;

begin
  Result := 0;
  Try
    if not GetIconInfo(SmallerIcon, SmallerIconInfo) then begin
      exit;
    end;
    Try
      GetDIBheaderAndBits(SmallerIconInfo.hbmColor, sbih, Pointer(sBits));
      if Assigned(sBits) then begin
        Try
          if (sbih.biWidth>IconSize) or (sbih.biHeight>IconSize) or (sbih.biPlanes<>1) or (sbih.biBitCount<>32) then begin
            exit;
          end;

          xorScanSize := BytesPerScanline(IconSize, 32, 32);
          Assert(xorScanSize=SizeOf(DWORD)*IconSize);
          andScanSize := BytesPerScanline(IconSize, 1, 32);
          xorBitsSize := IconSize*xorScanSize;
          andBitsSize := IconSize*andScanSize;
          resbitsSize := SizeOf(BITMAPINFOHEADER) + xorBitsSize + andBitsSize;
          resbits := AllocMem(resbitsSize);//AllocMem zeroises the memory
          Try
            dbih := resbits;
            InitialiseBitmapInfoHeader(dbih^);

            xorBits := resbits;
            inc(PByte(xorBits), SizeOf(BITMAPINFOHEADER));
            CreateXORbitmap(sbih, dbih^, sBits, xorBits);

            //don't need to fill in the mask bitmap when using RGBA
            Result := CreateIconFromResourceEx(resbits, resbitsSize, True, $00030000, IconSize, IconSize, LR_DEFAULTCOLOR);
          Finally
            FreeMem(resbits);
          End;
        Finally
          FreeMem(sBits);
        End;
      end;
    Finally
      if SmallerIconInfo.hbmMask<>0 then begin
        DeleteObject(SmallerIconInfo.hbmMask);
      end;
      if SmallerIconInfo.hbmColor<>0 then begin
        DeleteObject(SmallerIconInfo.hbmColor);
      end;
    End;
  Finally
    DestroyIcon(SmallerIcon);
  End;
end;

function LoadIconResourceSize(const ResourceName: string; IconSize: Integer): HICON;//will not throw an exception

  function LoadImage(IconSize: Integer): HICON;
  begin
    Result := Windows.LoadImage(HInstance, PChar(ResourceName), IMAGE_ICON, IconSize, IconSize, LR_DEFAULTCOLOR);
  end;

type
  TGrpIconDir = packed record
    idReserved: Word;
    idType: Word;
    idCount: Word;
  end;

  TGrpIconDirEntry = packed record
    bWidth: Byte;
    bHeight: Byte;
    bColorCount: Byte;
    bReserved: Byte;
    wPlanes: Word;
    wBitCount: Word;
    dwBytesInRes: DWORD;
    wID: WORD;
  end;

var
  i, BestAvailableIconSize, ThisSize: Integer;
  ResourceNameWide: WideString;
  Stream: TResourceStream;
  IconDir: TGrpIconDir;
  IconDirEntry: TGrpIconDirEntry;

begin
  //LoadIconWithScaleDown does high quality scaling and so we simply use it if it's available
  ResourceNameWide := ResourceName;
  if Succeeded(LoadIconWithScaleDown(HInstance, PWideChar(ResourceNameWide), IconSize, IconSize, Result)) then begin
    exit;
  end;

  //XP: find the closest sized smaller icon and draw without stretching onto the centre of a canvas of the right size
  Try
    Stream := TResourceStream.Create(HInstance, ResourceName, RT_GROUP_ICON);
    Try
      Stream.Read(IconDir, SizeOf(IconDir));
      Assert(IconDir.idCount>0);
      BestAvailableIconSize := high(BestAvailableIconSize);
      for i := 0 to IconDir.idCount-1 do begin
        Stream.Read(IconDirEntry, SizeOf(IconDirEntry));
        Assert(IconDirEntry.bWidth=IconDirEntry.bHeight);
        ThisSize := IconDirEntry.bHeight;
        if ThisSize=0 then begin//indicates a 256px icon
          continue;
        end;
        if ThisSize=IconSize then begin
          //a perfect match, no need to continue
          Result := LoadImage(IconSize);
          exit;
        end else if ThisSize<IconSize then begin
          //we're looking for the closest sized smaller icon
          if BestAvailableIconSize<IconSize then begin
            //we've already found one smaller
            BestAvailableIconSize := Max(ThisSize, BestAvailableIconSize);
          end else begin
            //this is the first one that is smaller
            BestAvailableIconSize := ThisSize;
          end;
        end;
      end;
      if BestAvailableIconSize<IconSize then begin
        Result := CreateIconFromSmallerIcon(IconSize, LoadImage(BestAvailableIconSize));
        if Result<>0 then begin
          exit;
        end;
      end;
    Finally
      FreeAndNil(Stream);
    End;
  Except
    ;//swallow because this routine is contracted not to throw exceptions
  End;

  //final fallback: make do without
  Result := 0;
end;

function LoadIconResourceMetric(const ResourceName: string; IconMetric: Integer): HICON;
begin
  Result := LoadIconResourceSize(ResourceName, IconSizeFromMetric(IconMetric));
end;

end.

Using these function is quite obvious. They assume that the resource is located in the same module as the code. The code could readily be generalised to receive an HMODULE in case you needed support for that level of generality.

Call LoadIconResourceMetric if you wish to load icons of size equal to the system small icon or system large icon. The IconMetric parameter should be either ICON_SMALL or ICON_BIG. For toolbars, menus and notification icons, ICON_SMALL should be used.

If you wish to specify the icon size in absolute terms use LoadIconResourceSize.

These functions return an HICON. You can of course assign this to the Handle property of a TIcon instance. More likely you will wish to add to an image list. The easiest way to do this is to call ImageList_AddIcon passing the Handle of the TImageList instance.

Note 1: Older versions of Delphi do not have LoadIconWithScaleDown defined in CommCtrl. For such Delphi versions you need to call GetProcAddress to load it. Note that this is a Unicode only API and so you must send it a PWideChar for the resource name. Like this: LoadIconWithScaleDown(..., PWideChar(WideString(ResourceName)),...).

Note 2: The definition of LoadIconWithScaleDown is flawed. If you call it after the common controls library has been initialised then you will have no problems. However, if you call the function early on in the life of your process then LoadIconWithScaleDown can fail. I have just submitted QC#101000 to report this problem. Again, if you are afflicted by this then you have to call GetProcAddress yourself.