系统_打印基本模块.bas

新世纪ERP系统管理源代码

                            End If
                        End If
                    End If
                Next Rowjsq
                
                Lszbj = .MarginLeft
                .MarginLeft = Bbqsx
                
                .EndTable
                .MarginLeft = Lszbj
                
                '生 成 报 表 表 尾
                Bbydy = Bbydy + Xbthjg
                If Bbbwhgs <> 0 Then
                    Bwhmaxlen = 0
                    For jsqte = 1 To Bbbwhgs
                        .CalcText = Bbbwh(jsqte)
                        If .TextWid > Bwhmaxlen Then
                            Bwhmaxlen = .TextWid
                        End If
                    Next jsqte
                    For jsqte = 1 To Bbbwhgs
                        .CalcText = Bbbwh(jsqte)
                        Select Case Bbbwhzzxs(jsqte)
                        Case 0
                            .TextBox Bbbwh(jsqte), Bbydx, Bbydy, .TextWid, .TextHei, False
                        Case 1
                            .TextBox Bbbwh(jsqte), Bbzkd / 2 - Bwhmaxlen / 2 + Bbydx, Bbydy, .TextWid, .TextHei, False
                        Case 2
                            .TextBox Bbbwh(jsqte), Bbydx + Bbzkd - .TextWid, Bbydy, .TextWid, .TextHei, False
                        End Select
                        Bbydy = Bbydy + .TextHei
                    Next jsqte
                End If
                .CalcText = Bwzb
                .TextBox Bwzb, Bbqsx, Bbydy, .TextWid, .TextHei
                .CalcText = Bwdyrq
                .TextBox Bwdyrq, Bbqsx + Bbzkd - .TextWid, Bbydy, .TextWid, .TextHei
                Bbydy = Bbydy + .TextHei
                .CalcText = Bwbzdw
                .TextBox Bwbzdw, Bbqsx, Bbydy, .TextWid, .TextHei
                .CalcText = Bwrjmc
                .TextBox Bwrjmc, Bbqsx + Bbzkd - .TextWid, Bbydy, .TextWid, .TextHei
                
                Bbydy = Bbydy + .TextHei + Bjjghs * .TextHei
                
                If Not (Sflxdy And .PageHeight - Bbydy >= Btzgd + Btsjhgd + Bwzgd) Then
                    Exit Do
                End If
            Loop
            
            '判 断 是 页 内 分 页 还 是 开 始 新 的 一 页
            If bbzzlz = bbsczzlz Then
                
                '如果为空表仅输出一页
                sfsckb = False
                
                bbynbz = "0"
                Bbynfyh = 1
                bbQslz = bbscQslz
                bbzzlz = bbscQslz
                If Bbhsjsq <= DY_Tybbyldy.DyylGrid.Rows - 1 Then
                    Bbhsjsqte = Bbhsjsq
                    .NewPage
                    Pagecount = Pagecount + 1
                End If
            Else
                bbynbz = "1"
                Bbhsjsq = Bbhsjsqte
                Bbynfyh = Bbynfyh + 1
                bbQslz = bbzzlz + 1
                .NewPage
            End If
            
            
            '解决由于纸张宽度太小出现死循环
            If Bbynfyh > DY_Tybbyldy.DyylGrid.Cols - 1 Then
                Tsxx = "纸张宽度太小不能输出报表,请重新设置!"
                Call Xtxxts(Tsxx, 0, 4)
                Unload DY_Tybbyldy
                Exit Sub
            End If
        Loop
        .EndDoc
        
        '还原操作状态
        Call Sub_SetOperStatus("")
        
        '输出打印页号填充滚动条
        
        DY_Tybbyldy.PageHScroll.Max = .Pagecount
        DY_Tybbyldy.PageHScroll.Min = 1
        DY_Tybbyldy.YlToolbar.Buttons("sy").Enabled = False
        If .Pagecount = 1 Then
            DY_Tybbyldy.YlToolbar.Buttons("xy").Enabled = False
        End If
    End With
    
    '预 览 打 印
    If bbylte Then
        DY_Tybbyldy.Show 1
    Else
        Call dyscbb(PrintMessageNotShow)
    End If
    
End Sub

Private Sub Scbbzdx(zdxwzte As Integer, zdxgdte As Double, zdxsjgte As Double, zdxzjgte As Double)      '输 出 报 表 装 订 线
    
    With DY_Tybbyldy.Tydy
        If zdxwzte <> 0 Then
            .PenColor = QBColor(12)
            .PenStyle = psDashDot
            Select Case zdxwzte
            Case 1
                .DrawLine 0, zdxgdte, .PageWidth, zdxgdte
                zdxsjgte = zdxgdte
            Case 2
                .DrawLine zdxgdte, 0, zdxgdte, .PageHeight
                zdxzjgte = zdxgdte
            End Select
            .PenColor = QBColor(0)
            .PenStyle = psSolid
        End If
    End With
    
End Sub

Private Sub scbbbt(Cxsjwg, bbQslz&, bbzzlz&, Kdfdbl#, Bbgdhgd#, Bbydy#, Bbydx#, Bbqsx#, Sftdfssc As Boolean)                 '输出网格任意多列表头
    
    '参数说明:当前网格,起始列值,终止列值,行宽放大比例,表头行高度,当前Y坐标,当前X坐标,起始X坐标
    Dim Hbrow1&, Hbcol1&, Hbrow2&, Hbcol2&               '合 并 单 元 范 围
    Dim Mgzkd&, Zyhs%                                    '每个字宽度,占用行数
    bbydyte = Bbydy
    bbydxte = Bbydx
    With DY_Tybbyldy.Tydy
        For Rowjsq = 0 To Cxsjwg.FixedRows - 1
            For Coljsq = bbQslz To bbzzlz
                Dyxsbz = True
                If Rowjsq <> 0 Or Coljsq <> bbQslz Then
                    If Rowjsq <> 0 Then
                        If Cxsjwg.TextMatrix(Rowjsq, Coljsq) = Cxsjwg.TextMatrix(Rowjsq - 1, Coljsq) Then
                            Dyxsbz = False
                        End If
                    End If
                    If Coljsq <> bbQslz And Dyxsbz Then
                        If Cxsjwg.TextMatrix(Rowjsq, Coljsq) = Cxsjwg.TextMatrix(Rowjsq, Coljsq - 1) Then
                            Dyxsbz = False
                        End If
                    End If
                End If
                If Dyxsbz Then
                    Cxsjwg.GetMergedRange Rowjsq, Coljsq, Hbrow1, Hbcol1, Hbrow2, Hbcol2
                    jxkd = 0
                    jxgd = 0
                    For hbrowjsq = Hbrow1 To Hbrow2
                        jxgd = jxgd + Bbgdhgd
                    Next hbrowjsq
                    If Hbcol1 < bbQslz Then
                        Hbcol1 = bbQslz
                    End If
                    If Hbcol2 > bbzzlz Then
                        Hbcol2 = bbzzlz
                    End If
                    For hbcoljsq = Hbcol1 To Hbcol2
                        jxkd = jxkd + Cxsjwg.ColWidth(hbcoljsq) * Kdfdbl
                    Next hbcoljsq
                    .CalcText = Cxsjwg.TextMatrix(Rowjsq, Coljsq)
                    If jxkd - .TextWid > 0 Then
                        textx1 = bbydxte + (jxkd - .TextWid) / 2
                        textkd = .TextWid
                        texty1 = bbydyte + (jxgd - .TextHei) / 2
                        textgd = .TextHei
                    Else
                        
                        '当网格列宽不足以容下标题时,计算文本框大小及坐标
                        If Len(Cxsjwg.TextMatrix(Rowjsq, Coljsq)) = 0 Then
                            Mgzkd = 1
                        Else
                            Mgzkd = .TextWid / Len(Cxsjwg.TextMatrix(Rowjsq, Coljsq))
                        End If
                        If jxkd > Mgzkd Then
                            If Len(Cxsjwg.TextMatrix(Rowjsq, Coljsq)) Mod Int(jxkd / Mgzkd) <> 0 Then
                                Zyhs = Int(Len(Cxsjwg.TextMatrix(Rowjsq, Coljsq)) / Int(jxkd / Mgzkd)) + 1
                            Else
                                Zyhs = Len(Cxsjwg.TextMatrix(Rowjsq, Coljsq)) / Int(jxkd / Mgzkd)
                            End If
                            If Int(jxgd / .TextHei) < Zyhs Then
                                Zyhs = Int(jxgd / .TextHei)
                            End If
                            textkd = Int(jxkd / Mgzkd) * Mgzkd
                            textx1 = bbydxte + (jxkd - textkd) / 2
                            textgd = Zyhs * .TextHei
                            texty1 = bbydyte + (jxgd - textgd) / 2
                        Else
                            Zyhs = -1
                            textx1 = bbydxte
                            texty1 = bbydyte
                            textkd = 0
                            textgd = 0
                        End If
                    End If
                    
                    If textkd <> 0 Then
                        .TextBox Cxsjwg.TextMatrix(Rowjsq, Coljsq), textx1, texty1, textkd, textgd, True
                    End If
                    If Not Sftdfssc Then
                        .DrawLine bbydxte, bbydyte, bbydxte + jxkd, bbydyte
                        .DrawLine bbydxte, bbydyte, bbydxte, bbydyte + jxgd
                        .DrawLine bbydxte + jxkd, bbydyte, bbydxte + jxkd, bbydyte + jxgd
                        .DrawLine bbydxte, bbydyte + jxgd, bbydxte + jxkd, bbydyte + jxgd
                    End If
                End If
                bbydxte = bbydxte + Cxsjwg.ColWidth(Coljsq) * Kdfdbl
            Next Coljsq
            bbydxte = Bbqsx
            bbydyte = bbydyte + Bbgdhgd
        Next Rowjsq
    End With
    
End Sub

Public Sub Scyxsjb(Cxsjwg As vsFlexGrid)                       '生成有效数据表(针对网格隐含和数据行为空行情况的解决方案)
    
    '过程参数:输出数据网格
    
    Dim Yxhzjsq%, Yxlzjsq%
    Dim Rowjsq As Long
    With DY_Tybbyldy.DyylGrid
        .Redraw = False             '为了加快传送速度
        .FontName = Cxsjwg.FontName
        .FontSize = Cxsjwg.FontSize
        .FixedRows = Cxsjwg.FixedRows
        .MergeCells = flexMergeFixedOnly
        For jsqte = 0 To .FixedRows - 1
            .MergeRow(jsqte) = True
        Next jsqte
        .WordWrap = True
        Yxlzjsq = 0
        For Coljsq = 0 To Cxsjwg.Cols - 1
            If Not Cxsjwg.ColHidden(Coljsq) Then
                Yxlzjsq = Yxlzjsq + 1
            End If
        Next Coljsq
        .Cols = Yxlzjsq
        Yxlzjsq = 0
        For Coljsq = 0 To Cxsjwg.Cols - 1
            If Not Cxsjwg.ColHidden(Coljsq) Then
                .ColAlignment(Yxlzjsq) = Cxsjwg.ColAlignment(Coljsq)
                .ColWidth(Yxlzjsq) = Cxsjwg.ColWidth(Coljsq)
                .ColFormat(Yxlzjsq) = Cxsjwg.ColFormat(Coljsq)
                .MergeCol(Yxlzjsq) = True
                Yxlzjsq = Yxlzjsq + 1
            End If
        Next Coljsq
        Yxhzjsq = 0
        For Rowjsq = 0 To Cxsjwg.Rows - 1
            If (Not Cxsjwg.RowHidden(Rowjsq)) And (Not GridRowEmpty(Cxsjwg, Rowjsq)) Then
                Yxhzjsq = Yxhzjsq + 1
            End If
        Next Rowjsq
        .Rows = Yxhzjsq
        Yxhzjsq = 0
        Yxlzjsq = 0
        For Rowjsq = 0 To Cxsjwg.Rows - 1
            If (Not Cxsjwg.RowHidden(Rowjsq)) And (Not GridRowEmpty(Cxsjwg, Rowjsq)) Then
                For Coljsq = 0 To Cxsjwg.Cols - 1
                    If Not Cxsjwg.ColHidden(Coljsq) Then
                        If Cxsjwg.ColDataType(Coljsq) = flexDTBoolean And Rowjsq >= .FixedRows Then           '布尔型列单独处理
                            If Cxsjwg.TextMatrix(Rowjsq, Coljsq) Then
                                .TextMatrix(Yxhzjsq, Yxlzjsq) = "√"
                            Else
                                .TextMatrix(Yxhzjsq, Yxlzjsq) = ""
                            End If
                        Else
                            .TextMatrix(Yxhzjsq, Yxlzjsq) = Cxsjwg.TextMatrix(Rowjsq, Coljsq)
                        End If
                        Yxlzjsq = Yxlzjsq + 1
                    End If
                Next Coljsq
                .RowHeight(Yxhzjsq) = Cxsjwg.RowHeight(Rowjsq)
                Yxlzjsq = 0
                Yxhzjsq = Yxhzjsq + 1
            End If
        Next Rowjsq
        
        .Redraw = True
    End With
    
End Sub

Public Function GridRowEmpty(Cxsjwg As vsFlexGrid, Rowte As Long) As Boolean           '判断网格行是否为空行
    
    GridRowEmpty = True
    With Cxsjwg
        For jsqte = 0 To .Cols - 1
            If Len(Trim(.TextMatrix(Rowte, jsqte))) <> 0 Then
                GridRowEmpty = False
                Exit Function
            End If
        Next jsqte
    End With