如何在Delphi 10.3.3中实现TImage的高DPI适配？

我之前在Delphi 10.3.3的VCL项目里也遇到过完全一样的TImage高DPI适配问题——高分辨率屏上模糊，用高清图又在普通屏拉伸变形。因为当时还没法升级到10.4用TVirtualImage，试了几个方案都挺管用，分享给你：

方案1：手动适配多分辨率图片，根据DPI加载对应资源 #

核心思路是为同一张图片准备多个分辨率版本（比如标准@1x、2倍@2x、1.5倍@1.5x），然后根据当前屏幕的DPI缩放比例，自动加载最匹配的图片文件，再调整TImage的显示参数避免拉伸。

步骤&代码示例： #

1. 先写一个获取当前DPI缩放比例的函数：

function GetDPIScale: Single;
var
  DC: HDC;
begin
  DC := GetDC(0);
  try
    // 96是Windows标准DPI，以此为基准计算缩放比例
    Result := GetDeviceCaps(DC, LOGPIXELSX) / 96;
  finally
    ReleaseDC(0, DC);
  end;
end;

2. 写一个加载适配DPI图片的过程：

procedure LoadImageForDPI(const AImage: TImage; const BaseFileName: string);
var
  Scale: Single;
  TargetFileName: string;
  Ext: string;
begin
  Scale := GetDPIScale;
  Ext := ExtractFileExt(BaseFileName);
  
  // 根据缩放比例选择对应分辨率的图片文件
  if Scale >= 2.0 then
    TargetFileName := ChangeFileExt(BaseFileName, '@2x' + Ext)
  else if Scale >= 1.5 then
    TargetFileName := ChangeFileExt(BaseFileName, '@1.5x' + Ext)
  else
    TargetFileName := BaseFileName;

  if FileExists(TargetFileName) then
  begin
    AImage.Picture.LoadFromFile(TargetFileName);
    // 开启比例保持，避免图片拉伸变形
    AImage.Proportional := True;
    AImage.AutoSize := False;
    // 根据缩放比例反向计算Image控件的显示尺寸
    AImage.Width := Round(AImage.Picture.Width / Scale);
    AImage.Height := Round(AImage.Picture.Height / Scale);
  end;
end;

3. 在窗体初始化或者需要加载图片的地方调用：

LoadImageForDPI(Image1, 'C:\Images\logo.png');

优点：完全原生实现，不需要依赖第三方；缺点：需要提前准备多分辨率图片资源，维护成本略高。

方案2：使用支持高DPI的第三方VCL组件 #

很多成熟的VCL控件套包都内置了DPI感知的图片组件，比如：

• DevExpress的TcxImage：搭配TcxImageCollection可以导入多分辨率图片，组件会自动根据当前屏幕DPI选择最优版本显示，还支持自动缩放适配控件大小。
• TMS的TAdvImage：同样支持DPI自适应，提供了丰富的图片渲染选项，能避免模糊和拉伸问题。

优点：省心省力，控件已经封装好了所有逻辑，还附带很多额外功能；缺点：需要购买第三方控件的许可，适合已经在用对应套包的项目。

方案3：自定义DPI感知的TImage子类 #

如果不想依赖第三方，也不想维护多版本图片，可以自己写一个继承自TImage的组件，重写Paint方法，在绘制时根据当前控件的DPI动态缩放图片，保证清晰度。

代码示例： #

unit DPIAwareImage;

interface

uses
  Vcl.Imaging.pngimage, Vcl.ExtCtrls, Vcl.Graphics, Winapi.Windows;

type
  TDPIAwareImage = class(TImage)
  protected
    procedure Paint; override;
  end;

implementation

// 辅助函数：计算保持图片比例的目标绘制矩形
function GetProportionalRect(const DestBounds: TRect; SrcWidth, SrcHeight: Integer): TRect;
var
  Ratio: Single;
  NewWidth, NewHeight: Integer;
begin
  Ratio := Min(DestBounds.Width / SrcWidth, DestBounds.Height / SrcHeight);
  NewWidth := Round(SrcWidth * Ratio);
  NewHeight := Round(SrcHeight * Ratio);
  // 让图片在控件中居中显示
  Result.Left := DestBounds.Left + (DestBounds.Width - NewWidth) div 2;
  Result.Top := DestBounds.Top + (DestBounds.Height - NewHeight) div 2;
  Result.Right := Result.Left + NewWidth;
  Result.Bottom := Result.Top + NewHeight;
end;

procedure TDPIAwareImage.Paint;
var
  Scale: Single;
  DestRect: TRect;
begin
  if Picture.Graphic = nil then Exit;

  // 获取当前控件的DPI缩放比例（基于系统标准96DPI）
  Scale := Self.Canvas.Font.PixelsPerInch / 96;
  // 计算适配后的绘制区域
  DestRect := GetProportionalRect(ClientRect, 
    Round(Picture.Graphic.Width * Scale), 
    Round(Picture.Graphic.Height * Scale));
  // 缩放绘制图片，保证清晰度
  Canvas.StretchDraw(DestRect, Picture.Graphic);
end;

end.

优点：完全自定义，不需要多版本图片，适配逻辑可控；缺点：需要自己处理绘制细节，比如图片居中、比例保持等逻辑。

内容的提问来源于stack exchange，提问作者Xel Naga