Data-based Tables

This example shows how you can create tables that show data from a database. The user can pick from several recordsets and the VSPrinter control is used to create a simple report that shows the data.

To create the DataTable example, start by adding the following controls to a new VB form:

VSPrinter control (name it vp)
ComboBox control (name it cmbSrc)
Data control (name it Data1)

Add the following code to initialize the form and controls:

Example Title	Copy Code
Private Sub Form_Load() ' initialize Data1 control ' (change the path so it points to the NWind.mdb file) Data1.DatabaseName = "D:\VB98\Nwind.mdb" ' initialize recordset list cmbSrc.AddItem "Employees: SELECT FirstName As First, " & _ "LastName As Last, Title FROM Employees" cmbSrc.AddItem "Customers: SELECT Country,City,CompanyName AS Company," & _ "ContactName As Contact, Phone FROM Customers " & _ "ORDER BY Country, City" cmbSrc.AddItem "Customers: SELECT CompanyName AS Company, " & _ "ContactName As Contact, Phone FROM Customers " & _ "ORDER BY CompanyName cmbSrc.AddItem "Inventory: SELECT ProductName AS Product,UnitPrice AS Unit," & _ "UnitsInStock AS Stock,UnitPriceUnitsInStock AS Inventory " & _ "FROM Products ORDER BY (UnitPrice UnitsInStock) DESC" cmbSrc.AddItem "Invoices: SELECT OrderID, ShipName AS Customer, " & _ "ShipCity AS City, " & _ "OrderDate AS Ordered, ExtendedPrice AS Total FROM Invoices " & _ "ORDER BY ExtendedPrice DESC" ' start with the first item cmbSrc.ListIndex = 0 End Sub

Example Title

Copy Code

Private Sub Form_Load()

 

  ' initialize Data1 control

  ' (change the path so it points to the NWind.mdb file)

  Data1.DatabaseName = "D:\VB98\Nwind.mdb"

 

  ' initialize recordset list

  cmbSrc.AddItem "Employees: SELECT FirstName As First, " & _

                 "LastName As Last, Title FROM Employees"

  cmbSrc.AddItem "Customers: SELECT Country,City,CompanyName AS Company," & _

                 "ContactName As Contact, Phone FROM Customers " & _

                 "ORDER BY Country, City"

  cmbSrc.AddItem "Customers: SELECT CompanyName AS Company, " & _

                 "ContactName As Contact, Phone FROM Customers " & _

                 "ORDER BY CompanyName

  cmbSrc.AddItem "Inventory: SELECT ProductName AS Product,UnitPrice AS Unit," & _

                 "UnitsInStock AS Stock,UnitPrice*UnitsInStock AS Inventory " & _

                 "FROM Products ORDER BY (UnitPrice * UnitsInStock) DESC"

  cmbSrc.AddItem "Invoices:  SELECT OrderID, ShipName AS Customer, " & _

                 "ShipCity AS City, " & _

                 "OrderDate AS Ordered, ExtendedPrice AS Total FROM Invoices " & _

                 "ORDER BY ExtendedPrice DESC"

 

  ' start with the first item

  cmbSrc.ListIndex = 0

 

End Sub

Now that the controls are initialized, add the following code to generate a document whenever the user selects a new record source:

Example Title	Copy Code
Private Sub cmbSrc_Click() ' get record source string (trim comments up to ":") Dim s$, i% s = cmbSrc i = InStr(s, ":") If i > 0 Then s = Trim(Mid(s, i + 1)) ' get recordset Data1.RecordSource = s Data1.Refresh Dim rs As Recordset Set rs = Data1.Recordset ' create document With vp ' set up .Header = "\|\|Page %d" .FontName = "Arial" .FontSize = 10 .StartDoc ' show title .Paragraph = "NorthWind Recordset. Query is:" .FontBold = True .Paragraph = s .FontBold = False .Paragraph = "" ' render recordset (main routine) RenderRecordset vp, rs, 0 ' done .EndDoc End With End Sub

Example Title

Copy Code

Private Sub cmbSrc_Click()

 

  ' get record source string (trim comments up to ":")

  Dim s$, i%

  s = cmbSrc

  i = InStr(s, ":")

  If i > 0 Then s = Trim(Mid(s, i + 1))

 

  ' get recordset

  Data1.RecordSource = s

  Data1.Refresh

  Dim rs As Recordset

  Set rs = Data1.Recordset

 

  ' create document

  With vp

       

    ' set up

    .Header = "||Page %d"

    .FontName = "Arial"

    .FontSize = 10

    .StartDoc

 

    ' show title

    .Paragraph = "NorthWind Recordset. Query is:"

    .FontBold = True

    .Paragraph = s

    .FontBold = False

    .Paragraph = ""

 

    ' render recordset (main routine)

    RenderRecordset vp, rs, 0

 

    ' done

    .EndDoc

  End With

 

End Sub

Now we are almost done. The only thing missing is the main routine, the one that renders the recordset. The following RenderRecordset routine is simple and generic. It takes as parameters a VSPrinter control, a Recordset object (DAO or ADO), and a maximum height for the table rows. The routine reads the recordset into an array using the GetRows method, creates a table using the AddTableArray method, and sets column widths and alignment using the TableCell property:

Example Title	Copy Code
Sub RenderRecordset(vp As VSPrinter, rs As Recordset, maxh As Single) Dim arr, i%, j%, wid!, fmt$, hdr$ ' read recordset into an array rs.MoveLast rs.MoveFirst i = rs.RecordCount If i = 0 Then Exit Sub arr = rs.GetRows(i) ' create table header and dummy format For i = 0 To rs.Fields.Count - 1 If i > 0 Then hdr = hdr & "\|": fmt = fmt & "\|" hdr = hdr & rs.Fields(i).Name fmt = fmt & "500" Next ' create table vp.StartTable vp.AddTableArray fmt, hdr, arr ' format table For i = 0 To rs.Fields.Count - 1 ' right-align numbers and dates Select Case rs.Fields(i).Type Case dbBigInt, dbByte, dbChar, dbCurrency, dbDecimal, dbDouble, _ dbFloat, dbInteger, dbLong, dbNumeric, dbSingle, dbDate vp.TableCell(tcColAlign, , i + 1) = taRightTop End Select ' set column width If rs.Fields(i).Type = dbMemo Then vp.TableCell(tcColWidth, , i + 1) = "2.5in" Else ' select longest string from 1st 100 records fmt = "" For j = 0 To UBound(arr, 2) If j > 100 Then Exit For If Len(fmt) < Len(arr(i, j)) Then fmt = arr(i, j) Next If Len(rs.Fields(i).Name) > Len(fmt) Then fmt = rs.Fields(i).Name ' set column width so the longest string fits vp.TableCell(tcColWidth, , i + 1) = vp.TextWidth(fmt) * 1.4 Next ' format header row (0) vp.TableCell(tcFontBold, 0) = True vp.TableCell(tcBackColor, 0) = vbYellow vp.TableCell(tcRowHeight, 0) = vp.TextHeight("Test") * 1.1 vp.TableCell(tcAlign, 0) = taLeftMiddle ' make sure it all fits, squeeze columns if necessary For i = 1 To vp.TableCell(tcCols) wid = wid + vp.TableCell(tcColWidth, , i) Next vp.GetMargins If wid > vp.X2 - vp.X1 Then wid = (vp.X2 - vp.X1) / wid * 0.95 For i = 1 To vp.TableCell(tcCols) vp.TableCell(tcColWidth, , i) = wid * _ vp.TableCell(tcColWidth, , i) Next End If ' honor maximum row height ' (in case there are long memo entries) If maxh > 0 Then For i = 1 To vp.TableCell(tcRows) If vp.TableCell(tcRowHeight, i) > maxh Then vp.TableCell(tcRowHeight, i) = maxh End If Next End If ' done with table vp.EndTable End Sub

Example Title

Copy Code

Sub RenderRecordset(vp As VSPrinter, rs As Recordset, maxh As Single)

  Dim arr, i%, j%, wid!, fmt$, hdr$

 

  ' read recordset into an array

  rs.MoveLast

  rs.MoveFirst

  i = rs.RecordCount

  If i = 0 Then Exit Sub

  arr = rs.GetRows(i)

 

  ' create table header and dummy format

  For i = 0 To rs.Fields.Count - 1

    If i > 0 Then hdr = hdr & "|": fmt = fmt & "|"

    hdr = hdr & rs.Fields(i).Name

    fmt = fmt & "500"

  Next

 

  ' create table

  vp.StartTable

  vp.AddTableArray fmt, hdr, arr

 

  ' format table

  For i = 0 To rs.Fields.Count - 1

 

    ' right-align numbers and dates

    Select Case rs.Fields(i).Type

      Case dbBigInt, dbByte, dbChar, dbCurrency, dbDecimal, dbDouble, _

           dbFloat, dbInteger, dbLong, dbNumeric, dbSingle, dbDate

      vp.TableCell(tcColAlign, , i + 1) = taRightTop

    End Select

 

    ' set column width

    If rs.Fields(i).Type = dbMemo Then

      vp.TableCell(tcColWidth, , i + 1) = "2.5in"

    Else

 

      ' select longest string from 1st 100 records

      fmt = ""

      For j = 0 To UBound(arr, 2)

        If j > 100 Then Exit For

        If Len(fmt) < Len(arr(i, j)) Then fmt = arr(i, j)

      Next

      If Len(rs.Fields(i).Name) > Len(fmt) Then fmt = rs.Fields(i).Name

 

      ' set column width so the longest string fits

      vp.TableCell(tcColWidth, , i + 1) = vp.TextWidth(fmt) * 1.4

    Next

 

    ' format header row (0)

    vp.TableCell(tcFontBold, 0) = True

    vp.TableCell(tcBackColor, 0) = vbYellow

    vp.TableCell(tcRowHeight, 0) = vp.TextHeight("Test") * 1.1

    vp.TableCell(tcAlign, 0) = taLeftMiddle

   

    ' make sure it all fits, squeeze columns if necessary

    For i = 1 To vp.TableCell(tcCols)

        wid = wid + vp.TableCell(tcColWidth, , i)

    Next

    vp.GetMargins

    If wid > vp.X2 - vp.X1 Then

        wid = (vp.X2 - vp.X1) / wid * 0.95

        For i = 1 To vp.TableCell(tcCols)

            vp.TableCell(tcColWidth, , i) = wid * _

                         vp.TableCell(tcColWidth, , i)

        Next

    End If

 

    ' honor maximum row height

    ' (in case there are long memo entries)

    If maxh > 0 Then

        For i = 1 To vp.TableCell(tcRows)

            If vp.TableCell(tcRowHeight, i) > maxh Then

                vp.TableCell(tcRowHeight, i) = maxh

            End If

        Next

    End If

 

    ' done with table

    vp.EndTable

 

End Sub

That's it. Run the sample and you should something that looks like the following image:

Note: If the table is too wide to fit the page, the RenderRecordset routine squeezes all columns proportionally until the table fits. This is a very simple approach, but it is not very good. It would be better to try squeezing only text and memo fields, since text can be wrapped and numbers cannot. This is left as an exercise.