How to draw a scaled version of images from the system ImageList?

Question

I create and initialize the TImageList...

ImageList:=TImageList.Create(self);
ImageList.ShareImages:=true;

I get the system ImageList handle for small icons (16x16)...

ImageList.Handle:=SHGetFileInfo('',0,FileInfo,SizeOf(FileInfo),SHGFI_SYSICONINDEX or SHGFI_SMALLICON);

And now I want to draw the icons on my control canvas scaled to 50x50 pixels. How I do this ?

Answer 1

Upscaling small icons is never good idea. 16X16 icon is too small to use it in any other way other as-is.

For start you can get larger shell images using

ImageList.Handle:=SHGetFileInfo('',0,FileInfo,SizeOf(FileInfo),SHGFI_SYSICONINDEX or SHGFI_ICON);

Those images will be generally 32x32 pix, but to be on safe side (if Windows are running in high DPI mode) you can get correct size from system

uses
  Winapi.Windows;

var
  IconWidth, IconHeight: integer;

  IconWidth := GetSystemMetrics(SM_CXICON);
  IconHeight := GetSystemMetrics(SM_CYICON);

You can also get even larger shell images with SHGetImageList http://msdn.microsoft.com/en-us/library/windows/desktop/bb762185%28v=vs.85%29.aspx

To retrieve icon from you ImageList (if ImageList contains icons, and in your case it does) you can use:

ImageList.GetIcon(Index: Integer; Image: TIcon);

For scaling icons, while preserving transparency, to custom dimension you can use following code:

procedure StretchDrawIcon(Canvas: TCanvas; Dest: TRect; Icon: TIcon);
begin
  DrawIconEx(Canvas.Handle, Dest.Left, Dest.Top, Icon.Handle, Dest.Right - Dest.Left, Dest.Bottom - Dest.Top, 0, 0, DI_NORMAL);
end;

Answer 2

TImageList does not support drawing a scaled image, it draws the image as-is. The only option it provides is to let you specify the X/Y coordinates where the image should be drawn on the destination Canvas.

To scale an image, you will have to extract the desired image to a temporary TBitmap first and call its Draw() method, which allows you to specify the desired rectangle on the destination Canvas. The bitmap will then stretch/scale its drawing to fill that rectangle as needed.

Answer 3

Since an extracted Icon can not be stretched with StretchDraw and a extracted Bitmap would lose the transparency one way might be to extract the Icons and manipulate the destination canvas using SetWorldTransform:

uses Shellapi, Math;

Procedure SetCanvasZoomAndRotation(ACanvas:TCanvas;Zoom:Double;Angle:Double;CenterpointX,CenterpointY:Double);
var
    form : tagXFORM;
    Winkel:Double;

begin
      Winkel := DegToRad(Angle);
      SetGraphicsMode(ACanvas.Handle, GM_ADVANCED);
      SetMapMode(ACanvas.Handle,MM_ANISOTROPIC);
      form.eM11 := Zoom * cos( Winkel);
      form.eM12 := Zoom *Sin( Winkel)  ;
      form.eM21 := Zoom * (-sin( Winkel));
      form.eM22 := Zoom * cos( Winkel) ;
      form.eDx := CenterpointX;
      form.eDy := CenterpointY;
      SetWorldTransform(ACanvas.Handle,form);
end;

 Procedure ResetCanvas(ACanvas:TCanvas);
begin
   SetCanvasZoomAndRotation(ACanvas , 1, 0, 0,0);
end;

procedure TDemoForm.Button1Click(Sender: TObject);
var
 FileInfo:_SHFileINfoW;
 ico:TIcon;
 ImageList:TImageList;
 i,x,y:Integer;
 zoom:double;
begin
  ImageList:=TImageList.Create(self);
  ImageList.ShareImages:=true;
  ImageList.Handle:=SHGetFileInfo('',0,FileInfo,SizeOf(FileInfo),SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
  ico:=TIcon.Create;
  try
  x := 0;
  y := 0;
  zoom := 50 / Imagelist.Width;
  SetCanvasZoomAndRotation(Canvas,zoom,0,0 ,0);
  for I := 0 to ImageList.Count-1 do
   begin
    ImageList.GetIcon(i,ico);
    Canvas.Draw(x,y,ico);
    inc(x,Imagelist.Width);
    if (x + Imagelist.Width) * zoom > width then
        begin
        x := 0;
        inc(y,Imagelist.Height);
        end;
   end;
  finally
    ico.Free;
    ResetCanvas(Canvas);
    ImageList.Free;
  end;
end;

An example using 250 as desired size: