Rotating (orienting) a label control on a VB Form

jeffb022197
jeffb022197 used Ask the Experts™
on
Using VB 6.0.  I have a label on a form that I would like to display vertically.  Is there an easy way to rotate the label 90 degrees?  Thanks in advance.
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Public Declare Function CreateFont Lib _
"gdi32" Alias "CreateFontA" (ByVal _
Height As Long, ByVal Width As Long, _
ByVal Escapement As Long, ByVal _
Orientation As Long, ByVal Weight _
As Long, ByVal Italic As Long, ByVal _
Underline As Long, ByVal StrikeOut As _
Long, ByVal CharSet As Long, ByVal _
OutputPrecision As Long, ByVal _
ClipPrecision As Long, ByVal Quality _
As Long, ByVal PitchAndFamily As _
Long, ByVal Face As String) As Long

Public Declare Function SelectObject _
Lib "gdi32" (ByVal hdc As Long, ByVal _
hObject As Long) As Long

Public Declare Function DeleteObject _
Lib "gdi32" (ByVal hObject As Long) As Long

Public Const FW_BOLD = 700
Public Const FW_NORMAL = 400
Public Const ANSI_CHARSET = 0
Public Const OUT_DEFAULT_PRECIS = 0
Public Const CLIP_DEFAULT_PRECIS = 0
Public Const PROOF_QUALITY = 2
Public Const DEFAULT_PITCH = 0
Public Const FF_DONTCARE = 0

Public Sub dotext(angpict As Object, _
angfont As StdFont, angtext As String, _
angle As Single)

' Parameters:
' angpict: picture box, etc to draw text in
' angfont: Font object with info about font to use
' angtext: text to print
' angle : angle, measured anti-clockwise from horizontal: ----->

Dim newfont As Long
Dim oldfont As Long
Dim angweight As Long

If angfont.Bold = True Then
  angweight = FW_BOLD
Else
  angweight = FW_NORMAL
End If

newfont = CreateFont(angfont.Size * 2, _
0, angle * 10, 0, angweight, _
angfont.Italic, angfont.Underline, _
angfont.Strikethrough, ANSI_CHARSET, _
OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, _
PROOF_QUALITY, DEFAULT_PITCH Or FF_DONTCARE, _
angfont.Name)

oldfont = SelectObject(angpict.hdc, newfont)

angpict.CurrentX = 1000
angpict.CurrentY = 1000
angpict.Print angtext

newfont = SelectObject(angpict.hdc, oldfont)

If DeleteObject(newfont) = 0 Then
' could not remove font from GDI heap
End If

End Sub

Private Sub Command1_Click()
Call dotext(Picture1,Form1.Font,"VB Square","240")
End Sub

Author

Commented:
I see the text in the picture box, however it doesn't rotate.  I'm using Windows ME.  I took this from the MSDN on CreateFont:

"Windows 95/98/Me: The nEscapement parameter specifies both the escapement and orientation. You should set nEscapement and nOrientation to the same value."

I tried this, but it made no difference.  The text is still displayed horizontally.  Any ideas?

Author

Commented:
I see the text in the picture box, however it doesn't rotate.  I'm using Windows ME.  I took this from the MSDN on CreateFont:

"Windows 95/98/Me: The nEscapement parameter specifies both the escapement and orientation. You should set nEscapement and nOrientation to the same value."

I tried this, but it made no difference.  The text is still displayed horizontally.  Any ideas?

Ensure you’re charging the right price for your IT

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

an easy function to print text in any angle:

Private Sub Command1_Click()
    Dim a As Long
    a = RotateText(Me, "This is some text", 100, 100, 12000, 6000)
End Sub

Private Function RotateText(TheObject As Object, TheText As String, StartPointX As Single, StartPointY As Single, EndPointX As Single, EndPointY As Single) As Long
    Dim HorizontalDistance As Single
    Dim HorizontalStep As Single
    Dim VerticalDistance As Single
    Dim VerticalStep As Single
    Dim Devider As Single
    Dim i As Long
   
    Devider = TheObject.TextWidth(TheText)
    HorizontalDistance = EndPointX - StartPointX
    VerticalDistance = EndPointY - StartPointY
    HorizontalStep = HorizontalDistance / Devider * Screen.TwipsPerPixelX
    VerticalStep = VerticalDistance / Devider * Screen.TwipsPerPixelY
   
    TheObject.CurrentX = StartPointX
    TheObject.CurrentY = StartPointY
   
    For i = 1 To Len(TheText)
        TheObject.Print Mid(TheText, i, 1);
        TheObject.CurrentX = StartPointX + (HorizontalStep * i)
        TheObject.CurrentY = StartPointY + (VerticalStep * i)
    Next
End Function

Author

Commented:
pierrecampe: while that's an interesing effect, that's not really what I'm looking for.  I want to actually rotate the text 90 degrees.
OK here how to rotate text 90°
however its the same as lucifer told you
(there is a very visible bug in lucifers code(a single is not a string))

Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, ByVal W As Long, ByVal I As Long, ByVal U As Long, ByVal S As Long, ByVal C As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As String) 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

Const ANSI_CHARSET As Long = 0
Const FF_DONTCARE As Long = 0
Const CLIP_LH_ANGLES As Long = &H10
Const CLIP_DEFAULT_PRECIS As Long = 0
Const OUT_TT_ONLY_PRECIS As Long = 7
Const PROOF_QUALITY As Long = 2
Const TRUETYPE_FONTTYPE As Long = &H4
Const p_WIDTH As Long = 12
Const p_HEIGHT As Long = 12

Private Sub RotateText(TheText As String, TheAngle As Long)
    Dim NewFont As Long
    Dim OldFont As Long
    NewFont = CreateFont(p_HEIGHT, p_WIDTH, TheAngle, 0, FF_DONTCARE, 0, 0, 0, ANSI_CHARSET, OUT_TT_ONLY_PRECIS, CLIP_LH_ANGLES Or CLIP_DEFAULT_PRECIS, PROOF_QUALITY, TRUETYPE_FONTTYPE, "Arial")
    OldFont = SelectObject(Me.hdc, NewFont)

    Print TheText

    NewFont = SelectObject(Me.hdc, OldFont)
    DeleteObject NewFont
End Sub

Private Sub Form_Load()
    Dim TheAngle As Long
    Me.Show
    CurrentX = 300
    CurrentY = 150
    TheAngle = -900
    RotateText "This is a test", -900 'angle in tenths of a degree
End Sub
RotateText "This is a test", -900
should ofcourse be:
RotateText "This is a test", TheAngle

Author

Commented:
Works like a champ.  Thanks!

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial