请问关于printer打印旋转文本的问题

Question

将Sub Print_Text中的
m_lFontHandle = CreateFont(20, 0, 10 * l_fAng, 0, FW_NORMAL, 0, 0, 0, 1, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, , "Arial")
改成
m_lFontHandle = CreateFont(x * 2, x, 10 * l_fAng, 0, FW_NORMAL, 0, 0, 0, 1, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH, "Arial")

Answer 1

袁飞打印预览控件,轻松打印旋转文字!
http://ygyuan.3322.net/
'====================================================Option ExplicitPrivate Const LF_FACESIZE = 32
Private Const CLIP_DEFAULT_PRECIS = 0
Private Const PROOF_QUALITY = 2
Private Const DEFAULT_PITCH = 0
Private Const FF_DONTCARE = 0    '  Don't care or don't know.
Private Const OEM_CHARSET = 255
Private Const ANSI_CHARSET = 0
Private Const OUT_DEFAULT_PRECIS = 0
Private Const OUT_TT_ONLY_PRECIS = 7
Private Type LOGFONT
   lfHeight As Long
   lfWidth As Long
   lfEscapement As Long
   lfOrientation As Long
   lfWeight As Long
   lfItalic As Byte
   lfUnderline As Byte
   lfStrikeOut As Byte
   lfCharSet As Byte
   lfOutPrecision As Byte
   lfClipPrecision As Byte
   lfQuality As Byte
   lfPitchAndFamily As Byte
   lfFaceName As String * LF_FACESIZE
End TypePrivate Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As LongPrivate Const LOGPIXELSY = 90        '  Logical pixels/inch in Y
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As Long, ByVal lpInitData As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long       ' or Boolean
Public Sub RotateText(obj As Object, Degrees As Long, OutString As String)
      Dim lf As LOGFONT
      Dim result As Long
      Dim hOldfont As Long
      Dim hPrintDc As Long
      Dim hFont As Long
      Dim X As Long, Y As Long
    Dim hWnd As Long
    Dim hdc As Long
    Dim PixelPerInchY As Long   '沿高度每逻辑英寸的像素数'---------------------------------------------------------------
'取得沿高度每逻辑英寸的像素数
    If obj Is Printer Then
        hdc = Printer.hdc
    Else
       hWnd = GetDesktopWindow
       hdc = GetDC(hWnd)
    End If
    
    PixelPerInchY = GetDeviceCaps(hdc, LOGPIXELSY)
    
    If obj Is Printer Then
    Else
        Call ReleaseDC(hWnd, hdc)
    End If
'---------------------------------------------------------------'---------------------------------------------------------------
'建立逻辑字体   With lf
      .lfHeight = -(obj.Font.Size * PixelPerInchY) / 72
      .lfWidth = 0
      .lfEscapement = Degrees * 10
      .lfOrientation = .lfEscapement
      .lfWeight = obj.Font.Weight
      .lfItalic = obj.Font.Italic
      .lfUnderline = obj.Font.Underline
      .lfStrikeOut = obj.Font.Strikethrough
      .lfClipPrecision = CLIP_DEFAULT_PRECIS
      .lfQuality = PROOF_QUALITY
      .lfPitchAndFamily = DEFAULT_PITCH Or FF_DONTCARE
      .lfFaceName = obj.Font.Name & vbNullChar
      .lfCharSet = obj.Font.Charset
      If .lfCharSet = OEM_CHARSET Then
         If (Degrees Mod 360) <> 0 Then
            .lfCharSet = ANSI_CHARSET
         End If
      End If
      If (Degrees Mod 360) <> 0 Then
         .lfOutPrecision = OUT_TT_ONLY_PRECIS
      Else
         .lfOutPrecision = OUT_DEFAULT_PRECIS
      End If
   End With
   hFont = CreateFontIndirect(lf)
'---------------------------------------------------------------
'应用逻辑字体并打印
    With obj
        If obj Is Printer Then
            X = .Width * .CurrentX / .ScaleWidth \ Printer.TwipsPerPixelX
            Y = .Height * .CurrentY / .ScaleHeight \ Printer.TwipsPerPixelY
        Else
        
            X = .Width * .CurrentX / .ScaleWidth \ Screen.TwipsPerPixelX
            Y = .Height * .CurrentY / .ScaleHeight \ Screen.TwipsPerPixelY
        End If
    End With
    
    hPrintDc = obj.hdc
    hOldfont = SelectObject(hPrintDc, hFont)
    result = TextOut(hPrintDc, X, Y, OutString, LenB(StrConv(OutString, vbFromUnicode)))
    result = SelectObject(hPrintDc, hOldfont)
    result = DeleteObject(hFont)
End Sub