📄 sysugprivops.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 = "SysUgPrivTbs"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Dim OSysUgPrivTbs As Collection
Public Property Get Count() As Integer
Count = OSysUgPrivTbs.Count
End Property
Public Sub Add(OSysUgPrivTb As SysUgPrivTb)
Dim vKey As Integer, vSysUgPrivTb As SysUgPrivTb
For Each vSysUgPrivTb In OSysUgPrivTbs
If vSysUgPrivTb.SysUgPrivTb_Key > vKey Then
vKey = vSysUgPrivTb.SysUgPrivTb_Key
End If
Next
vKey = vKey + 1
OSysUgPrivTb.SysUgPrivTb_Key = vKey
OSysUgPrivTbs.Add OSysUgPrivTb, CStr(vKey)
End Sub
Public Function Item(Vindex) As SysUgPrivTb
Attribute Item.VB_UserMemId = 0
Set Item = OSysUgPrivTbs.Item(Vindex)
End Function
Public Sub Remove(Vindex)
OSysUgPrivTbs.Remove (Vindex)
End Sub
Public Sub ClearAll()
Dim i, Vcount As Integer
Vcount = OSysUgPrivTbs.Count
For i = 1 To Vcount
OSysUgPrivTbs.Remove (1)
Next
End Sub
Public Sub Fillbydb(vSysUgPriv As SysUgPriv, Optional Orderstr As String = "SYSTBSEQ")
Dim OSysUgPrivTb As SysUgPrivTb
Dim Rs As DbRs
Dim SqlStr As String, SqlStr1 As String
Dim vKey As Integer
On Error GoTo ErrorHandle
ClearAll
If vSysUgPriv.SysForm.SysFormTbType <> 5 Then
SqlStr = "SELECT SELECTFLG=CASE WHEN EXISTS(SELECT * FROM SYSUGPRIVTBREC WHERE SYSUGPRIVTbNO1=" & CStr(vSysUgPriv.SysUgPrivNo) & " AND SYSUGPrivTb_SysTbNo=SYSFTB_SYSTBNO) THEN 1 ELSE 0 END,SysUgPrivTbNO1=" & CStr(vSysUgPriv.SysUgPrivNo) & ",SysUgPrivTb_SysTbNo=SysFtb_SYSTBNo,SysUgPrivTb_SysTbCode=SysTbCode,SysUgPrivTb_SysTbMc=SYSTBDESC,SysUgPrivTbno=COALESCE((SELECT SYSUGPrivTbNO FROM SYSUGPrivTbREC WHERE SYSUGPrivTbNO1=" & CStr(vSysUgPriv.SysUgPrivNo) & " AND SYSUGPrivTb_SysTbNo=SysFtb_SYSTBNo),0) FROM SYSFTBREC,SYSTBREC WHERE SYSFTBTYPE=" & CStr(vSysUgPriv.SysForm.SysFormTbType) & " AND SYSTBNO=SYSFTB_SYSTBNO AND SYSTBISPRIV=1"
Else
SqlStr = "SELECT SELECTFLG=CASE WHEN EXISTS(SELECT * FROM SYSUGPRIVTBREC WHERE SYSUGPRIVTbNO1=" & CStr(vSysUgPriv.SysUgPrivNo) & " AND SYSUGPrivTb_SysTbNo=SYSFORMTB_SYSTBNO) THEN 1 ELSE 0 END,SysUgPrivTbNO1=" & CStr(vSysUgPriv.SysUgPrivNo) & ",SysUgPrivTb_SysTbNo=SYSFORMTB_SYSTBNO,SysUgPrivTb_SysTbCode=SysTbCode,SysUgPrivTb_SysTbMc=SYSTBDESC,SysUgPrivTbno=COALESCE((SELECT SYSUGPrivTbNO FROM SYSUGPrivTbREC WHERE SYSUGPrivTbNO1=" & CStr(vSysUgPriv.SysUgPrivNo) & " AND SYSUGPrivTb_SysTbNo=SYSFORMTB_SYSTBNO),0) FROM SYSFORMTBREC,SYSTBREC WHERE SYSFORMTB_SYSFORMNO=" & CStr(vSysUgPriv.SysForm.SysFormNo) & " AND SYSTBNO=SYSFORMTB_SYSTBNO AND SYSTBISPRIV=1"
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 OSysUgPrivTb = New SysUgPrivTb
Set OSysUgPrivTb.Parent = vSysUgPriv
OSysUgPrivTb.SysUgPrivTb_Key = vKey
OSysUgPrivTb.BatchLet Rs!SysUgPrivTbNo1, Rs!SysUgPrivTb_SysTbNo, Rs!SysUgPrivTb_SysTbCode, Rs!SysUgPrivTb_SysTbMc, Rs!SysUgPrivTbNo, Rs!SelectFlg
If Rs!SysUgPrivTbNo1 = 0 Then
OSysUgPrivTb.SysUgPrivTb_id = -1
Else
OSysUgPrivTb.SysUgPrivTb_id = 1
End If
OSysUgPrivTbs.Add OSysUgPrivTb, 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 = OSysUgPrivTbs.[_NewEnum]
End Function
Private Sub Class_Initialize()
Set OSysUgPrivTbs = New Collection
End Sub
Private Sub Class_Terminate()
Set OSysUgPrivTbs = Nothing
End Sub
Public Property Get Name() As String
Name = "SysUgPrivTbs"
End Property
Public Sub DbSave()
Dim mSysUgPrivTb As SysUgPrivTb
Dim mNotSaved As Collection
Dim mNotDeled As Collection
On Error GoTo ErrorHandle
Set mNotSaved = New Collection
Set mNotDeled = New Collection
For Each mSysUgPrivTb In OSysUgPrivTbs
If mSysUgPrivTb.SelectFlg = 1 Then
If mSysUgPrivTb.SysUgPrivTb_id = -1 Then
mNotSaved.Add mSysUgPrivTb
End If
mSysUgPrivTb.DbSave
Else
If mSysUgPrivTb.SysUgPrivTb_id = 1 Then
mNotDeled.Add mSysUgPrivTb
mSysUgPrivTb.DbDel
mSysUgPrivTb.SysUgPrivTb_id = -1
End If
End If
Next
Set mNotSaved = Nothing
Set mNotDeled = Nothing
Exit Sub
ErrorHandle:
For Each mSysUgPrivTb In mNotSaved
mSysUgPrivTb.SysUgPrivTb_id = -1
Next
For Each mSysUgPrivTb In mNotDeled
mSysUgPrivTb.SysUgPrivTb_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 + -