[FAQ] Drawing labels at an angle...

Print labels at an angle...

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.

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 GetStcokObject 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(frmInHDC, 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 CreateFontIndirec 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.

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:

VB 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

HTH,
Duncan