Vertical text

What do you mean by Vertical text?

I
S

T
H
I
S

W
H
A
T

Y
O
U

M
E
A
N
?


If so you have to print each letter one at a time.

Printer.Print "I"
Printer.Print "S"

Printer.Print "T"
Printer.Print "H"
Printer.Print "etc....."

This function only works for monospaced fonts such as those used in text files to create columns. It will not work with windows programs using fonts that are not monospaced due to kerning. In other words, they won't line up. But it's great for creating text files with columns.

VB Code:

' Declarations
 
Private Enum TEXT_ALIGN
  ALIGN_LEFT = 0
  ALIGN_RIGHT = 1
End Enum
 
Private Function PadString(ByVal sString As String, Length As Integer, Align As Integer, Optional PadChar As String = " ") As String
Dim iLen As Integer
 
sString = Trim$(sString)
iLen = Len(sString)
 
Select Case Align
  Case Is = ALIGN_RIGHT
    PadString = String$(Length - iLen, PadChar) & sString
  Case Else ' Align left
    PadString = sString & String$(Length - iLen, PadChar)
End Select
 
End Function

Note: These pseudo-lables don't generate click events and always go underneath any other controls...but it's a start.

Drawing text on a VB window
In order to draw on a VB form using the API, we first need to get a handle to the form's Device Context.
A device context is a hardware abstraction which allows the same drawing commands to be performed by a range of different hardware types - display drivers, printers, plotters etc.
In VB the form exposes its device context handle in the Form.hDC member.

Making a font at an angle
In order to write text at an angle we have to request a font which is at that angle, select that font into the form's device context, write the text and then unselect the font.
To request a font at an angle we use the LOGFONT structure. This structure defines the font we would ideally like to have, and when selected the hardware tries to match our ideal font as closely as it can.
Note that only TrueType fonts can be rotated.

VB Code:

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(LF_FACESIZE) As Byte 
End Type

To fill this structure we need to use the SelectObject API to get a handle to the font being used by the device context and then use the GetObject API to fill in the structure according to this handle.

The declarations are:

VB Code:

Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long 
 
' Getting a LOGFONT from its handle 
Private Declare Function GetObjectLOGFONT Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As LOGFONT) As Long

Unfortunately, SelectObject needs to be passed a handle for a new GDI object of the type that you want returned to work. Thus, to get the handle of the current font for a form you have to pass in the handle for another font. This would be a circular problem except for the existence of certain standard fonts which are returned by the GetStockObject API call:

VB Code:

Public Enum GDIStockFonts 
    OEM_FIXED_FONT = 10 
    ANSI_FIXED_FONT = 11 
    ANSI_VAR_FONT = 12 
    SYSTEM_FONT = 13 
    DEVICE_DEFAULT_FONT = 14 
    SYSTEM_FIXED_FONT = 16 
    DEFAULT_GUI_FONT = 17 
End Enum 
 
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long

Thus the procedure to fill a LOGFONT from a form is thus:

VB Code:

Public Sub GetCurrentLogFont(Byval frmIn As Form, lfIn as LOGFONT) 
 
Dim lNewFont As Long 
Dim lOldFont As Long 
Dim lRet As Long 
 
    ' Get the current font's handle 
    lOldFont = SelectObject(frmIn.HDC, GetStockObject(ANSI_FIXED_FONT)) 
    ' Select it back in to prevent the actualk font being wrongly changed 
    lNewFont = SelectObject(frmIn.HDC, lOldFont) 
 
    lRet = GetObjectLOGFONT(lOldFont, Len(lfIn), lfIn) 
 
End Sub

Then to alter this to set the font at an angle we change the LOGFONT's Orientation member. This is in 10ths of a degree...so to set it to 45 degrees the actual value should be 450.

The resulting LOGFONT needs to be given a font handle by calling CreateFontIndirect API call:

VB Code:

' Declaration 
Private Declare Function CreateFontIndirect Lib "gdi32" Alias _ 
            "CreateFontIndirectA" (lpLOGFONT As LOGFONT) As Long

and the handle returned by this can then be used in SelectObject. Any text printed using the TextOut API call after that will use this angled font.

Code:

VB Code:

'\ Declaration 
Private Declare Function TextOutApi 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
 
Thus the final code is: 
 
Code:Public Sub PrintTextAtAnAngle(ByVal frmIn As Form, ByVal Angle As Long, Byval xPos As Long, ByVal yPos As Long, ByVal Text As String) 
 
Dim lfNew As LOGFONT 
Dim hNewFont As Long 
Dim hOldFont As Long 
Dim lRet As Long 
 
    '\ Make the angled font 
    Call GetCurrentLogFont(frmIn, lfNew) 
 
    lfNew.lfEscapement = (Angle * 10) 
 
    hNewFont = CreateFontIndirect(lfNew) 
 
    '\ Select the angled font 
    hOldFont = SelectObject(frmIn.hdc, hNewFont) 
 
    '\ print the text 
    lRet = TextOutApi(frmIn.HDC, xPos, yPos, Text, Len(Text)) 
 
    '\ Reselect the previous font 
    hNewFont = SelectObject(frmIn.hdc, hOldFont) 
End Sub

Use

VB Code:

Private Sub Form_Paint()
 
Call PrintTextAtAnAngle(Me, 90,200,100, "Straight up!")
 
End Sub

HTH,
Duncan

I was just about to post a link to your article actually :)