为什么没有GetTextExtentPoint32为600英尺打印的1英寸字符串返回600?

时间:2016-04-28 21:28:51

标签: vba winapi

  • 字符串的宽度" ------------------"在我的600dpi打印机的Arial 12pt正好是1英寸。

  • GetDeviceCaps(DC,LOGPIXELSX)为该设备返回600.

然而,当传递正nHeight时,GetTextExtentPoint32返回x = 540,而当传递负数时,返回351,090。

x = 600的字符串超过1英寸。

我在哪里错了? GetTextExtentPoint32可以提供这种精度吗?

这个功能到目前为止证明了我的方法。

Option Explicit


Private Const MyPrinterName = "Brother HL-5370DW series"


Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32.dll" (ByVal hdc As Long, ByVal nIndex As Long) As Long
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

Private Const LOGPIXELSY = 90

Function GetPrintedWidth(strText As String, strFntName As String, sngFntSize As Single) as Long

    Dim DC As Long, nHeight as Long, fnt As Long, sz As SIZE

    DC = CreateDC(0, MyPrinterName, 0, 0)       

    nHeight = sngFntSize * GetDeviceCaps(DC, LOGPIXELSY) / 72

    fnt = CreateFont(-nHeight, 0, 0, 0, 400, 0, 0, 0, 0, 0, 0, 0, 0, strFntName & Chr$(0))

    DeleteObject SelectObject(DC, fnt)

    GetTextExtentPoint32 DC, strText, Len(strText), sz

    GetPrintedWidth = sz.x

    DeleteObject fnt
    DeleteDC DC

End Function

我没有使用MulDiv来计算nHeight,因为它将参数转换为long,因此不会处理十进制字体大小。

0 个答案:

没有答案