The new vbAccelerator Site - more VB and .NET Code and Controls
Source Code
3 Code Libraries &nbsp

Text At Any Angle

Convert a VB StdFont to a GDI font, and get more control over font use.

NOTE: this code has been superceded by the version at the new site.

[Vertical Text Picture]

UpdatedUpdated! 21 March 1999
&nbsp The previous version of the font code didn't take the character set into account, so you could not display symbol or international fonts correctly. Thanks to Lance Franklin for providing the fix to this code. &nbsp

Download the SideLogo project files (11kb)

VB doesn't provide you with any method to change the angle text is written out at on a Form or PictureBox. This seems to be a curious oversight of the OLE StdFont object, because it is in fact very simple to create a font with angles other than horizontal. This article shows you how to do it. The source code provides a class which creates a side logo bar like the one shown in the picture above, additionally demonstrating a method of drawing gradients which run between any two colours.
To create a font with a different angle, you must delve into the API world of creating fonts rather than use the StdFont object. In the API world, you build up a LOGFONT structure with information about the font, and then pass this into the CreateFontIndirect function. This returns a handle to the newly created font, which can then be selected into a Device context using the GDI SelectObject method. The LOGFONT structure is quite closely related to the standard font options we normally use, but some of the options need a bit of playing with before it works.

Private Type LOGFONT
&nbsp &nbsp lfHeight As Long
' The font size (see below)
&nbsp &nbsp lfWidth As Long ' Normally you don't set this, just let Windows create the default
&nbsp &nbsp lfEscapement As Long ' The angle, in 0.1 degrees, of the font
&nbsp &nbsp lfOrientation As Long ' Leave as default
&nbsp &nbsp lfWeight As Long ' Bold, Extra Bold, Normal etc
&nbsp &nbsp lfItalic As Byte ' As it says
&nbsp &nbsp lfUnderline As Byte ' As it says
&nbsp &nbsp lfStrikeOut As Byte ' As it says
&nbsp &nbsp lfCharSet As Byte ' As it says
&nbsp &nbsp lfOutPrecision As Byte ' Leave for default
&nbsp &nbsp lfClipPrecision As Byte ' Leave for default
&nbsp &nbsp lfQuality As Byte ' Leave as default (see end of article)
&nbsp &nbsp lfPitchAndFamily As Byte ' Leave as default (see end of article)
&nbsp &nbsp lfFaceName(LF_FACESIZE) As Byte ' The font name converted to a byte array
End Type

The main differences between this and the StdFont object are:

  • Face name must be specified as a byte array rather than a string.
  • The font size is specified through lfHeight. However, you can't just put the size in points here - first you have to make it negative and work out what the font size should be given the number of logical pixels per item vertically.
  • The Bold option accepts a number of different settings, which normally have no effect, such as extra bold, extra light and so forth.

To make it simple to fill in this type, here is a sub which takes a StdFont object and fills a LOGFONT structure with the equivalent settings:

Private Sub pOLEFontToLogFont(fntThis As StdFont, hDC As Long, tLF As LOGFONT)
Dim sFont As String
Dim iChar As Integer

&nbsp &nbsp ' Convert an OLE StdFont to a LOGFONT structure:
&nbsp &nbsp With tLF
&nbsp &nbsp &nbsp &nbsp sFont = fntThis.Name
&nbsp &nbsp &nbsp &nbsp ' There is a quicker way involving StrConv and CopyMemory, but
&nbsp &nbsp &nbsp &nbsp ' this is simpler!:
&nbsp &nbsp &nbsp &nbsp For iChar = 1 To Len(sFont)
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp .lfFaceName(iChar - 1) = CByte(Asc(Mid$(sFont, iChar, 1)))
&nbsp &nbsp &nbsp &nbsp Next iChar
&nbsp &nbsp &nbsp &nbsp ' Based on the Win32SDK documentation:
&nbsp &nbsp &nbsp &nbsp .lfHeight = -MulDiv((fntThis.Size), (GetDeviceCaps(hDC, LOGPIXELSY)), 72)
&nbsp &nbsp &nbsp &nbsp .lfItalic = fntThis.Italic
&nbsp &nbsp &nbsp &nbsp If (fntThis.Bold) Then
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp .lfWeight = FW_BOLD
&nbsp &nbsp &nbsp &nbsp Else
&nbsp &nbsp &nbsp &nbsp &nbsp &nbsp .lfWeight = FW_NORMAL
&nbsp &nbsp &nbsp &nbsp End If
&nbsp &nbsp &nbsp &nbsp .lfUnderline = fntThis.Underline
&nbsp &nbsp &nbsp &nbsp .lfStrikeOut = fntThis.Strikethrough
&nbsp &nbsp &nbsp &nbsp ' Fix to ensure the correct character set is selected. Otherwise you
&nbsp &nbsp &nbsp &nbsp ' cannot display Wingdings or international fonts:
&nbsp &nbsp &nbsp &nbsp .lfCharset = fntThis.CharSet
&nbsp &nbsp &nbsp &nbsp
&nbsp &nbsp End With

End Sub

Using this you can create a LOGFONT structure easily, and then set the angle. For example, here is code you could use to draw some text vertically on a form:

Dim hFnt As Long
Dim hFntOld As Long

&nbsp &nbsp ' Using the form's font, create a vertical copy
&nbsp &nbsp pOLEFontToLogFont Me.Font, Me.hDC, tLF
&nbsp &nbsp tLF.lfEscapement = 900
' This is the angle to display at x 10
&nbsp &nbsp hFnt = CreateFontIndirect(tLF)

&nbsp &nbsp ' Select the font into the Form's Device context, storing the font that was already there
&nbsp &nbsp hFntOld = SelectObject(Me.hDC, hFnt)

&nbsp &nbsp ' Now we can print text vertically using either VB or API methods
&nbsp &nbsp Me.CurrentX = 16*Screen.TwipsPerPixelX
&nbsp &nbsp Me.CurrentY = Me.ScaleHeight-16*Screen.TwipsPerPixelY
&nbsp &nbsp Me.Print "This Text is Vertical"

&nbsp &nbsp ' Clear up the font by putting the original one back and deleting the vertical copy:
&nbsp &nbsp SelectObject Me.hDC, hFntOld
&nbsp &nbsp DeleteObject hFnt

That's all there is to it. For convenience, here are all the API declarations you will need to make the code above work:

Private Declare Function GetDeviceCaps Lib "gdi32" ( _
&nbsp &nbsp &nbsp &nbsp ByVal hDC As Long, ByVal nIndex As Long
&nbsp &nbsp ) As Long
&nbsp &nbsp Private Const LOGPIXELSX = 88
' Logical pixels/inch in X
&nbsp &nbsp Private Const LOGPIXELSY = 90' Logical pixels/inch in Y
Private Declare Function MulDiv Lib "kernel32" ( _
&nbsp &nbsp ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long _
&nbsp &nbsp ) As Long
Private Const LF_FACESIZE = 32
Private Type LOGFONT
&nbsp &nbsp lfHeight As Long
&nbsp &nbsp lfWidth As Long
&nbsp &nbsp lfEscapement As Long
&nbsp &nbsp lfOrientation As Long
&nbsp &nbsp lfWeight As Long
&nbsp &nbsp lfItalic As Byte
&nbsp &nbsp lfUnderline As Byte
&nbsp &nbsp lfStrikeOut As Byte
&nbsp &nbsp lfCharSet As Byte
&nbsp &nbsp lfOutPrecision As Byte
&nbsp &nbsp lfClipPrecision As Byte
&nbsp &nbsp lfQuality As Byte
&nbsp &nbsp lfPitchAndFamily As Byte
&nbsp &nbsp lfFaceName(LF_FACESIZE) As Byte
End Type
Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" ( _
&nbsp &nbsp &nbsp &nbsp lpLogFont As LOGFONT _
&nbsp &nbsp ) As Long
Private Declare Function SelectObject Lib "gdi32" ( _
&nbsp &nbsp &nbsp &nbsp ByVal hDC As Long, ByVal hObject As Long _
&nbsp &nbsp ) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Const FW_NORMAL = 400
Private Const FW_BOLD = 700
Private Const FF_DONTCARE = 0
Private Const DEFAULT_QUALITY = 0
Private Const DEFAULT_PITCH = 0
Private Const DEFAULT_CHARSET = 1

There are more things you can do with this. The lfOrientation member of the LOGFONT type specifies the orientation of the characters independently of which angle the text is drawn at. To make this member work you have to call SetGraphicsMode on the DC to draw in to set the graphics mode to GM_ADVANCED:

Private Declare Function SetGraphicsMode Lib "gdi32" Alias "SetGraphicsMode" _
(ByVal hdc As Long, ByVal iMode As Long) As Long
Private Const GM_ADVANCED = 2


&nbsp &nbsp SetGraphicsMode Me.hdc, GM_ADVANCED
&nbsp &nbsp tLF.lfEscapement = 300
' This is the angle to display at x 10
&nbsp &nbsp tLF.lfOrientation = 1200 ' Set the angle to display the characters at x 10
&nbsp &nbsp hFnt = CreateFontIndirect(tLF)

&nbsp &nbsp ' Select the font into the Form's Device context, storing the font that was already there
&nbsp &nbsp hFntOld = SelectObject(Me.hDC, hFnt)


Finally, here are the values you can use for the other constants:

' lfQuality Constants:
Private Const DEFAULT_QUALITY = 0 ' Appearance of the font is set to default
Private Const DRAFT_QUALITY = 1
' Appearance is less important that PROOF_QUALITY.
Private Const PROOF_QUALITY = 2
' Best character quality
' Don't smooth font edges even if system is set to smooth font edges
' Ensure font edges are smoothed if system is set to smooth font edges

' lfPitchAndFamilyConstants - or together one from pitch and one from family:
' Pitch:
Private Const DEFAULT_PITCH = 0
Private Const FIXED_PITCH = 1
Private Const VARIABLE_PITCH = 2
' Family:
Private Const FF_DONTCARE = 0 ' Don't care or don't know.
Private Const FF_ROMAN = 16 ' Variable stroke width, serifed.
' Times Roman, Century Schoolbook, etc.
Private Const FF_SWISS = 32 ' Variable stroke width, sans-serifed.
'Helvetica, Swiss, etc.
Private Const FF_MODERN = 48 ' Constant stroke width, serifed or sans-serifed.
' Pica, Elite, Courier, etc.
Private Const FF_SCRIPT = 64 ' Cursive, etc.
Private Const FF_DECORATIVE = 80 ' Old English, etc.

' Character sets:
Private Const ANSI_CHARSET = 0
Private Const DEFAULT_CHARSET = 1
Private Const SYMBOL_CHARSET = 2
Private Const SHIFTJIS_CHARSET = 128
Private Const HANGEUL_CHARSET = 129
Private Const HANGUL_CHARSET = 129
Private Const GB2312_CHARSET = 134
Private Const CHINESEBIG5_CHARSET = 136
Private Const OEM_CHARSET = 255
Private Const JOHAB_CHARSET = 130
Private Const HEBREW_CHARSET = 177
Private Const ARABIC_CHARSET = 178
Private Const GREEK_CHARSET = 161
Private Const TURKISH_CHARSET = 162
Private Const VIETNAMESE_CHARSET = 163
Private Const THAI_CHARSET = 222
Private Const EASTEUROPE_CHARSET = 238
Private Const RUSSIAN_CHARSET = 204
Private Const MAC_CHARSET = 77
Private Const BALTIC_CHARSET = 186

TopBack to top

Source Code - What We're About!Back to Source Code


AboutContributeSend FeedbackPrivacy

Copyright 1998-1999, Steve McMahon ( All Rights Reserved.
Last updated: 21 March 1999