ColumnWidths property responding to length of string supplied by user 1

[duGly]

I am using VBA with Word 2003. I want to dynamically change the ColumnWidths property of a ListBox control (on a UserForm) based on the length of the text entered by the user. Here's why:

The width of my ListBox is quite large: 450 pts. I really can't make it much larger than that due to design constraints on the UserForm. The width is large enough to accomodate most, but not all, of the values that a typical user might enter.

I want to adjust the ColumnWidths property only when needed in order to show the horizontal scroll bar when an entry is too large for the control. (Setting the combined ColumnWidths > Width displays the horizontal scroll bar.)

So here's my question: how do I calculate the width (in points, picas, or whatever) of the text entered by the user?

 

[fumei]

450 pts!??! Without seeing the userform, or knowing the processes involved, I still have to say that this seems extraordinary. May I ask why this is required?

Listboxes should list items, not whole chunks of text. At least normally. If the user requires fuller text that is matched to the item, why not make the full text as a Label? The Label.Caption could be the longer text, and would change depending on the selected item in the listbox.

If the issue is entry of text, why not use a textbox for user text entry, rather than a listbox?

I guess what I am saying is, could you elaborate on the design and function of the userform?

Gerry
My paintings and sculpture

 

[duGly]

Thanks for your response and your interest, Gerry. You have responded to many of my posts and always ask good questions to clarify the issue.

The project I am working on automates many common tasks in the creation of NEPA (National Environmental Policy Act) documents, specifically EISs (Environmental Impact Statements) and EAs (Environmental Assessments). The purpose of the UserForm in question is to assist the user in organizing the chapters and subsections for the document, before the actual writing begins. The list box holds the titles of the chapters and subsections, allowing the user to add, delete, rename, and move chapters up and down. The user can also indent and outdent the subsections.

The ListBox works great for my purposes because it allows the user to see an overview of the different chapters and subsections. A checkbox hides/shows the subsections, allowing the user to see more or less. Once the user has organized the structure of the document to their satisfaction, clicking OK will create the subdocuments (from a template) and apply the headings and subheading created using the UserForm.

I actually use the ListBox for display only. Additions are made through a text box. All other functions (delete, edit, move, indent, outdent) are performed by CommandButtons. The data is stored in an array, and displayed on the ListBox.

The unwieldy length of some of the chapter titles (NEPA can be a bear!) makes it necessary for the ListBox to be so wide. But even as wide as it is, there are some titles which just don't fit. That's why I want the user to be able to scroll to the right if necessary, but I don't want the scroll bars to appear if they are not needed.

So back to my original question, how can I figure the horizontal size (in picas, points, etc.) of the text input by the user?

 

[strongm]

You might actually want to consider a TreeView for this, you know, rather than a ListBox

 

[duGly]

All right, for anyone dealing with a similar situation, I found a solution for my problem. I still haven't figured out how to do my original task, which was to calculate the width of a string of text. It seems like I read about some VBA function that does that, but I haven't been able to find it again.

My solution is much less elegant, but it runs in the background and it works. What I did was create a label (lblTextWidth). I set Visible = False and AutoSize = True. As I am populating the ListBox, I set the caption for lblTextWidth to the text of each respective row. Although invisible, the label grows or shrinks according the the length of the caption. I then use a variable (intColumnWidths) to record the width of the longest row.

[blue]For[/blue] intEntry = m_intStart [blue]To[/blue] m_intEnd
    ...
    Me.lstPlanner.AddItem  strText

    [green]' Set intColumnWidths.[/green]
    Me.lblTextWidth = strText
    [blue]If[/blue] Me.lblTextWidth.Width > intColumnWidths [blue]Then[/blue] intColumnWidths = Me.lblTextWidth.Width
[blue]Next[/blue]    [green]' intEntry[/green]

When I'm finished populating the ListBox, I set the ColumnWidths value to intColumnWidths + 18 (to add a little breathing room).

Me.lstPlanner.ColumnWidths = intColumnWidths + 18

As I said, my solution works, but is hardly elegant. If anyone thinks of a more efficient way to accomplish this task, I would be grateful for your suggestions.

 

[HughLerwill]

duGly,

A Google on this took me back to this forum's thread707-687866 and use of the the GetTextExtentPoint32 API which looks promising if you wanted to devise your own VBATextWidth/Height functions.

A link at

http://www.vbforums.com/printthread.php?t=331907

appears to give code for using GetTextExtentPoint32 and there is another useful looking link at

http://www.allapi.net/apilist/GetTextExtentPoint32.shtml

As often in things API (and I have'nt found a strongm on this yet) it appears almost done for you at

http://vbnet.mvps.org/index.html?code/comboapi/combowidthadv.htm

and

http://vbnet.mvps.org/index.html?code/comboapi/combowidthadv.htm

(you'll have to convert from vb6 to VBA)

However, it is unlikely that any of the above will give you less coding than your inovative use of the autosized textbox.

HTH Hugh

 

[duGly]

Thank you, HTH Hugh. Your links provided me with some great information.

API is still a scary unknown to me. Can anyone provide a good link for a basic API primer?


[purple]— Artificial intelligence is no match for natural stupidity.[/purple]

 

[duGly]

Based on HTH Hugh's suggestions, I have modified my code as follows:

1) I created the following function named TextWidth, along with its required API calls:

[green]'   Modular Constants:[/green]
    [blue]Private Const[/blue] FontSize% = 10
    [blue]Private Const[/blue] LogPixelsX! = 116
    [blue]Private Const[/blue] FontName$ = "Arial"[green]
'
'   Modular Types:[/green]
    [blue]Public Type[/blue] TextSize
        cx [blue]As Long[/blue]
        cy [blue]As Long[/blue]
    [blue]End Type[/blue]
    [blue]Private Type[/blue] LogFont
        lfHeight [blue]As Long[/blue]
        lfWidth [blue]As Long[/blue]
        lfEscapement [blue]As Long[/blue]
        lfOrientation [blue]As Long[/blue]
        lfWeight [blue]As Long[/blue]
        lfItalic [blue]As Byte[/blue]
        lfUnderline [blue]As Byte[/blue]
        lfStrikeOut [blue]As Byte[/blue]
        lfCharSet [blue]As Byte[/blue]
        lfOutPrecision [blue]As Byte[/blue]
        lfClipPrecision [blue]As Byte[/blue]
        lfQuality [blue]As Byte[/blue]
        lfPitchAndFamily [blue]As Byte[/blue]
        lfFaceName [blue]As String[/blue] * 32
    [blue]End Type[/blue][green]
'
'   Modular API Functions:[/green]
    [blue]Private Declare Function[/blue] CreateDC& [blue]Lib[/blue] "gdi32.dll" [blue]Alias[/blue] "CreateDCA" _
        ([blue]ByVal[/blue] lpDriverName$, [blue]ByVal[/blue] lpDeviceName$, [blue]ByVal[/blue] lpOutput$, lpInitData&)
    [blue]Private Declare Function[/blue] CreateCompatibleBitmap& [blue]Lib[/blue] "gdi32.dll" _
        ([blue]ByVal[/blue] hdc&, [blue]ByVal[/blue] nWidth&, [blue]ByVal[/blue] nHeight&)
    [blue]Private Declare Function[/blue] CreateFontIndirect& [blue]Lib[/blue] "gdi32.dll" [blue]Alias[/blue] "CreateFontIndirectA" _
        (lpLogFont [blue]As LogFont[/blue])
    [blue]Private Declare Function[/blue] SelectObject& [blue]Lib[/blue] "gdi32.dll" _
        ([blue]ByVal[/blue] hdc&, [blue]ByVal[/blue] hObject&)
    [blue]Private Declare Function[/blue] DeleteObject& [blue]Lib[/blue] "gdi32.dll" _
        ([blue]ByVal[/blue] hObject&)
    [blue]Private Declare Function[/blue] GetTextExtentPoint32& [blue]Lib[/blue] "gdi32.dll" [blue]Alias[/blue] "GetTextExtentPoint32A" _
        ([blue]ByVal[/blue] hdc&, [blue]ByVal[/blue] lpsz$, [blue]ByVal[/blue] cbString&, lpSize [blue]As TextSize[/blue])
    [blue]Private Declare Function[/blue] GetDC& [blue]Lib[/blue] "user32.dll" _
        ([blue]ByVal[/blue] hwnd&)
    [blue]Private Declare Function[/blue] GetDeviceCaps& [blue]Lib[/blue] "gdi32.dll" _
        ([blue]ByVal[/blue] hdc&, [blue]ByVal[/blue] nIndex&)
    [blue]Private Declare Function[/blue] DeleteDC& [blue]Lib[/blue] "gdi32.dll" _
        ([blue]ByVal[/blue] hdc&)
    [blue]Option Explicit[/blue][green]



' •TextWidth Function•
' Purpose: Measure the size of txtString (in pixels).
' Arguments:
'   txtString = String to be analyzed.[/green]
[blue]Public Function[/blue] TextWidth(txtString$) [blue]As[/blue] TextSize
    [blue]Dim[/blue] tempDC&, tempBMP&, f&
    [blue]Dim[/blue] lf [blue]As[/blue] LogFont[green]
    
    ' Create a device context and a bitmap that can be used to store a _
    ' temporary font object. Assign the bitmap to the device context.[/green]
    tempDC = CreateDC("DISPLAY", vbNullString, vbNullString, [blue]ByVal[/blue] 0)
    tempBMP = CreateCompatibleBitmap(tempDC, 1, 1)[green]
    
    ' Set up the LogFont structure and create the font.[/green]
    lf.lfFaceName = FontName & Chr$(0)
    lf.lfHeight = -FontSize * GetDeviceCaps(GetDC(0), LogPixelsX) / 72
    f = CreateFontIndirect(lf)[green]
    
    ' Assign the font to the device context.[/green]
    DeleteObject SelectObject(tempDC, f)[green]
    
    ' Measure the text, and return it as TextWidth.[/green]
    GetTextExtentPoint32 tempDC, txtString, Len(txtString), TextWidth[green]
    
    ' Delete objects.[/green]
    DeleteObject f
    DeleteObject tempBMP
    DeleteDC tempDC
    
[blue]End Function[/blue]

This function measures the width (in pixels) of the text supplied by the argument strText. The text is measured at 10 pt. Arial, althought the font and font size can be changed by modifying the constants FontName and FontSize.

2) Next, I modified the code which populates the ListBox. (Compare this to the code from my previous post on 4 Jan 07.)

[blue]For[/blue] intEntry = m_intStart [blue]To[/blue] m_intEnd
    ...
    Me.lstPlanner.AddItem  strText

    [green]' Set intColumnWidths.[/green]
    Me.lblTextWidth = strText
    [blue]If[/blue] Me.lblTextWidth.Width > intColumnWidths [blue]Then[/blue] intColumnWidths = Me.lblTextWidth.Width
[blue]Next[/blue]    [green]' intEntry[/green]

3) When I'm finished populating the ListBox, I set the ColumnWidths value to intColumnWidths + 6 (to add a little breathing room).

Me.lstPlanner.ColumnWidths = intColumnWidths + 18

4) I deleted the invisible lblTextWidth, as it is no longer needed.

Although this solution requires much more code, I like it much better than my previous solution, perhaps because it bugged me to create a superfluous (albeit invisible) control on the UserForm. Thanks to all who responded to my post, and especially to HTH Hugh for pointing me in the right direction!

P.S. I'm still looking for a good API primer if someone could point me to one. Thanks in advance!

[purple]— Artificial intelligence is no match for natural stupidity.[/purple]

 

[HughLerwill]

Sounds like you have been priming yourself; well done..

You may consider including the required font in the call as in;

Public Function TextWidth(txtString$, MyFont as Font) As TextSize

And then call it with TextWidth(txtString$, MyListBox.Font)

regards Hugh,

 

[duGly]

Whoops! I copied in the wrong code for Step #2 of my last post. It should have read as follows:

[blue]For[/blue] intEntry = m_intStart [blue]To[/blue] m_intEnd
    ...
    Me.lstPlanner.AddItem  strText

    [green]' Set intColumnWidths.[/green]
        intTextWidth = TextWidth(strText).cx
        [blue]If[/blue] intTextWidth > intColumnWidths [blue]Then[/blue] intColumnWidths = intTextWidth
[blue]Next[/blue]    [green]' intEntry[/green]

[purple]— Artificial intelligence is no match for natural stupidity.[/purple]

 

[strongm]

>and I have'nt found a strongm on this yet



You haven't looked hard enough. I've made several posts on the subject in the VB5/6 forum ... e.g thread222-1036091

 

[HughLerwill]

Strongm,
I will look harder next time, however on this occasion
thread222-1036091 would have been an unfortunate choice because your code as is will not run in VBA(Excel 2003) and in VB6 the original FontSize * 1000 is returned to the caller.

regards Hugh<g>

 

[duGly]

Hi, strongm. I like the example you posted in thread222-1036091. It's much more efficient than my solution and I'd like to try to make it work with my project.

I've got a couple of questions from your post.

1) Why do you use the variable "myFont"? Why not just use the argument "Font"?

2) Perhaps this will answer question #1, but why is "myFont" declared as IFont rather than StdFont (as is "Font")? What's the difference?

Here's the code that you posted in the aforementioned thread:

Option Explicit

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 CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (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

Public Function vbGetTextWidth(ByVal strSource As String, Font As StdFont) As Long
    Dim myFont As IFont ' We want the IFont interface
    Dim hFont As Long
    Dim mySize As SIZE
    Dim hdc As Long
    
    Set myFont = Font ' switch interface
    myFont.SIZE = Font.SIZE * 1000 ' increases accuracy since resultant mysize only hold longs
    
    hdc = CreateCompatibleDC(0) ' compatible with screen display
    hFont = SelectObject(hdc, myFont.hFont)
    GetTextExtentPoint32 hdc, strSource, Len(strSource), mySize
    
    'Clean up as much as we need to
    SelectObject hdc, hFont
    DeleteDC hdc
    
    vbGetTextWidth = mySize.cx / 1000 ' bring back to normal
End Function

Thanks for your help.

[purple]— Artificial intelligence is no match for natural stupidity.[/purple]

 

[strongm]

>your code as is 1) will not run in VBA(Excel 2003) and 2)in VB6 the original FontSize * 1000 is returned to the caller.

1) Well, it is in the VB6 forum, so one could expect a minor tweak or two to get it working in VBA environments. In this case simply changing
[tt]Dim myFont As IFont [/tt]
to
[tt]Dim myFont As stdOLE.IFont[/tt]
fixes the issue (Excel supports a number of different iFont interfaces, so we need to choose the right one)

2) Well, it scales up the size of the passed-in font by 1000, yes. But it returns the correct string width in pixels

Here's the cleaned up version that resolves both of these issues. You'll notice very little difference from the original (the declarations remain as before):

[blue]Public Function vbGetTextWidth(ByVal strSource As String, Font As stdole.IFont) As Long
    Dim myFont As stdole.IFont ' We want the IFont interface
    Dim hFont As Long
    Dim mySize As SIZE
    Dim hdc As Long
    
    Font.Clone myFont ' switch interface
    myFont.SIZE = Font.SIZE * 1000 ' increases accuracy since resultant mysize only hold longs
    
    hdc = CreateCompatibleDC(0) ' compatible with screen display
    hFont = SelectObject(hdc, myFont.hFont)
    GetTextExtentPoint32 hdc, strSource, Len(strSource), mySize
    
    'Clean up as much as we need to
    SelectObject hdc, hFont
    DeleteDC hdc
    
    vbGetTextWidth = mySize.cx / 1000 ' bring back to normal
End Function[/blue]

>1) Why do you use the variable "myFont"? Why not just use the argument "Font"?

Because what I really wanted to do was to clone 'Font' so that we didn't actually effect the size of the passed in font. I just didn't get around to putting in the clone code

>why is "myFont" declared as IFont rather than StdFont

because I needed stdOLE.iFont's hFont property (and, latterkly, Clone method)

 

[strongm]

(and I still think a TreeView is a more appropriate control for this ... ;-) )