clsentdef.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 = "clsEntDef"
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 rsUnit As New UfRecordset
Private rsAcc As New UfRecordset
Private RsNull As Boolean
Private cur_node As Node

Public edstatus As Byte

Public bfind As Boolean
Public cUnitCode As String
Public cUnitName As String
Public cMark As String
Public rsFind As New UfRecordset
'调用数据
Public Sub load_data()

Dim itmX As Node
Dim Code As String, cType As String
Dim Name As String
Dim iNum As Long
Dim iType As Byte
Dim pKey As String

frmEntDef.tvEnt.Nodes.Clear
Set rsUnit = dbsZJ.OpenRecordset("FD_AccUnit")
Set rsAcc = dbsZJ.OpenRecordset("FD_AccDEf")
Set itmX = frmEntDef.tvEnt.Nodes.Add(, , "p", "个人", "tree", "seltree")
Set itmX = frmEntDef.tvEnt.Nodes.Add(, , "d", "部门", "tree", "seltree")
Set itmX = frmEntDef.tvEnt.Nodes.Add(, , "b", "银行", "tree", "seltree")
Set itmX = frmEntDef.tvEnt.Nodes.Add(, , "c", "客户", "tree", "seltree")
Set itmX = frmEntDef.tvEnt.Nodes.Add(, , "g", "供应商", "tree", "seltree")
Set itmX = frmEntDef.tvEnt.Nodes.Add(, , "i", "项目", "tree", "seltree")

If rsUnit.EOF Then
  Set_rsnull_true
Else
  Set_rsnull_false
End If

If RsNull Then
  genadd
  Exit Sub
Else
  set_edstatus_true
End If

Dim bFirst As Boolean
bFirst = True
rsUnit.MoveFirst
While Not rsUnit.EOF
  Code = rsUnit!cUnitCode
  Name = rsUnit!cUnitName
  iType = rsUnit!iType
  iNum = iNum + 1
  Select Case iType
    Case 0
      pKey = "p"
      cType = "个人"
    Case 1
      pKey = "d"
      cType = "部门"
    Case 2
      pKey = "b"
      cType = "银行"
    Case 3
      pKey = "c"
      cType = "客户"
    Case 4
      pKey = "g"
      cType = "供应商"
    Case 5
      pKey = "i"
      cType = "项目"
  End Select
  Set itmX = frmEntDef.tvEnt.Nodes.Add(pKey, tvwChild, pKey + Code, Code & Chr(9) & Name, "leaf", "leafsel")
  If bUsed(Code) Then itmX.Tag = "t" Else itmX.Tag = "f"
  If bFirst Then itmX.EnsureVisible: itmX.Selected = True: bFirst = False
  itmX.Sorted = True
  rsUnit.MoveNext
Wend

GenMove

End Sub

Private Sub Class_Terminate()

rsUnit.oClose

End Sub

Private Sub Set_rsnull_true()

RsNull = True

End Sub

Private Sub Set_rsnull_false()

RsNull = False

End Sub

Private Sub set_edstatus_false()
    Dim i
    
    For i = 0 To 2
        frmEntDef.txt(i) = ""
        frmEntDef.txt(i).Enabled = True
        frmEntDef.txt(i).BackColor = COLOR_WHITE
    Next i
    'frmEntDef.mnuDelR.Enabled = False
    frmEntDef.tlb_dwdy.Buttons("del").Enabled = False
    frmEntDef.cmdok.Enabled = False
    With frmRightMenu
        .mnuE_DelR.Enabled = False
    End With
    edstatus = ENT_STATUS_ADD
    SetEdtTxtFocus frmEntDef.txt(0)
End Sub

Private Sub set_edstatus_true()

    With frmEntDef
        .tlb_dwdy.Buttons("del").Enabled = True
        .cmdok.Enabled = False
    End With
    With frmRightMenu
        .mnuE_DelR.Enabled = True
    End With
    edstatus = ENT_STATUS_EDIT

End Sub

Public Sub GenMove()

Dim key As String
Dim ind As Integer

  set_cur_node
  
  If cur_node.Parent Is Nothing Then
    Select Case cur_node.key
      Case "p"
        ind = 0
      Case "d"
        ind = 1
      Case "b"
        ind = 2
      Case "c"
        ind = 3
      Case "g"
        ind = 4
      Case "i"
        ind = 5
    End Select
    frmEntDef.cobtype.ListIndex = ind
    frmEntDef.uf1.Visible = False
    set_used frmEntDef.uf1.Visible
    set_edstatus_false
  Else
    key = mID(cur_node.key, 2)
    rsUnit.FindFirst "cUnitCode = '" & key & "'"
    
    If rsUnit.NoMatch Then
        frmEntDef.tvEnt.Nodes.Remove cur_node.Index
        Exit Sub
    End If
      frmEntDef.cobtype.ListIndex = rsUnit!iType
      frmEntDef.txt(0) = rsUnit!cUnitCode
      frmEntDef.txt(1) = rsUnit!cUnitName
      frmEntDef.txt(2) = IIf(IsNull(rsUnit!cMark), "", rsUnit!cMark)
      frmEntDef.uf1.Visible = UnitCodeUsed(frmEntDef.txt(0))
     
    set_used UnitCodeUsed(frmEntDef.txt(0))
    set_edstatus_true
    frmEntDef.tlb_dwdy.Buttons("del").Enabled = True
    
  End If

End Sub

Private Sub set_used(T_F As Boolean)
    With frmEntDef
        .txt(0).Locked = T_F
        '.txt(1).Locked = T_F
'        .txt(2).Locked = T_F   'Cuidong 2000/08/04
    End With
End Sub

Private Sub set_cur_node()

Set cur_node = frmEntDef.tvEnt.SelectedItem

End Sub

Public Sub genadd()

set_edstatus_false
frmEntDef.uf1.Visible = False
set_used False

End Sub

Public Sub save_change()

Dim nodx As Node
Dim pKey As String
On Error GoTo errsave1

errsave1:
If Not Valid Then Exit Sub

If edstatus = ENT_STATUS_ADD Then
  rsUnit.AddNew
  rsUnit!cUnitCode = frmEntDef.txt(0)
  rsUnit!cUnitName = frmEntDef.txt(1)
  rsUnit!iType = frmEntDef.cobtype.ListIndex
  rsUnit!cMark = frmEntDef.txt(2)
  rsUnit.Update
    
  Select Case frmEntDef.cobtype.ListIndex
    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 nodx = frmEntDef.tvEnt.Nodes.Add(pKey, tvwChild, "i" + frmEntDef.txt(0), frmEntDef.txt(0) + Chr(9) + frmEntDef.txt(1), "leaf", "leafsel")
  nodx.Tag = "f"
  nodx.Sorted = True
  nodx.Selected = True
  nodx.EnsureVisible
  set_cur_node
  GenMove
  'set_edstatus_true
  frmEntDef.tvEnt.SetFocus
ElseIf edstatus = ENT_STATUS_EDIT Then

    If Err.Number = 3167 Then
        rsUnit.AddNew
        rsUnit!cUnitCode = frmEntDef.txt(0)
        rsUnit!iType = frmEntDef.cobtype.ListIndex
    Else
        rsUnit.edit
        If frmEntDef.txt(0) <> rsUnit!cUnitCode Then
           rsUnit!cUnitCode = frmEntDef.txt(0)
         End If
    End If
  
  rsUnit!cUnitName = frmEntDef.txt(1)
  rsUnit!cMark = frmEntDef.txt(2)
  rsUnit.Update
  
  cur_node.key = "i" + frmEntDef.txt(0)
  cur_node.Text = frmEntDef.txt(0) + Chr(9) + frmEntDef.txt(1)
  
  set_cur_node

  GenMove
End If

End Sub

Private Function Valid() As Boolean

  Valid = False
  
  If frmEntDef.txt(0) = vbNullString Then
    MsgBox "开户单位编码不能为空!", vbCritical, zjGl_Name
    Exit Function
  End If
  
  If frmEntDef.txt(1) = vbNullString Then
    MsgBox "开户单位名称不能为空!", vbCritical, zjGl_Name
    Exit Function
  End If
  
  If edstatus = ENT_STATUS_ADD Then
    rsUnit.FindFirst "cUnitCode = '" & frmEntDef.txt(0) & "'"
    
    If Not rsUnit.NoMatch Then
      MsgBox "开户单位编码定义冲突!", vbCritical, zjGl_Name
      frmEntDef.txt(0).SetFocus
      Exit Function
    End If
  

  Else
      
    Dim dwrst As New UfRecordset
    If frmEntDef.txt(0) <> Left(cur_node.Text, InStr(1, cur_node.Text, Chr(9)) - 1) Then
        Set dwrst = dbsZJ.OpenRecordset("select * from FD_AccUnit where cUnitCode='" & frmEntDef.txt(0) & "'", dbOpenSnapshot)
        If Not dwrst.EOF Then
            dwrst.oClose
            MsgBox "开户单位编码定义冲突!", vbCritical, zjGl_Name
            SetTxtFocus frmEntDef.txt(0)
            Exit Function
        End If
        dwrst.oClose
    End If
    

    
    If cur_node.Tag = "t" Then
      If mID(cur_node.Text, InStr(1, cur_node.Text, Chr(9)) + 1) <> frmEntDef.txt(1) Then
        If MsgBox("是否保存变更后单位名称?" & vbCrLf & vbCrLf & "如确认变更,则关联数据将随之变化!", vbInformation + vbOKCancel, zjGl_Name) = vbCancel Then
          Exit Function
        End If
      End If
    End If
  End If
  
  Valid = True
  
End Function

Public Sub GenDel()
On Error Resume Next
Dim bFlag As Boolean

If bUsed(mID(cur_node.key, 2)) Then
  MsgBox "当前单位已使用,不能删除!", vbCritical, zjGl_Name
  Exit Sub
End If

If MsgBox("是否确认删除此单位？", vbQuestion + vbOKCancel, zjGl_Name) = vbCancel Then Exit Sub
rsUnit.Delete
frmEntDef.tvEnt.Nodes.Remove cur_node.Index

If rsUnit.EOF Then
  Set_rsnull_true
Else
  Set_rsnull_false
End If

If RsNull Then
  set_edstatus_false
Else
  GenMove
End If

End Sub

Public Sub GenExit()

Unload frmEntDef

End Sub

Private Function bUsed(cUnitCode As String) As Boolean

rsAcc.FindFirst "cUnitCode = '" & cUnitCode & "'"

If Not rsAcc.NoMatch Then
  bUsed = True
Else
  bUsed = False
End If

End Function

Public Sub GenFindNext()

Dim nodx As Node
Dim cType As String

  With rsFind
    Select Case !iType
      Case 0
        cType = "个人"
      Case 1
        cType = "部门"
      Case 2
        cType = "银行"
      Case 3
        cType = "客户"
      Case 4
        cType = "供应商"
      Case 5
        cType = "项目"
    End Select
    
    If Not FindNode(frmEntDef.tvEnt, False, cType, !cUnitCode & Chr(9) & !cUnitName) Then
      MsgBox "未找到符合条件的单位!", vbInformation, zjGl_Name
      Exit Sub
    End If
  End With
  
  set_cur_node
  GenMove
  
End Sub

Public Sub GenImport()
    frmEntImport.Show vbModal
    load_data
End Sub