资金使用计划.frm

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

      Caption         =   "资金使用计划申报表"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   3480
      TabIndex        =   16
      Top             =   840
      Width           =   5055
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      Caption         =   "审批日期:"
      Height          =   255
      Left            =   8040
      TabIndex        =   22
      Top             =   2295
      Width           =   1095
   End
End
Attribute VB_Name = "frmPlan"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private m_objAddon As New U8BudgetMgr.clsAddOnImp   '附表处理类
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 '保存查询结果
Private m_iPos As Integer   '当前位置
Private m_objMgr As U8BudgetMgr.IBudgetMgr  '后台处理类
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_objAddonRef As IXMLDOMElement

Private Sub btnBudget_Click()
    Dim rtn As ADODB.Recordset
    Dim str As String
    Dim Node As IXMLDOMElement
    Dim vTmp
    
    On Error Resume Next
    
    txtsUnitname = Trim(txtsUnitname)
    If txtsUnitname = "" Then
        iShowMsg "未指定正确的单位!"
        txtsUnitname.SetFocus
        Exit Sub
    Else
        vTmp = vCheckExist("unit", txtsUnitname)
        If IsNull(vTmp) Then
            iShowMsg "单位名称不正确!"
            txtsUnitname.SetFocus
            Exit Sub
        Else
            SetHead "accunit_id", CStr(vTmp)
        End If
    End If
    
    Set Node = m_objRefTree.documentElement.selectSingleNode("budget")
    Set rtn = objShowCommonRef(Node.getAttribute("sql") & " and accunit_id='" & GetHead("accunit_id") & "'", 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
        txtBudget.Text = mID(str, 1, Len(str) - 1)
    End If
    FillCur
End Sub

Private Sub btnBudget_LostFocus()
    btnBudget.Visible = False
End Sub

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.Text = 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
End Sub

Private Sub txtsUnitname_LostFocus()
'    txtsUnitname = Trim(txtsUnitname)
    If Me.ActiveControl.Name = "btnUnitName" Then
    
    Else
        btnUnitName.Visible = False
    End If
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub txtBudget_GotFocus()
    btnBudget.Visible = True
End Sub



Private Sub txtBudget_LostFocus()
'    txtBudget = Trim(txtBudget)
    If Me.ActiveControl.Name = "btnBudget" Then
    
    Else
        btnBudget.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 btndStart_LostFocus()
    btndStart.Visible = False
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 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 txtdApprove.Text = "" 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 = False
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"     '帮助
        SendKeys "{F1}"
    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_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" Then
            strOrigin = GetContent(m_iCol, m_iRow)
            If Text = "" Then
            
            ElseIf Not IsNumeric(Text) Then
                iShowMsg "输入不是数字类型!"
                Exit Sub
            ElseIf Text = "0" Then
                Text = ""
            ElseIf CDbl(Text) > 1000000000 Then
                iShowMsg "输入的金额超过最大值!"
                Exit Sub
            ElseIf Not bInRange(m_iRow, Text) Then
                Exit Sub
            End If
        ElseIf tp = "datetime" And Text <> "" Then
            If mID(Text, 1, 1) = "'" Then
                Text = m_objAid.sCheckDate(mID(Text, 2))
            Else
                Text = m_objAid.sCheckDate(Text)
            End If
            If Text = "" Then
                iShowMsg "输入的不是合法的日期格式!"
                Exit Sub
            End If
            
            '检查日期是否在要求的范围内
            If m_objAid.iDateDiff(txtdStart.Text, Text) < 0 Then
                iShowMsg "输入日期不得小于开始日期!"
                Exit Sub
            End If
            
            If m_objAid.iDateDiff(txtdEnd.Text, Text) > 0 Then