资金预算.frm

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

        End If
        Set Node = m_objHead.documentElement
    End If
    
    Node.setAttribute sName, sValue
    
    '如果是改变模式
    If (sName = "smode") Then
        If sValue = "0" Then
            m_sWhere = " where fd_budgethead.btype='0'"
            Node.setAttribute "template", "budget_declare"
            Set m_objMgr = New U8BudgetMgr.clsBudgetImp
        ElseIf sValue = "1" Then
            m_sWhere = " where fd_budgethead.btype='0'"
            Node.setAttribute "template", "budget_approve"
            Set m_objMgr = New U8BudgetMgr.clsBudgetImp
        Else
            m_sWhere = " where fd_budgethead.btype='0'and fd_budgethead.dapprove is not null "
            Node.setAttribute "template", "budget_analys"
            Set m_objMgr = New U8BudgetMgr.clsAnalysAllImp
        End If
        '获取表头
        m_objMgr.Init zjLogInfo
        m_objMgr.GetTableHead m_objHead, m_objTable, m_objError
        If PrintError(m_objError) Then Exit Sub
        '获取符合条件的记录列表
        m_objMgr.GetIDSerial m_arrReportID, objWrapWhere(m_sWhere), m_objError
        If PrintError(m_objError) Then Exit Sub
'        SwitchState svalue
    End If
End Sub

Private Function GetHead(sName As String, Optional Node As IXMLDOMElement = Nothing) As String
    Dim tmp
    If Node Is Nothing Then
        Set Node = m_objHead.documentElement
    End If
    
    GetHead = m_objAid.GetAttributeVal(sName, Node)
    
'    '如果是名称
'    If sName = "sname" And GetHead = "" Then
'        GetHead = "资金预算申报表(##)"
'    End If
End Function

Private Sub RemoveHead(sName As String, Optional Node As IXMLDOMElement = Nothing)
    If Node Is Nothing Then
        Set Node = m_objHead.documentElement
    End If
    Node.removeAttribute sName
End Sub

'子表操作
Private Sub SetContent(ByVal Col As Integer, ByVal Row As Integer, sValue As String, Optional attr As String = "")
    Dim child As IXMLDOMElement
    Dim tmp As String
    Dim tp As String
    
    If attr = "" Then
        tmp = GetField(Col, "fieldname")
    Else
        tmp = attr
        Col = GetFieldIndex(attr)
    End If
   
    tp = GetField(Col, "type")
    
    If tp = "money" And sValue = "0" Then
        sValue = ""
    ElseIf tp = "int" Then
        sValue = m_objCurRef.getAttribute(sValue)
    End If
    
    Set child = m_objContent.documentElement.childNodes.Item(Row - 2)
    If sValue = "" Then
        RemoveHead tmp, child
    Else
        child.setAttribute tmp, sValue
    End If
        
    '如果数字字段为0,保存为空
    If tp = "int" Then
        ocxCell.SetCellString Col, Row, 0, m_objMgr.GetCur("cur" & sValue)
    Else
        ocxCell.SetCellString Col, Row, 0, sValue
    End If
End Sub
'
Private Function GetContent(ByVal Col As Integer, ByVal Row As Integer, Optional str As String) As String
    Dim child As IXMLDOMElement
    Dim tmp
    
    If str = "" Then
        tmp = GetField(Col, "fieldname")
    Else
        tmp = str
    End If
    
    Set child = m_objContent.documentElement.childNodes.Item(Row - 2)
    GetContent = m_objAid.GetAttributeVal(CStr(tmp), child)
    
    '如果是数字信息,而且内容为空的话,设置为0,计算时用
    tmp = GetField(Col, "type")
    If (Col = -1 Or tmp = "money") And GetContent = "" Then
        GetContent = "0"
    ElseIf tmp = "int" Then
        GetContent = m_objMgr.GetCur("cur" & GetContent)
    End If
End Function

Private Function GetField(ByVal Col, ByVal sValue As String) As String
    Dim child As IXMLDOMElement
    
    If IsNumeric(Col) Then
        Set child = m_objTable.documentElement.childNodes.Item(Col - 1)
    Else
        Set child = m_objTable.documentElement.selectSingleNode(Col)
    End If
    
    GetField = m_objAid.GetAttributeVal(sValue, child)
End Function

Private Function GetFieldIndex(ByVal sValue As String) As Integer
    Dim child As IXMLDOMElement
    
    GetFieldIndex = -1
    Set child = m_objTable.documentElement.selectSingleNode(sValue)
    GetFieldIndex = CInt(child.getAttribute("index"))
End Function

'cell和dom以及数据库间的转化
Private Sub DomToTable()
    Dim mode As String
    
    mode = GetHead("smode")
    
    If GetHead("operation") = "add" Then    '新建
        MakeTitle
        MakeHead
        MakeRow
        MergeRow
    ElseIf m_iPos = 0 Then  '没有数据,显示空表
            m_objHead.loadXML "<head smode='" & GetHead("smode") & "' btype='0'/>"
            ClearReportInfo
            ocxCell.ResetContent
            Set m_objContent = Nothing
            SetTableState
            SetPassive
            MakeHead
    Else    '显示已有的数据
        If m_objHead.documentElement.Attributes.length > 3 Then
            m_objHead.loadXML "<head smode='" & mode & "' btype='0'/>"
        End If
        SetHead "iid", m_arrReportID(m_iPos)
        SetHead "book", CStr(m_iBook)
        m_objMgr.GetReport m_objHead, m_objContent, m_objError
        If PrintError(m_objError) Then Exit Sub
        SetPassive
        MakeTitle
        MakeHead
        MakeRow
        MergeRow
''        If mode = "2" Then
'        GetSum "mapprove"
'        GetSum "mused"
''        End If
        
    End If
    SetPageInfo
End Sub

Private Sub TableToDB()
    '
    Dim proc As String
    
    proc = GetHead("operation")
    If GetHead("smode") = "0" And (proc = "desert" Or proc = "confirm") Then
        m_objMgr.SetReport m_objHead, Nothing, m_objError
    Else
        m_objMgr.SetReport m_objHead, m_objContent, m_objError
    End If
    If PrintError(m_objError) Then Exit Sub
End Sub

Private Sub MakeHead()
    Dim i As Integer
    Dim Col As Integer
    Dim tmp
    Dim left As Integer
    Dim right As Integer
    Dim cmergeid As String
    
    Col = m_objTable.documentElement.childNodes.length
    ocxCell.SetCols Col + 1, 0
    left = 0
    right = 0
    i = 1
    While i <= Col
'        tmp = GetField(i, "mergeid")
'        If tmp <> "" And tmp <> cmergeid Then
'            '定义起始位置
'            cmergeid = tmp
'            right = i
'            left = i
'        ElseIf tmp = "" Then
'            ocxCell.MergeCells left, 1, right, 1
'            right = right + 1
'            left = right
'        Else
'            right = right + 1
'        End If
        ocxCell.SetColWidth 0, CInt(GetField(i, "width")), i, 0
        ocxCell.SetCellString i, 1, 0, GetField(i, "caption")
        ocxCell.SetCellAlign i, 1, 0, 36
        ocxCell.SetCellFont i, 1, 0, ocxCell.FindFontIndex("宋体", 1)
        ocxCell.SetCellFontSize i, 1, 0, 9
        ocxCell.SetCellBackColor i, 1, 0, ocxCell.FindColorIndex(RGB(255, 128, 255), 1)
        i = i + 1
    Wend
    ocxCell.SetFixedCol 1, 1
End Sub

Private Sub MakeRow()
    Dim root As IXMLDOMElement
    Dim Node As IXMLDOMElement
    Dim Col As Integer
    Dim Row As Integer
    Dim i As Integer, j As Integer
    Dim tmp, tmp1
    Dim left As Integer, right As Integer, top As Integer, bottom As Integer
    Dim cmergeid As String, rmergeid As String
    
    '清空币种对照
    Set m_objCurRef = m_objAid.objMakeNode("ref")
    
    '获取行列数,设定行数
    Col = m_objTable.documentElement.childNodes.length
    Row = m_objContent.documentElement.childNodes.length
    ocxCell.SetRows Row + 2, 0
    cmergeid = "1"
    Set root = m_objContent.documentElement
    
    j = 2
    For Each Node In root.childNodes
        If GetHead("mergeallcol", Node) = "1" Then  '整行合并
            ocxCell.MergeCells 1, j, Col + 1, j
            ocxCell.SetCellAlign 1, j, 0, 33
            ocxCell.SetCellString 1, j, 0, GetHead(GetField(1, "fieldname"), Node)
            ocxCell.SetCellBackColor 1, j, 0, ocxCell.FindColorIndex(RGB(128, 255, 128), 1)
            ocxCell.SetCellFont 1, j, 0, ocxCell.FindFontIndex("宋体", 1)
            ocxCell.SetCellFontSize 1, j, 0, 9
        Else
            i = 1
            cmergeid = ""
            While i <= Col
              
                '设定单元格式
                tmp = GetField(i, "type")
                If (tmp = "money") Then    '数字
                    ocxCell.SetCellString i, j, 0, GetHead(GetField(i, "fieldname"), Node)
                ElseIf (tmp = "int") Then     '下拉框
                    If mID(GetHead("iflid", Node), 1, 1) <> "-" And GetHead("smode") = "0" Then
                        ocxCell.SetDroplistCell i, j, 0, m_objMgr.GetCur(), 0
                    End If
                    
                    tmp1 = GetHead(GetField(i, "fieldname"), Node)
                    tmp = m_objMgr.GetCur("cur" & tmp1)
                    ocxCell.SetCellString i, j, 0, tmp
                    '保存币种信息
                    On Error Resume Next
                    m_objCurRef.setAttribute tmp, tmp1
                ElseIf (tmp = "date") Then  '日期格式
                    ocxCell.SetCellDateStyle i, j, 0, 0
                Else    '普通处理
                    ocxCell.SetCellString i, j, 0, GetHead(GetField(i, "fieldname"), Node)
                End If
                
                ocxCell.SetCellAlign i, j, 0, 32 + CInt(GetField(i, "align"))
                If Node.getAttribute("readonly") = "1" Then '设置只读列颜色
                    ocxCell.SetCellBackColor i, j, 0, ocxCell.FindColorIndex(RGB(128, 255, 128), 1)
                ElseIf Node.getAttribute("sum") = "1" Then  '设置合计列颜色
                    ocxCell.SetCellBackColor i, j, 0, ocxCell.FindColorIndex(RGB(0, 128, 255), 1)
                End If
                ocxCell.SetCellFont i, j, 0, ocxCell.FindFontIndex("宋体", 1)
                ocxCell.SetCellFontSize i, j, 0, 9
                i = i + 1
            Wend
        End If
        j = j + 1
    Next
    ocxCell.SetFixedRow 1, 1
End Sub

Private Sub MakeTitle()
    Dim Node As IXMLDOMElement
    Set Node = m_objHead.documentElement
    txtsName.Text = GetHead("sname")
    txtsUnitname.Text = GetHead("sunitname")
    txtdStart.Text = m_objAid.sCheckDate(GetHead("dstart"))
    txtdEnd.Text = m_objAid.sCheckDate(GetHead("dend"))
    txtdDeclare.Text = m_objAid.sCheckDate(GetHead("ddeclare"))
    txtdApprove.Text = m_objAid.sCheckDate(GetHead("dapprove"))
    stbState.Panels("sbill").Text = "制单人: " & GetHead("sbill")
    stbState.Panels("scheck").Text = "审批人: " & GetHead("scheck")
    stbState.Panels("sconfirm").Text = "复核人: " & GetHead("sconfirm")
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
            ocxCell.MergeCells 1, top, 1, bottom
        Else
            If top > bottom Then
                ocxCell.MergeCells 1, top, 1, top
            Else
                ocxCell.MergeCells 1, top, 1, 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 "ddeclare", txtdDeclare.Text
        SetHead "dstart", txtdStart.Text
        SetHead "dend", txtdEnd.Text
        SetHead "ddeclare", txtdDeclare.Text
        stbState.Panels("sconfirm").Text = "复核人: " & GetHead("sconfirm")
        stbState.Panels("sbill").Text = "制单人: " & GetHead("sbill")
    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"