Print Rotated Text

Author: Smalig.

This code will show you how to print rotated text with any angle you choose.

Preparations

Add 1 Command Button to your form.

Module Code

Option Explicit

Public Const LF_FACESIZE = 32

Public 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

Public Type DOCINFO
  cbSize As Long
  lpszDocName As String
  lpszOutput As String
  lpszDatatype As String
  fwType As Long
End Type

Declare Function CreateFontIndirect Lib "gdi32" Alias _
  "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long

Declare Function SelectObject Lib "gdi32" _
  (ByVal hdc As Long, ByVal hObject As Long) As Long

Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

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

Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

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

Declare Function StartDoc Lib "gdi32" Alias "StartDocA" _
  (ByVal hdc As Long, lpdi As DOCINFO) As Long

Declare Function EndDoc Lib "gdi32" (ByVal hdc As Long) As Long

Declare Function StartPage Lib "gdi32" (ByVal hdc As Long) As Long

Declare Function EndPage Lib "gdi32" (ByVal hdc As Long) As Long
Form Code

Private Sub Command1_Click()
  Const DESIREDFONTSIZE = 12 ' Font Size.

  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
Go Back