INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

Visual Basic (Microsoft) Versions 5/6 FAQ

Database

Format and print a recordset by Bubbler
Posted: 15 Dec 03

The example below shows how to format and print a recordset. I see a lot of people ask about this in Tek-Tips.


Public Function PrintRecordSet(rs As Recordset, PRN As Printer)
' Use .75 inch margins.
Const TOP_MARGIN = 1440 * 0.5
Const LEFT_MARGIN = 1440 * 0.75

Dim lCurrentPos As Long
Dim sCurrentField As String
Dim bChange() As Boolean
Dim iLongest As Integer
Dim lShorten As Long
Dim i As Integer
Dim x As Long
Dim lTotalHeaderLength As Long
Dim maxWidthPerLine As Long
Dim lLineWidth As Long
Dim maxFlengths() As Long
Dim fStartPos() As Long
Dim BM As Single
Dim numFields As Integer
Dim lFlengths() As Long
Dim sFNames() As String
Dim lFHeaderlenghts() As Long
Dim iNumToExpand As Integer
Dim PLines As Integer
Dim lCurrentY As Long
Dim Tlen As Integer
Dim LowY As Long

numFields = rs.Fields.Count - 1

ReDim lFlengths(numFields)
ReDim sFNames(numFields)
ReDim lFHeaderlenghts(numFields)
ReDim maxFlengths(numFields)
ReDim bChange(numFields)
ReDim fStartPos(numFields)
ReDim fEndPos(numFields)

'set bottom margin to an inch
BM = PRN.ScaleTop + PRN.ScaleHeight - 1440
maxWidthPerLine = PRN.Width - (LEFT_MARGIN * 2)
maxWidthPerLine = maxWidthPerLine - (100 * numFields)

For i = 0 To numFields
    sFNames(i) = rs.Fields(i).Name
'    maxFlengths(i) = PRN.TextWidth(sFNames(i)) + 100
    lFHeaderlenghts(i) = PRN.TextWidth(sFNames(i))
    lTotalHeaderLength = lTotalHeaderLength + lFHeaderlenghts(i)
Next

'get longest text in all fields
rs.MoveFirst
Do While rs.EOF <> True
    For i = 0 To numFields
        sCurrentField = rs(i)
        If PRN.TextWidth(sCurrentField) > maxFlengths(i) Then
            maxFlengths(i) = PRN.TextWidth(sCurrentField)
        End If
    Next i
    rs.MoveNext
Loop

For i = 0 To numFields
    If lFHeaderlenghts(i) > maxFlengths(i) Then
        lFlengths(i) = lFHeaderlenghts(i)
        bChange(i) = False
    Else
        lFlengths(i) = maxFlengths(i)
        bChange(i) = True
        iNumToExpand = iNumToExpand + 1
    End If
    lLineWidth = lLineWidth + lFlengths(i)
Next

'determine linewidths

Do While lLineWidth > maxWidthPerLine
    iLongest = 1
    For i = 0 To numFields
        If lFlengths(i) > lFlengths(iLongest) Then
            iLongest = i
        End If
    Next
    lShorten = 0.05 * (lFlengths(iLongest))
    lFlengths(iLongest) = lFlengths(iLongest) - lShorten
    lLineWidth = lLineWidth - lShorten

Loop



lCurrentPos = LEFT_MARGIN
For i = 0 To numFields
    
    fStartPos(i) = lCurrentPos
    If i <= numFields Then
        lCurrentPos = lCurrentPos + lFlengths(i) + 100
    End If
    
    Debug.Print CStr(fStartPos(i)) & "      " & CStr(lFlengths(i))
Next i

rs.MoveFirst

    Printer.CurrentX = TOP_MARGIN
    Printer.CurrentY = LEFT_MARGIN
    For i = 0 To numFields
        PRN.CurrentX = fStartPos(i)
        PRN.Print sFNames(i);
    Next i
    PRN.Print
    PRN.Line (LEFT_MARGIN, PRN.CurrentY)-(PRN.Width - LEFT_MARGIN, PRN.CurrentY)


Do While rs.EOF = False
    'print a line
        lCurrentY = PRN.CurrentY
        For i = 0 To numFields
            PRN.CurrentX = fStartPos(i)
            sCurrentField = rs.Fields(i) & ""
            If PRN.TextWidth(sCurrentField) > lFlengths(i) Then
                PRN.CurrentY = lCurrentY
                PLines = PRN.TextWidth(sCurrentField) \ lFlengths(i) + 1
                Tlen = Len(sCurrentField) / PLines
                PRN.Print Left(sCurrentField, Tlen);
                For x = 2 To PLines
                    PRN.Print
                    PRN.CurrentX = fStartPos(i)
                    PRN.Print Mid(sCurrentField, (x - 1) * Tlen + 1, Tlen);
                    If PRN.CurrentY > LowY Then
                        LowY = PRN.CurrentY
                    End If
                Next x
            
            Else
                PRN.CurrentY = lCurrentY
                PRN.Print sCurrentField;
                If PRN.CurrentY > LowY Then
                    LowY = PRN.CurrentY
                End If
            End If
        Next i
    If PRN.CurrentY >= BM Then
        ' Start a new page.
        
        PRN.NewPage
        PRN.CurrentY = TOP_MARGIN
        Printer.CurrentX = TOP_MARGIN
        Printer.CurrentY = LEFT_MARGIN
        LowY = PRN.CurrentY
        For i = 1 To numFields
            PRN.CurrentX = fStartPos(i)
            PRN.Print sFNames(i);
        Next i
        PRN.Print
        PRN.Line (LEFT_MARGIN, PRN.CurrentY)-(PRN.Width - LEFT_MARGIN, PRN.CurrentY)

    Else
        PRN.CurrentY = LowY
        PRN.Print
        PRN.Line (LEFT_MARGIN, PRN.CurrentY)-(PRN.Width - LEFT_MARGIN, PRN.CurrentY)
    End If
    rs.MoveNext
    
Loop

Printer.EndDoc

End Function

Back to Visual Basic (Microsoft) Versions 5/6 FAQ Index
Back to Visual Basic (Microsoft) Versions 5/6 Forum

My Archive

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close