frmagereport.frm

金算盘软件代码

'    Me.Visible = False
'    Me.Left = -30000
    MsgForm.PleaseWait
    
    msgAccount.FixedCols = 0                    '报表数据网格
    strSql = mclsAgeSet.SQLString
    strSql = strReplace(strSql, "JZRQ", mclsAgeSet.AgeEndDate)
    Set mrstTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    
    Set Data1.Resultset = mrstTemp
    If mrstTemp.RowCount > 0 Then
        mblnHaveData = True
    Else
        mblnHaveData = False
    End If
    
    msgAccount.Rows = mrstTemp.RowCount + 1
    On Error GoTo 0
    InitGridRowCol                              '初始化表头、表体的行列值
    
    InitGridTitle                               '设置表体字段名称
    
    For i = 1 To msgAccount.Rows - 1
        msgAccount.TextMatrix(i, msgAccount.Cols - 1) = "#"         '原始绑定数据
    Next i
    
    lblTitle = mclsAgeSet.AgeName ' & strTmp '"（共" & mrstTemp.RowCount & "条记录）"
    cboAnaDate.Text = mclsAgeSet.AgeDateDesc
    mstrStartDate = cboAnaDate.Text
    GacEndDate.Text = Format(CDate(mclsAgeSet.AgeEndDate), "yyyy-mm-dd")
    mdatEndDate = CDate(GacEndDate.Text)
    
    mRecordNumber = mrstTemp.RowCount
    
'    If mclsAgeSet.IsGrouped Then
'        DealWithGroups
'    End If
   
    NewDisplayRowSumData
    
    If mclsAgeSet.IsGrouped Then
        DisplayRowPercent
        If mclsAgeSet.HaveChooseZLTS Then CalcZLTS    '计算帐龄天数并恢复为计算帐龄天数的影响.
    End If
    
    AddTail
    
    SumARemain '计算余额
    
'    mintGroupCols = 0
'    For i = 0 To msgAccount.Cols - 2 'To 0 Step -1
'        If mbolColGrouped(i) Then
'            mintGroupCols = mintGroupCols + 1
'            DealWithGroupOrder (i)
'        End If
'    Next i
    
    ChangeDataFormat

    
    SetDataToBook
    mblnFormLoad = True
    Form_Resize
    If Not (MsgForm Is Nothing) Then Unload MsgForm
    Utility.LoadFormSetting Me
    
    Me.Visible = True
    mblnFatalErr = False
    Exit Sub
    
ErrHandle:
    mblnFatalErr = True
    If Not (MsgForm Is Nothing) Then Unload MsgForm
    ShowMsg Me.hWnd, "数据库中日期字段为非法日期表达式，请重新再试！", vbOKOnly + vbCritical, "数据错误"
    Filter.DelSelectedCond mclsAgeSet.AgeReportID, 2
    Unload Me
End Sub

'图形分析
Private Sub cmdGraphics_Click()
    If Not Report.MyReportExist(mclsAgeSet.AgeReportID) Then
        mblnFatalErr = True
        Unload Me
        Exit Sub
    End If
    
    MsgForm.PleaseWait
    GraphicsAnalysis
    Unload MsgForm
End Sub

'改变当前页
Private Sub CmdPage_Click(Index As Integer)
    Dim i As Integer
    Dim nHeight As Integer
    On Error Resume Next
    nHeight = lPage(0).Height + Lcaption(0).Height + 90
    i = Picpage.Height / nHeight
    If i > 10 Then i = 10
    If Index = 1 Then
         If mlngCurPage > 0 Then
             mlngCurPage = mlngCurPage - 1
             If mlngCurPage <= VSpage.Value Then
                If VSpage.Value > 0 Then
                    VSpage.Value = VSpage.Value - 1
                End If
                SetPageContents VSpage.Value, mlngPages
             End If
            SetData
        End If
    ElseIf Index = 2 Then
        If mlngCurPage < mlngPages Then
             mlngCurPage = mlngCurPage + 1
             If mlngCurPage > VSpage.Value + i - 1 Then
                VSpage.Value = VSpage.Value + 1
                SetPageContents VSpage.Value, mlngPages
             End If
             SetData
        End If
    ElseIf Index = 0 Then
        mlngCurPage = 0
        VSpage.Value = 0
        SetPageContents VSpage.Value, mlngPages
        SetData
    ElseIf Index = 3 Then
        mlngCurPage = mlngPages - 1
        If mlngPages > i Then VSpage.Value = mlngPages - i '- 1
        SetPageContents VSpage.Value, mlngPages
        SetData
    End If
End Sub

'打印:      请注意：帐龄分析报表的起始页为 0
Private Sub CmdPrint_Click()
    Dim frm As New frmPrint
    Dim i As Long
    Dim oldPage As Long
    Dim lngStartPage, lngEndPage As Long
    Dim oldGridTop As Long
    Dim oldNegative As Long
    If Not Report.MyReportExist(mclsAgeSet.AgeReportID) Then
        mblnFatalErr = True
        Unload Me
        Exit Sub
    End If
    
    If frm.ShowFrmPrint(1, mlngPages, mclsFset.PrintSetupID) Then
        ABook.PrintDataOnly = frm.GblnIsTaoda
        mclsFset.InitPropertyByDataBase 6, mclsAgeSet.AgeReportID
        GetDefaultSet

'    If frm.ShowFrmPrint(1, CInt(mlngPages), mclsAgeSet.PrintID) Then
''        ABook.PrintDataOnly = frm.GblnIsTaoda '是否套打
'        mclsFset.RefreshDB mclsAgeSet.AgeReportID
'        GetDefaultSet mclsFset
        oldPage = mlngCurPage
        oldGridTop = ABook.GridTop
        If frm.GIsPrintOnPrinter Then       '打印
            Dim x As Printer
            Dim strDevName As String
            For Each x In Printers
                If x.DeviceName = frm.GDeviceName Then
                    If mblnOrient Then
                        ABook.SelectPrinter x.DeviceName, x.DriverName, x.Port, PaperHeight / 5.67, PaperWidth / 5.67, 1, mclsFset.GPaperTypeIndex
                    Else
                        ABook.SelectPrinter x.DeviceName, x.DriverName, x.Port, PaperWidth / 5.67, PaperHeight / 5.67, 2, mclsFset.GPaperTypeIndex
                    End If
                    GoTo PrintStart
                End If
            Next
            Set frm = Nothing
            MsgBox "未发现选定打印机(" & frm.GDeviceName & ")"
            Exit Sub
PrintStart:
            ABook.StartPrint mclsAgeSet.AgeName
            
            
            MsgForm.PleaseWait "正在输出到打印机，请稍候…"
            oldNegative = ABook.Negative
            If frm.GIsColorPrint Then           '彩色打印
                ABook.Negative = 1                  '将负数设为红字
            Else
                ABook.Negative = 0
            End If
            
            If frm.GPrintRange = 0 Then         '全部打印
                lngStartPage = 0
                lngEndPage = mlngPages - 1
            Else                                '从 X 页到 Y 页
                lngStartPage = frm.GBeginPagePrint - 1
                lngEndPage = frm.GEndPagePrint - 1
            End If
            
            If frm.GIsPagebyPage Then         '逐份打印
                For i = 1 To frm.GCopiesPrint       '打印份数
                    If Not frm.GIsDoublePrint Then          '单面打印
                        For mlngCurPage = lngStartPage To lngEndPage
                            SetData
                            ABook.PrintDirect
                        Next mlngCurPage
                    Else                                    '双面打印
                        
'********************************     奇数页        ************************************************

                        If frm.GIsPrintByOrderOne Then          '按顺序 1 打印，起始页必须为偶数 (4,2,0)
                            For mlngCurPage = (lngEndPage \ 2) * 2 To lngStartPage Step -2 '5,3,1
                                SetData
                                ABook.PrintDirect
                            Next mlngCurPage
                        Else                                    '不按顺序 1 打印，起始页必须为偶数 (0,2,4)
                            For mlngCurPage = lngStartPage + IIf(lngStartPage Mod 2 <> 0, 1, 0) To lngEndPage Step 2  '1,3,5
                                SetData
                                ABook.PrintDirect
                            Next mlngCurPage
                        End If
                                
'*******************************    偶数页          **************************************************

                        If frm.GIsPrintbyPrderTwo Then          '按顺序 2 打印，起始页必须为奇数 (5,3,1)
                            For mlngCurPage = lngEndPage + IIf(lngEndPage Mod 2 <> 0, 0, -1) To lngStartPage Step -2  '6,4,2
                                SetData
                                ABook.PrintDirect
                            Next mlngCurPage
                        Else                                    '当前页必须为奇数 (1,3,5)
                            For mlngCurPage = lngStartPage + IIf(lngStartPage Mod 2 <> 0, 0, 1) To lngEndPage Step 2 '2,4,6
                                SetData
                                ABook.PrintDirect
                            Next mlngCurPage
                        End If
                        
                    End If '单面打印
                Next i '打印份数
                
            Else '逐页打印
            
                If Not frm.GIsDoublePrint Then          '单面打印
                    For mlngCurPage = lngStartPage To lngEndPage
                        SetData
                        For i = 1 To frm.GCopiesPrint '打印份数
                            ABook.PrintDirect
                        Next i
                    Next mlngCurPage
                Else                                    '双面打印
                    If frm.GIsPrintByOrderOne Then          '按顺序 1 打印，起始页必须为偶数 (4,2,0)
                        For mlngCurPage = (lngEndPage \ 2) * 2 To lngStartPage Step -2  '5,3,1
                            SetData
                            For i = 1 To frm.GCopiesPrint
                                ABook.PrintDirect
                            Next i
                        Next mlngCurPage
                    Else                    '不按顺序 1 打印，起始页必须为偶数 (0,2,4)
                        For mlngCurPage = lngStartPage + IIf(lngStartPage Mod 2 <> 0, 1, 0) To lngEndPage Step 2 '1,3,5
                            SetData
                            For i = 1 To frm.GCopiesPrint
                                ABook.PrintDirect
                            Next i
                        Next mlngCurPage
                    End If
                        
                    If frm.GIsPrintbyPrderTwo Then          '按顺序 2 打印，起始页必须为奇数 (5,3,1)
                        For mlngCurPage = lngEndPage + IIf(lngEndPage Mod 2 <> 0, 0, -1) To lngStartPage Step -2 '6,4,2
                            SetData
                            For i = 1 To frm.GCopiesPrint
                                ABook.PrintDirect
                            Next i
                        Next mlngCurPage
                    Else                                '按顺序 2 打印，起始页必须为奇数 (1,3,5)
                        For mlngCurPage = lngStartPage + IIf(lngStartPage Mod 2 <> 0, 0, 1) To lngEndPage Step 2 '2,4,6
                            SetData
                            For i = 1 To frm.GCopiesPrint
                                ABook.PrintDirect
                            Next i
                        Next mlngCurPage
                    End If
                    
                End If '单面打印
            End If '逐份打印
        
            ABook.EndPrint
            mlngCurPage = oldPage
            ABook.GridTop = oldGridTop
            ABook.Negative = oldNegative
'            SetData
            Unload MsgForm
            
        Else                '输出到文件
            Dim aaa As New FileSeverClass
            
            msgFileTitle.Rows = 1
'            msgFileTitle.Cols = msgAccount.Cols
'            For i = 0 To msgFileTitle.Cols - 1
'                msgFileTitle.TextMatrix(0, i) = "Field" & CStr(i)
'            Next i
'            msgAccount.FixedRows = 0
            If frm.GintFileType = 4 Then
                If Not aaa.SaveAS(frm.GStrFileName, 4, msgFileTitle, , msgAccount, , mclsAgeSet.AgeName, frm.GintFileIndex) Then
                    ShowMsg Me.hWnd, "文件保存不成功！", vbOKOnly + vbCritical
                End If
            ElseIf frm.GintFileType = 5 Then   '打印到电子表格
                PrintToEt frm
            Else
                If Not aaa.SaveAS(frm.GStrFileName, frm.GintFileType, msgFileTitle, , msgAccount, , mclsAgeSet.AgeName) Then
                    ShowMsg Me.hWnd, "文件保存不成功！", vbOKOnly + vbCritical
                End If
            End If
''            msgAccount.FixedRows = 1
            Set aaa = Nothing
        End If
    Else
'        mclsFset.r mclsAgeSet.AgeReportID
        GetDefaultSet
    End If
    If DispartPage Then SetData                      '设置数据
    Set frm = Nothing
    
End Sub

'保存
Private Sub cmdSave_Click()
    If Not Report.MyReportExist(mclsAgeSet.AgeReportID) Then
        mblnFatalErr = True
        Unload Me
        Exit Sub
    End If
    
    On Error Resume Next
''    If mclsAgeSet.AgePre = 1 Then
''       If (MsgBox("预置报表不能直接存盘,另存否?", vbYesNo)) = vbYes Then
''            cmdSaveAs_Click
''       End If
''       Exit Sub
''    End If
        
    MsgForm.PleaseWait "正在保存数据，请稍候…"
    GetColWidths
    mclsFormCond.KeyID = mclsAgeSet.AgeReportID
    mclsFormCond.UpdateCond
    mclsAgeSet.SaveWizard
    SavePeriodWidth
    Unload MsgForm
    mblnChanged = False
    gclsSys.SendMessage Me.hWnd, msgReport
End Sub
'打印到电子表格
Private Sub PrintToEt(frm As frmPrint)
    Dim clsEtPrint As New clsReport2ET
    SetEtFormatSet clsEtPrint, mclsFset       '设置ET格式（HB）
    SetEtColTitle clsEtPrint                 '设置ET列标题
    SetEtFreeCell clsEtPrint                '设置ET自由单元
    clsEtPrint.SaveAS frm.GStrFileName, msgAccount
    Set clsEtPrint = Nothing
End Sub

'初始化图形分析数组
Private Sub InitGraphyArr()
    Dim i, j, intIndex, intCount As Long 'Integer
'************************       图形分析数组        **************************************
    With msgAccount
        j = 0