frmgridprint.frm

中专学校的学生操行分管理系统,包含了网络查询的功能

    j = 1
    For i = 0 To iFCount - 1
        If colInfo(i).Width > (Printer.ScaleWidth - leftX - rightX) Then
            MsgBox "列 “" & colInfo(i).Text & "”　的宽度超出打印纸的宽度（" _
                & CStr(colInfo(i).Width) & ">" & CStr(Printer.ScaleWidth - leftX - rightX) _
                & "），请检查！", vbOKOnly + vbInformation
            Unload Me
            Exit Sub
        End If
        intCurrentWidth = intCurrentWidth + colInfo(i).Width
        colInfo(i).CurX = intCurX
        intCurX = intCurX + colInfo(i).Width
        If intCurX > (Printer.ScaleWidth - leftX - rightX) Then
            intCurrentWidth = intCurrentWidth - colInfo(i).Width
            arrCol(j, 3) = intCurrentWidth
            arrCol(j, 2) = i - 1
            arrCol(j + 1, 1) = i
            i = i - 1
            j = j + 1
            intCurX = 0
            intCurrentWidth = 0
        End If
        If i = iFCount - 1 Then
            arrCol(j, 2) = iFCount - 1
            arrCol(j, 3) = intCurrentWidth
        End If
    Next
    intPartCount = j
    For i = 2 To intPartCount
        arrCol(i, 4) = arrCol(i - 1, 4) + arrCol(i - 1, 3)
    Next i
End Sub

'***********************************************************************************
'   打印报表头
'***********************************************************************************
Private Sub PrintPageHeader(obj As Object, ByVal percent As Integer)
'   打印信息的Style列为两个字符，第一个字母为L表示无边框打印，为E表示打印边框
'       第二个字母为S表示当前的Text列为直接打印的字符串，为E表示Text列为表达式，要解释成字符串后再打印
    Dim i As Integer
    Dim intCurX As Integer, intCurY As Integer, intWidth As Integer  '当前打印位置的X轴值和Y轴值
    Dim intLeft As Integer, intRight As Integer '当前页的起始位置和宽度
'   打印报表名
    myInfo.CurX = (arrCol(intPartIndex, 3) - 5.56 * Len(strName)) / 2 + leftX
    myInfo.CurY = lHeight
    myInfo.Font.Name = "宋体"
    myInfo.Font.Size = 16
    myInfo.Font.Bold = True
    myInfo.percent = percent
    myInfo.style = "LS"
    myInfo.Text = strName
    PrintHeader obj, myInfo '调用自定义函数PrintHeader打印指定内容
    lHeight = lHeight + 10
'   打印编制日期
    myInfo.CurY = lHeight
    myInfo.Font.Size = 10
    myInfo.Font.Bold = False
    myInfo.CurX = (arrCol(intPartIndex, 3) - 40) / 2 + leftX
    myInfo.Text = "编制日期：" & FormatDateTime(Date, vbLongDate)
    PrintHeader obj, myInfo
   
'   打印分页情况
    myInfo.CurX = (arrCol(intPartIndex, 3) - 30) + leftX
    myInfo.Text = "分页情况：" & CStr(intPartIndex) & "/" & CStr(intPartCount)
    PrintHeader obj, myInfo
    lHeight = lHeight + 5
    
'   打印报表各列的上层列头
    intLeft = arrCol(intPartIndex, 4)
    intRight = arrCol(intPartIndex, 3) + arrCol(intPartIndex, 4)
    For i = 0 To iICount - 1
        If itemInfo(i).Height > 0 Then
            intCurX = itemInfo(i).CurX
            intCurY = itemInfo(i).CurY
            intWidth = itemInfo(i).Width
            If LineContain(itemInfo(i).CurX, itemInfo(i).Width, intLeft, intRight) Then
                itemInfo(i).CurX = leftX + itemInfo(i).CurX - intLeft
                itemInfo(i).CurY = lHeight + intCurY
                itemInfo(i).percent = percent
                PrintHeader obj, itemInfo(i)
            End If
            itemInfo(i).CurX = intCurX
            itemInfo(i).CurY = intCurY
            itemInfo(i).Width = intWidth
        End If
    Next i
'   打印报表各列的列头
    For i = arrCol(intPartIndex, 1) To arrCol(intPartIndex, 2)
        intCurX = colInfo(i).CurX
        intCurY = colInfo(i).CurY
        colInfo(i).CurX = leftX + intCurX
        colInfo(i).CurY = lHeight + intCurY
        colInfo(i).percent = percent
        PrintHeader obj, colInfo(i)
        colInfo(i).CurX = intCurX
        colInfo(i).CurY = intCurY
    Next i
    lHeight = lHeight + intHeaderHeight
End Sub

'***********************************************************************************
'------打印页尾
'***********************************************************************************
Private Sub PrintPageFooter(obj As Object, ByVal percent As Integer)
    Dim i As Integer
    Dim intCurX As Integer, intCurY As Integer
'   打印报表的备注信息
'   打印报表各列的表尾计算值
    myInfo.Font.Name = "宋体"
    myInfo.Font.Bold = True
    myInfo.Height = intRowHeight
    myInfo.CurY = lHeight
    myInfo.percent = percent
    myInfo.style = "ES"
    If (pageNum = pageCount) And modPub.bReportCalc Then
        For i = arrCol(intPartIndex, 1) To arrCol(intPartIndex, 2)
            myInfo.Font.Size = 10
            myInfo.CurX = leftX + colInfo(i).CurX
            myInfo.Width = colInfo(i).Width
            If IsNull(varReportCalc(i)) Then
                myInfo.Text = ""
            Else
                myInfo.Text = CStr(varReportCalc(i))
            End If
            Do While myInfo.Width > 0
                Set picPreview.Font = myInfo.Font
                If myInfo.Width >= picPreview.TextWidth(myInfo.Text) Then Exit Do
                myInfo.Font.Size = myInfo.Font.Size - 1
                If myInfo.Font.Size = 1 Then Exit Do
            Loop
            PrintRecord obj, myInfo
        Next i
        lHeight = lHeight + intRowHeight
    End If
    
'   打印报表的页码信息
    myInfo.Font.Bold = False
    myInfo.CurX = leftX + (arrCol(intPartIndex, 3) - 30) / 2
    myInfo.CurY = lHeight + 3
    myInfo.style = "LS"
    myInfo.Text = "共 " & CStr(pageCount) & " 页   第 " & CStr(pageNum) & " 页"
    PrintHeader obj, myInfo
End Sub

'***********************************************************************************
'   打印报表
'***********************************************************************************
Private Sub PrintReport(ByVal percent As Long)
    Dim i As Integer
    Dim CurX As Integer
    Dim CurY As Integer

    On Error Resume Next
'   当前页码超出打印的页码范围时停止打印
    Me.MousePointer = 11
    lHeight = topY
'   打印报表头
    PrintPageHeader Printer, percent
'   打印记录
    myInfo.Align = colInfo(0).Align
    Set myInfo.Font = colInfo(0).Font
    myInfo.percent = percent
    myInfo.style = "ES"
    myInfo.Height = intRowHeight

    Do While Not rstReport.EOF
        For i = arrCol(intPartIndex, 1) To arrCol(intPartIndex, 2)
            myInfo.CurX = colInfo(i).CurX + leftX
            myInfo.CurY = lHeight
            myInfo.FieldType = colInfo(i).FieldType
            myInfo.Align = colInfo(i).Align
            myInfo.Width = colInfo(i).Width
            If IsNull(rstReport(i)) Then
                myInfo.Text = ""
            Else
                Select Case myInfo.FieldType
                    Case 6, 14, 131
                        myInfo.Text = Format(rstReport(i), "##,##0.00")
                    Case Else
                        myInfo.Text = Trim(rstReport(i))
                End Select
            End If
            PrintRecord Printer, myInfo
        Next i
        lHeight = lHeight + intRowHeight
        rstReport.MoveNext
'       如果打印到页尾，打印页尾信息并换页
        If Printer.CurrentY >= Printer.ScaleHeight - bottomY - intRowHeight Then
            PrintPageFooter Printer, percent
            Printer.NewPage
            Me.MousePointer = 0
            Exit Sub
        End If
    Loop
'   打印完的记录集的最后一条记录后打印页尾并结束打印
    PrintPageFooter Printer, percent
    Printer.EndDoc
    Me.MousePointer = 0
End Sub

'***********************************************************************************
'   预览报表
'***********************************************************************************
Private Sub PrintPreview(ByVal percent As Long)
    Dim i As Integer
   
    On Error Resume Next
    Me.MousePointer = 11
'   根据打印机纸张的设置和设置picPreview的高和宽及picPreview模拟显示的高和宽
    picPreview.Height = Printer.Height * percent / 100
    picPreview.Width = Printer.Width * percent / 100
    picPreview.ScaleHeight = Printer.ScaleHeight
    picPreview.ScaleWidth = Printer.ScaleWidth
    
    ResizePic
    picPreview.Cls
    
    lHeight = topY
'   根据当前页码和每页的记录数计算当前应从哪条记录开始显示
    rstReport.MoveFirst
    rstReport.Move (pageNum - 1) * rowNum
'   显示报表头
    PrintPageHeader picPreview, percent
'   显示记录
    myInfo.Align = colInfo(0).Align
    Set myInfo.Font = colInfo(0).Font
    myInfo.percent = percent
    myInfo.style = "ES"
    myInfo.Height = intRowHeight
    
    Do While Not rstReport.EOF
        For i = arrCol(intPartIndex, 1) To arrCol(intPartIndex, 2)
            myInfo.CurX = colInfo(i).CurX + leftX
            myInfo.CurY = lHeight
            myInfo.FieldType = colInfo(i).FieldType
            myInfo.Align = colInfo(i).Align
            myInfo.Width = colInfo(i).Width
            If IsNull(rstReport(i)) Then
                myInfo.Text = ""
            Else
                Select Case myInfo.FieldType
                    Case 6, 14, 131
                        myInfo.Text = Format(rstReport(i), "##,##0.00")
                    Case Else
                        myInfo.Text = Trim(rstReport(i))
                End Select
            End If
            PrintRecord picPreview, myInfo
        Next i
        lHeight = lHeight + intRowHeight
        rstReport.MoveNext
'       打印位置超过页尾时显示页尾并退出循环
        If picPreview.CurrentY >= picPreview.ScaleHeight - bottomY - intRowHeight Then GoTo DOHANDLE
    Loop

DOHANDLE:
'   打印页尾
    PrintPageFooter picPreview, percent
'   当打印位置超出右边界时无法处理，在此统一将右边界的位置打印成空白
    picPreview.Line ((picPreview.ScaleWidth - rightX), 0)-(picPreview.ScaleWidth, picPreview.ScaleHeight), RGB(255, 255, 255), BF
    Me.MousePointer = 0
End Sub

Private Sub cboScale_Click()
    If oldIndex <> cboScale.ListIndex Then
        Dim strPercent As String
        Dim percent As Long     '表示预览显示的比例
'       计算出显示比例，调用PrintPreview预览当前页
        oldIndex = cboScale.ListIndex
        strPercent = cboScale.List(cboScale.ListIndex)
        strPercent = Left(strPercent, Len(strPercent) - 1)
        percent = CLng(strPercent)
        PrintPreview percent
    End If
End Sub

Private Sub cmdAbout_Click()
    Dim strAbout As String
    
    strAbout = Chr(10) & Chr(13) & Space(8) & "本控件是测试版软件，如果您在使用过程中发现BUG或有什么建议，请与作者联系。" & Chr(10) & Chr(13) & Chr(10) & Chr(13) _
                & "由于是测试版控件，作者对使用本控件所造成的一切后果不付任何责任。" & Chr(10) & Chr(13) & Chr(10) & Chr(13) _
                & Space(8) & "作者  ：小溪" & Chr(10) & Chr(13) & Chr(10) & Chr(13) _
                & Space(8) & "QQ    ：36287066" & Chr(10) & Chr(13) & Chr(10) & Chr(13) _
                & Space(8) & "E_mail：[e-mail]"
    MsgBox strAbout, , "关于打印控件"
End Sub

Private Sub cmdClose_Click()
    Unload Me
End Sub

'****************************************************
'   跳至某页
'****************************************************
Private Sub cmdGoTo_Click()
    Dim strPercent As String
    Dim percent As Long
    
    If txtPageNum.Text = "" Then Exit Sub
    If CInt(txtPageNum.Text) < 1 Or CInt(txtPageNum.Text) > pageCount Then
        MsgBox "此页码不存在！", vbOKOnly + vbInformation
        Exit Sub
    End If
    
    cmdNext.Enabled = True
    cmdPrevious.Enabled = True
    strPercent = cboScale.List(cboScale.ListIndex)
    strPercent = Left(strPercent, Len(strPercent) - 1)
    percent = CLng(strPercent)
    intPartIndex = 1
    pageNum = CInt(txtPageNum.Text)
    
    If pageNum = 1 Then
        If intPartIndex = 1 Then cmdPrevious.Enabled = False