DELPHI GDI + TGPFont UnitPixel 问题解决

查不少资料，在

 GPfont := TGPFont.Create(fontFamily,   Font.Size  , FontStyleRegular,UnitPixel  );

时，显示的字体，并不是按DPI显示，特别是同时在屏幕与打印机显示时，差异更明显

在切换 UnitPoint 能解决该问题，但是又遇到了新的问题，我想绘图后保存到文件，且需要高分辨率时，就over了

重新查看微软官方API时，发现官方API与delphi中的一致，哪说明该问题，应该是有可解决的办法。

先是试着

 GPfont := TGPFont.Create(fontFamily,   Font.Size/72*页面DPI  , FontStyleRegular,UnitPixel  ); 

结果是行不通

于是，我试着用

 GPfont := TGPFont.Create(fontFamily,   Font.Size*页面DPI  , FontStyleRegular,UnitPixel  );

时，发现屏幕显示与打印，均保持一致，就是字特别大。

到此，感觉终于找到方向，于是进一步随便除一个心理比值。

于是，我试着用

 

 GPfont := TGPFont.Create(fontFamily,   Font.Size*页面DPI/3  , FontStyleRegular,UnitPixel  );

显示的结果，意外的与使用UnitPoint 时相近 保存到高分辨率图片测试，效果满意，比值3是否最佳值，待进一步确认。

 

 

function GETTextWidth(FontEx: TFontEx; str: string):Single  
 var
  GPG:TGPGraphics;
  fontFamily: TGPFontFamily;
  GPfont: TGPFont;
boundingBox: TGPRectF;
  origin : TGPPointF;
begin
  origin.x:=0;
  origin.Y:=0;
    GPG:=TGPGraphics.Create(Canvas.Handle);

    GPG.SetPageUnit(UnitPixel);

   fontFamily := TGPFontFamily.Create(Font.Name);
   GPfont := TGPFont.Create(fontFamily, Font.Size *DPI/3 ,Font.FontStyle,UnitPixel ); //UnitPixel  UnitPoint

  try
    GPG.MeasureString(str,-1,GPfont,origin,boundingBox);
    Result:=boundingBox.Width-length(str)*0.065* DPI/72;//取到的宽度均不够，适当减去一个值，不过还是不精确
  finally
   GPfont.Free;
   fontFamily.Free;
   GPG.Free;
  end;

随手改了下工作中代码，上个取文字宽的完整代码供参考，没测试是否能运行。

DPI 值由   GetDeviceCaps(PrinterHandle, LOGPIXELSX)等相关函数取得，不再列出