如何从系统ImageList中绘制缩放版本的图像？

Question

我创建并初始化TImageList ...

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

我得到小图标的系统ImageList句柄（16x16）......

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

现在我想在我的控制画布上绘制缩放到50x50像素的图标。我是怎么做到的

Answer 1

提升小图标永远不是一个好主意。 16X16图标太小，无法以其他任何方式使用它。

首先，您可以使用

获取更大的shell图像

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

这些图像通常为32x32像素，但为了安全起见（如果Windows在高DPI模式下运行），您可以从系统中获得正确的大小

uses
  Winapi.Windows;

var
  IconWidth, IconHeight: integer;

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

您还可以使用SHGetImageList http://msdn.microsoft.com/en-us/library/windows/desktop/bb762185%28v=vs.85%29.aspx

获取更大的外壳图像

要从ImageList中检索图标（如果ImageList包含图标，在您的情况下包含图标），您可以使用：

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

为了在保持透明度的同时缩放图标，可以使用以下代码：

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

由于无法使用StretchDraw拉伸提取的Icon，并且提取的Bitmap会失去透明度，因此可以使用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;

使用250作为所需大小的示例：

Answer 3

TImageList不支持绘制缩放图像，它按原样绘制图像。它提供的唯一选项是让您指定应在目标画布上绘制图像的X / Y坐标。

要缩放图像，您必须首先将所需图像提取到临时TBitmap并调用其Draw()方法，这样您就可以在目标画布上指定所需的矩形。然后，位图将拉伸/缩放其绘图以根据需要填充该矩形。