Resizing ListViews 1

[AndyWatt]

Dear All,

Below is the code I use to resize ListViews. Can anyone suggest any improvements?

Public Sub ResizeListView(lvwTarget As ListView)
  Const cstrRoutineName As String = "ResizeListView"
  Const cintX As Integer = 180, _
        cintC As Integer = 240
  Dim frmX As Form
  Dim intC As Integer, _
      intR As Integer, _
      intW As Integer, _
      intS As Integer
  Dim blnB As Boolean, _
      blnI As Boolean, _
      blnS As Boolean, _
      blnU As Boolean
  
  On Error GoTo ErrExit
  
  With lvwTarget
    
    ' Check parent object is a form
    If Not (TypeOf .Parent Is Form) Then GoTo ErrExit
    
    ' Set reference to parent form to use TextWidth
    Set frmX = .Parent
    
    ' Save font settings
    blnB = frmX.Font.Bold
    blnI = frmX.Font.Italic
    intS = frmX.Font.Size
    blnS = frmX.Font.Strikethrough
    blnU = frmX.Font.Underline
    
    ' Get font settings from ListView
    frmX.Font.Italic = .Font.Italic
    frmX.Font.Size = .Font.Size
    frmX.Font.Strikethrough = .Font.Strikethrough
    frmX.Font.Underline = .Font.Underline
    
    ' Loop through columns
    For intC = 1 To .ColumnHeaders.Count
      
      ' Set font settings
      frmX.Font.Bold = .Font.Bold
      
      ' Get width of column header
      .ColumnHeaders(intC).Tag = frmX.TextWidth(.ColumnHeaders(intC).Text)
      
      ' Loop through rows
      For intR = 1 To .ListItems.Count
      
        ' Is this the Text column?
        If intC = 1 Then
        
          ' Yes - get Bold property
          frmX.Font.Bold = .ListItems(intR).Bold
          
          ' Get width of .Text
          intW = frmX.TextWidth(.ListItems(intR).Text)
          
          ' Is Text wider than any before?
          If intW > .ColumnHeaders(intC).Tag Then
            ' Yes - Save width
            .ColumnHeaders(intC).Tag = intW
          End If
          
        Else ' Not text column
          
          ' Get Bold setting again
          frmX.Font.Bold = .Font.Bold
          
          ' Get width of SubItem
          intW = frmX.TextWidth(.ListItems(intR).SubItems(intC - 1))
          
          ' Is SubItem value wider than any before?
          If intW > .ColumnHeaders(intC).Tag Then
            ' Yes - Save Width
            .ColumnHeaders(intC).Tag = intW
          End If
        
        End If ' Text or Subitem
      
      ' Next Row
      Next intR
      
      ' Is this the first column, and are Checkboxes enabled?
      If intC = 1 And .CheckBoxes = True Then
        ' Yes checkboxes enabled - add fudge
        .ColumnHeaders(intC).Tag = .ColumnHeaders(intC).Tag + cintC
      End If
      
      ' Add fudge to column width
      .ColumnHeaders(intC).Width = .ColumnHeaders(intC).Tag + cintX
    Next intC
    
    ' Restore font settings
    frmX.Font.Bold = blnB
    frmX.Font.Italic = blnI
    frmX.Font.Size = intS
    frmX.Font.Strikethrough = blnS
    frmX.Font.Underline = blnU

    ' Release reference to parent form
    Set frmX = Nothing
  
  End With ' lvwTarget
  
  ' Return
ErrExit:
End Sub

Andy
"Logic is invincible because in order to combat logic it is necessary to use logic." -- Pierre Boutroux
"Why does my program keep showing error messages every time something goes wrong?"

 

[Hypetia]

Well, I had a similar problem in one of my programs and I went simply for this.
___
[tt]
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
Const LVM_FIRST = &H1000
Const LVM_SETCOLUMNWIDTH = LVM_FIRST + 30
Const LVSCW_AUTOSIZEUSEHEADER = -2
Sub ResizeListView(LV As ListView)
Dim N As Long
For N = 0 To LV.ColumnHeaders.Count - 1
SendMessage LV.hwnd, LVM_SETCOLUMNWIDTH, N, ByVal LVSCW_AUTOSIZEUSEHEADER
Next
End Sub[/tt]
___

This is somewhat similar to pressing [Ctrl]+[Numpad+] to autosize the columns of a listview while the subject listview has got the keyboard focus.

 

[AndyWatt]

Hypetia,

A star for you!

Thank you.


Andy
"Logic is invincible because in order to combat logic it is necessary to use logic." -- Pierre Boutroux
"Why does my program keep showing error messages every time something goes wrong?"

 

[AndyWatt]

Now that's kooky!

This is the code I've just been comparing with my attempt posted above:

Sub ResizeListViewTT(lvwTarget As ListView)
  Const cstrRoutineName As String = "ResizeListViewTT"
  Const LVM_FIRST = &H1000
  Const LVM_SETCOLUMNWIDTH = LVM_FIRST + 30
  Const LVSCW_AUTOSIZEUSEHEADER = -2
  Dim lngX As Long
  
  On Error GoTo ErrHandler

  ResizeListViewVB lvwTarget

  For lngX = 0 To lvwTarget.ColumnHeaders.Count - 1
    SendMessage lvwTarget.hwnd, LVM_SETCOLUMNWIDTH, lngX, ByVal LVSCW_AUTOSIZEUSEHEADER
  Next lngX
  Exit Sub

ErrHandler:
  Select Case ErrMsg(mcstrModuleName, cstrRoutineName, Erl)
    Case vbAbort
      Exit Sub
    Case vbIgnore
      Resume Next
    Case vbRetry
      Resume
  End Select
End Sub

Note that the SendMessage line will never be reached.

What I found was that my routine would not correctly size the first column - if the ListItem's Bold property was set to True - unless the SendMessage line was commented out, but when it was, my routine sized it correctly.

After this bit of testing I found that the method posted by Hypetia also does not appear to size bold first column correctly. Neither does [Ctrl]+[Numpad+] or double-clicking the right edge of the ColumnHeader. In fact they make it even narrower!


Andy
"Logic is invincible because in order to combat logic it is necessary to use logic." -- Pierre Boutroux
"Why does my program keep showing error messages every time something goes wrong?"

 

[Hypetia]

You are right Andy. My code does not size the first column correctly if the widest item in the column is individually set to bold.

When sized using send message or [Ctrl]+[Numpad+] or double-clicking the right edge of the listview, Windows treats all items as if they have normal font weight. (i.e. ignores the boldness of individual items)

However, this behaviour does not occur if the overall font of the listview control is set to bold.

In my program, I did not require to set the font of individual items to bold state, that's why I did not encounter this behaviour.

I consider it to be a bug/flaw in the design of the control.