Delphi TMetafileCanvas远程桌面非标准分辨率下字体比例异常求助

问题成因 #

• 微软远程桌面物理尺寸传递异常：TMetafileCanvas依赖系统返回的VERTSIZE/HORZSIZE（物理屏幕尺寸，单位0.1mm）计算字体渲染比例。当通过微软远程桌面设置自定义非标准分辨率（如1920x800）时，远程桌面服务未正确传递真实物理尺寸值，导致TMetafileCanvas基于错误比例缩放字体，引发宽高比失衡、字间距异常，分辨率比例差异越大，失真越严重。
• 远程客户端处理逻辑差异：MAC版Parallels Client可正确传递真实的VERTSIZE值（212），TMetafileCanvas基于正确参数计算渲染规则，因此字体显示正常。

修复方案 #

方案1：手动指定固定物理尺寸 #

创建TMetafile时，手动设置符合标准的VERTSIZE/HORZSIZE值，替代系统返回的错误参数，确保字体渲染比例正确：

var
  MetaFile: TMetafile;
  MetaCanvas: TMetafileCanvas;
begin
  MetaFile := TMetafile.Create;
  try
    // 以1920x1080对应的典型物理尺寸为例（可根据实际场景调整）
    MetaFile.VertSize := 280; // 单位：0.1mm
    MetaFile.HorzSize := 500;
    MetaCanvas := TMetafileCanvas.Create(MetaFile, 0);
    try
      MetaCanvas.Font.Name := '微软雅黑';
      MetaCanvas.Font.Size := 14;
      MetaCanvas.TextOut(20, 20, '测试渲染文本');
    finally
      MetaCanvas.Free;
    end;
    Image1.Picture.Assign(MetaFile);
  finally
    MetaFile.Free;
  end;
end;

方案2：基于分辨率动态计算物理尺寸 #

通过当前屏幕分辨率和标准DPI反推正确的物理尺寸，避免依赖远程桌面传递的错误值：

function GetCorrectVertSize: Integer;
var
  ScreenHeight: Integer;
  DPI: Integer;
begin
  DPI := GetDeviceCaps(GetDC(0), LOGPIXELSY);
  ScreenHeight := Screen.Height;
  // 公式：(像素高度/DPI) * 25.4mm * 10（转换为0.1mm单位）
  Result := Round((ScreenHeight / DPI) * 25.4 * 10);
end;

function GetCorrectHorzSize: Integer;
var
  ScreenWidth: Integer;
  DPI: Integer;
begin
  DPI := GetDeviceCaps(GetDC(0), LOGPIXELSX);
  ScreenWidth := Screen.Width;
  Result := Round((ScreenWidth / DPI) * 25.4 * 10);
end;

// 使用示例
MetaFile.VertSize := GetCorrectVertSize;
MetaFile.HorzSize := GetCorrectHorzSize;

方案3：切换设备无关的映射模式 #

通过SetMapMode设置设备无关的坐标模式，让字体渲染不受物理尺寸参数影响：

MetaCanvas.SetMapMode(MM_LOMETRIC); // 使用逻辑毫米单位
// 后续绘制逻辑适配对应坐标模式即可

相关附件 #

• 问题截图：
• 正常显示截图：
• 项目核心源码：

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  MetaFile: TMetafile;
  MetaCanvas: TMetafileCanvas;
begin
  MetaFile := TMetafile.Create;
  try
    MetaCanvas := TMetafileCanvas.Create(MetaFile, 0);
    try
      MetaCanvas.Font.Name := '微软雅黑';
      MetaCanvas.Font.Size := 14;
      MetaCanvas.TextOut(20, 20, '远程桌面字体测试文本');
    finally
      MetaCanvas.Free;
    end;
    Image1.Picture.Assign(MetaFile);
  finally
    MetaFile.Free;
  end;
end;

end.

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