Como redimensionar el tamaño del texto de un label de acuerdo a su ancho y alto

[Bazooka]

HOLA , de nuevo hay alguna forma de ajustar el tamaño de un label al ancho y alto del mismo?

Yo tengo unos labels que se ajustan de acuerdo al tmaño del form y no se de que manera se puede calcular el Font.Size para que no sea muy pequeña ni muy grande!!!

Gracias

[79137913]

HOLA!!!

Esto no lo hice yo pero tiene pinta:

This is the best alternative to TextWidth/TextHeight I have seen (but not worth using unless you have VB5):
VB Code:

Código: [Seleccionar]

    'definitions:
    Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
    Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" _
        (ByVal hDC As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As SIZE) As Long
    Private Type SIZE
      cx As Long
      cy As Long
    End Type
     
    'code:
    Function GetVisualLength(ByVal Text, ByVal form_hWnd) As Long
    'not needed in VB6, can use  <form/printer/picbox>.TextHeight
     
    Dim hDC As Long
    Dim sz As SIZE
     
      hDC = GetDC(form_hWnd)
      Call GetTextExtentPoint32(hDC, Text, Len(Text), sz)
      GetVisualLength = sz.cx
      Call ReleaseDC(form_hWnd, hDC)
     
    End Function
Notice that it also requires a reference to a form for font information.

GRACIAS POR LEER!!!

[Bazooka]

Pero un ejemplito por favor no se como se utiliza!!

[79137913]

HOLA!!!

Te lo voy a editar para que se te haga mas facil...

La funcion es la siguiente:

Código: (VB) [Seleccionar]

    Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
    Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" _
        (ByVal hDC As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As SIZE) As Long
    Private Type SIZE
      cx As Long
      cy As Long
    End Type
   
    Function GetVisualLength(ByVal Text, LabelX As Label, XtrueYfalse As Boolean) As Long
    Dim hDC As Long
    Dim sz As SIZE
    Me.Font = LabelX.Font
    Me.FontBold = LabelX.FontBold
    Me.FontName = LabelX.FontName
    Me.FontSize = LabelX.FontSize
      hDC = GetDC(Me.hWnd)
      Call GetTextExtentPoint32(hDC, Text, Len(Text), sz)
      If XtrueYfalse Then GetVisualLength = sz.cx Else GetVisualLength = sz.cy
      Call ReleaseDC(form_hWnd, hDC)
    End Function
y para usarla haces asi:

Código: (VB) [Seleccionar]

Private Sub Form_Load()
'tengo un label llamado label1
'quiero saber cuanto ocuparia de ancho el texto "prueba" en label 1:
Debug.Print GetVisualLength("prueba", Label1, True)
'quiero saber cuanto ocuparia de alto el texto "prueba" en label 1:
Debug.Print GetVisualLength("prueba", Label1, False)
'El resultado es devuelto en Pixels... CREO XD
End Sub
GRACIAS POR LEER!!!

[Bazooka]

Perdon por mi ignorancia 79137913 ahora voy entendiendo (maso) pero y teniendo el ancho y el alto como traduzco eso al tamaño que FontSize debería utilizar para que ocupe todo el ANCHO Y ALTO del label1??

[79137913]

HOLA!!!

Uh mil disculpas bazooka, entendi mal la consigna y por ahi te maree un poco...

La funcion que te deje yo te va a devolver cuantos pixeles ocupa una cadena de texto en la fuente y tamaño de tu label.


Pero no perdamos los animos digo!!!

Aca codee una funcion complementaria a la que le pones un texto y un label y te devuelve el fontsize maximo que podras ponerle sin perder ninguna letra!

todo el code es el siguiente:

Código: (VB) [Seleccionar]

        Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
        Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
        Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" _
            (ByVal hDC As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As SIZE) As Long
        Private Type SIZE
          cx As Long
          cy As Long
        End Type
       
        Function GetVisualLength(ByVal Text, LabelX As Label, Fsize As Long, XtrueYfalse As Boolean) As Long
        Dim hDC As Long
        Dim sz As SIZE
        Me.Font = LabelX.Font
        Me.FontBold = LabelX.FontBold
        Me.FontName = LabelX.FontName
        Me.FontSize = Fsize
          hDC = GetDC(Me.hWnd)
          Call GetTextExtentPoint32(hDC, Text, Len(Text), sz)
          If XtrueYfalse Then GetVisualLength = sz.cx Else GetVisualLength = sz.cy
          Call ReleaseDC(form_hWnd, hDC)
        End Function
       
        Function GetMaxSize(Text As String, LabelX As Label) As Long
            Dim x As Long
            Dim y As Long
            Dim MaxW As Long
            Dim MaxH As Long
            Me.ScaleMode = 3
            MaxW = LabelX.Width
            MaxH = LabelX.Height
            For x = 2 To 74 Step 2
                If MaxH < GetVisualLength(Text, LabelX, x, False) Then Exit For
            Next
            x = x - 2
            For y = 2 To 74 Step 2
                If MaxW < GetVisualLength(Text, LabelX, y, True) Then Exit For
            Next
            y = y - 2
            If y > x Then GetMaxSize = x Else GetMaxSize = y
        End Function
El uso es muy simple:

Código: (VB) [Seleccionar]

Private Sub Form_Load()
' aca consultamos a la funcion getmaxsize cual es el tamaño de fuente indicado
' para que la palabra hola quepa en label1
    Label1.FontSize = GetMaxSize("hola", Label1)
End Sub
P.D: Esta hecha para poner en el form, si la queres poner en un modulo asi:

Código: (VB) [Seleccionar]

        Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
        Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
        Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" _
            (ByVal hDC As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As SIZE) As Long
        Private Type SIZE
          cx As Long
          cy As Long
        End Type
       
        Function GetVisualLength(ByVal Text, LabelX As Label, Fsize As Long, XtrueYfalse As Boolean, FormX As Form) As Long
        Dim hDC As Long
        Dim sz As SIZE
        FormX.Font = LabelX.Font
        FormX.FontBold = LabelX.FontBold
        FormX.FontName = LabelX.FontName
        FormX.FontSize = Fsize
          hDC = GetDC(FormX.hWnd)
          Call GetTextExtentPoint32(hDC, Text, Len(Text), sz)
          If XtrueYfalse Then GetVisualLength = sz.cx Else GetVisualLength = sz.cy
          Call ReleaseDC(form_hWnd, hDC)
        End Function
       
        Function GetMaxSize(Text As String, LabelX As Label, FormX As Form) As Long
            Dim x As Long
            Dim y As Long
            Dim MaxW As Long
            Dim MaxH As Long
            FormX.ScaleMode = 3
            MaxW = LabelX.Width
            MaxH = LabelX.Height
            For x = 2 To 74 Step 2
                If MaxH < GetVisualLength(Text, LabelX, x, False, FormX) Then Exit For
            Next
            x = x - 2
            For y = 2 To 74 Step 2
                If MaxW < GetVisualLength(Text, LabelX, y, True, FormX) Then Exit For
            Next
            y = y - 2
            If y > x Then GetMaxSize = x Else GetMaxSize = y
        End Function

y este codigo en el form:

Código: (VB) [Seleccionar]

Private Sub Form_Load()
    Label1.FontSize = GetMaxSize("hola", Label1, Me)
End Sub

GRACIAS POR LEER!!!

[Bazooka]

UN KAPO!!!!   79137913  amigo como me gustaría tener un socio como vos haríamos mucha $$

[79137913]

HOLA!!!

No hay porque bazooka, estamos para ayudar .

GRACIAS POR LEER!!!