资金预算.frm

财务信息管理系统,适合做毕业论文的人使用

    ElseIf m_arrReportID.count <> 1 And m_iPos = m_arrReportID.count Then   '最后一条
        tlbTool.Buttons("first").Enabled = True
        tlbTool.Buttons("last").Enabled = True
        tlbTool.Buttons("next").Enabled = False
        tlbTool.Buttons("previous").Enabled = True
        stbState.Panels("position").Text = "位置信息: " & m_iPos & "/" & m_arrReportID.count
    ElseIf m_arrReportID.count <> 1 And m_iPos = 1 Then '最前一条
        tlbTool.Buttons("first").Enabled = True
        tlbTool.Buttons("last").Enabled = True
        tlbTool.Buttons("next").Enabled = True
        tlbTool.Buttons("previous").Enabled = False
        stbState.Panels("position").Text = "位置信息: " & m_iPos & "/" & m_arrReportID.count
    Else    '中间
        tlbTool.Buttons("first").Enabled = True
        tlbTool.Buttons("last").Enabled = True
        tlbTool.Buttons("next").Enabled = True
        tlbTool.Buttons("previous").Enabled = True
        stbState.Panels("position").Text = "位置信息: " & m_iPos & "/" & m_arrReportID.count
    End If
    
    SetButtonState
End Sub

Private Sub SetTableState()
    ocxCell.ShowPageBreak 0
    ocxCell.ShowSideLabel 0, 0
    ocxCell.ShowTopLabel 0, 0
    ocxCell.ShowSheetLabel 0, 0
    ocxCell.ReadOnly = 1
    ocxCell.SetRows 2, 0
    ocxCell.MoveDir = 2
 End Sub
 
Private Sub SwitchState(mode As String)
    If mode = "0" Then
        lbTitle.Caption = "资金预算申报表"
        stbState.Panels("state").Text = "当前状态: 申报"
        tlbTool.Buttons("audit").Visible = False
        tlbTool.Buttons("append").Visible = False
        tlbTool.Buttons("fill").Visible = False
        tlbTool.Buttons("append").Visible = False
    ElseIf mode = "1" Then
        lbTitle.Caption = "资金预算审批表"
        stbState.Panels("state").Text = "当前状态: 审批"
        tlbTool.Buttons("confirm").Visible = False
        tlbTool.Buttons("add").Visible = False
        tlbTool.Buttons("edit").Visible = False
        tlbTool.Buttons("delete").Visible = False
        tlbTool.Buttons("save").Visible = True
        tlbTool.Buttons("fill").Visible = True
        tlbTool.Buttons("append").Visible = True
        tlbTool.Buttons("audit").Visible = True
    Else
        lbTitle.Caption = "资金预算分析报表"
        stbState.Panels("state").Text = "当前状态: 分析"
        tlbTool.Buttons("sep").Visible = False
        tlbTool.Buttons("add").Visible = False
        tlbTool.Buttons("delete").Visible = False
        tlbTool.Buttons("confirm").Visible = False
        tlbTool.Buttons("edit").Visible = False
        tlbTool.Buttons("cancel").Visible = False
        tlbTool.Buttons("save").Visible = False
        tlbTool.Buttons("desert").Visible = False
    End If
End Sub

Private Sub SetPassive()
    txtsName.Enabled = False
    txtsUnitname.Enabled = False
    txtdStart.Enabled = False
    btndStart.Enabled = False
    btndEnd.Enabled = False
    txtdEnd.Enabled = False
    btnApprove.Enabled = False
    btnDeclare.Enabled = False
    txtdDeclare.Enabled = False
    txtdApprove.Enabled = False
End Sub

Private Sub SetEdit()
    If GetHead("smode") = "0" Then
        txtsUnitname.Enabled = True
        txtdStart.Enabled = True
        btndStart.Enabled = True
        btndEnd.Enabled = True
        btnApprove.Enabled = False
        btnDeclare.Enabled = True
        txtdDeclare.Enabled = True
        txtdApprove.Enabled = False
        txtdEnd.Enabled = True
        txtsName.Enabled = True
    Else
        txtsUnitname.Enabled = False
        txtdStart.Enabled = False
        btndStart.Enabled = False
        btndEnd.Enabled = False
        btnApprove.Enabled = True
        btnDeclare.Enabled = False
        txtdDeclare.Enabled = False
        txtdApprove.Enabled = True
        txtdEnd.Enabled = False
        txtsName.Enabled = False
        tlbTool.Buttons("fill").Enabled = True
    End If
End Sub

Private Sub ClearReportInfo()
    If GetHead("smode") = "0" Then
        txtsName.Text = ""
        stbState.Panels("state").Text = "当前状态: 申报"
    ElseIf GetHead("smode") = "1" Then
        txtsName.Text = ""
        stbState.Panels("state").Text = "当前状态: 审批"
    Else
        txtsName.Text = ""
        stbState.Panels("state").Text = "当前状态: 分析"
    End If
    txtdStart.Text = ""
    txtdEnd.Text = ""
    txtsUnitname.Text = ""
    txtdApprove.Text = ""
    txtdDeclare.Text = ""
End Sub

'菜单事件实现方法
Private Sub Reload()
    Query m_sWhere, m_iPos
End Sub

Private Sub SaveData()
    Dim proc As String
    
    proc = GetHead("operation")
    
    If proc = "" Then
        Exit Sub
    End If
    
    If Not bCheckTitle Then
       Exit Sub
    End If
    
    SetTitle
    
    '检查头部信息
    If proc <> "confirm" And proc <> "desert" Then
        m_objMgr.CheckHead m_objHead, Nothing, m_objError
    End If
    
    If PrintError(m_objError) Then
        Exit Sub
    End If
        
    TableToDB
    
    If proc = "add" Then
        m_arrReportID.Add GetHead("iid"), GetHead("iid")
        m_iPos = m_arrReportID.count
    End If
    
    SetHead ("operation"), ""
    SetPassive
    SetPageInfo
End Sub

Private Sub Output()
    Dim doc As DOMDocument
    Dim root As IXMLDOMElement
    
    On Error Resume Next
    comFile.Filename = ""
    comFile.DefaultExt = "xls"
    comFile.Flags = cdlOFNOverwritePrompt Or cdlOFNPathMustExist Or cdlOFNLongNames Or cdlOFNExtensionDifferent Or cdlOFNHideReadOnly
    comFile.Filter = "Text Files(*.txt)|*.txt|Excel Files(*.xls)|*.xls|Html Files(*.html)|*.html|Xml Files(*.xml)|*.xml"
    If GetHead("iid") <> "" Then
        comFile.Filter = comFile.Filter & "|Mdb Files(*.mdb)|*.mdb"
    End If
    comFile.FilterIndex = 1
    comFile.ShowSave
    If Trim(comFile.Filename) <> "" And Not m_objContent Is Nothing Then
        
        Select Case comFile.FilterIndex
            Case 1 '文本文件
                HeadToTable
                If ocxCell.ExportTextFile(" ", comFile.Filename, 0) = 0 Then
                    iShowMsg "输出失败!"
                Else
                    iShowMsg "输出成功!"
                End If
                RemovePrintPart
            Case 2 'excel文件
                HeadToTable
                If ocxCell.ExportExcelFile(comFile.Filename) = 0 Then
                    iShowMsg "输出失败!"
                Else
                    iShowMsg "输出成功!"
                End If
                RemovePrintPart
            Case 3 'html文件
                HeadToTable
                If ocxCell.ExportHtmlFile(comFile.Filename) = 0 Then
                    iShowMsg "输出失败!"
                Else
                    iShowMsg "输出成功!"
                End If
                RemovePrintPart
            Case 4 'xml文件
                Set doc = m_objAid.objGenerateUFDom("roottag", "fd")
                Set root = m_objAid.objSelectRootTag(doc)
                root.appendChild m_objTable.documentElement
                root.appendChild m_objHead.documentElement
                root.appendChild m_objContent.documentElement
                doc.Save comFile.Filename
                If Err.Number <> 0 Then
                    iShowMsg "输出失败!"
                Else
                    iShowMsg "输出成功!"
                End If
            Case 5 'mdb
                If Not bOutputAsMdb(GetHead("iid"), comFile.Filename) Then
                    iShowMsg "输出失败!"
                Else
                    iShowMsg "输出成功!"
                End If
            Case Else
        End Select
    End If
End Sub

Private Sub AddNew()
    m_objHead.loadXML "<head smode='0' btype='0' operation='add'/>"
    SetHead "sbill", zjLogInfo.cUserName
    m_objMgr.NewReport m_objContent, m_objError
    If PrintError(m_objError) Then Exit Sub
    SetEdit
    DomToTable
End Sub

Private Sub Cancel()
    If iCheck = vbCancel Then
        Exit Sub
    End If
End Sub

Private Sub Go2(pos As Integer)
    m_iPos = pos
    DomToTable
End Sub

Private Sub GoFirst()
    If iCheck = vbCancel Then
        Exit Sub
    End If
    
    Go2 1
End Sub

Private Sub GoLast()
    If iCheck = vbCancel Then
        Exit Sub
    End If
    
    Go2 m_arrReportID.count
End Sub

Private Sub GoNext()
    If iCheck = vbCancel Then
        Exit Sub
    End If
    
    Go2 m_iPos + 1
End Sub

Private Sub GoPre()
    If iCheck = vbCancel Then
        Exit Sub
    End If
    
    Go2 m_iPos - 1
End Sub

Private Sub DeleteData()
    Dim tmp As Integer
    
    '提示删除
    If iShowMsg("确定要删除记录吗?", vbYesNo) = vbYes Then
        '获取删除后的位置
        tmp = m_iPos
        If m_iPos < m_arrReportID.count Then
            m_iPos = m_iPos + 1
        Else
            m_iPos = m_iPos - 1
        End If
        '删除
        m_arrReportID.Remove tmp
        m_objMgr.DeleteReport m_objHead, m_objError
        If PrintError(m_objError) Then Exit Sub
        DomToTable
    Else
        Exit Sub
    End If
End Sub

Private Sub SetChange()
    SetHead "operation", "edit"
    SetHead "sbill", zjLogInfo.cUserName
    SetEdit
    SetButtonState
End Sub

Private Sub Audit()
    '如果未审批,且制单人和当前操作人员不同
    SetHead "operation", "audit"
    SetHead "scheck", zjLogInfo.cUserName
    SetEdit
    SetButtonState
    tlbTool.Buttons("fill").Enabled = True
End Sub

Private Sub Append()
    '必须是已经审批通过的
    SetHead "operation", "append"
    SetHead "scheck", zjLogInfo.cUserName
    SetEdit
    SetButtonState
    tlbTool.Buttons("fill").Enabled = True
End Sub

Private Sub Confirm()
    SetHead "operation", "confirm"
    SetHead "sconfirm", zjLogInfo.cUserName
    SaveData
End Sub

Private Sub Desert()
    Dim Row As Integer
    Dim i As Integer
    
    If GetHead("smode") = "0" Then
        SetHead "operation", "desert"
        RemoveHead "sconfirm"
    Else
        Row = m_objContent.documentElement.childNodes.length + 1
        SetHead "operation", "desert"
        RemoveHead "scheck"
        RemoveHead "dapprove"
        For i = 2 To Row
            SetContent 1, i, "", "mapprove"
        Next
    End If
    SaveData
End Sub

Private Sub Query(Optional str As String, Optional pos As Integer = 0)
    m_objMgr.GetIDSerial m_arrReportID, objWrapWhere(str), m_objError
    If PrintError(m_objError) Then Exit Sub
    If m_arrReportID.count > 0 Then
        If pos = 0 Or pos > m_arrReportID.count Then
            Go2 1
        Else
            Go2 pos
        End If
    Else
        Go2 0
        iShowMsg "目前没有相关记录!"
    End If
End Sub

Private Sub FillMe()
    Dim Row As Integer
    Dim i As Integer
    
    Row = m_objContent.documentElement.childNodes.length + 1
    For i = 2 To Row
        SetContent 1, i, GetContent(-1, i, "mdeclare"), "mapprove"
    Next
End Sub

Private Sub PrintMe()
    HeadToTable
    ocxCell.PrintPara 1, 0, 1, 1
    ocxCell.PrintSheet 1, 0
    RemovePrintPart
End Sub

Private Sub Preview()
    HeadToTable
    ocxCell.PrintPara 1, 0, 1, 1
    ocxCell.PrintPreview 1, 0
    RemovePrintPart
End Sub

Private Sub QueryIt()
    If GetHead("smode") = "2" Then
        frmBudgetQuery.ShowAnalys (True)
    End If
    frmBudgetQuery.ReportType "0"
    frmBudgetQuery.Show vbModal
    If frmBudgetQuery.where <> "" Then
        m_sWhere = frmBudgetQuery.where
        m_iBook = frmBudgetQuery.book
        Query m_sWhere, 1
    End If