Thank you, Coral.
Vlada.

-----Original Message-----
From: Coral Johnson [mailto:coral.johnson@r...]
Sent: Thursday, September 26, 2002 12:07 AM
To: professional vb
Subject: [pro_vb] RE: Rotation of the Label or TextBox controls with
their caption/text


There are API calls you can use to print rotated text on the form.  I found
a Rotator class on the web that handles it for you.  I think you can connect
it to the form instead of a picture box, so it will look like a label.  You
then use it like this.

Dim rotTest As New clsRotator
'Connect Rotator object to the picture box
Set rotTest.Device = picTest
rotTest.Angle = 90
rotTest.Label "Put your text here"

This is the class

'ROTATOR.CLS
Option Explicit

'API constants
Private Const LF_FACESIZE = 32
Private Const LOGPIXELSY = 90

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 - 1) As Byte
End Type

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 Declare Function CreateFontIndirect _
Lib "gdi32" Alias "CreateFontIndirectA" ( _
    lpLogFont As LOGFONT _
) As Long

Private Declare Function TextOut _
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

Private Declare Function GetDeviceCaps _
Lib "gdi32" ( _
    ByVal hdc As Long, _
    ByVal nIndex As Long _
) As Long

'Module-level private variables
Private mobjDevice As Object
Private mfSX1 As Single
Private mfSY1 As Single
Private mfXRatio As Single
Private mfYRatio As Single
Private lfFont As LOGFONT
Private mnAngle As Integer

'~~~Angle
Property Let Angle(nAngle As Integer)
    mnAngle = nAngle
End Property
Property Get Angle() As Integer
    Angle = mnAngle
End Property

'~~~Label
Public Sub Label(sText As String)
    Dim lFont As Long
    Dim lOldFont As Long
    Dim lRes As Long
    Dim byBuf() As Byte
    Dim nI As Integer
    Dim sFontName As String
    'Prepare font name, decoding from Unicode
    sFontName = mobjDevice.Font.Name
    byBuf = StrConv(sFontName & Chr$(0), vbFromUnicode)
    For nI = 0 To UBound(byBuf)
        lfFont.lfFaceName(nI) = byBuf(nI)
    Next nI
    'Convert known font size to required units
    lfFont.lfHeight = mobjDevice.Font.Size * _
        GetDeviceCaps(mobjDevice.hdc, LOGPIXELSY) \ 72
    'Set Italic or not
    If mobjDevice.Font.Italic = True Then
        lfFont.lfItalic = 1
    Else
        lfFont.lfItalic = 0
    End If
    'Set Underline or not
    If mobjDevice.Font.Underline = True Then
        lfFont.lfUnderline = 1
    Else
        lfFont.lfUnderline = 0
    End If
    'Set Strikethrough or not
    If mobjDevice.Font.Strikethrough = True Then
        lfFont.lfStrikeOut = 1
    Else
        lfFont.lfStrikeOut = 0
    End If
    'Set Bold or not (use font's weight)
    lfFont.lfWeight = mobjDevice.Font.Weight
    'Set font rotation angle
    lfFont.lfEscapement = CLng(mnAngle * 10#)
    lfFont.lfOrientation = lfFont.lfEscapement
    'Build temporary new font and output the string
    lFont = CreateFontIndirect(lfFont)
    lOldFont = SelectObject(mobjDevice.hdc, lFont)
    lRes = TextOut(mobjDevice.hdc, XtoP(mobjDevice.CurrentX), _
        YtoP(mobjDevice.CurrentY), sText, Len(sText))
    lFont = SelectObject(mobjDevice.hdc, lOldFont)
    DeleteObject lFont
End Sub

'~~~Device
Property Set Device(objDevice As Object)
    Dim fSX2 As Single
    Dim fSY2 As Single
    Dim fPX2 As Single
    Dim fPY2 As Single
    Dim nScaleMode As Integer
    Set mobjDevice = objDevice
    With mobjDevice
        'Grab current scaling parameters
        nScaleMode = .ScaleMode
        mfSX1 = .ScaleLeft
        mfSY1 = .ScaleTop
        fSX2 = mfSX1 + .ScaleWidth
        fSY2 = mfSY1 + .ScaleHeight
        'Temporarily set pixels mode
        .ScaleMode = vbPixels
        'Grab pixel scaling parameters
        fPX2 = .ScaleWidth
        fPY2 = .ScaleHeight
        'Reset user's original scale
        If nScaleMode = 0 Then
            mobjDevice.Scale (mfSX1, mfSY1)-(fSX2, fSY2)
        Else
            mobjDevice.ScaleMode = nScaleMode
        End If
        'Calculate scaling ratios just once
        mfXRatio = fPX2 / (fSX2 - mfSX1)
        mfYRatio = fPY2 / (fSY2 - mfSY1)
    End With
End Property

'Scales X value to pixel location
Private Function XtoP(fX As Single) As Long
    XtoP = (fX - mfSX1) * mfXRatio
End Function

'Scales Y value to pixel location
Private Function YtoP(fY As Single) As Long
    YtoP = (fY - mfSY1) * mfYRatio
End Function


> Subject: Rotation of the  Label or TextBox controls with their caption/tex
>      t
> From: Vlada Bromberg <Vlada@d...>
> Date: Wed, 25 Sep 2002 13:28:32 -0400
> X-Message-Number: 22
>
> Hello,
> Does anybody know if it is possible to rotate Label or TextBox controls 90
> degrees. I achieved in rotation the label but the Caption stayed
> horizontal.
> If it is not possible, can you suggest another Control?
> Thanks,
> Vlada.
>



---
Visual C# - A Guide for VB6 Developers
This book will make it easy to transfer your skills 
from Visual Basic 6 to C#, the language of choice 
of the .NET Framework.
http://www.wrox.com/ACON11.asp?ISBN=1861007175&p2p0059