系统_打印基本模块.bas

新世纪ERP系统管理源代码

End Function

Public Sub dyscbb(Optional PrintMessageNotShow As Boolean)                             '打 印 输 出 报 表(调用打印提示选择项窗体)
    
    If Not PrintMessageNotShow Then
        DY_DytsFrm.Show 1
    Else
        DY_DytsFrm.Output_Printer
    End If
    
End Sub

Private Function Thwxzf(Thzfc As String) As String                                     '替换打印中妨碍字符 ";"和"|" 为全角有效字符
    
    Dim lswz As Integer
    Do While InStr(1, Thzfc, ";") <> 0
        lswz = InStr(1, Thzfc, ";")
        Thzfc = Mid(Thzfc, 1, lswz - 1) + "；" + Mid(Thzfc, lswz + 1, Len(Thzfc))
    Loop
    Do While InStr(1, Thzfc, "|") <> 0
        lswz = InStr(1, Thzfc, "|")
        Thzfc = Mid(Thzfc, 1, lswz - 1) + Mid(Thzfc, lswz + 1, Len(Thzfc))
    Loop
    Thwxzf = Thzfc
    
End Function

'单据打印输出
Public Sub BillGridPrint(WglrGrid As Object, LrText As Object, GridStr() As String, Szzls As Integer, Grid_code As String, Text_code As String, XtReportCode As String, Optional PrintDirect As Boolean = False, Optional PrintType As String = "default")
    On Error Resume Next
    Dim i As Integer, GridTop As Double, GridLeft As Double, BodyTop As Integer, FixRowHeight As Double
    Dim TableFormat As String, TableBody As String, DataRows As Integer, TableData() As String
    Dim DataRowHeight As Integer, Rowjsq As Integer, GridDataRows As Integer, BillTitlePrint As String
    Dim aDo_Rec As New Recordset, ColSum(), MarginLeft As Integer, MarginTop As Integer, BillTitleLeft As Integer, BillTitleTop As Integer
    Dim Bbsjqfont As String, Bbsjqsize As String
    With DY_Tybbyldy
        '=====================
        Set aDo_Rec = Cw_DataEnvi.DataConnect.Execute("select * from Xt_dybbcs where bbbm='" & XtReportCode & "'")
        .Tydy.PaperSize = aDo_Rec!PaperSize
        .Tydy.Orientation = aDo_Rec!PaperScfx
        .Tydy.MarginLeft = aDo_Rec!bbzbj
        .Tydy.MarginTop = aDo_Rec!bbsbj
        .Tydy.FontName = Trim(aDo_Rec!Bbbtfont)
        .Tydy.FontSize = aDo_Rec!Bbbtsize
        Bbsjqfont = aDo_Rec!Bbsjqfont
        Bbsjqsize = aDo_Rec!Bbsjqsize
        MarginLeft = .Tydy.MarginLeft
        MarginTop = .Tydy.MarginTop
        aDo_Rec.Close
        '=====================
        For Rowjsq = WglrGrid.FixedRows To WglrGrid.Rows - 1
            If WglrGrid.TextMatrix(Rowjsq, 0) <> "*" Then
                Exit For
            End If
            GridDataRows = GridDataRows + 1
        Next
        
        '=====================
        Set aDo_Rec = Cw_DataEnvi.DataConnect.Execute("select * from xt_v_billgridPrint where grid_code='" & Grid_code & "' and printgridcode='" & Trim(PrintType) & "' order by colid")
        '================
        If aDo_Rec.RecordCount > 0 Then
            '-----------
            .DyylGrid.FixedRows = aDo_Rec!FixRows: .DyylGrid.Cols = 0
            GridTop = aDo_Rec!PrintGridTop: GridLeft = aDo_Rec!PrintGridLeft
            FixRowHeight = aDo_Rec!FixRowHeight: DataRows = aDo_Rec!PrintDataRows
            DataRowHeight = aDo_Rec!DataRowHeight
            BillTitleLeft = aDo_Rec!BillTitleLeft
            BillTitleTop = aDo_Rec!BillTitleTop
            BillTitlePrint = Trim("" & aDo_Rec!BillTitlePrint)
            '----------
            If aDo_Rec!FixRows = 1 Then BodyTop = aDo_Rec!FixRowHeight + GridTop
            If aDo_Rec!FixRows = 2 Then BodyTop = aDo_Rec!FixRowHeight * 2 + GridTop
            If aDo_Rec!FixRows = 3 Then BodyTop = aDo_Rec!FixRowHeight * 3 + GridTop
            '----------
            aDo_Rec.MoveNext
            '================
            .DyylGrid.MergeCells = flexMergeFixedOnly
            For i = 0 To .DyylGrid.FixedRows - 1
                .DyylGrid.MergeRow(i) = True
            Next i
            i = 0
            '======================
            ReDim TableData(aDo_Rec.RecordCount - 1)
            ReDim ColSum(2, aDo_Rec.RecordCount - 1)
            
            Do While Not aDo_Rec.EOF           '网格头
                If aDo_Rec!YnPrint = False Then
                    .DyylGrid.Cols = .DyylGrid.Cols + 1
                    .DyylGrid.TextMatrix(0, i) = Trim(aDo_Rec!ColTitle1)
                    .DyylGrid.TextMatrix(1, i) = Trim(aDo_Rec!ColTitle2)
                    .DyylGrid.TextMatrix(2, i) = Trim(aDo_Rec!ColTitle3)
                    .DyylGrid.ColWidth(i) = aDo_Rec!PrintColWidth
                    .DyylGrid.MergeCol(i) = True
                    '-----------
                    If aDo_Rec!ColAlignment = 6 Then
                        TableFormat = TableFormat & "+>" & aDo_Rec!PrintColWidth & "|"
                    Else
                        TableFormat = TableFormat & "+<" & aDo_Rec!PrintColWidth & "|"
                    End If
                    TableData(i) = Trim(aDo_Rec!ColIndex)
                    ColSum(0, i) = aDo_Rec!ColSum_flag
                    '-----------
                    i = i + 1
                End If
                aDo_Rec.MoveNext
            Loop
            aDo_Rec.Close
            TableFormat = Mid(TableFormat, 1, Len(TableFormat) - 1)
            '---------------
        End If
        '======================
        Dim h As Integer, PrintDataRows As Integer
        Dim PrintRow As Integer: Dim TTF As Boolean
        PrintRow = WglrGrid.FixedRows
        Set aDo_Rec = Cw_DataEnvi.DataConnect.Execute("select * from Xt_v_billtextPrint where text_group_code='" & Text_code & "' and printtextcode='" & Trim(PrintType) & "' order by text_index")
        '<<<<<<<<
        .Tydy.StartDoc
        '------------
        PrintDataRows = GridDataRows \ (DataRows - 1)
        If GridDataRows Mod (DataRows - 1) > 0 Then PrintDataRows = PrintDataRows + 1
        If PrintDataRows = 0 Then PrintDataRows = 1
        
        .Tydy.CurrentX = BillTitleLeft + MarginLeft: .Tydy.CurrentY = BillTitleTop + MarginTop
        .Tydy = BillTitlePrint
        .Tydy.FontName = Trim(Bbsjqfont)
        .Tydy.FontSize = Bbsjqsize
        
        For h = 1 To PrintDataRows
            '==============
            aDo_Rec.MoveFirst
            TableBody = ""
            '----------
            Do While Not aDo_Rec.EOF '表头数据
                If aDo_Rec!YnPrint = True Then
                    .Tydy.CurrentX = Val("" & aDo_Rec!printLabelLeft) + MarginLeft: .Tydy.CurrentY = aDo_Rec!PrintTop + MarginTop
                    .Tydy = Trim(aDo_Rec!Text_Name) & ":"
                    .Tydy.CurrentX = aDo_Rec!PrintLeft + MarginLeft: .Tydy.CurrentY = aDo_Rec!PrintTop + MarginTop
                    .Tydy = LrText(aDo_Rec!text_Index)
                End If
                aDo_Rec.MoveNext
            Loop
            '==========
            If DataRows <> 0 Then
                '===================== 表体数据
                
                TableBody = ""
                TTF = False
                For Rowjsq = PrintRow To WglrGrid.Rows - 1
                    If WglrGrid.TextMatrix(Rowjsq, 0) <> "*" Then
                        TTF = True
                        Exit For
                    End If
                    '----------------表体数据行
                    For i = 0 To UBound(TableData) - 1
                        If Trim(WglrGrid.ColFormat(Sydz(TableData(i), GridStr(), Szzls))) = "" Then
                            TableBody = TableBody & Trim(WglrGrid.TextMatrix(Rowjsq, Sydz(TableData(i), GridStr(), Szzls))) & "|"
                        Else
                            TableBody = TableBody & Format(Trim(WglrGrid.TextMatrix(Rowjsq, Sydz(TableData(i), GridStr(), Szzls))), WglrGrid.ColFormat(Sydz(TableData(i), GridStr(), Szzls))) & "|"
                        End If
                        If ColSum(0, i) = True Then
                            ColSum(1, i) = ColSum(1, i) + Val(WglrGrid.TextMatrix(Rowjsq, Sydz(TableData(i), GridStr(), Szzls)))
                        End If
                    Next i
                    TableBody = Mid(TableBody, 1, Len(TableBody) - 1)
                    TableBody = TableBody & ";"
                    PrintRow = PrintRow + 1
                    
                    If (Rowjsq - WglrGrid.FixedRows + 1) - ((DataRows - 1) * h) = 0 Then
                        Exit For
                    End If
                    
                Next Rowjsq
                
                For DataRow = (Rowjsq - WglrGrid.FixedRows + 1) - ((DataRows - 1) * (h - 1)) To DataRows
                    
                    If DataRow = IIf(TTF, DataRows, DataRows - 1) Then
                        TableBody = TableBody & "小计:" & "|"
                        '--------
                        For i = 1 To UBound(TableData) - 1
                            If ColSum(0, i) = True Then
                                TableBody = TableBody & Format(Trim(ColSum(1, i)), WglrGrid.ColFormat(Sydz(TableData(i), GridStr(), Szzls))) & "|"
                                ColSum(1, i) = 0
                            Else
                                TableBody = TableBody & " |"
                            End If
                        Next i
                        '--------
                        TableBody = Mid(TableBody, 1, Len(TableBody) - 1) & ";"
                        Exit For
                    End If
                    '=============================
                    For i = 0 To UBound(TableData) - 1
                        TableBody = TableBody & " |"
                    Next i
                    TableBody = Mid(TableBody, 1, Len(TableBody) - 1) & ";"
                Next DataRow
                
                
                '=====================
                
                Call scbbbt(.DyylGrid, 0, .DyylGrid.Cols - 1, 1, FixRowHeight, GridTop + MarginTop, GridLeft + MarginLeft, GridLeft + MarginLeft, False)
                '====================
                .Tydy.MarginLeft = GridLeft + MarginLeft: .Tydy.CurrentY = BodyTop + MarginTop
                .Tydy.StartTable
                '--------
                .Tydy.AddTable TableFormat, "", TableBody, , , True
                .Tydy.TableCell(tcRows) = DataRows
                For i = 1 To DataRows
                    .Tydy.TableCell(tcRowHeight, i) = DataRowHeight
                Next
                '--------
                .Tydy.EndTable
                '===================
                If h < PrintDataRows Then
                    .Tydy.NewPage
                End If
                '=================
                
            End If
            
        Next h
        '================
        
        .Tydy.EndDoc
        
        '判断是直接打印还是预览
        If Not PrintDirect Then
            .Show 1                                     '预览
        Else
            Call DY_DytsFrm.Output_Printer              '直接打印输出
            Unload DY_Tybbyldy                          '卸载打印预览窗体
            Unload DY_DytsFrm                           '卸载打印选择提示选项
        End If
        
    End With
    
End Sub

'单据打印输出
Public Sub BillTextPrint(Lab_Title As Object, LrText As Object, Text_code As String, XtReportCode As String, Optional PrintDirect As Boolean = False, Optional PrintType As String = "default")
    On Error Resume Next
    Dim aDo_Rec As New Recordset, MarginLeft As Integer, MarginTop As Integer, Bbmc As String
    With DY_Tybbyldy
        '=====================
        Set aDo_Rec = Cw_DataEnvi.DataConnect.Execute("select * from Xt_dybbcs where bbbm='" & XtReportCode & "'")
        .Tydy.PaperSize = aDo_Rec!PaperSize
        .Tydy.Orientation = aDo_Rec!PaperScfx
        .Tydy.MarginLeft = aDo_Rec!bbzbj
        .Tydy.MarginTop = aDo_Rec!bbsbj
        MarginLeft = aDo_Rec!bbzbj
        MarginTop = aDo_Rec!bbsbj
        .Tydy.FontName = Trim(aDo_Rec!Bbbtfont)
        .Tydy.FontSize = aDo_Rec!Bbbtsize
        Bbsjqfont = aDo_Rec!Bbsjqfont
        Bbsjqsize = aDo_Rec!Bbsjqsize
        aDo_Rec.Close
        '=====================
        
        
        Set aDo_Rec = Cw_DataEnvi.DataConnect.Execute("select * from Xt_v_billtextPrint where text_group_code='" & Text_code & "' and printtextcode='" & Trim(PrintType) & "' order by text_index")
        '<<<<<<<<
        .Tydy.StartDoc
        If .Tydy.Orientation = 0 Then
            .Tydy.CurrentX = .Tydy.PaperWidth / 2 - Lab_Title.Width / 2
        Else
            .Tydy.CurrentX = .Tydy.PaperHeight / 2 - Lab_Title.Width / 2
        End If
        .Tydy.CurrentY = MarginTop
        .Tydy = Lab_Title
        .Tydy.FontName = Trim(Bbsjqfont)
        .Tydy.FontSize = Bbsjqsize
        
        '=========
        Do While Not aDo_Rec.EOF '表头数据
            If aDo_Rec!YnPrint = True Then
                .Tydy.CurrentX = Val("" & aDo_Rec!printLabelLeft) + MarginLeft: .Tydy.CurrentY = aDo_Rec!PrintTop + MarginTop
                .Tydy = Trim(aDo_Rec!Text_Name) & ":"
                .Tydy.CurrentX = aDo_Rec!PrintLeft + MarginLeft: .Tydy.CurrentY = aDo_Rec!PrintTop + MarginTop
                .Tydy = LrText(aDo_Rec!text_Index)
            End If
            aDo_Rec.MoveNext
        Loop
        '==========
        
        .Tydy.EndDoc
        
        '判断是直接打印还是预览
        If Not PrintDirect Then
            .Show 1                                     '预览
        Else
            Call DY_DytsFrm.Output_Printer              '直接打印输出
            Unload DY_Tybbyldy                          '卸载打印预览窗体
            Unload DY_DytsFrm                           '卸载打印选择提示选项
        End If
        
    End With
    
End Sub