VB3 How to Fill a List Box from a Snapshot Generically (115712)

MORE INFORMATION

When handling result sets from database queries that produce variable result sets, you may find it useful to have a generic function display the contents in a list box.

The following example defines a Sub (Fill_List) that accepts a list-box control and snapshot as parameters and fills the list box with the contents of the snapshot. The function can be easily modified to accept a table or dynaset object as well.

For additional information, please see the following article in the Microsoft Knowledge Base:

Step-by-Step Instructions for Creating the Program

1. Start a new project in Visual Basic. Form1 is created by default.
2. Add a command button (Command1) and a list box (List1) to the form. Set the caption property of Command1 to "Fill list".
3. Add the following code to the form's general declarations section:

      Option Explicit
      Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal
      wMsg
      As
       Integer, ByVal wParam As Integer, lparam As Any) As Long
      Const WM_USER = &H400
      Const LB_SETTABSTOPS = WM_USER + 19
      Const LB_SETHORIZONTALEXTENT = WM_USER + 21
   
      Sub Fill_List (lb As ListBox, sn As Snapshot)
        Const NUMCHARS = 2  ' Amount of white space between columns.
   
        ' Temporary variables to preserve form font settings:
        Dim hold_fontname As String, hold_fontsize As Integer
        Dim hold_fontbold As Integer, hold_fontitalic As Integer
        Dim hold_fontstrikethru As Integer, hold_fontunderline  As Integer
   
        Dim whiteSpace As Integer, accumtabstops As Integer, dialogUnits As
      Integer
        Dim fieldVal As String, listline As String
        Dim avgWidth As Single
   
        Dim retval As Long, i As Integer
        Dim biggest_value() As Single
        Dim tabstops() As Integer
   
        ' Save form's font settings so we can use the form to calculate the
        ' TextWidth / Height of the strings to go into the list box.
        hold_fontname = Me.FontName
        hold_fontsize = Me.FontSize
        hold_fontbold = Me.FontBold
        hold_fontitalic = Me.FontItalic
        hold_fontstrikethru = Me.FontStrikethru
        hold_fontunderline = Me.FontUnderline
   
        ' Set form font settings to be identical to list box.
        Me.FontName = lb.FontName
        Me.FontSize = lb.FontSize
        Me.FontBold = lb.FontBold
        Me.FontItalic = lb.FontItalic
        Me.FontStrikethru = lb.FontStrikethru
        Me.FontUnderline = lb.FontUnderline
   
        ' Get the average character width of the current list box font
        ' (in pixels) using the form's TextWidth width method.
        avgWidth =
      Me.TextWidth("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ")
        avgWidth = avgWidth / Screen.TwipsPerPixelX / 52
   
        ' Set the white space you want between columns.
        whiteSpace = avgWidth * NUMCHARS
   
        ReDim biggest_value(0 To sn.Fields.Count - 1)
        ReDim tabstops(1 To sn.Fields.Count)
   
        lb.Clear
   
        ' Loop through the field values for each record in the snapshot.
        ' Calculate the width required for that field value to fit in the list
        ' box. Also, build each line of the list box and add it to the list as
        ' you go.
        While Not sn.EOF
          For i = 0 To sn.Fields.Count - 1
            fieldVal = sn(i) & ""       ' Append "" in case of a null field.
   
            ' The LB_SETTABSTOP message requires coordinates in dialog units
            ' (roughly 4 *, the average character width in pixels).
            dialogUnits = ((Me.TextWidth(fieldVal) / Screen.TwipsPerPixelX +
      whiteSpace) \ avgWidth) * 4
            If dialogUnits > biggest_value(i) Then
              biggest_value(i) = dialogUnits
            End If
   
            listline = listline & sn(i) & Chr$(9)
          Next i
   
          lb.AddItem listline
          listline = ""
          sn.MoveNext
        Wend
   
        ' Fill the tabstops() array with the position of each tab stop.
        For i = 0 To sn.Fields.Count - 1
          accumtabstops = accumtabstops + biggest_value(i)
          tabstops(i + 1) = accumtabstops
        Next i
   
        ' Send LB_SETTABSTOP to the list box to set the position of each
          column.
        retval& = SendMessage(lb.hWnd, LB_SETTABSTOPS, i, tabstops(1))
   
        ' Set the horizontal extent just wider than the first tab stop.
        ' This will produce a horizontal scroll bar on the list box.
        ' This message requires coordinates in pixels, so we convert the tab
        ' stop coordinate back from dialog units to pixels.
        retval& = SendMessage(lb.hWnd, LB_SETHORIZONTALEXTENT, (tabstops(i) \ 
      4)
      *
      avgWidth, 0&)
   
        ' Restore form's original font property settings.
        Me.FontName = hold_fontname
        Me.FontSize = hold_fontsize
        Me.FontBold = hold_fontbold
        Me.FontItalic = hold_fontitalic
        Me.FontStrikethru = hold_fontstrikethru
        Me.FontUnderline = hold_fontunderline
      End Sub
   						

4. Add the following code to the Command1_Click event:

      Sub Command1_Click ()
        Dim db As database
        Dim sn As Snapshot
   
        Set db = OpenDatabase("BIBLIO.MDB")
        Set sn = db.CreateSnapshot("select * from [title author publisher]")
        Fill_List list1, sn
   
        Set sn = Nothing
        db.Close
      End Sub
   						

5. Run the program by pressing the F5 key. Now, the list box contains neat columns displaying the contents of the [Title Author Publisher] query. The scroll bar enables you to see the entire line. Alter the NUMCHARS constant to allow more white space between columns if you want.