资金预算.frm

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

      Caption         =   "审批日期:"
      Height          =   255
      Left            =   7725
      TabIndex        =   15
      Top             =   1935
      Width           =   1095
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      Caption         =   "申报日期:"
      Height          =   255
      Left            =   4440
      TabIndex        =   14
      Top             =   1935
      Width           =   1095
   End
End
Attribute VB_Name = "frmBudget"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private m_objHead As New DOMDocument    '主表信息
Private m_objTable As DOMDocument   '表头信息
Private m_objContent As DOMDocument     '子表信息
Private m_objError As DOMDocument   '错误信息
Private m_arrReportID As Collection '查询结果id
Private m_iPos As Integer   '记录当前节点,和前者结合可实现导航
Private m_objMgr As U8BudgetMgr.IBudgetMgr    '数据库操作字段
Private m_objAid As New U8BudgetMgr.clsCommon   '辅助方法类
Private m_iRow As Integer   '记录当前列
Private m_iCol As Integer   '记录当前行
Private m_objsum As Collection  '排序用
Private m_sWhere As String  '当前的查询语句,刷新时用
Private m_iBook As Integer  '是否查询记账记录,分析时用
Private m_objCurRef As IXMLDOMElement     '保存币种的参照信息 中文名-id

Private Sub btnUnitName_Click()
    Dim rtn As ADODB.Recordset
    Dim str As String
    Dim Node As IXMLDOMElement
    
    On Error Resume Next
    
    Set Node = m_objRefTree.documentElement.selectSingleNode("unit")
    Set rtn = objShowCommonRef(Node.getAttribute("sql"), Node.getAttribute("fieldname"))
        
    If rtn Is Nothing Then
        Exit Sub
    End If
    
    While Not rtn.EOF
        str = str & "" & rtn(Node.getAttribute("showfield")) & ","
        rtn.MoveNext
    Wend
    If str <> "" Then
        txtsUnitname = mID(str, 1, Len(str) - 1)
    End If
End Sub

Private Sub btnUnitName_LostFocus()
    btnUnitName.Visible = False
End Sub


Private Sub Form_Resize()
    ResizeTlb Me
End Sub

Private Sub ocxCtbTool_OnCommand(ByVal enumType As prjTBCtrl.ENUM_MENU_OR_BUTTON, ByVal cButtonId As String, ByVal cMenuId As String)
        tlbTool_ButtonClick tlbTool.Buttons(cButtonId)
End Sub

Private Sub txtsName_LostFocus()
    If Len(Trim(txtsName.Text)) > 50 Then
        iShowMsg "要求名称不能超过50个字,请确认!"
        txtsName.SetFocus
    End If
End Sub

Private Sub txtsUnitname_GotFocus()
    btnUnitName.Visible = True
    '初始化单位定义参照
    If GetHead("operation") <> "" Then
        Dim tmp As New U8BudgetMgr.clsQueryParam
        tmp.sShowField = "cunitname"
        tmp.sContentField = "accunit_id"
        tmp.sTableName = "fd_accunit"
        tmp.sConString = g_sDataSourceName
        Dim str As String
    End If
End Sub

Private Sub txtsUnitname_LostFocus()
'    Dim tmp
    
'    txtsUnitname = Trim(txtsUnitname)
    If Me.ActiveControl.Name = "btnUnitName" Then
    
'    ElseIf txtsUnitname = "" Then
'        ishowmsg "必须选择一个单位!"
'        txtsUnitname.SetFocus
    Else
'        tmp = vCheckExist("unit", txtsUnitname)
'        If IsNull(tmp) Then
'            ishowmsg "单位错误!"
'            RemoveHead "accunit_id"
'            txtsUnitname.SetFocus
'        Else
'            SetHead "accunit_id", CStr(tmp)
'            btnUnitName.Visible = False
'        End If
        btnUnitName.Visible = False
    End If
End Sub

'日期参照事件
Private Sub txtdStart_GotFocus()
    btndStart.Visible = True
End Sub

Private Sub txtdApprove_GotFocus()
    btnApprove.Visible = True
End Sub

Private Sub txtdDeclare_GotFocus()
    btnDeclare.Visible = True
End Sub

Private Sub txtdEnd_GotFocus()
     btndEnd.Visible = True
End Sub

Private Sub btnApprove_LostFocus()
    btnApprove.Visible = False
End Sub

Private Sub btnDeclare_LostFocus()
    btnDeclare.Visible = False
End Sub

Private Sub btndEnd_LostFocus()
    btndEnd.Visible = False
End Sub

Private Sub btndStart_LostFocus()
    btndStart.Visible = False
End Sub

Private Sub btndEnd_Click()
    ShowDateRef txtdEnd
End Sub

Private Sub btndStart_Click()
    ShowDateRef txtdStart
End Sub

Private Sub btnDeclare_Click()
    ShowDateRef txtdDeclare
End Sub

Private Sub btnApprove_Click()
    ShowDateRef txtdApprove
End Sub

Private Sub txtdDeclare_LostFocus()
    Dim tmp As String
    If Trim(txtdDeclare.Text) = "" And Me.ActiveControl.Name <> "btnDeclare" Then
        btnDeclare.Visible = False
        Exit Sub
    End If
    If Me.ActiveControl.Name = "btnDeclare" Then
        Exit Sub
    End If
    tmp = m_objAid.sCheckDate(Trim(txtdDeclare.Text))
    If tmp = "" Then
        iShowMsg "输入的结束日期格式不正确!"
        txtdDeclare.SetFocus
    End If
    txtdDeclare.Text = tmp
    btnDeclare.Visible = False
End Sub

Private Sub txtdApprove_LostFocus()
    Dim tmp As String
    If Trim(txtdApprove.Text) = "" And GetHead("smode") <> "1" And Me.ActiveControl.Name <> "btnApprove" Then
        btnApprove.Visible = False
        Exit Sub
    End If
    
    If Me.ActiveControl.Name = "btnApprove" Then
        Exit Sub
    End If
    
    tmp = m_objAid.sCheckDate(Trim(txtdApprove.Text))
    If tmp = "" Then
        iShowMsg "输入的结束日期格式不正确!"
        txtdApprove.SetFocus
    End If
    txtdApprove.Text = tmp
    btnApprove.Visible = True
End Sub

Private Sub txtdEnd_LostFocus()
    Dim tmp As String
    If Trim(txtdEnd.Text) = "" And Me.ActiveControl.Name <> "btndEnd" Then
        btndEnd.Visible = False
        Exit Sub
    End If
    If Me.ActiveControl.Name = "btndEnd" Then
        Exit Sub
    End If
    tmp = m_objAid.sCheckDate(Trim(txtdEnd.Text))
    If tmp = "" Then
        iShowMsg "输入的结束日期格式不正确!"
        txtdEnd.SetFocus
    End If
    txtdEnd.Text = tmp
    btndEnd.Visible = False
End Sub

Private Sub txtdStart_LostFocus()
    Dim tmp As String
    If Trim(txtdStart.Text) = "" And Me.ActiveControl.Name <> "btndStart" Then
        btndStart.Visible = False
        Exit Sub
    End If
    If Me.ActiveControl.Name = "btndStart" Then
        Exit Sub
    End If
    tmp = m_objAid.sCheckDate(Trim(txtdStart.Text))
    If tmp = "" Then
        iShowMsg "输入的起始日期格式不正确!"
        txtdStart.SetFocus
    End If
    txtdStart.Text = tmp
    btndStart.Visible = False
End Sub

'窗体事件
Private Sub Form_Load()
    LoadToolPic
    SetTableState
    SwitchState (GetHead("smode"))
    If m_arrReportID.count <> 0 Then
        Go2 1
    Else
        Go2 0
    End If
    SetTBStyle Me
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    bShortCut KeyCode, Shift
End Sub

'菜单事件
Private Sub tlbTool_ButtonClick(ByVal Button As MsComctlLib.Button)
    Select Case Button.key
    Case "print"    '打印数据
        PrintMe
    Case "preview"  '预览
        Preview
    Case "output"
        Output
    Case "add"  '添加数据
        AddNew
    Case "save" '保存数据
        SaveData
    Case "delete"   '删除数据
        DeleteData
    Case "cancel"   '取消变化
        Cancel
    Case "edit"     '编辑数据
        SetChange
    Case "find"     '查找数据
        'ShowFind
    Case "first"    '移至最前
        GoFirst
    Case "last"     '移至最末
        GoLast
    Case "next"     '下一个
        GoNext
    Case "previous"     '前一个
        GoPre
    Case "refresh"  '刷新
        Reload
    Case "audit"
        Audit
    Case "confirm"
        Confirm
    Case "desert"   '弃审
        Desert
    Case "fill" '填充
        FillMe
    Case "help"     '帮助
        help
    Case "quit"     '退出
        Quit
    Case "append"   '追加
        Append
    Case "query"    '查询
        QueryIt
    End Select
    
    If Button.key <> "quit" Then
        If GetHead("operation") = "" Then HideRef
        ocxCtbTool.RefreshEnable
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If iCheck = vbCancel Then
        Cancel = 1
        Exit Sub
    End If
    Set m_objContent = Nothing
    Set m_objHead = Nothing
End Sub

'cell事件
Private Sub ocxCell_DropCellSelected(ByVal Col As Long, ByVal Row As Long)
    '只有在申报模式进行增加和修改时,才可以选币种
    If GetHead("operation") = "add" Or GetHead("operation") = "edit" Then
        SetContent Col, Row, ocxCell.GetCellString(Col, Row, 0)
        GetSum
    Else
        ocxCell.SetCellString Col, Row, 0, GetContent(Col, Row)
    End If
End Sub

Private Sub ocxCell_EditFinish(Text As String, approve As Long)
    Dim tp As String
    Dim strOrigin As String
    
    approve = 0
    If GetHead("operation") <> "" Then
        Text = Trim(Text)
        tp = GetField(m_iCol, "type")
        If tp = "money" And Text <> "" Then    '检查数字是否正确
            strOrigin = ocxCell.GetCellString(m_iCol, m_iRow, 0)
            If Not IsNumeric(Text) Then
                iShowMsg "输入不是数字类型!"
                Exit Sub
            ElseIf Text = "0" Then
                Text = ""
            ElseIf CDbl(Text) > 1000000000 Then
                iShowMsg "输入的金额超过最大值!"
                Exit Sub
            End If
        ElseIf tp = "date" And Text <> "" Then  '检查日期格式
            If m_objAid.sCheckDate(Text) = "" Then
                iShowMsg "输入的不是合法的日期格式!"
                Exit Sub
            End If
        Else
            tp = GetField(m_iCol, "len")
            If tp <> "" Then
                If Len(Text) > CInt(tp) Then
                    iShowMsg "注释不能超过" & tp & "个字!"
                    Exit Sub
                End If
            End If
        End If
        approve = 1
        SetContent m_iCol, m_iRow, Text
        '如果是数字,统计
        If GetField(m_iCol, "type") = "money" And Text <> strOrigin Then
            GetSum
        End If
    End If
End Sub

Private Sub ocxCell_MouseLClick(ByVal Col As Long, ByVal Row As Long, ByVal updn As Long)
    '检查是否超出范围
    If m_objContent Is Nothing Then Exit Sub
    
    If GetHead("operation") = "" Or Row < 2 Then  '如果没有操作
        ocxCell.ReadOnly = 1
    Else
        HideRef
        
        If GetField(Col, "readonly") = "1" Or GetContent(Col, Row, "readonly") = "1" _
            Or Row = 1 Or (GetContent(Col, Row, "sum") = "1" And GetField(Col, "fieldname") <> "sremark") _
            Or (GetContent(Col, Row, "innersum") = "1" And GetField(Col, "fieldname") <> "sremark") Then
            ocxCell.ReadOnly = 1
        Else
            ocxCell.ReadOnly = 0
        End If
    End If
    '保存当前位置
    m_iRow = Row
    m_iCol = Col
End Sub

'主表操作
Public Sub SetHead(sName As String, sValue As String, Optional Node As IXMLDOMElement = Nothing)
    '如果头为空,初始化
    If Node Is Nothing Then
        If m_objHead.xml = "" Then
            m_objHead.loadXML "<head/>"