CodeItBetter Programming Another VB Programming Blog

How to Display Rotated text in Picture Box

Posted on July 13, 2011
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
'Controls - How to Display Rotated text in Picture Box
'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
Filed under: Controls Leave a comment
Comments (0) Trackbacks (0)

No comments yet.


Leave a comment


 

No trackbacks yet.