frmprint.frm

朋友给的

    If strReportFooter = "" Then
        Exit Function
    End If
    With obj
        .Font.name = "宋体"
        .Font.Size = sngFontSize
        lngWidth = obj.TextWidth(strReportFooter)
        If lngWidth <= lngRealWidth Then
            .CurrentX = lngLeftMargin
            .CurrentY = lngTopMargin + lngTitleHeight + lngCaptionHeight + lngColumnHeaderHeight + lngRealHeight
            obj.Print strReportFooter
        End If
    End With
    Exit Function
Err_Handle:
    MsgBox "发生下列错误" & vbCrLf & "错误代码：" & Err.Number & vbCrLf & "错误描述：" & Err.Description, vbOKOnly, "打印错误"
End Function

Private Function PrintOnePage(obj As Object, ByVal PageH As Long, ByVal PageV As Long) As Long
    Dim i As Long, j As Long
    Dim lngLastRow As Long
    Dim lngLastCol As Long
    Dim lngStartH As Long
    Dim lngStartV As Long
On Error GoTo Err_Handle
    lngStartH = lngLeftMargin
    lngStartV = lngTopMargin + lngTitleHeight + lngCaptionHeight + lngColumnHeaderHeight
    With obj
        If PageH = lngPageCountH - 1 Then
            lngLastCol = msgContents.Cols - 1
        Else
            lngLastCol = lngFirstColPerPage(PageH + 1) - 1
        End If
        If PageV = lngPageCountV - 1 Then
            lngLastRow = msgContents.Rows - 1
        Else
            lngLastRow = lngFirstRowPerPage(PageV + 1) - 1
        End If
        '打印报表标题
        PrintReportTitle obj
        '打印报表首行
        PrintReportCaption obj
        '打印列头
        PrintColumnHeader obj, lngFirstColPerPage(PageH), lngLastCol
        '打印报表内容
        .Font.name = "宋体"
        .Font.Size = cmbFontSize.ItemData(cmbFontSize.ListIndex) / 10
        
        For i = lngFirstRowPerPage(PageV) To lngLastRow
            If msgContents.RowHeight(i) > 0 Then
                For j = lngFirstColPerPage(PageH) To lngLastCol
                    If msgContents.ColWidth(j) > 0 Then
                        If msgContents.ColAlignment(j) = 7 Then
                            .CurrentX = lngStartH + lngStartPerCol(j) + (msgContents.ColWidth(j)) - RealLength(msgContents.TextMatrix(i, j)) * sngFontSize * 10 - 1.5 * LINE_ADJUST
                        Else
                            .CurrentX = lngStartH + lngStartPerCol(j)
                        End If
                        
                        .CurrentY = lngStartV + lngStartPerRow(i)
                        obj.Print msgContents.TextMatrix(i, j)
                    End If
                Next j
                obj.Line (lngLeftMargin - LINE_ADJUST, lngStartV + lngStartPerRow(i) + msgContents.RowHeight(i) - LINE_ADJUST)-(lngStartH + lngStartPerCol(j - 1) + msgContents.ColWidth(j - 1) + LINE_ADJUST, lngStartV + lngStartPerRow(i) + msgContents.RowHeight(i) - LINE_ADJUST)
            End If
        Next i
        obj.Line (lngLeftMargin - LINE_ADJUST, lngStartV - LINE_ADJUST)-(lngStartH + lngStartPerCol(j - 1) + msgContents.ColWidth(j - 1) + LINE_ADJUST, lngStartV - LINE_ADJUST)
        For j = lngFirstColPerPage(PageH) To lngLastCol
            If msgContents.ColWidth(j) > 0 Then
                obj.Line (lngStartH + lngStartPerCol(j) - LINE_ADJUST, lngStartV - LINE_ADJUST)-(lngStartH + lngStartPerCol(j) - LINE_ADJUST, lngStartV + lngStartPerRow(i - 1) + msgContents.RowHeight(i - 1) - LINE_ADJUST)
            End If
           
        Next j
        obj.Line (lngStartH + lngStartPerCol(j - 1) + msgContents.ColWidth(j - 1) + LINE_ADJUST, lngStartV - LINE_ADJUST)-(lngStartH + lngStartPerCol(j - 1) + msgContents.ColWidth(j - 1) + LINE_ADJUST, lngStartV + lngStartPerRow(i - 1) + msgContents.RowHeight(i - 1) - LINE_ADJUST)
        '打印报表末行
        PrintReportFooter obj
        '打印报表页码
        PrintPageCode obj, PageV * lngPageCountH + PageH + 1
    End With
    Exit Function
Err_Handle:
    MsgBox "请注意设置适当的页边距！"
End Function

Private Function PrintPageCode(obj As Object, PageCode As Long)
    On Error GoTo Err_Handle
    PrintPageCode = 0
    If lngBottomMargin < PIXELS_PER_CM Then
        Exit Function
    End If
    With obj
        .CurrentX = lngLeftMargin + lngRealWidth - 300
'        .CurrentY = lngPaperHeight - lngBottomMargin + (lngBottomMargin - sngFontSize * 10 * 2) / 2
        '.CurrentY = lngPaperHeight - lngTopMargin - lngBottomMargin + (lngBottomMargin - sngFontSize * 10 * 2) / 2
        .CurrentY = lngPaperHeight - lngBottomMargin '+ (lngBottomMargin - sngFontSize * 10 * 2) / 2
        obj.Print PageCode
    End With
    Exit Function
Err_Handle:
    MsgBox "发生下列错误" & vbCrLf & "错误代码：" & Err.Number & vbCrLf & "错误描述：" & Err.Description, vbOKOnly, "打印错误"
End Function

Public Function ShowMe(GridorRecordset As Boolean, Optional PrintGrid As MSFlexGrid, Optional PrintRecordset As Recordset, Optional ReportName As String, Optional ReportTitle As String, Optional ReportCaption As String, Optional ReportFooter As String, Optional PaperSize As Long, Optional Orientation As Long) As Long
'=====================================
'函数说明：显示打印预览窗口并完成初始化工作
'参数说明:
'GridorRecordset    :说明参数是MSFLEXGRID还是ADODB.RECORDSET
'PrintGrid          :说明要打印的MSFLEXGRID
'PrintRecordset     :说明要打印的ADODB.RECORDSET
'ReportName         :报表名称
'ReportTitle        :报表标题
'ReportCaption      :报表首行
'ReportFooter       :报表末行
'PaperSize          :打印纸张名称
'Orientation        :横向或纵向 1-横向,2-纵向
'=====================================
    
    Dim i As Long, j As Long
    On Error GoTo Err_Handle
    If PaperSize = 0 Then
        PaperSize = Printer.PaperSize
    End If
    If Orientation = 0 Then
        Orientation = Printer.Orientation
    End If
    If Orientation <> 1 Then
        Orientation = 2
    End If
    InitForm PaperSize, Orientation
    
    strReportName = ReportName
    
'    If ReportName = "" Then
'        cmdSaveSet.Visible = False
'        cmdRestoreSet.Visible = False
'    Else
'        cmdSaveSet.Visible = True
'        cmdRestoreSet.Visible = True
'    End If
    Me.Refresh
    If GridorRecordset Then
    
        If PrintGrid Is Nothing Then
            #If V_DEBUG Then
                MsgBox "程序员注意，请传递PrintGrid参数！"
            #End If
            Exit Function
        End If
        
        With PrintGrid
            If Val(.Tag) > 0 Then
                msgContents.Rows = Val(.Tag) + .FixedRows
            Else
                msgContents.Rows = .Rows
            End If
            
            msgContents.Cols = .Cols
            msgContents.FixedRows = .FixedRows
            msgContents.FixedCols = 0
            msgContents.Font.Size = .Font.Size
            msgContents.Font.name = .Font.name
            msgContents.MergeCells = .MergeCells
            For i = 0 To msgContents.Rows - 1
                msgContents.MergeRow(i) = .MergeRow(i)
                For j = 0 To .Cols - 1
                    msgContents.TextMatrix(i, j) = .TextMatrix(i, j)
                Next j
            Next i
            For i = 0 To msgContents.Rows - 1
                msgContents.RowHeight(i) = .RowHeight(i)
            Next i
            
            msgContents.Row = .FixedRows
            msgContents.Col = .FixedCols
            If Val(.Tag) > 0 Then
                msgContents.Rows = Val(.Tag) + .FixedRows
            End If
            For i = 0 To .Cols - 1
                msgContents.ColAlignment(i) = .ColAlignment(i)
            Next i
        End With
    Else
        If PrintRecordset.RecordCount > 0 Then
            PrintRecordset.MoveLast
            PrintRecordset.MoveFirst
            msgContents.Rows = PrintRecordset.RecordCount + 1
            msgContents.Cols = PrintRecordset.Fields.count
            For i = 0 To PrintRecordset.Fields.count - 1
                msgContents.TextMatrix(0, i) = PrintRecordset.Fields(i).name
                Select Case PrintRecordset.Fields(i).Type
                Case 2, 3, 4, 5, 6, 17
                    msgContents.ColAlignment(i) = 7
                End Select
            Next i
            For i = 0 To PrintRecordset.RecordCount - 1
                For j = 0 To PrintRecordset.Fields.count - 1
                    msgContents.TextMatrix(i + 1, j) = PrintRecordset.Fields(j) & ""
                    
                Next j
                PrintRecordset.MoveNext
            Next i
        End If
    End If
    txtReportTitle = ReportTitle
    txtReportCaption = ReportCaption
    txtReportFooter = ReportFooter
    Dim lstItem As ListItem
    For i = 0 To msgContents.Cols - 1
        Set lstItem = lvwFieldName.ListItems.Add(, , msgContents.TextMatrix(IIf((msgContents.FixedRows - 1) < 0, 0, msgContents.FixedRows - 1), i))
        lstItem.Checked = True
    Next i
    For i = 0 To msgContents.FixedRows - 1
        msgContents.Row = i
        For j = 0 To msgContents.Cols - 1
            msgContents.Col = j
            msgContents.CellAlignment = 4
        Next j
    Next i
    cmbFontSize_Click
    Me.Show
    Exit Function
Err_Handle:
    MsgBox "发生下列错误" & vbCrLf & "错误代码：" & Err.Number & vbCrLf & "错误描述：" & Err.Description, vbOKOnly, "打印错误"
End Function

Private Function InitForm(PaperSize As Long, Orientation As Long) As Long
On Error GoTo Err_Handle
    Dim i As Long
    
    If Printers.count = 0 Then
        MsgBox "没有安装打印机，不能进行打印预览！"
        GoTo E_Exit
    End If
    
    optContents.Value = True
    optContents_Click
    
    bLoad = True
    
    cmbFontSize.ListIndex = 3
    
    bLoad = False
    On Error Resume Next
    Printer.PaperSize = PaperSize
    Printer.Orientation = Orientation
    On Error GoTo 0
    lngOldPaperSize = Printer.PaperSize
    lngOldOrientation = Printer.Orientation
    '填写缺省打印机的纸张
    AddPapers
    
    Printer.PaperSize = lngOldPaperSize
    
    '得到打印机纸张的宽度和高度
    txtWidth.Text = Format(Printer.Width / PIXELS_PER_CM, "0.00")
    txtHeight.Text = Format(Printer.Height / PIXELS_PER_CM, "0.00")
    
    lvwFieldName.ColumnHeaders.Add , , "列名"

    If lngOldOrientation = 1 Then
        optOrientation(0).Value = True
        optOrientation_Click (0)
    Else
        optOrientation(1).Value = True
        optOrientation_Click (1)
    End If
   
    
    For i = 0 To cmbPaperType.ListCount - 1
        If cmbPaperType.ItemData(i) = lngOldPaperSize Then
            cmbPaperType.ListIndex = i
            Exit For
        End If
    Next i
    
    lngTopMargin = TOP_MARGIN * PIXELS_PER_CM
    lngBottomMargin = BOTTOM_MARGIN * PIXELS_PER_CM
    lngLeftMargin = LEFT_MARGIN * PIXELS_PER_CM
    lngRightMargin = RIGHT_MARGIN * PIXELS_PER_CM
    
    txtMargin(0) = TOP_MARGIN
    txtMargin(1) = BOTTOM_MARGIN
    txtMargin(2) = LEFT_MARGIN
    txtMargin(3) = RIGHT_MARGIN
    
    Exit Function
E_Exit:
    InitForm = 1
    Exit Function
Err_Handle:
    MsgBox "发生下列错误" & vbCrLf & "错误代码：" & Err.Number & vbCrLf & "错误描述：" & Err.Description, vbOKOnly, "打印错误"
End Function

'************************
'去掉API返回值最后的字符0
'************************
Function StripTerminator(ByVal strString As String) As String
    Dim intZeroPos As Integer
    intZeroPos = InStr(strString, Chr$(0))
    If intZeroPos > 0 Then
        StripTerminator = Left$(strString, intZeroPos - 1)
    Else
        StripTerminator = strString
    End If
End Function

Private Function AddPapers() As Long
    Dim lResult As Long
    Dim i As Long, j As Long
    Dim strPaperNames As String
    Dim strPaperName As Variant
    Dim lpDevMode As DEVMODE
    Dim strOutput() As Integer

On Error GoTo Err_Handle

    lResult = DeviceCapabilities(Printer.DeviceName, Printer.Port, DC_PAPERS, vbNullString, lpDevMode)
    If lResult > 0 Then
        ReDim strOutput(lResult - 1) As Integer
        strPaperNames = Space(lResult * 64)
        lResult = DeviceCapabilities1(Printer.DeviceName, Printer.Port, DC_PAPERS, strOutput(0), lpDevMode)
        lResult = DeviceCapabilities(Printer.DeviceName, Printer.Port, DC_PAPERNAMES, strPaperNames, lpDevMode)
        
        With cmbPaperType
            .Clear
            For i = 0 To UBound(strOutput)
                .AddItem Trim(StripTerminator(RealMid(strPaperNames, i * 64 + 1, 64)))
                .ItemData(i) = strOutput(i)
            Next i

        End With
    Else
        strPaperName = Array("信笺， 8 1/2 x 11 英寸", "小型信笺， 8 1/2 x 11 英寸", "小型报， 11 x 17 英寸", "分类帐， 17 x 11 英寸", "法律文件， 8 1/2 x 14 英寸", "声明书，5 1/2 x 8 1/2 英寸", "行政文件，7 1/2 x 10 1/2 英寸", "A3, 297 x 420 毫米", "A4, 210 x 297 毫米", "A4小号， 210 x 297 毫米", _
                "A5, 148 x 210 毫米", "B4, 250 x 354 毫米", "B5, 182 x 257 毫米", "对开本， 8 1/2 x 13 英寸", "四开本， 215 x 275 毫米", "10 x 14 英寸", "11 x 17 英寸", "便条，8 1/2 x 11 英寸", "#9 信封， 3 7/8 x 8 7/8 英寸", "#10 信封， 4 1/8 x 9 1/2 英寸", _
                "#11 信封， 4 1/2 x 10 3/8 英寸", "#12 信封， 4 1/2 x 11 英寸", "#14 信封， 5 x 11 1/2 英寸", "C 尺寸工作单", "D 尺寸工作单", "E 尺寸工作单", "DL 型信封， 110 x 220 毫米", "C3 型