?? 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"
'軟件著作權(quán): 北京用友軟件集團(tuán)有限公司
'系統(tǒng)名稱: 資金計息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
'調(diào)用數(shù)據(jù)
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", "供應(yīng)商", "tree", "seltree")
Set itmX = frmEntDef.tvEnt.Nodes.Add(, , "i", "項(xiàng)目", "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 = "供應(yīng)商"
Case 5
pKey = "i"
cType = "項(xiàng)目"
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 & "如確認(rèn)變更,則關(guān)聯(lián)數(shù)據(jù)將隨之變化!", 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 "當(dāng)前單位已使用,不能刪除!", vbCritical, zjGl_Name
Exit Sub
End If
If MsgBox("是否確認(rèn)刪除此單位?", 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 = "供應(yīng)商"
Case 5
cType = "項(xiàng)目"
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
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -