Vertical fonts ok on screen but not on printer 
Author Message
 Vertical fonts ok on screen but not on printer

I am trying to use vertical fonts in VB5 via the WIN api.

The following sub successfully sets the vertical font for screen display
in a picture box.

 pr_vfont("Arial",10)     ' returns textheight for use in spacing lines
of text
 picturebox1.print "Vertical text"

However when I send the text to the printer it still comes out
The font type and size are correct.

 printer.print "Vertical text"

I have tried several different printers with the same result,

A similar VB3 routine will display text vertically on both screen and

The frustrating  (theres that word again) thing is I'm sure this was
working when I did the original development of the plots for this
project, but that was over a year ago and it could have been before we
moved from vb4 to vb5.

Any suggestions appreciated

Kym Wilson


Global Const LF_FACESIZE = 32
        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(LF_FACESIZE) As Byte
End Type

' 32bit WIN API declarations

Declare Function CreateFontIndirect Lib "gdi32" Alias
"CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal
nIndex As Long) As Long
Declare Function GetTextFace Lib "gdi32" Alias "GetTextFaceA" (ByVal hdc
As Long, ByVal nCount As Long, ByVal lpFacename As String) As Long
Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal
hObject As Long) As Long

sub  pr_vfont(pfontname, psize) 'create vertical font
Dim temp() As Byte, i As Integer

' create font for vertical text and set it as current

    Dim nvalue, szfacename$
    Dim retval&, nchars, sometext$
    Dim lf As LOGFONT
    Dim oldhdc&
    Dim TempByteArray() As Byte
    Dim dl&, X%
    Dim ByteArrayLimit&, FontToUse As Long

    If FontToUse <> 0 Then dl = DeleteObject(FontToUse)
    If printerflag Then
       nvalue = GetDeviceCaps(Printer.hdc, 34)
       lf.lfHeight = psize      ' font height in log units
       nvalue = GetDeviceCaps(paper.hdc, 34)
       lf.lfHeight = psize * tratio  ' font height in log units
    End If
    lf.lfWidth = 0
    lf.lfEscapement = 900
    lf.lfOrientation = 900
    lf.lfWeight = 400
    lf.lfItalic = 0
    lf.lfUnderline = 0
    lf.lfStrikeOut = 0
    lf.lfOutPrecision = 0
    lf.lfClipPrecision = 0
    lf.lfQuality = 0
    lf.lfPitchAndFamily = 0
    lf.lfCharSet = 1
    TempByteArray = StrConv(pfontname & Chr$(0), vbFromUnicode)
    ByteArrayLimit = UBound(TempByteArray)
    For X% = 0 To ByteArrayLimit
      lf.lfFaceName(X%) = TempByteArray(X%)
    Next X%
    FontToUse = CreateFontIndirect(lf)
    If FontToUse <> 0 Then
        szfacename$ = Space$(80)
        If printerflag Then
          holdfont = SelectObject(Printer.hdc, FontToUse)
          retval& = GetTextFace(Printer.hdc, 79, szfacename$)
          holdfont = SelectObject(paper.hdc, FontToUse)
          retval& = GetTextFace(paper.hdc, 79, szfacename$)
        End If
    End If
End sub

Tue, 19 Sep 2000 03:00:00 GMT  
 [ 1 post ] 

 Relevant Pages 

1. Vertical text on screen and printer

2. dbcombo does not paint screen ok

3. A HOW-TO: Setting Printer fonts: WAS Printer fonts

4. Printer.Font.Name and Printer.Font.Size problems with HP LaserJets

5. Changing ListViewRow colours...OK, subitem colours NOT OK...

6. formname.action ok in IE4 but not ok in IE3

7. Changing ListViewRow colours...OK, subitem colours NOT OK...

8. Changing ListViewRow colours...OK, subitem colours NOT OK...

9. Changing ListViewRow colours...OK, subitem colours NOT OK...

10. Printing a screen font on a printer

11. Screen AND Printer fonts???

12. Screen vs Printer Fonts


Powered by phpBB® Forum Software