📄 sysugrfds.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 = "SysUgRfds"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Dim OSysUgRfds As Collection
Public Property Get Count() As Integer
Count = OSysUgRfds.Count
End Property
Public Sub Add(OSysUgRfd As SysUgRfd)
Dim vKey As Integer, vSysUgRfd As SysUgRfd
For Each vSysUgRfd In OSysUgRfds
If vSysUgRfd.SysUgRfd_Key > vKey Then
vKey = vSysUgRfd.SysUgRfd_Key
End If
Next
vKey = vKey + 1
OSysUgRfd.SysUgRfd_Key = vKey
OSysUgRfds.Add OSysUgRfd, CStr(vKey)
End Sub
Public Function Item(Vindex) As SysUgRfd
Attribute Item.VB_UserMemId = 0
Set Item = OSysUgRfds.Item(Vindex)
End Function
Public Sub Remove(Vindex, Optional NeedDel As Integer = 1)
If NeedDel = 1 Then
Dim mSysUgRfd As SysUgRfd
Set mSysUgRfd = OSysUgRfds(Vindex)
mSysUgRfd.DbDel
End If
OSysUgRfds.Remove (Vindex)
End Sub
Public Sub ClearAll()
Dim i, Vcount As Integer
Vcount = OSysUgRfds.Count
For i = 1 To Vcount
OSysUgRfds.Remove (1)
Next
End Sub
Public Sub Fillbydb(vSysUg As SysUg, Optional Wherestr As String = "", Optional Orderstr As String = "RfdCode")
Dim OSysUgRfd As SysUgRfd
Dim Rs As DbRs
Dim SqlStr As String
Dim vKey As Integer
On Error GoTo Errorhandle
ClearAll
SqlStr = "SELECT SELECTFLG=CASE WHEN EXISTS(SELECT * FROM SysUgRfdREC WHERE SYSUGRFD_SYSUGNO=" & CStr(vSysUg.SysUgNo) & " AND SysUgRfd_RFDNO=RFDNO) THEN 1 ELSE 0 END,SysUgRfd_RFDNO=RFDNO,SysUgRfd_RFDCode=RFDCODE,SysUgRfd_RFDMc=RFDMC,SysUgRfdNo=COALESCE((SELECT SysUgRfdNO FROM SysUgRfdREC WHERE SYSUGRFD_SYSUGNO=" & CStr(vSysUg.SysUgNo) & " AND SysUgRfd_RFDNO=RFDNO),0) FROM RFDREC"
If Wherestr <> "" Then
SqlStr = SqlStr + " WHERE " + Wherestr
End If
If Orderstr <> "" Then
SqlStr = SqlStr + " order by " + Orderstr
End If
Set Rs = New DbRs
Rs.Fillbydb SqlStr
Rs.MoveFirst
vKey = 1
Do Until Rs.EOF
Set OSysUgRfd = New SysUgRfd
Set OSysUgRfd.SysUg = vSysUg
OSysUgRfd.BatchLet Rs!SelectFlg, Rs!SysUgRfd_RfdNo, Rs!SysUgRfd_RfdCode, Rs!SysUgRfd_RfdMc, Rs!SysUgRfdNo
OSysUgRfd.SysUgRfd_Key = vKey
If OSysUgRfd.SelectFlg = 1 Then
OSysUgRfd.SysUgRfd_id = 1
Else
OSysUgRfd.SysUgRfd_id = -1
End If
OSysUgRfds.Add OSysUgRfd, CStr(vKey)
Rs.MoveNext
vKey = vKey + 1
Loop
Set Rs = Nothing
Exit Sub
Errorhandle:
Set Rs = Nothing
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Public Function NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
Set NewEnum = OSysUgRfds.[_NewEnum]
End Function
Private Sub Class_Initialize()
Set OSysUgRfds = New Collection
End Sub
Private Sub Class_Terminate()
Set OSysUgRfds = Nothing
End Sub
Public Property Get Name() As String
Name = "SysUgRfds"
End Property
Public Sub DbSave()
Dim mNotSaved As Collection
Dim mNotDeled As Collection
Dim mSysUgRfd As SysUgRfd
On Error GoTo Errorhandle
Set mNotSaved = New Collection
Set mNotDeled = New Collection
For Each mSysUgRfd In OSysUgRfds
If mSysUgRfd.SelectFlg = 1 Then
If mSysUgRfd.SysUgRfd_id = -1 Then
mNotSaved.Add mSysUgRfd
mSysUgRfd.DbSave
End If
Else
If mSysUgRfd.SysUgRfd_id = 1 Then
mNotDeled.Add mSysUgRfd
mSysUgRfd.DbDel
mSysUgRfd.SysUgRfd_id = -1
End If
End If
Next
Set mNotSaved = Nothing
Exit Sub
Errorhandle:
For Each mSysUgRfd In mNotSaved
mSysUgRfd.SysUgRfd_id = -1
Next
For Each mSysUgRfd In mNotDeled
mSysUgRfd.SysUgRfd_id = 1
Next
Set mNotSaved = Nothing
Set mNotDeled = Nothing
Err.Raise vbObjectError + 1, , gDbCommon.Conn.Errors(0)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -