Newsgroup: it.comp.lang.visual-basic
Titolo: Label in verticale

E' possibile mettere una label in verticale? o comunque far apparire la
scritta in verticale?
Grazie
Saluti

 scritta in verticale?
Bhè... Mettere una label in verticale no... Dovresti usare qualche OCX
personalizato. Però potresti ottenere un buon effetto mettendo la proprietà
autosize su false, impostando la larghezza in modo che ci vada un solo
carattere e inserendo da codice la caption con qualcosa del tipo
Label1.Caption = "P" + VbCrLf + "R", ecc.
Antonio Mirarchi

 scritta in verticale?
Intendi qualcosa come questo?
Lascio a te la ricerca di tutte le dichiarazioni mancanti :)
Puoi passare Form.hDC come prova.
Sub znnDrawRotatedText(ByVal hDc As Long, ByVal Degrees As Integer, ByVal x
As Long, ByVal y As Long, Text As String)
'Funziona SOLO con caratteri True Type!!!
    Dim RotateF As LOGFONT
    Dim CurF As Long, rF As Long
    Dim TM As TEXTMETRIC
    Call GetTextMetrics(hDc, TM)
    RotateF.lfEscapement = Degrees * 10
    RotateF.lfWeight = TM.tmWeight
    RotateF.lfHeight = TM.tmHeight
    RotateF.lfItalic = TM.tmItalic
    RotateF.lfStrikeOut = TM.tmStruckOut
    RotateF.lfUnderline = TM.tmUnderlined
    Call p_GetTextFace(hDc, UBound(RotateF.lfFaceName) + 1,
RotateF.lfFaceName)
    rF = p_CreateFontIndirect(RotateF)
    CurF = p_SelectObject(hDc, rF)
    Call p_TextOut(hDc, x, y, Text, Len(Text))
    'Restore
    Call p_SelectObject(hDc, CurF) 'Rimette Orizzontale
    Call p_DeleteObject(rF)
End Sub
Ciao
--
Math Parser : 
http://www.neodatatype.net
Sito Comune : 
http://www.it-lang-vb.net
            +-- 
http://www.neodatatype.net/iclvb/AxBalloon.zip
            +-- 
http://www.neodatatype.net/iclvb/vb_project.zip


Zanna, ci ho giocato un po ma non va!
Ho dovuto cambiare qualcosa perchè non mi tornavano le definizioni:
    RotateF.lfItalic = TM.tmItalic
    RotateF.lfStrikeOut = TM.tmStruckOut
    RotateF.lfUnderline = TM.tmUnderlined
e
    UBound(RotateF.lfFaceName) + 1   mi da errore
così non da errori ma non va
-----------------------------
   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 As String * LF_FACESIZE
   End Type
  '** TYPES **
  Private Type TEXTMETRIC
     tmHeight As Integer
     tmAscent As Integer
     tmDescent As Integer
     tmInternalLeading As Integer
     tmExternalLeading As Integer
     tmAveCharWidth As Integer
     tmMaxCharWidth As Integer
     tmWeight As Integer
     tmItalic As String * 1
     tmUnderlined As String * 1
     tmStruckOut As String * 1
     tmFirstChar As String * 1
     tmLastChar As String * 1
     tmDefaultChar As String * 1
     tmBreakChar As String * 1
     tmPitchAndFamily As String * 1
     tmCharSet As String * 1
     tmOverhang As Integer
     tmDigitizedAspectX As Integer
     tmDigitizedAspectY As Integer
   End Type
Private Declare Function GetTextMetrics Lib "gdi32" Alias
"GetTextMetricsA" (ByVal hDc As Long, lpMetrics As TEXTMETRIC) As Long
Private Declare Function GetTextFace Lib "gdi32" Alias "GetTextFaceA"
(ByVal hDc As Long, ByVal nCount As Long, ByVal lpFacename As String)
As Long
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 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 ' or Boolean
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As
Long) As Long
Sub znnDrawRotatedText(ByVal hDc As Long, ByVal Degrees As Integer,
ByVal x As Long, ByVal y As Long, Text As String)
'Funziona SOLO con caratteri True Type!!!
    Dim RotateF As LOGFONT
    Dim CurF As Long, rF As Long
    Dim TM As TEXTMETRIC
    Call GetTextMetrics(hDc, TM)
    RotateF.lfEscapement = Degrees * 10
    RotateF.lfWeight = TM.tmWeight
    RotateF.lfHeight = TM.tmHeight
    RotateF.lfItalic = CByte(Asc(TM.tmItalic))
    RotateF.lfStrikeOut = CByte(Asc(TM.tmStruckOut))
    RotateF.lfUnderline = CByte(Asc(TM.tmUnderlined))
    Call GetTextFace(hDc, Len(RotateF.lfFaceName) + 1,
RotateF.lfFaceName)
 
    rF = CreateFontIndirect(RotateF)
    CurF = SelectObject(hDc, rF)
    Call TextOut(hDc, x, y, Text, Len(Text))
    'Restore
    Call SelectObject(hDc, CurF) 'Rimette Orizzontale
    Call DeleteObject(rF)
End Sub
Private Sub Form_Activate()
 Call znnDrawRotatedText(Me.hDc, 90, 10, 10, "pippo")
End Sub

    UBound(RotateF.lfFaceName) + 1   mi da errore
Quale errore?
Hai dichiarato RotateF.lfFaceName come array di char oppure
come String a lunghezza fissa?
E soprattutto, che razza di istruzione e' quella che hai scritto?
-- 
ciao, hal

E soprattutto, che razza di istruzione e' quella che hai scritto?
Dal post di Zanna:
    Call p_GetTextFace(hDc, UBound(RotateF.lfFaceName) + 1,
RotateF.lfFaceName)
Ho modificato per vedere se andava:


 Ho dovuto cambiare qualcosa perchè non mi tornavano le definizioni:
Uff, deve sempre pensarci il vecchio :)
Prendi un progetto nuovo e appiccicaci un CommandButton, poi incolla questo
codice:
Ciao
Option Explicit
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
Private Type TEXTMETRIC
    tmHeight As Long
    tmAscent As Long
    tmDescent As Long
    tmInternalLeading As Long
    tmExternalLeading As Long
    tmAveCharWidth As Long
    tmMaxCharWidth As Long
    tmWeight As Long
    tmOverhang As Long
    tmDigitizedAspectX As Long
    tmDigitizedAspectY As Long
    tmFirstChar As Byte
    tmLastChar As Byte
    tmDefaultChar As Byte
    tmBreakChar As Byte
    tmItalic As Byte
    tmUnderlined As Byte
    tmStruckOut As Byte
    tmPitchAndFamily As Byte
    tmCharSet As Byte
End Type
Private Declare Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA"
(ByVal hdc As Long, lpMetrics As TEXTMETRIC) As Long
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 GetTextFace Lib "gdi32" Alias "GetTextFaceA" (ByVal
hdc As Long, ByVal nCount As Long, ByVal lpFacename As String) 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 DeleteObject Lib "gdi32" (ByVal hObject As Long) As
Long
Private Sub Command1_Click()
    Call znnDrawRotatedText(Form1.hdc, 90, 100, 100, "Ciao")
End Sub
Sub znnDrawRotatedText(ByVal hdc As Long, ByVal Degrees As Integer, ByVal x
As Long, ByVal y As Long, Text As String)
'Funziona SOLO con caratteri True Type!!!
    Dim RotateF As LOGFONT
    Dim CurF As Long, rF As Long
    Dim TM As TEXTMETRIC
    Call GetTextMetrics(hdc, TM)
    RotateF.lfEscapement = Degrees * 10
    RotateF.lfWeight = TM.tmWeight
    RotateF.lfHeight = TM.tmHeight
    RotateF.lfItalic = TM.tmItalic
    RotateF.lfStrikeOut = TM.tmStruckOut
    RotateF.lfUnderline = TM.tmUnderlined
    Call GetTextFace(hdc, UBound(RotateF.lfFaceName) + 1,
RotateF.lfFaceName)
    rF = CreateFontIndirect(RotateF)
    CurF = SelectObject(hdc, rF)
    Call TextOut(hdc, x, y, Text, Len(Text))
    'Restore
    Call SelectObject(hdc, CurF) 'Rimette Orizzontale
    Call DeleteObject(rF)
End Sub
--


Accidenti!!!
Proverò :)
Comunque grazie :)
e Buon Anno

--------------------------------
Inviato via 
http://arianna.libero.it/usenet/


Adesso è ok
grazie
ciao 
  Stefano