cgshdhs.cls
来自「制造业产供销与往来系统源码」· CLS 代码 · 共 124 行
CLS
124 行
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "CgShdhs"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Dim oCgShdhs As Collection
Public Property Get Name() As String
Name = "CgShdhs"
End Property
Private Sub Class_Initialize()
Set oCgShdhs = New Collection
End Sub
Public Sub Add(oCgShdh As CgShdh, Optional Needsave As Integer = 1)
Dim mKey As Integer
Dim vCgShdh As CgShdh
For Each vCgShdh In oCgShdhs
If mKey < vCgShdh.CgShdhKey Then
mKey = vCgShdh.CgShdhKey
End If
Next
oCgShdh.CgShdhKey = mKey + 1
If Needsave = 1 Then
oCgShdh.Save
End If
oCgShdhs.Add Item:=oCgShdh, Key:=CStr(mKey + 1)
End Sub
Public Sub Remove(Vindex, Optional Needdel As Integer = 1)
Dim oCgShdh As CgShdh
Set oCgShdh = Item(Vindex)
If Needdel = 1 And oCgShdh.CgShdhId = 1 Then
oCgShdh.Del
End If
oCgShdhs.Remove (Vindex)
Set oCgShdh = Nothing
End Sub
Public Property Get Count() As Integer
Count = oCgShdhs.Count
End Property
Public Function Item(Vindex) As CgShdh
Attribute Item.VB_UserMemId = 0
Set Item = oCgShdhs.Item(Vindex)
End Function
Public Sub ClearAll()
Dim i, Vcount As Integer
Vcount = oCgShdhs.Count
For i = 1 To Vcount
oCgShdhs.Remove (1)
Next
End Sub
Public Sub Fillbydb(Optional vWhereStr As String = "")
Dim oCgShdh As CgShdh
Dim mRs As DbRs
Dim mKey As Integer
Dim mSqlStr As String
On Error GoTo Errorhandle
ClearAll
mSqlStr = "SELECT CGSHDHTYPE,CgShdHDOCNO,CgShdHDAT,CgShdH_KHCODE=COALESCE((SELECT KHCODE FROM KHREC WHERE KHNO=CGSHDH_KHNO),''),CgShdH_KHNO,"
mSqlStr = mSqlStr & "CgShdh_CwQjCode=COALESCE((SELECT CWQJCODE FROM CWQJREC WHERE CWQJNO=CgShdh_CwQjno),''),CgShdh_CwQjno,"
mSqlStr = mSqlStr & "CgShdh_CwBzCode=COALESCE((SELECT CWBZCODE FROM CWBZREC WHERE CWBZNO=CgShdh_CwBzno),''),CgShdh_CwBzno,CGSHDHFORM,"
mSqlStr = mSqlStr & "CgShdHNO FROM CgShdHREC"
If vWhereStr <> "" Then
mSqlStr = mSqlStr & " WHERE " & vWhereStr
End If
mSqlStr = mSqlStr & " ORDER BY CgShdHDOCNO"
Set mRs = New DbRs
mRs.Fillbydb mSqlStr
mRs.MoveFirst
mKey = 1
Do Until mRs.EOF
Set oCgShdh = New CgShdh
oCgShdh.CgShdhKey = mKey
oCgShdh.BatchLet mRs!CgShdhType, mRs!CgShdhDocno, mRs!CgShdhDat, mRs!CgShdh_CwQjCode, mRs!CgShdh_CwqjNo, mRs!CgShdh_KhCode, mRs!CgShdh_Khno, mRs!CgShdh_CwBzCode, mRs!CgShdh_CwBzno, mRs!CgShdhForm, mRs!CgShdhNo
oCgShdhs.Add Item:=oCgShdh, Key:=CStr(mKey)
mRs.MoveNext
mKey = mKey + 1
Loop
Set mRs = Nothing
Exit Sub
Errorhandle:
Set mRs = 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 = oCgShdhs.[_NewEnum]
End Function
Private Sub Class_Terminate()
ClearAll
Set oCgShdhs = Nothing
End Sub
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?