by Huy Nguyen (1 Submission)
Category: Databases/Data Access/DAO/ADO
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Sun 31st December 2000
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
This function will property format and print a recordset. Printed rows are adjusted so that so that the fields will all fit horizontally on a
VBcoders
' 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
No comments have been posted about This function will property format and print a recordset. Printed rows are adjusted so that so that. Why not be the first to post a comment about This function will property format and print a recordset. Printed rows are adjusted so that so that.
