资金使用计划.frm

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

    stbState.Panels("sconfirm").Text = "复核人: " & GetHead("sconfirm")
    stbState.Panels("scheck").Text = "审核人: " & GetHead("scheck")
End Sub

Private Sub FindMergePos(top As Integer, bottom As Integer, sID As String)
    Dim root As IXMLDOMElement
    Dim Node As IXMLDOMElement
    Set root = m_objContent.documentElement
    Dim flag As Boolean
    Dim tmp
    Dim i As Integer
    
    i = 2
    For Each Node In root.childNodes
        tmp = GetHead("mergeid", Node)
        If IsNull(tmp) Then
            flag = False
        ElseIf Not flag And tmp = sID Then
            flag = True
            top = i
        ElseIf flag And tmp <> sID Then
            bottom = i - 1
            sID = CInt(sID) + 1
            Exit Sub
        ElseIf flag And Node Is root.lastChild Then
            bottom = i
            sID = CInt(sID) + 1
            Exit Sub
        End If
        i = i + 1
    Next
End Sub

Private Sub MergeRow()
    Dim top As Integer, bottom As Integer
    Dim old As String
    Dim nw As String
    Dim width As Integer

    old = "1"
    nw = "1"
    top = 2
    While True
        old = nw
        FindMergePos top, bottom, nw
        If nw <> old Then
            If mID(GetContent(1, top, "iflid"), 1, 1) = "-" Or GetContent(1, top, "scaptionh") = GetContent(1, top, "scaptionc") Then
                ocxCell.MergeCells 1, top, 2, bottom
            Else
                ocxCell.MergeCells 1, top, 1, bottom
            End If
        Else
            If top > bottom Then
                ocxCell.MergeCells 1, top, 2, top
            Else
                ocxCell.MergeCells 1, top, 2, bottom
            End If
            Exit Sub
        End If
    Wend
End Sub

'状态控制
Private Sub SetTitle()
    Dim mode As String
    Dim proc As String
    
    mode = GetHead("smode")
    proc = GetHead("operation")
    If mode = "0" Then '申报模式
        SetHead "sname", txtsName.Text
        SetHead "sunitname", txtsUnitname.Text
        SetHead "dstart", txtdStart.Text
        SetHead "dend", txtdEnd.Text
        SetHead "ddeclare", txtdDeclare.Text
        stbState.Panels("sbill").Text = "制单人: " & GetHead("sbill")
        stbState.Panels("sconfirm").Text = "复核人: " & GetHead("sconfirm")
    Else    '审核模式
        stbState.Panels("scheck").Text = "审核人: " & GetHead("scheck")
        If proc <> "desert" Then
            SetHead "dapprove", txtdApprove.Text
        Else
            txtdApprove.Text = GetHead("dapprove")
        End If
    End If
End Sub

Private Sub SetPageInfo()
    If m_arrReportID.count = 0 Then '没有数据
        tlbTool.Buttons("first").Enabled = False
        tlbTool.Buttons("last").Enabled = False
        tlbTool.Buttons("next").Enabled = False
        tlbTool.Buttons("previous").Enabled = False
        stbState.Panels("position").Text = "位置信息: "
    ElseIf m_arrReportID.count = 1 Then '一条数据
        tlbTool.Buttons("first").Enabled = True
        tlbTool.Buttons("last").Enabled = False
        tlbTool.Buttons("next").Enabled = False
        tlbTool.Buttons("previous").Enabled = False
        stbState.Panels("position").Text = "位置信息: 1/1"
    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 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
    txtBudget.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
        txtBudget.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
        txtBudget.Enabled = False
    End If
End Sub

Private Sub ClearReportInfo()
    Dim mode As String
    
    mode = GetHead("smode")
    If mode = "0" Then
        txtsName.Text = ""
        stbState.Panels("state").Text = "当前状态: 申报"
    ElseIf mode = "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 = ""
    txtBudget.Text = ""
End Sub

Private Sub SwitchState(mode As String)
    If mode = "0" Then
        stbState.Panels("state").Text = "当前状态: 申报"
        lbTitle.Caption = "资金使用计划申报表"
        tlbTool.Buttons("audit").Visible = False
        tlbTool.Buttons("append").Visible = False
        tlbTool.Buttons("fill").Visible = False
        tlbTool.Buttons("append").Visible = False
    ElseIf mode = "1" Then
        stbState.Panels("state").Text = "当前状态: 审批"
        lbTitle.Caption = "资金使用计划审批表"
        tlbTool.Buttons("desert").Visible = True
        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
        tlbTool.Buttons("confirm").Visible = False
    Else
        stbState.Panels("state").Text = "当前状态: 分析"
        lbTitle.Caption = "资金使用计划分析表"
        tlbTool.Buttons("sep").Visible = False
        tlbTool.Buttons("add").Visible = False
        tlbTool.Buttons("delete").Visible = False
        tlbTool.Buttons("edit").Visible = False
        tlbTool.Buttons("cancel").Visible = False
        tlbTool.Buttons("save").Visible = False
        tlbTool.Buttons("confirm").Visible = False
        tlbTool.Buttons("desert").Visible = False
    End If
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 GetHead("operation") = "add" Then
        m_arrReportID.Add GetHead("iid"), GetHead("iid")
        m_iPos = m_arrReportID.count
    End If
    
    If GetHead("operation") <> "" Then
        ManageAddon False
    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='1' operation='add'/>"
    SetHead "sbill", zjLogInfo.cUserName
    SetHead "addon", "#" & lTmpID '保存附表使用计划id
    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()
    Go2 1
End Sub

Private Sub GoLast()
    Go2 m_arrReportID.count
End Sub

Private Sub GoNext()
    Go2 m_iPos + 1
End Sub

Private Sub GoPre()
    Go2 m_iPos - 1
End Sub

Private Sub DeleteData()
    If m_iPos = 0 Or GetHead("operation") <> "" Then
        Exit Sub
    End If
    Dim tmp As Integer
    If iShowMsg("确定要删除记录吗?", vbYesNo) = vbYes Then
        m_objMgr.DeleteReport m_objHead, m_objError
        If PrintError(m_objError) Then Exit Sub
        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
        
        '删除附表数据
        ManageAddon True, GetHead("iid")
    Else
        Exit Sub
    End If
End Sub

Private Sub SetChange()
    '只能修改现有的,新增的或已经修改的不能重复修改
    SetHead "addon", "#" & lTmpID
    SetHead "operation", "edit"