How to Print labels at an angle

How to 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.



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:



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:



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:



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 actual 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:



\'\\\\ 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.


\'\\\\ 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:


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