Home > How-To Library > Controls

How to Display Rotated text in Picture Box

****************************************************************
*       © 2007 CodeItBetter http://www.codeitbetter.com        *
*          This notice MUST stay intact for legal use          *
****************************************************************

'The following code snippet show how to display text in different angles in a 
'picture box.For that Open a new Project, add a picturebox and a command 
'button control to the form.

'Add a PictureBox Control and Command Button to the form.

Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" _
    (lpLogFont As LOGFONT) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Type LOGFONT
    lfHeight As Long
    lfWidth As Long
    lfEscapement As Long
    lfOrientation As Long
    lfWeight As Long
    lfItalic As String * 1
    lfUnderline As String * 1
    lfStrikeOut As String * 1
    lfCharSet As String * 1
    lfOutPrecision As String * 1
    lfClipPrecision As String * 1
    lfQuality As String * 1
    lfPitchAndFamily As String * 1
    lfFaceName As String * 32
End Type

'Create a procedure named RotateText and pass the following parameters as arguments
'Picturebox, Text to be displayed, current X and Current Y as parameters

'Call the procedure from the click event of the command button

Private Sub RotateText(PBCtrl As PictureBox, disptxt As String, CX, CY)
    Dim Font As LOGFONT
    Dim hFont As Long, ret As Long
    Const FONTSIZE = 8  ' Desired point size of font

    Font.lfEscapement = 900    ' 180-degree rotation
    Font.lfFaceName = "Arial" + Chr$(0)
    Font.lfWeight = 50

    'Windows expects the font size to be in pixels and to be negative if you are 
    'specifying the character height you want.

    Font.lfHeight = (FONTSIZE * -20) / Screen.TwipsPerPixelY
    hFont = CreateFontIndirect(Font)
    SelectObject PBCtrl.hdc, hFont

    PBCtrl.CurrentX = CX
    PBCtrl.CurrentY = CY
    PBCtrl.Print disptxt

    ' Clean up by restoring original font.
    ret = DeleteObject(hFont)
End Sub

Private Sub Command1_Click()
    RotateText Picture1, "Heat Details", Picture1.Width \ 5, Picture1.Height - 200
End Sub

If you would like to submit your code here please us. Do not forget to mention your name. We are always thankful to each and everyone of you who submitted their code here.