Autosize label

[john42]

Is it possible to have a labels width fixed (1335 twips) and have it´s height autosized?

I want the labels height to change dynamicly at runtime. I´ve tried all kinds of solutions, but nothing seems to work for me.

[RhinoBull]

You may use Multiline textbox with Locked = True instead.

[john42]

Originally posted by RhinoBull
You may use Multiline textbox with Locked = True instead.

Hmm ok i don´t think i understand I want the label (or textbox doesn´t matter) to resize to fit the text so you can see all the text without the need to scroll.

[nareth]

wow thats hard! set the property.. to autosize, true.. wow how hard...[/sarcasm]

[RhinoBull]

It's not about autosize at all and here is a sample:
create a textbox with Multiline = True and no Scrollbars and run this code (modified version of Randy's sample):

Option Explicit
 
Private Declare Function SendMessage Lib "user32" _
   Alias "SendMessageA" _
  (ByVal hwnd As Long, _
   ByVal wMsg As Long, _
   ByVal wParam As Long, _
   lParam As Any) As Long
 
Private Const EM_GETLINECOUNT = &HBA
 
Private Sub Form_Load()
    Me.Font = Text1.Font
End Sub
 
Private Sub Text1_Change()
'==========================
Dim h As Long
Dim lineCount As Long
 
On Local Error Resume Next
 
    lineCount = SendMessage(Text1.hwnd, EM_GETLINECOUNT, 0&, ByVal 0&)
    h = TextHeight("A") * lineCount
    If Text1.Height < h Then Text1.Height = h + 120
 
End Sub

[Merri]

You don't need textbox! Just set label's both WordWrap and Autosize = True, make the label correct width and it autosizes just like you described

[RhinoBull]

Label isn't always behave as expected so that's why textbox with Locked and Multiline = True comes very handy.

[Merri]

Show me an example when wordwrapped autosized label doesn't work as it should, as for me it has always worked fine.

[john42]

Originally posted by Merri
Show me an example when wordwrapped autosized label doesn't work as it should, as for me it has always worked fine.

Private Sub Command1_Click()

Label1.AutoSize = True
Label1.WordWrap = True
Label1.Width = 1335
Label1.Caption = "mksadlaskdlaksmasertgrtgertgrtgertgertgd "
MsgBox Label1.Width
End Sub

Run this code, what does the msgbox show? My msgbox shows 3045 and i want it to show 1335

[john42]

Originally posted by RhinoBull
It's not about autosize at all and here is a sample:
create a textbox with Multiline = True and no Scrollbars and run this code (modified version of Randy's sample):

Option Explicit
 
Private Declare Function SendMessage Lib "user32" _
   Alias "SendMessageA" _
  (ByVal hwnd As Long, _
   ByVal wMsg As Long, _
   ByVal wParam As Long, _
   lParam As Any) As Long
 
Private Const EM_GETLINECOUNT = &HBA
 
Private Sub Form_Load()
    Me.Font = Text1.Font
End Sub
 
Private Sub Text1_Change()
'==========================
Dim h As Long
Dim lineCount As Long
 
On Local Error Resume Next
 
    lineCount = SendMessage(Text1.hwnd, EM_GETLINECOUNT, 0&, ByVal 0&)
    h = TextHeight("A") * lineCount
    If Text1.Height < h Then Text1.Height = h + 120
 
End Sub

That was a great example! I´m gonna use that code.

[RhinoBull]

Originally posted by john42
That was a great example! I´m gonna use that code.

Cool !

[Merri]

Ah, that case. I've always used "proper" text when I've used wordwrapped text. Anyways, you can always have wordwrapped label and do this:

Option Explicit
Private Function FormatWrap(ByVal Text As String, InWidth As Long) As String
    Dim Temps() As String, Temp As String
    Dim A As Integer, B As Integer
    Temps = Split(Text, " ")
    For A = 0 To UBound(Temps)
        If TextWidth(Temps(A)) < InWidth Then
            Temp = Temp & " " & Temps(A)
        Else
            B = Len(Temps(A))
            Do While B
                B = B - 1
                If TextWidth(Left$(Temps(A), B)) < InWidth Then
                    Temp = Temp & " " & Left$(Temps(A), B)
                    If Not B = Len(Temps(A)) Then
                        Temps(A) = Mid$(Temps(A), B + 1)
                        B = Len(Temps(A)) + 1
                    Else
                        B = 0
                    End If
                End If
            Loop
        End If
    Next A
    FormatWrap = Mid$(Temp, 2)
End Function
Private Sub Form_Load()
    Label1 = FormatWrap("Mgfdhgkjdhgkdhhdk", Label1.Width)
End Sub

I'm too generous for making all these codes!

[RhinoBull]

I would assume it works but very inefficient - loop within another loop ... plus all of those string functions, array, vars ...

[Merri]

I know, I were too lazy to start converting to byte array and loop through it and convert back to string It works fast enough for single purpose needs though.