资金预算.frm

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

End Sub

Private Sub Quit()
    Unload Me
End Sub

'报表求小计
Private Sub GetSum(Optional mode As String)
    Dim Cur As Integer
    Dim Row As Integer
    Dim i As Integer
    Dim j As Integer
    Dim keyword As String
    Dim income As Double, outcome As Double, sum As Double
    Dim inpos As Integer, outpos As Integer
    
    Set m_objsum = New Collection
    Row = m_objContent.documentElement.childNodes.length
    Cur = CInt(m_objAid.GetAttributeVal("cur", m_objContent.documentElement))   '币种数目

    '来源总计
    i = Cur + 3
    If mode = "" Then
        mode = GetHead("smode")
    End If
    If mode = "1" Then
        mode = "mapprove"
    ElseIf mode = "0" Then
        mode = "mdeclare"
    End If
    
    sum = 0
    While GetContent(1, i, "iflid") <> "-3"
        keyword = GetContent(1, i, "scurcode") & "1"
        AddIt i, keyword, mode
        i = i + 1
    Wend
    inpos = i
    '支出总计
    i = i + Cur + 1
    sum = 0
    outpos = Row - 2 * Cur + 2
    While i < outpos
        keyword = GetContent(1, i, "scurcode") & "2"
        AddIt i, keyword, mode
        i = i + 1
    Wend
    '期末结存
    For i = 1 To Cur
        keyword = GetContent(1, i + 1, "scurcode")
        income = 0
        outcome = 0
        '计算来源
        On Error Resume Next
        income = CDbl(m_objsum.Item(keyword & "1"))
        If Err.Number <> 0 Then
            income = 0
            Err.clear
        End If
        SetContent -1, inpos, CStr(income), mode
        inpos = inpos + 1
        '计算支出
        outcome = CDbl(m_objsum.Item(keyword & "2"))
        If Err.Number <> 0 Then
            outcome = 0
            Err.clear
        End If
        SetContent -1, outpos, CStr(outcome), mode
        outpos = outpos + 1
        '计算合计
        If GetHead("smode") <> "2" Then
            SetContent -1, Row - Cur + i + 1, CStr(CDbl(GetContent(-1, i + 1, mode)) + income - outcome), mode
        End If
    Next
End Sub

Private Sub AddIt(Row As Integer, flag As String, mode As String)
    Dim mny As String
    Dim tmp As String
    
    mny = GetContent(-1, Row, mode)
    If mny = "" Then
        mny = 0
    End If
    On Error Resume Next
    m_objsum.Item (flag)
    If Err.Number <> 0 Then
        m_objsum.Add CStr(mny), flag
    Else
        tmp = m_objsum.Item(flag)
        m_objsum.Remove flag
        m_objsum.Add CStr(CDbl(mny) + CDbl(tmp)), flag
    End If
End Sub

'其他的帮助方法
Private Function iCheck() As Integer
    Dim sparam As String
    iCheck = 0
    If GetHead("operation") = "" Then
        Exit Function
    ElseIf GetHead("operation") = "add" Then
        sparam = "要保存增加的项目吗?"
    Else
        sparam = "要保存项目的修改吗?"
    End If
    iCheck = iShowMsg(sparam, vbYesNoCancel)
    If iCheck = vbNo Then
        SetHead "operation", ""
        DomToTable
    ElseIf iCheck = vbYes Then
        SaveData
    Else
        
    End If
End Function

Private Function bCheckTitle() As Boolean
    '检查时间格式
    Dim dstart As Date
    Dim dEnd As Date
    Dim dcur As Date
    Dim tmp As String
    Dim vTmp
        
    '非审批模式检查头部信息
    bCheckTitle = False
    If GetHead("smode") = "0" Then
        
        '编号不能为空
        If Trim(txtsName.Text) = "" Then
            iShowMsg "编号不能为空!"
            txtsName.Text = ""
            txtsName.SetFocus
            Exit Function
        End If
        
        '检查单位名称写了没有
        vTmp = vCheckExist("unit", Trim(txtsUnitname))
        If IsNull(vTmp) Then
            iShowMsg "非法的单位名称!"
            txtsUnitname.SetFocus
            Exit Function
        Else
            SetHead "accunit_id", CStr(vTmp)
        End If
        
        '检查开始时间填了吗
        txtdStart = m_objAid.sCheckDate(txtdStart)
        If Trim(txtdStart.Text) = "" Then
            iShowMsg "请填好起始时间!"
            txtdStart.SetFocus
            Exit Function
        End If
        
        '检查截至时间填了吗
        txtdEnd = m_objAid.sCheckDate(txtdEnd)
        If Trim(txtdEnd.Text) = "" Then
            iShowMsg "请填好截至时间!"
            txtdEnd.SetFocus
            Exit Function
        End If
        
        '检查开始时间填了吗
        txtdDeclare = m_objAid.sCheckDate(txtdDeclare)
        If Trim(txtdDeclare.Text) = "" Then
            iShowMsg "请填好申报时间!"
            txtdDeclare.SetFocus
            Exit Function
        End If
        
        '申报日期大于启用日期
        If m_objAid.iDateDiff(txtdDeclare, CStr(ZjAccInfo.zjStartdate)) > 0 Then
            iShowMsg "申报日期必须大于启用日期!"
            txtdDeclare.SetFocus
            Exit Function
        End If
        
        '申报时间小于等于登陆时间
        If m_objAid.iDateDiff(zjLogInfo.curDate, txtdDeclare) > 0 Then
            iShowMsg "申报日期必须小于等于登陆日期!"
            txtdDeclare.SetFocus
            Exit Function
        End If
        
        '起始日期必须大于申报日期
        If m_objAid.iDateDiff(txtdStart, txtdDeclare) >= 0 Then
            iShowMsg "起始日期必须大于申报日期!"
            txtdStart.SetFocus
            Exit Function
        End If
        
        '起始日期必须小于截至日期
        If m_objAid.iDateDiff(txtdStart, txtdEnd) <= 0 Then
            iShowMsg "输入的截至日期必须大于起始日期!"
            txtdEnd.SetFocus
            Exit Function
        End If
    Else
        txtdApprove = m_objAid.sCheckDate(txtdApprove)
        If Trim(txtdApprove.Text) = "" Then
            iShowMsg "请填写审批日期!"
            txtdApprove.SetFocus
            Exit Function
        End If
        
        If m_objAid.iDateDiff(txtdEnd, CStr(ZjAccInfo.zjStartdate)) > 0 Then
            iShowMsg "审批日期必须大于等于启用日期!"
            txtdApprove.SetFocus
            Exit Function
        End If
        
        '审批日期小于等于登陆日期
        If m_objAid.iDateDiff(zjLogInfo.curDate, txtdApprove) > 0 Then
            iShowMsg "审批日期必须小于等于登陆日期!"
            txtdApprove.SetFocus
            Exit Function
        End If
        
        '审批日期大于等于申报日期
        If m_objAid.iDateDiff(txtdApprove, txtdDeclare) > 0 Then
            iShowMsg "审批日期必须大于申报日期!"
            txtdApprove.SetFocus
            Exit Function
        End If
        
        '起始日期必须大于审批日期
        If m_objAid.iDateDiff(txtdStart, txtdApprove) >= 0 Then
            iShowMsg "起始日期必须大于审批日期!"
            txtdApprove.SetFocus
            Exit Function
        End If
    End If
    bCheckTitle = True
End Function

Private Sub LoadToolPic()
    With IltTool.ListImages
         .clear
         .Add , "print", LoadResPicture(314, vbResBitmap)
         .Add , "preview", LoadResPicture(312, vbResBitmap)
         .Add , "output", LoadResPicture(263, vbResBitmap)
         .Add , "add", LoadResPicture(323, vbResBitmap)
         .Add , "delete", LoadResPicture(326, vbResBitmap)
         .Add , "edit", LoadResPicture(324, vbResBitmap)
         .Add , "cancel", LoadResPicture(316, vbResBitmap)
         .Add , "refresh", LoadResPicture(154, vbResBitmap)
         .Add , "save", LoadResPicture(1145, vbResBitmap)
         .Add , "query", LoadResPicture(331, vbResBitmap)
         .Add , "help", LoadResPicture(396, vbResBitmap)
         .Add , "quit", LoadResPicture(1118, vbResBitmap)
         .Add , "first", LoadResPicture(1174, vbResBitmap)
         .Add , "last", LoadResPicture(1117, vbResBitmap)
         .Add , "previous", LoadResPicture(1139, vbResBitmap)
         .Add , "next", LoadResPicture(1133, vbResBitmap)
         
         .Add , "audit", LoadResPicture(1100, vbResBitmap)
         .Add , "desert", LoadResPicture(144, vbResBitmap)
         .Add , "append", LoadResPicture(143, vbResBitmap)
         .Add , "fill", LoadResPicture(364, vbResBitmap)
         .Add , "confirm", LoadResPicture(309, vbResBitmap)
    End With
    
    With tlbTool
         Set .ImageList = IltTool
        
         .Buttons("print").Image = "print"
         .Buttons("preview").Image = "preview"
         .Buttons("output").Image = "output"
         .Buttons("cancel").Image = "cancel"
         .Buttons("add").Image = "add"
         .Buttons("edit").Image = "edit"
         .Buttons("delete").Image = "delete"
         .Buttons("refresh").Image = "refresh"
         .Buttons("save").Image = "save"
         .Buttons("help").Image = "help"
         .Buttons("query").Image = "query"
         .Buttons("quit").Image = "quit"
         .Buttons("first").Image = "first"
         .Buttons("last").Image = "last"
         .Buttons("previous").Image = "previous"
         .Buttons("next").Image = "next"
         .Buttons("confirm").Image = "confirm"
         .Buttons("audit").Image = "audit"
         .Buttons("desert").Image = "desert"
         .Buttons("append").Image = "append"
         .Buttons("fill").Image = "fill"
    End With
    
    btndStart.Picture = LoadResPicture(1108, vbResBitmap)
    btndEnd.Picture = LoadResPicture(1108, vbResBitmap)
    btnDeclare.Picture = LoadResPicture(1108, vbResBitmap)
    btnApprove.Picture = LoadResPicture(1108, vbResBitmap)
    btnUnitName.Picture = LoadResPicture(129, vbResBitmap)
    Me.Icon = LoadResPicture(109, vbResIcon)
End Sub

'设置菜单按钮的状态
Private Sub SetButtonState()
    Dim proc As String
    Dim mode As String
    Dim con As String
    Dim chk As String
    Dim bill As String
    
    mode = GetHead("smode")
    proc = GetHead("operation")
    con = GetHead("sconfirm")
    chk = GetHead("scheck")
    
    With tlbTool
    If m_iPos = 0 And m_objContent Is Nothing Then
        '打印
        .Buttons("preview").Enabled = False
        .Buttons("print").Enabled = False
        .Buttons("output").Enabled = False
        
        '
        If mode = "0" Then
            .Buttons("add").Enabled = True
            .Buttons("edit").Enabled = False
            .Buttons("delete").Enabled = False
            
            .Buttons("confirm").Enabled = False
            .Buttons("desert").Enabled = False
        ElseIf mode = "1" Then
            .Buttons("audit").Enabled = False
            .Buttons("append").Enabled = False
            .Buttons("desert").Enabled = False
            .Buttons("fill").Enabled = False
        End If
        
        .Buttons("cancel").Enabled = False
        .Buttons("save").Enabled = False
            
        .Buttons("refresh").Enabled = True
        .Buttons("query").Enabled = True
        
        '导航按钮
        .Buttons("first").Enabled = False
        .Buttons("last").Enabled = False
        .Buttons("next").Enabled = False
        .Buttons("previous").Enabled = False
    ElseIf proc <> "" Then
        '打印
        .Buttons("preview").Enabled = True
        .Buttons("print").Enabled = True
        .Buttons("output").Enabled = True
        
        If mode = "0" Then
            .Buttons("edit").Enabled = False
            .Buttons("add").Enabled = False
            .Buttons("delete").Enabled = False
            
            .Buttons("confirm").Enabled = False
            .Buttons("desert").Enabled = False
        ElseIf mode = "1" Then
            .Buttons("audit").Enabled = False
            .Buttons("append").Enabled = False
            .Buttons("fill").Enabled = False
        End If
        
        .Buttons("cancel").Enabled = True
        .Buttons("save").Enabled = True
            
        .Buttons("refresh").Enabled = False
        .Buttons("query").Enabled = False
        
        .Buttons("first").Enabled = False
        .Buttons("last").Enabled = False
        .Buttons("next").Enabled = False
        .Buttons("previous").Enabled = False
    Else
        .Buttons("preview").Enabled = True
        .Buttons("print").Enabled = True
        .Buttons("output").Enabled = True
        
        If mode = "1" Then
            .Buttons("audit").Enabled = True
            .Buttons("append").Enabled = True
            .Buttons("desert").Enabled = True
            .Buttons("fill").Enabled = False
        ElseIf mode = "0" Then
            .Buttons("edit").Enabled = True
            .Buttons("add").Enabled = True
            .Buttons("delete").Enabled = True
            .Buttons("confirm").Enabled = True
            .Buttons("desert").Enabled = True
        End If
        
        .Buttons("cancel").Enabled = False
        .Buttons("save").Enabled = False
        
        .Buttons("refresh").Enabled = True
        .Buttons("query").Enabled = True
        
        If mode = "0" Then
            If con = "" Then    '如果没有复核,可以修改
                If zjLogInfo.cUserName = GetHead("sbill") Then
                    .Buttons("confirm