frmqueryprint.frm

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

    For i = 0 To iFCount - 1
        If colInfo(i).Width > (Printer.ScaleWidth - rectMargin.Left - rectMargin.Right) Then
            MsgBox "列 “" & colInfo(i).Text & "”　的宽度超出打印纸的宽度（" _
                & CStr(colInfo(i).Width) & ">" & CStr(Printer.ScaleWidth - rectMargin.Left - rectMargin.Right) _
                & "），请检查！", 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 - rectMargin.Left - rectMargin.Right) 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 ShowPrintLabel(obj As Object, ByVal band As String, ByVal percent As Integer)
    Dim i As Integer
    
    For i = 0 To iCount - 1
        If liPrint(i).band = band Then
            With liPrint(i)
                myInfo.Align = .LineAlign
                Call CopyFont(.Font, myInfo.Font)
                Select Case .Text
                    Case "Date"
                        myInfo.Text = "编制日期：" & FormatDateTime(Date, vbLongDate)
                    Case "Page"
                        myInfo.Text = "共 " & CStr(pageCount) & " 页   第 " & CStr(pageNum) & " 页"
                    Case Else
                        myInfo.Text = .Text
                End Select
                CopyFont .Font, obj.Font
                .Width = obj.TextWidth(myInfo.Text)
                
                myInfo.Height = .Height
                myInfo.Width = .Width
                Select Case .LineAlign
                    Case 1
                        myInfo.CurX = rectMargin.Left
                    Case 2
                        myInfo.CurX = (arrCol(intPartIndex, 3) - .Width) / 2 _
                                            + rectMargin.Left
                    Case 3
                        myInfo.CurX = (arrCol(intPartIndex, 3) - .Width) + rectMargin.Left
                End Select
                myInfo.curY = .curY + lHeight
                myInfo.percent = percent
                myInfo.style = "LS"
            End With
            PrintHeader obj, myInfo '调用自定义函数PrintHeader打印指定内容
        End If
    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 + rectMargin.Left
'    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 + rectMargin.Left
'    myInfo.Text = "编制日期：" & FormatDateTime(Date, vbLongDate)
'    PrintHeader obj, myInfo
    Call ShowPrintLabel(obj, "head", percent)
'   打印分页情况
    If intPartCount > 1 Then
        myInfo.CurX = (arrCol(intPartIndex, 3) - 30) + rectMargin.Left
        myInfo.curY = 5
        myInfo.Text = "分页情况：" & CStr(intPartIndex) & "/" & CStr(intPartCount)
        PrintHeader obj, myInfo
    End If
    lHeight = lHeight + iHeadHeight
    
'   打印报表各列的上层列头
    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 = rectMargin.Left + 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 = rectMargin.Left + 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 bReportCalc Then
        For i = arrCol(intPartIndex, 1) To arrCol(intPartIndex, 2)
            myInfo.Font.Size = 10
            myInfo.CurX = rectMargin.Left + 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.CurY = lHeight + 3
'    myInfo.style = "LS"
'    If strRemark <> "" Then
'        myInfo.CurX = rectMargin.Left + 3
'        myInfo.Text = "备注：" & strRemark
'        PrintHeader obj, myInfo
'    End If
''   打印报表的页码信息
'    myInfo.CurX = rectMargin.Left + (arrCol(intPartIndex, 3) - 30) / 2
'    myInfo.Text = "共 " & CStr(pageCount) & " 页   第 " & CStr(pageNum) & " 页"
'    PrintHeader obj, myInfo
    lHeight = lHeight + 3
    Call ShowPrintLabel(obj, "foot", percent)
End Sub

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

    On Error Resume Next
'   当前页码超出打印的页码范围时停止打印
    Me.MousePointer = 11
    lHeight = rectMargin.Top
'   打印报表头
    PrintPageHeader Printer, percent
'   打印记录
    myInfo.Align = colInfo(0).Align
    Set myInfo.Font = colInfo(0).Font
    myInfo.percent = percent
    myInfo.style = "ES"
    myInfo.Height = intRowHeight
    For j = 1 To rowNum
        If Not rstReport.EOF Then
            For i = arrCol(intPartIndex, 1) To arrCol(intPartIndex, 2)
                myInfo.CurX = colInfo(i).CurX + rectMargin.Left
                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
        Else
            Exit For
        End If
    Next j
'   打印完的记录集的最后一条记录后打印页尾并结束打印
    PrintPageFooter Printer, percent
    If (pageNum = pageCount) And (intPartIndex = intPartCount) Then
        Printer.EndDoc
    Else
        Printer.NewPage
    End If
    Me.MousePointer = 0
End Sub

'***********************************************************************************
'   预览报表
'***********************************************************************************
Private Sub PrintPreview(ByVal percent As Long)
    Dim i As Integer, j 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 = rectMargin.Top
'   根据当前页码和每页的记录数计算当前应从哪条记录开始显示
    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
    
    For j = 1 To rowNum
        If Not rstReport.EOF Then
            For i = arrCol(intPartIndex, 1) To arrCol(intPartIndex, 2)
                myInfo.CurX = colInfo(i).CurX + rectMargin.Left
                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
        Else
            Exit For
        End If
    Next j
DOHANDLE:
'   打印页尾
    PrintPageFooter picPreview, percent
'   当打印位置超出右边界时无法处理，在此统一将右边界的位置打印成空白
    picPreview.Line ((picPreview.ScaleWidth - rectMargin.Right), 0)-(picPreview.ScaleWidth, picPreview.ScaleHeight), RGB(255, 255, 255), BF
    Call SetMoveButton
    Me.MousePointer = 0
End Sub

Private Sub cboScale_Click()
    If oldIndex <> cboScale.ListIndex Then
        oldIndex = cboScale.ListIndex
        iPercent = cboScale.ItemData(cboScale.ListIndex)
        PrintPreview iPercent
    End If
End Sub

Private Sub cmdCancle_Click()
    bCancle = True
End Sub

Private Sub Form_Load()
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim l As Integer
    Dim intCurX As Integer
    
'   设置打印机的度量单位为毫米
    Printer.ScaleMode = 6