clsaccdef.cls

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

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsAccDef"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"

'软件著作权: 北京用友软件集团有限公司
'系统名称: 资金计息8.0
'功能说明: 账户类模块
'作者: 魏小黎
Option Explicit

Private rsAcc As New UfRecordset
Private rsUnit As New UfRecordset
Private RsNull As Boolean
Public cur_node As Node
Private bAccNod As Boolean
Public edstatus As Ed_Status

Public rsFind As New UfRecordset

Public Sub load_data()
'    Dim itmX As Node
'    Dim nodx As Node
'    Dim uCode As String
'    Dim uName As String
'    Dim cCode As String
'    Dim cName As String
'    Dim bFirst As Boolean
'    Dim sql As String
'    Dim rsl As New UfRecordset
'    Dim pKey As String
'
'    Set rsAcc = dbsZJ.OpenRecordset("FD_AccDef")
'    Set rsUnit = dbsZJ.OpenRecordset("FD_AccUnit")
'
'    'With frmAccDef
'    '    .tvAccDef.Nodes.Clear
'    '    .cobSrc.Clear
'    '    .Combo1.Clear
'    'End With
'    If rsUnit.EOF Then
'        Set_rsnull_true
'    Else
'        Set_rsnull_false
'    End If
''    With frmAccDef.cobSrc
''        .AddItem "0 - " & "资金"
''        .AddItem "1 - " & "总账"
''        .ListIndex = 0
''    End With
'    Set rsl = dbsZJ.OpenRecordset("ForeignCurrency", dbOpenSnapshot)
''    With rsl
''        If .EOF Then frmAccDef.Combo1.AddItem "人民币"
''        While Not .EOF
''            frmAccDef.Combo1.AddItem !cexch_name
''            .MoveNext
''        Wend
''        frmAccDef.Combo1.ListIndex = 0
''    End With
''    If RsNull Then             'Cuidong 2000/08/08
''        Exit Sub               'Cuidong 2000/08/08
''    End If                     'Cuidong 2000/08/08
''    With frmAccDef.tvAccDef
''        Set itmX = .Nodes.Add(, , "p", "个人", "tree", "seltree")
''        frmAccDef.tvAccDef.SelectedItem = itmX
''        itmX.Expanded = True
''        Set itmX = .Nodes.Add(, , "d", "部门", "tree", "seltree")
''        itmX.Expanded = True
''        Set itmX = .Nodes.Add(, , "b", "银行", "tree", "seltree")
''        itmX.Expanded = True
''        Set itmX = .Nodes.Add(, , "c", "客户", "tree", "seltree")
''        itmX.Expanded = True
''        Set itmX = .Nodes.Add(, , "g", "供应商", "tree", "seltree")
''        itmX.Expanded = True
''        Set itmX = .Nodes.Add(, , "i", "项目", "tree", "seltree")
''        itmX.Expanded = True
''    End With
''    If RsNull Then                        'Cuidong 2000/08/08
''        frmAccDef.tvAccDef_NodeClick itmX 'Cuidong 2000/08/08
''        Exit Sub                          'Cuidong 2000/08/08
''    End If                                'Cuidong 2000/08/08
'    With rsUnit
'        .MoveFirst
'        While Not .EOF
'            uCode = !cUnitCode
'            uName = !cUnitName
'            Select Case !iType
'                Case 0
'                    pKey = "p"
'                Case 1
'                    pKey = "d"
'                Case 2
'                    pKey = "b"
'                Case 3
'                    pKey = "c"
'                Case 4
'                    pKey = "g"
'                Case 5
'                    pKey = "i"
'            End Select
'            Set itmX = frmAccDef.tvAccDef.Nodes.Add(pKey, tvwChild, "u" + uCode, uName, "tree", "seltree")
'            itmX.Sorted = True
'            itmX.Tag = uCode
'            sql = "select * from FD_AccDef where cUnitCode='" + uCode + "'"
'            Set rsl = dbsZJ.OpenRecordset(sql, dbOpenSnapshot)
'            With rsl
'                While Not .EOF
'                    cCode = !cAccID
'                    cName = !CAccName
'                    Set itmX = frmAccDef.tvAccDef.Nodes.Add("u" + uCode, tvwChild, "a" + cCode, cCode + Space(1) + cName, "leaf", "leafsel")
'                    itmX.Sorted = True
'                    itmX.Tag = cCode
'                    If Not bFirst Then
'                        Set nodx = itmX
'                        bFirst = True
'                    End If
'                    .MoveNext
'                Wend
'            End With
'            .MoveNext
'        Wend
'    End With
'    If Not nodx Is Nothing Then
'
'       nodx.Selected = True
'       On Error Resume Next              '
'       frmAccDef.tvAccDef_NodeClick nodx 'Cuidong 2000/06/13
'       On Error GoTo 0                   '
'
'    ElseIf Not itmX Is Nothing Then
'      set_edstatus_false
'      itmX.Selected = True
'      If itmX.Parent.key Like "b*" Then
'        frmAccDef.optIE(1).Value = True
'      Else
'        frmAccDef.optIE(0).Value = True
'      End If
'    Else
'      frmAccDef.tvAccDef.Nodes(1).Selected = True
'      On Error Resume Next                                      '
'      frmAccDef.tvAccDef_NodeClick frmAccDef.tvAccDef.Nodes(1)  'Cuidong 2000/06/13
'      On Error GoTo 0                                           '
'      Exit Sub
'    End If
'    GenMove
    
End Sub

Private Sub Class_Terminate()
    rsAcc.oClose
    rsUnit.oClose
End Sub

Public Sub GenMove()

'Dim key As String
'Dim nodx As Node
'Dim i As Long, buse_D As Boolean
'
'If RsNull Then
'    Exit Sub
'End If
'
'set_cur_node
'key = cur_node.Tag
'
'If Not bAccNod Then
'  'rsUnit.Index = "PrimaryKey"
'  rsUnit.FindFirst "cUnitCode = '" & key & "'"
'  If Not rsUnit.NoMatch Then
'    frmAccDef.txt(0) = rsUnit!cUnitName
'    frmAccDef.txt(0).Tag = key
'  End If
'  With frmAccDef
'    .Flag1.Visible = False
'    .Flag2.Visible = False
'    .UfKill.Visible = False
'    .txt(5).Locked = False
'    .txt(6).Locked = False
'    .tlb_dwdy.Buttons("kill").Enabled = False
'  End With
'
'  setAccType zw, 0, 0
'
'  set_used_true False
'  set_edstatus_false
'
'Else
'  Set nodx = cur_node.Parent
'  If nodx Is Nothing Then Exit Sub
'  key = nodx.Tag
'  'rsUnit.Index = "PrimaryKey"
'  rsUnit.FindFirst "cUnitCode = '" & key & "'"
'  If Not rsUnit.NoMatch Then
'    frmAccDef.txt(0) = rsUnit!cUnitName
'    frmAccDef.txt(0).Tag = key
'  End If
'  key = cur_node.Tag
'  'rsAcc.Index = "PrimaryKey"
'  rsAcc.FindFirst "cAccID = '" & key & "'"
'  If Not rsAcc.NoMatch Then
'    setAccType rsAcc!iDataSrc, rsAcc!iio, rsAcc!iType
'    frmAccDef.Flag2.Visible = IIf(rsAcc!istate = 0, False, True)
'    frmAccDef.UfKill.Visible = rsAcc!bDestroy
'    frmAccDef.tlb_dwdy.Buttons("kill").Enabled = Not rsAcc!bDestroy
'    frmRightMenu.mnuA_DestoryR.Enabled = Not rsAcc!bDestroy
'    frmAccDef.txt(1) = rsAcc!cAccID
'    frmAccDef.txt(2) = rsAcc!CAccName
'    frmAccDef.txt(8) = rsAcc!cAccBank & ""
'    frmAccDef.txt(3) = rsAcc!cIntrID
'    frmAccDef.txt(4) = IIf(IsNull(rsAcc!cCadID) Or frmAccDef.optPC(0).Value, "", rsAcc!cCadID)
''    frmAccDef.txt(5) = IIf(frmAccDef.optPC(0).Value Or frmAccDef.cobSrc.ListIndex = 1, "", rsAcc!Mb)                  'Cuidong 2000/07/13
'    frmAccDef.txt(5) = IIf(frmAccDef.optPC(0).Value Or frmAccDef.cobSrc.ListIndex = 1, "", Format(rsAcc!Mb, "#0.00"))  'Cuidong 2000/07/13
''    frmAccDef.txt(6) = IIf(frmAccDef.optPC(0).Value, "", rsAcc!Mh)                   'Cuidong 2000/07/13
'    frmAccDef.txt(6) = IIf(frmAccDef.optPC(0).Value, "", Format(rsAcc!Mh, "#0.00"))   'Cuidong 2000/07/13
'    frmAccDef.txt(7) = Format(rsAcc!dOpenDate, "yyyy-mm-dd")
'    Get_iYt rsAcc            'cuidong YT.A 2001.10.20
'    Get_cYtID rsAcc          'cuidong YT.A 2001.10.20
'    frmAccDef.Chk_LxYt_Click 'cuidong YT.A 2001.10.20
'    For i = 0 To frmAccDef.Combo1.ListCount - 1
'      If frmAccDef.Combo1.List(i) = rsAcc!cexch_name Then
'        frmAccDef.Combo1.ListIndex = i
'        Exit For
'      End If
'    Next i
'    buse_D = AccountUsed(frmAccDef.txt(1).Text)
'
'  End If
'
'
'  frmAccDef.Flag1.Visible = buse_D
'
''  With frmAccDef
''      .txt(2).Locked = buse_D
''      .txt(8).Locked = buse_D
''      .txt(5).Locked = buse_D
''      .txt(6).Locked = buse_D
''  End With
'
'  set_used_true buse_D Or frmAccDef.UfKill.Visible
'
'  If Not rsAcc.NoMatch Then
'    If rsAcc!bDestroy Then
'        With frmAccDef
'            .txt(5).Locked = True
'            .txt(6).Locked = True
'            .tlb_dwdy.Buttons("del").Enabled = Not buse_D
'            .tlb_dwdy.Buttons("fre").Enabled = False
'        End With
'        frmRightMenu.mnuA_DelR.Enabled = Not buse_D
'        frmRightMenu.mnuA_FreezeR.Enabled = False
'    Else
'        frmAccDef.txt(5).Locked = False
'        frmAccDef.txt(6).Locked = False
'        set_edstatus_true buse_D
'    End If
'  Else
'      frmAccDef.tvAccDef.Nodes.Remove cur_node.Index
'  End If
'
'  edstatus = Child_Edit
'
'End If
'frmAccDef.cmdOk.Enabled = False
End Sub

'cuidong YT.A 2001.10.20
Private Sub Get_iYt(oRs As Object)
'    On Error GoTo Err_Get_iYt
'    frmAccDef.Chk_LxYt.Value = 0
'    frmAccDef.Chk_LxYt.Value = IIf(IsNull(oRs!iYt), 0, IIf(oRs!iYt = 0, 0, 1))
'Err_Get_iYt:
End Sub

'cuidong YT.A 2001.10.20
Private Sub Get_cYtID(oRs As Object)
'    On Error GoTo Err_Get_cYtID
'    frmAccDef.txt(9).Text = vbNullString
'    frmAccDef.txt(9) = IIf(IsNull(oRs!cYtID), vbNullString, oRs!cYtID)
'Err_Get_cYtID:

End Sub

Private Sub set_cur_node()

'Set cur_node = frmAccDef.tvAccDef.SelectedItem
'If Left(cur_node.key, 1) = "u" Then
'  bAccNod = False
'Else
'  bAccNod = True
'End If

End Sub

Private Sub set_edstatus_false()
'If frmAccDef.txt(0) = "" Then Exit Sub
'Dim i
'
''For i = 1 To 8 'cuidong YT.A 2001.10.20
'For i = 1 To 9  'cuidong YT.A 2001.10.20
'  frmAccDef.txt(i) = ""
'Next i
'With frmAccDef
'    .Flag1.Visible = False
'    .Flag2.Visible = False
'    .UfKill.Visible = False
'    .txt(5).Locked = False
'    .txt(6).Locked = False
'    .Chk_LxYt.Value = 0 'cuidong YT.A 2001.10.20
'    .Chk_LxYt_Click     'cuidong YT.A 2001.10.20
'    .tlb_dwdy.Buttons("del").Enabled = False
'    .tlb_dwdy.Buttons("fre").Enabled = False
'    .tlb_dwdy.Buttons("kill").Enabled = False
'End With
'With frmRightMenu
'    .mnuA_DelR.Enabled = False
'    .mnuA_FreezeR.Enabled = False
'    .mnuA_DestoryR.Enabled = False
'End With
'frmAccDef.cmdOk.Enabled = True
'SetEdtTxtFocus frmAccDef.txt(1)
'edstatus = Child_Add

End Sub

Private Sub set_edstatus_true(Used As Boolean)
'    With frmAccDef
'    .tlb_dwdy.Buttons("del").Enabled = Not Used
'    .tlb_dwdy.Buttons("fre").Enabled = True
'    .tlb_dwdy.Buttons("kill").Enabled = True
'    End With
'    With frmRightMenu
'        .mnuA_DelR.Enabled = Not Used
'        .mnuA_FreezeR.Enabled = True
'        .mnuA_DestoryR.Enabled = True
'    End With
End Sub

Public Sub genadd()
    set_used_true False
    set_edstatus_false
End Sub

Public Sub save_change()

'Dim nodx As Node
'Dim key As String
'Dim dOpen As Date, ts As Boolean
'
'On Error Resume Next
'ts = True
'
'saver1:
'
'If Not Valid Then Exit Sub
'
'If edstatus = Child_Add Then
'  If ts Then
'      If Not Pd_lldmer(frmAccDef.txt(3).Text, Format(zjLogInfo.curDate, "yyyy-mm-dd"), False) Then
'         If MsgBox("登录日期：" & Format(zjLogInfo.curDate, "yyyy-mm-dd") & _
'                  vbCrLf & vbCrLf & "是否将开户日期设为当前的登录日期？", vbQuestion & vbYesNo, zjGl_Name) = vbYes Then
'             dOpen = zjLogInfo.curDate
'         Else
'             View_Tref = frmAccDef.txt(3).Text
'             frmOpenDate.Show vbModal
'             If View_Tref = "" Then
'                Exit Sub
'             Else
'                dOpen = View_Tref
'             End If
'         End If
'      Else
'         View_Tref = frmAccDef.txt(3).Text
'         frmOpenDate.Show vbModal
'         If View_Tref = "" Then
'            Exit Sub
'         Else
'            dOpen = View_Tref
'         End If
'      End If
'
'      '检查利率在刚才是否被删除                          'Cuidong 2000/08/16
'      If Not IntrCodeExist(frmAccDef.txt(3).Text) Then   'Cuidong 2000/08/16
'        MsgBox "利率代码不存在！", vbCritical, zjGl_Name 'Cuidong 2000/08/16
'        frmAccDef.txt(3).SetFocus                        'Cuidong 2000/08/16
'        Exit Sub                                         'Cuidong 2000/08/16
'      End If                                             'Cuidong 2000/08/16
'
'      '检查结息日在刚才是否被删除                        'Cuidong 2000/08/16
'      If frmAccDef.txt(4).Enabled Then                   'Cuidong 2000/08/16
'        If Not CadCodeExist(frmAccDef.txt(4).Text) Then  'Cuidong 2000/08/16
'            MsgBox "结息日代码不存在！", vbCritical, zjGl_Name 'Cuidong 2000/08/16