BUG: Problems Printing Rotated Text on Visual Basic 5.0 SP2

• Microsoft Visual Basic Learning, Professional, and Enterprise Editions for Windows, version 5.0

SYMPTOMS

If you try to print rotated text using the Printer object from Visual Basic 5.0 with Visual Studio 97 Service Pack 2 using the technique described in the following Microsoft Knowledge Base article, the text fails to rotate:

   ARTICLE-ID: Q154515
   TITLE     : HOWTO: Print Rotated Text Using Win32 API

CAUSE

There is a problem in Visual Studio 97 Service Pack 2 for Visual Basic 5.0 where any Font selected for the Printer.hDC is ignored by the Printer object.

RESOLUTION

To work around this problem, print with API functions entirely without using the Printer object.

STATUS

Microsoft has confirmed this to be a bug in the Microsoft Visual Studio 97 Service Pack 2 (SP2.) We are researching this bug and will post new information here in the Microsoft Knowledge Base as it becomes available.

MORE INFORMATION

The technique described in Knowledge Base article Q154515, prints to a PictureBox control but will also work using the Printer object. Printing to a PictureBox still works in SP2 but fails using the Printer object. The following code example will work from Visual Basic 4.0 or Visual Basic 5.0, with or without a Service Pack. Because this code creates a Device Context (DC) for your printer and you can only print to one DC at a time, it has the limitation that you cannot use the Printer object at the same time. So, you must end this document before returning to using the Printer object.

Code Example

1. Start a new project. Form1 is created by default.

2. Add a CommandButton to Form1.

3. Add the following code to the General Declarations section of Form1:

         Option Explicit
   

         Private Const LF_FACESIZE = 32
   

         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 Type
   
         Private Type DOCINFO
             cbSize As Long
             lpszDocName As String
             lpszOutput As String
             lpszDatatype As String
             fwType As Long
         End Type
   
         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
   
         Private Declare Function StartDoc Lib "gdi32" Alias "StartDocA" _
         (ByVal hdc As Long, lpdi As DOCINFO) As Long
   
         Private Declare Function EndDoc Lib "gdi32" (ByVal hdc As Long) _
         As Long
   
         Private Declare Function StartPage Lib "gdi32" (ByVal hdc As Long) _
         As Long
   
         Private Declare Function EndPage Lib "gdi32" (ByVal hdc As Long) _
         As Long
   
         Private Sub Command1_Click()
            Const DESIREDFONTSIZE = 12     ' Could use variable, TextBox, etc.
   
            Dim OutString As String  'String to be rotated
            Dim lf As LOGFONT        'Structure for setting up rotated font
            Dim temp As String       'Temp string var
            Dim result As Long       'Return value for calling API functions
            Dim hOldfont As Long     'Hold old font information
            Dim hPrintDc As Long     'Handle to printer dc
            Dim hFont As Long        'Handle to new Font
            Dim di As DOCINFO        'Structure for Print Document info
   
            OutString = "Hello World"   'Set string to be rotated
   
            'Set rotation in tenths of a degree, i.e., 1800 = 180 degrees
            lf.lfEscapement = 1800
            lf.lfHeight = (DESIREDFONTSIZE * -60) / Screen.TwipsPerPixelY
            hFont = CreateFontIndirect(lf)  'Create the rotated font
            di.cbSize = 20                  'Size of DOCINFO structure
            di.lpszDocName = "My Document"  'Set name of print job (Optional)
   
            'Create a printer device context
            hPrintDc = CreateDC(Printer.DriverName, Printer.DeviceName, 0, 0)
   
            result = StartDoc(hPrintDc, di) 'Start a new print document
            result = StartPage(hPrintDc)    'Start a new page
   
            'Select our rotated font structure and save previous font info
            hOldfont = SelectObject(hPrintDc, hFont)
   
            'Send rotated text to printer, starting at location 1000, 1000
            result = TextOut(hPrintDc, 1000, 1000, OutString, Len(OutString))
   
            'Reset font back to original, non-rotated
            result = SelectObject(hPrintDc, hOldfont)
   
            'Send non-rotated text to printer at same page location
            result = TextOut(hPrintDc, 1000, 1000, OutString, Len(OutString))
   
            result = EndPage(hPrintDc)      'End the page
            result = EndDoc(hPrintDc)       'End the print job
            result = DeleteDC(hPrintDc)     'Delete the printer device context
            result = DeleteObject(hFont)    'Delete the font object
         End Sub
   
   

4. Run the Project and click on Command1.