report.bas

扫描软件

Attribute VB_Name = "Report"
Option Explicit

'**************************************************************
' Global (Public) Variables
'**************************************************************
    
    '----------------------------------------------------------
    ' Report Variables
    '----------------------------------------------------------
    Public gstrAsterisks As String
    Public gstrDashes As String
        
'**************************************************************
' Global (Public) Constants
'**************************************************************

    '----------------------------------------------------------
    ' Message box constants.
    '----------------------------------------------------------
    Public Const INFO_IN_FILE = "The information has been captured in the file "
        
    '----------------------------------------------------------
    ' Constants used to control report behavior and formatting.
    '----------------------------------------------------------
    Public Const LINE_LENGTH = 78           'Print out line length.
    Public Const STRITEMNO_LENGTH = 5       'Column to hold line numbers.
    
Public Sub PrintReportHeader(intFileNumber As Integer, strHeader As String, _
    strSymbol As String, intFollowingLines As Integer)
'**************************************************************
' PUBLIC SUB PrintReportHeader:  Print header with either
' dashes or asterisks, depending upon the symbol passed.  A
' trailing blank line(s) may or may not be printed, depending
' upon the value of intFollowingLines.
'**************************************************************
'** Strings
    Dim strLeft As String
    Dim strRight As String

    Print #intFileNumber, ""
    Print #intFileNumber, strSymbol
    strLeft = Left(strSymbol, 1) & " "
    strRight = strHeader
    Call PrintReportWrapLine(intFileNumber, strLeft, strRight, "\")
    Print #intFileNumber, strSymbol
        
    Do Until intFollowingLines = 0
        Print #intFileNumber, ""
        intFollowingLines = intFollowingLines - 1
    Loop
    
End Sub

Public Sub PrintReportInitialHeader(intFileNumber As Integer, _
    strReportFileFullPath As String)
'**************************************************************
' PUBLIC SUB PrintReportInitialHeader:  Prints the initial
' header of the report.
'**************************************************************
'** Strings
    Dim strVersion As String
    
    '----------------------------------------------------------
    ' Fabricate the version number.
    '----------------------------------------------------------
    strVersion = "Version " & App.Major & "." & App.Minor & "." & App.Revision
    
    '----------------------------------------------------------
    ' Print the Product Name, the Version, and Copyright.
    '----------------------------------------------------------
    Print #intFileNumber, gstrAsterisks
    Print #intFileNumber, "* " & App.Title
    Print #intFileNumber, "*    " & strVersion
    Print #intFileNumber, "*    " & App.LegalCopyright
    
    '----------------------------------------------------------
    ' Print where the application is installed.
    '----------------------------------------------------------
    Call PrintReportWrapLine(intFileNumber, "*    Installed in:  ", gstrAppDirectory, "\")
    
    '----------------------------------------------------------
    ' Print the date and time the report was generated.
    '----------------------------------------------------------
    Print #intFileNumber, gstrAsterisks
    Print #intFileNumber, ""
    Print #intFileNumber, gstrAsterisks
    Print #intFileNumber, "* Report Information"
    Print #intFileNumber, "*    Date:  " & Format$(Now, "Long Date")
    Print #intFileNumber, "*    Time:  " & Format$(Now, "h:mm:ss AM/PM")
    
    '----------------------------------------------------------
    ' Print the name of the report.
    '----------------------------------------------------------
    Call PrintReportWrapLine(intFileNumber, "*    Name:  ", strReportFileFullPath, "\")
    Print #intFileNumber, gstrAsterisks
    Print #intFileNumber, ""
    
End Sub

Public Sub PrintReportWrapLine(intFileNumber As Integer, strLeft As String, _
    strRight As String, strSymbol As String)
'**************************************************************
' PUBLIC SUB PrintReportWrapLine:  Print a report line, and
' wrap it to the following line(s) if necessary.
'**************************************************************
'** Integers
    Dim intLineCounter As Integer
    Dim intStartPosition As Integer
    Dim intSymbolPosition As Integer
'** Strings
    Dim strLeftLegend As String
    Dim strPartialString As String
    Dim strWorkingString As String
    
    On Error Resume Next
        
    '----------------------------------------------------------
    ' If the passed-in line (a combination of the left-hand
    ' legend and the right-hand string) fits on the report line,
    ' print it and then exit the subroutine.
    '----------------------------------------------------------
    If Len(strLeft) + Len(strRight) <= LINE_LENGTH Then
        Print #intFileNumber, strLeft & strRight
        Exit Sub
    End If
    
    '----------------------------------------------------------
    ' If it doesn't fit, start parsing the right-hand string to
    ' fit on multiple lines.  Set the line counter to 1 and
    ' move the right-hand string into a working string.
    '----------------------------------------------------------
    intLineCounter = 1
    strWorkingString = strRight
    
    '----------------------------------------------------------
    ' Loop while the working string isn't spaces.
    '----------------------------------------------------------
    Do While strWorkingString <> ""
        '------------------------------------------------------
        ' If the right-hand string won't fit on the print line
        ' (when concatenated with the left-hand legend), create
        ' a partial string which will fit.
        '------------------------------------------------------
        If Len(strWorkingString) + Len(strLeft) > LINE_LENGTH Then
            strPartialString = Left(strWorkingString, LINE_LENGTH - Len(strLeft))
            '--------------------------------------------------
            ' Loop through the line, looking for the last
            ' occurrence of a symbol which can be used to
            ' "split" the line.  (This symbol was passed in as
            ' strSymbol, and would be a " " for comments, or a
            ' "\" for a directory name.) Once the last symbol
            ' has been found, truncate the line at the symbol's
            ' position.
            '--------------------------------------------------
            intStartPosition = 1
            Do
                intSymbolPosition = InStr(intStartPosition, strPartialString, strSymbol)
                If intSymbolPosition > 0 Then
                    intStartPosition = intSymbolPosition + 1
                End If
            Loop Until intSymbolPosition = 0
            strPartialString = Trim$(Left(strWorkingString, intStartPosition - 1))
        '------------------------------------------------------
        ' Since the line does fit on the print line, use it.
        ' Also, move spaces to the working string.
        '------------------------------------------------------
        Else
            strPartialString = Trim$(strWorkingString)
            strWorkingString = ""
        End If
        '------------------------------------------------------
        ' If the first line to be printed, move strLeft into
        ' strLeftLegend; otherwise, move the leftmost character
        ' of strLeft followed by spaces into strLeftLegend.
        '------------------------------------------------------
        If intLineCounter = 1 Then
            strLeftLegend = strLeft
            intLineCounter = intLineCounter + 1
        Else
            strLeftLegend = Left(strLeft, 1) & Space$(Len(strLeft) - 1)
        End If
        '------------------------------------------------------
        ' Concatentate strLeftLegend and the partial string
        ' and print them.  Then remove the line that was just
        ' printed.
        '------------------------------------------------------
        Print #intFileNumber, strLeftLegend & strPartialString
        If strWorkingString <> "" Then
            strWorkingString = Mid(strWorkingString, intStartPosition)
        End If
    Loop
    
End Sub