GetTextExtentPoint32 的结果不随 nHeight 线性缩放

Sna*_*hmo 5 winapi vba

我编写了一个 VBA 函数,以 300dpi 的给定字体和磅值返回字符串的宽度。我不是一个很有经验的程序员,这是我第一次使用 Windows API。我希望宽度会随着字体大小逐渐减小,但并不是那么渐进。

例如:

点大小 = 返回的宽度(Arial 字体中的字符串“文本”)

14 = 99

13.5 = 95

13 = 91

12.5 = 90

12 = 84

11.5 = 83

11 = 75

因此,将字体大小减小 0.5 会将宽度更改为 4>4>1>6>1>8。我想了解为什么字体大小和返回宽度之间存在非线性关系。我知道字体渲染有些模糊,但我猜这不是故事的全部,尤其是在 300dpi 时?

就像我说的,我是一个不可─相当-novice可以随意说“谷歌[关键词],擦洗!”

上下文:与 GetTextExtent 的大多数用途不同,没有我想要适应的对象。最终目标是返回在以 300dpi 以字体 F 打印时 X 点处的字符串 A 是否比 Y 点处的字符串 B 宽的函数。

这是我的代码折叠为一个功能...

Option Explicit

Private Declare PtrSafe Function CreateDC Lib "gdi32.dll" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, ByVal lpInitData As Long) As Long
Private Declare PtrSafe Function CreateFont Lib "gdi32.dll" Alias "CreateFontA" (ByVal nHeight As Integer, ByVal nWidth As Integer, ByVal nEscapement As Integer, ByVal nOrientation As Integer, ByVal fnWeight As Integer, ByVal fdwItalic As Long, ByVal fdwUnderline As Long, ByVal fdwStrikeOut As Long, ByVal fdwCharSet As Long, ByVal fdwOutputPrecision As Long, ByVal fdwClipPrecision As Long, ByVal fdwQuality As Long, ByVal fdwPitchAndFamily As Long, ByVal lpszFace As String) As Long
Private Declare PtrSafe Function SelectObject Lib "gdi32.dll" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare PtrSafe Function GetTextExtentPoint32 Lib "gdi32.dll" Alias "GetTextExtentPoint32A" (ByVal hDC As Long, ByVal lpctStr As String, ByVal c As Integer, ByRef sz As SIZE) As Boolean
Private Declare PtrSafe Function DeleteDC Lib "gdi32.dll" (ByVal hDC As Long) As Long
Private Declare PtrSafe Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long

Private Type SIZE
  x As Long
  y As Long
End Type

Function GetPrintedWidth(strToTest As String, strFontName as String, sngFontSize As Single)
  'Create the device context. (Documents are rendered to PDF before printing, so I'm using the Adobe PDF printer driver. Mistake?)
  Dim DC As Long: DC = CreateDC(0, "Adobe PDF", 0, 0)
  'Convert sngFontSize points to logical units.  Final print is @300dpi.      
  'Most examples I've seen use MulDiv, but it converts sngFontSize to long before calculating.
  Dim nHeight As Long: nHeight = sngFontSize * 300 / 72
  'Create the font.
  Dim fnt As Long: fnt = CreateFont(nHeight, 0, 0, 0, 400, 0, 0, 0, 0, 0, 0, 0, 0, strFontName & Chr$(0))
  'Select font into DC.
  DeleteObject SelectObject(DC, fnt) 
  'Get string dimensions.
  Dim sz As SIZE: GetTextExtentPoint32 DC, strToTest, Len(strToTest), sz
  'Return width.
  GetPrintedWidth = sz.x 
  'Clean up.
  DeleteObject fnt
  DeleteDC DC
End Function
Run Code Online (Sandbox Code Playgroud)

我对基本的代码更正非常开放,我还在学习!

你们都是最棒的,谢谢你所做的一切:)


更新

增加 nHeight 会使事情变得平滑。我得到的结果几乎是线性的:

    nHeight = sngFontSize * 300 / 72
Run Code Online (Sandbox Code Playgroud)

到:

    nHeight = sngFontSize * 3000 / 72
Run Code Online (Sandbox Code Playgroud)

所以...我想这只是一个字体缩放的问题,但我在黑暗中完全是为何。AFAIK nHeight 公式应该是

    FontSize * PointsPerLogicalInch / 72
Run Code Online (Sandbox Code Playgroud)

...ergo 300dpi 打印机应该有 300 PointsPerLogicalInch,不是吗?


更新 2

GetDeviceCaps LOGPIXELSY 通常用于获取 PointsPerLogicalInch。我测试了可用的打印机:

  • Adobe PDF 打印驱动程序返回 1200

  • 我的台式打印机退回了 600

顺便说一句,LOGPIXELSX 返回了相同的

所以 300 应该是对的,否则我搞砸了一些东西。