frmagereport.frm

金算盘软件代码

        For i = 0 To .Cols - 2
            If (mbytColType(i) = 1) Then 'Or (mbytColType(i) = 0) Then
                j = j + 1
            End If
        Next i
        If .FixedCols > 0 Then j = j + .FixedCols
        
        If mclsAgeSet.IsGrouped Then
            intCount = .Rows - 1
        Else
            intCount = .Rows - 2
        End If
        
        ReDim mstrGraphics(1 To intCount, 1 To j)
        If intCount <= 1 Then mblnHaveData = False
        
        For i = 1 To intCount '.Rows
            intIndex = 1
            For j = 1 To .Cols - 2
                If .FixedCols >= j Then
'                    If Trim(.TextMatrix(i - 1, 0)) <> "合 计" Then
'                        mstrGraphics(i, intIndex) = GetNoXString(.TextMatrix(i - 1, 0), 1, " ")
'                    Else
                        mstrGraphics(i, intIndex) = .TextMatrix(i - 1, j - 1)
'                    End If
                    intIndex = intIndex + 1
                Else
                    If (mbytColType(j - 1) = 1) Then ' Or (mbytColType(j - 1) = 0) Then
                        mstrGraphics(i, intIndex) = .TextMatrix(i - 1, j - 1)
                        intIndex = intIndex + 1
                    End If
                End If
            Next j
        Next i
    End With
End Sub

'图形分析
Private Sub GraphicsAnalysis()
    On Error GoTo errhandle1
    Dim x As New GraphAnalysisClass
    InitGraphyArr       '初始化图形分析数组
    x.ShowArrayGraph gclsBase.BaseDB, mstrGraphics, , , msgAccount.FixedCols
    Set x = Nothing
    Exit Sub
errhandle1:
    If Not (x Is Nothing) Then Set x = Nothing
    Select Case Err.Number
        Case 7
            ShowMsg Me.hWnd, "内存不足,请先关闭部分窗体！", vbOKOnly + vbCritical, "系统错误"
        Case 336, 337, 338
            ShowMsg Me.hWnd, "图形控件不能正常加载！", vbOKOnly + vbCritical, "系统错误"
        Case Else
            ShowMsg Me.hWnd, " 未知的错误！", vbOKOnly + vbCritical, "系统错误"
    End Select
End Sub

'另存为
Private Sub cmdSaveAs_Click()
    Dim strName As String
    Dim OldID As Long
    If Not Report.MyReportExist(mclsAgeSet.AgeReportID) Then
        mblnFatalErr = True
        Unload Me
        Exit Sub
    End If
    strName = "未定义"
Label1:
    If Not frmReportSameName.ShowInputBox("当前报表另存为…", strName, "另存为") Then
        Exit Sub
    End If
    
    If Not CheckName(strName) Then GoTo Label1
    
    MsgForm.PleaseWait "正在保存数据，请稍候…"
    OldID = mclsAgeSet.AgeReportID
    '设置报表打印ID
    mclsAgeSet.PrintID = StandardReport.GetPrintSetupID(6, mclsAgeSet.AgeReportID)
    mclsAgeSet.AddReport
    mclsAgeSet.AgeName = strName
    mclsAgeSet.SaveWizard
    SavePeriodWidth
    mclsFormCond.KeyID = mclsAgeSet.AgeReportID
    mclsFormCond.UpdateCond
    Unload MsgForm
    SetGridTitle mclsAgeSet.AgeName
    ABook.Refresh
    Caption = "帐龄分析" & " - " & mclsAgeSet.AgeName           '窗体标题
    gclsSys.SendMessage Me.hWnd, msgReport
    mblnChanged = False
End Sub

'检查报表名称
Private Function CheckName(ByVal strName As String) As Boolean
    Dim strMsg As String
    Dim strTitle As String
    Dim strStr1 As String
    Dim rstTemp As rdoResultset
    
    If Trim(strName) = "" Then
        strMsg = "报表名称不允许为空，请重新设置报表名称。"
        strTitle = "错误操作：参数不足"
        ShowMsg Me.hWnd, strMsg, vbOKOnly + vbCritical, strTitle
        CheckName = False
        Exit Function
    End If
    
    If StrLen(strName) > 40 Then
        strMsg = "报表名称太长，请重新设置报表名称。"
        strTitle = "错误操作"
        ShowMsg Me.hWnd, strMsg, vbOKOnly + vbCritical, strTitle
        CheckName = False
        Exit Function
    End If
    
    strStr1 = "SELECT * FROM Report WHERE strReportName = '" & strName _
            & "' AND bytGroup = " & mclsAgeSet.GroupNo '.ParentId
    Set rstTemp = gclsBase.BaseDB.OpenResultset(strStr1, rdOpenStatic)
    If rstTemp.RowCount > 0 Then
        strMsg = "数据库中已有同名报表，请重新设置报表名称。"
        strTitle = "错误操作"
        ShowMsg Me.hWnd, strMsg, vbOKOnly + vbCritical, strTitle
        CheckName = False
        Exit Function
    End If
    
    CheckName = True
    Set rstTemp = Nothing
End Function


Private Sub CmdSpliter_Click()
    ReleaseCapture
    SetCapture Me.hWnd
    mbResizeing = True
End Sub


Private Sub Form_Activate()
    gclsSys.CurrFormName = Me.hWnd
'    frmMain.mnuFilePrint.Enabled = True
    Report.SetReportTlb
    SetHelpID 70003
'    frmMain.SetToolBar
End Sub

Private Sub Form_Deactivate()
    frmMain.mnuFilePrint.Enabled = False
    frmMain.SetEditUnEnabled
    frmMain.SetToolBar
End Sub


Private Sub Form_Load()
    On Error GoTo EndHandle

    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    Me.Visible = False
'    Me.Left = -30000
    MsgForm.PleaseWait
'    SetHelpID  70003
    mblnHaveHead = True
    msgAccount.Visible = False
    mintCurContents = 1
    cmdPaper.ToolTipText = "纸张大小：" & CInt(PicPaper.width / 56.7) & "毫米×" & CInt(PicPaper.Height / 56.7) & "毫米"
    ZoomIndex = 3
    PaperWidth = PicPaper.width
    PaperHeight = PicPaper.Height
    cmdZoom.ToolTipText = "当前放缩比:100%"
    cboAnaDate.AddRefer "开票日"
    cboAnaDate.AddRefer "到期日"
    mAutoRefresh = True
    Exit Sub
EndHandle:
    Unload Me
 End Sub


'设置字段名称
Private Sub InitGridTitle()
    Dim intCount As Integer
    Dim intCol As Integer
    Dim strTemp As String
    
    Me.Caption = "帐龄分析"
    
    With msgAccount
         intCol = 0
         .Row = 0
         .RowHeight(0) = lngTitleHeight
         For intCount = 0 To mclsAgeSet.ColNumber - 1       '普通字段名
            If mclsAgeSet.ColIsChoosed(intCount) And Not mclsAgeSet.IsHeadCol(intCount) Then
                .TextMatrix(0, intCol) = Trim(mclsAgeSet.colDesc(intCount))
                .ColWidth(intCol) = mclsAgeSet.ColWidth(intCount)
                .col = intCol
                .ColAlignment(intCol) = flexAlignLeftCenter
                .CellAlignment = flexAlignCenterCenter
                mbytColType(intCol) = 0
                mbolColGrouped(intCol) = mclsAgeSet.ColGrouped(intCount)
                intCol = intCol + 1
            End If
         Next intCount
         
         For intCount = 0 To mclsAgeSet.ColNumber - 1       '普通字段名
            If mclsAgeSet.ColIsChoosed(intCount) And mclsAgeSet.IsHeadCol(intCount) Then
                .TextMatrix(0, intCol) = Trim(mclsAgeSet.colDesc(intCount))
                .ColWidth(intCol) = mclsAgeSet.ColWidth(intCount)
                .col = intCol
                .ColAlignment(intCol) = flexAlignLeftCenter
                .CellAlignment = flexAlignCenterCenter
                mbytColType(intCol) = 1
                mbolColGrouped(intCol) = mclsAgeSet.ColGrouped(intCount)
                intCol = intCol + 1
            End If
         Next intCount
         
         
         For intCount = 0 To mclsAgeSet.PeriodNumber - 1    '区间字段
            
            .TextMatrix(0, intCol) = Trim(mclsAgeSet.PeriodName(intCount))
            .ColWidth(intCol) = mvarPeriodPerWidth(intCount * IIf(mclsAgeSet.IsGrouped, 2, 1))
            .col = intCol
            .ColAlignment(intCol) = flexAlignRightCenter
            .CellAlignment = flexAlignCenterCenter
            mbytColType(intCol) = 1
            intCol = intCol + 1
            
          If mclsAgeSet.IsGrouped Then
            .TextMatrix(0, intCol) = "百分比[%]"                    '百分比字段
            If mclsAgeSet.IsGrouped Then
                .ColWidth(intCol) = mvarPeriodPerWidth(intCount * IIf(mclsAgeSet.IsGrouped, 2, 1) + 1)
            Else
                .ColWidth(intCol) = 0
            End If
            .col = intCol
            .ColAlignment(intCol) = flexAlignRightCenter
            .CellAlignment = flexAlignCenterCenter
            mbytColType(intCol) = 2
            intCol = intCol + 1
          End If
        Next intCount
        
        .TextMatrix(0, intCol) = "合 计"            '行合计
        .ColWidth(intCol) = mvarPeriodPerWidth((mclsAgeSet.PeriodNumber) * IIf(mclsAgeSet.IsGrouped, 2, 1))
        .col = intCol
        .ColAlignment(intCol) = flexAlignRightCenter
        .CellAlignment = flexAlignCenterCenter
        mbytColType(intCol) = 3
         
        intCol = intCol + 1                         '各行所占百分比
        .TextMatrix(0, intCol) = "百分比[%]"
        .ColWidth(intCol) = mvarPeriodPerWidth((mclsAgeSet.PeriodNumber) * IIf(mclsAgeSet.IsGrouped, 2, 1) + 1)
        .col = intCol
        .ColAlignment(intCol) = flexAlignRightCenter
        .CellAlignment = flexAlignCenterCenter
        mbytColType(intCol) = 4
        
    End With
End Sub


'显示报表
Public Sub ShowAcntBook(ByVal lngReportID As Long, ByVal lngReportViewID, Optional clsAgeSet As Age = Nothing)
    Dim i As Long 'Integer
    Dim strSql As String
    Dim strTemp As String
    Dim recCurrencys As rdoResultset
    Dim strSQLCurr As String
    On Error GoTo EndHandle
    
    
    
    Set ABook = New ReportBook
    ABook.SetWin PicPaper.hWnd
    
    
    ABook.RowResize = True
    ABook.Version = Report.VersionInfo
    
    If ABook.IsInitSuccessed = 0 Then
        ShowMsg Me.hWnd, "未安装打印机或者未指定默认打印机。", vbOKOnly + vbCritical
        Unload Me
        Exit Sub
    End If
    mblnFormLoad = False
'    Me.Visible = False
'    Me.Left = -30000
    MsgForm.PleaseWait
    '显示已存盘的帐表
    If clsAgeSet Is Nothing Then
        Set mclsAgeSet = New Age
        Set mclsFormCond = New FormCond
        mclsFormCond.InitCondArr lngReportID, lngReportViewID, 2
        Select Case mclsFormCond.ViewId
            Case 610, 1005, 611, 1004
                mclsFormCond.EmployeeTag = 2
            Case Else
                mclsFormCond.EmployeeTag = 4
        End Select
        mclsAgeSet.strWhere = mclsFormCond.GetCond()
        strSql = mclsAgeSet.GetAgeReportSet(lngReportID, lngReportViewID)
    '显示才由向导生成的帐表
    Else
        Set mclsAgeSet = clsAgeSet
        strSql = mclsAgeSet.SQLString
    End If

    msgAccount.FixedCols = 0
    strSql = strReplace(strSql, "JZRQ", mclsAgeSet.AgeEndDate)
    Set mrstTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    
    If mrstTemp.RowCount > 0 Then
        mblnHaveData = True
    Else
        mblnHaveData = False
    End If
    
    msgAccount.Rows = mrstTemp.RowCount + 1
    Set Data1.Resultset = mrstTemp
    On Error GoTo 0
    Me.Caption = "帐龄分析"
    '************
    Set mclsFset = New ClsFormatset
    mclsFset.InitPropertyByDataBase 6, mclsAgeSet.AgeReportID
    GetDefaultSet
    '*****************
    
    InitGridRowCol                              '初始化表体的行列值
    
    '1999-12-17
    InitPeriodWidth

    
    InitGridTitle                               '设置字段名称
    
    For i = 1 To msgAccount.Rows - 1
        msgAccount.TextMatrix(i, msgAccount.Cols - 1) = "#"         '原始绑定数据
    Next i
    
    lblTitle = mclsAgeSet.AgeName '& strTemp

    blnIsNewDisplay = True
    cboAnaDate.Text = mclsAgeSet.AgeDateDesc
    mstrStartDate = cboAnaDate.Text
    #If conVersionType = 16 Then
        If gclsBase.ControlAccount = False Then
            cboAnaDate.Visible = False
            lblAnaDate.Visible = False
        End If
    #End If
    GacEndDate.Text = Format(CDate(mclsAgeSet.AgeEndDate), "yyyy-mm-dd")
    mdatEndDate = CDate(GacEndDate.Text)
    mRecordNumber = mrstTemp.RowCount
    '*****************
    LSTCurrencys.SeekCol = "1,2,3"
    strSQLCurr = "select lngCurrencyID as a1,strCurrencyCode as a2,strCurrencyName as a3 from currencys where blnIsInActive=0 order by lngCurrencyID "
    Set recCurrencys = gclsBase.BaseDB.OpenResultset(strSQLCurr, rdOpenStatic)
    Set LSTCurrencys.Resultset = recCurrencys
    LSTCurrencys.AddRefer "   " & "本位币", 0, 1