📄 cgpodhs.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 = "CgPodhs"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'QQ:75347626
'MSN:whailin2000@hotmail.com
Option Explicit
Dim oCgPodhs As Collection
Public Property Get Name() As String
Name = "CgPodhs"
End Property
Private Sub Class_Initialize()
Set oCgPodhs = New Collection
End Sub
Public Sub Add(oCgPodh As CgPodh, Optional Needsave As Integer = 1)
Dim mKey As Integer
Dim vCgPodh As CgPodh
For Each vCgPodh In oCgPodhs
If mKey < vCgPodh.CgPodhKey Then
mKey = vCgPodh.CgPodhKey
End If
Next
oCgPodh.CgPodhKey = mKey + 1
If Needsave = 1 Then
oCgPodh.Save
End If
oCgPodhs.Add Item:=oCgPodh, Key:=CStr(mKey + 1)
End Sub
Public Sub Remove(Vindex, Optional Needdel As Integer = 1)
Dim oCgPodh As CgPodh
Set oCgPodh = Item(Vindex)
If Needdel = 1 And oCgPodh.CgPodhId = 1 Then
oCgPodh.Del
End If
oCgPodhs.Remove (Vindex)
Set oCgPodh = Nothing
End Sub
Public Property Get Count() As Integer
Count = oCgPodhs.Count
End Property
Public Function Item(Vindex) As CgPodh
Attribute Item.VB_UserMemId = 0
Set Item = oCgPodhs.Item(Vindex)
End Function
Public Sub ClearAll()
Dim I, Vcount As Integer
Vcount = oCgPodhs.Count
For I = 1 To Vcount
oCgPodhs.Remove (1)
Next
End Sub
Public Sub Fillbydb()
Dim oCgPodh As CgPodh
Dim Rs As ADODB.Recordset
Dim mKey As Integer
On Error GoTo Errorhandle
ClearAll
Set Rs = Conn.Execute("SELECT CgPodHDOCNO,CgPodHDAT,CgPodH_KHCODE=KHCODE,CgPodH_KHNO,CgPodHSYSDAT,CgPodHSYSTIME,CgPodHNO FROM CgPodHREC,KHREC WHERE KHNO=CgPodH_KHNO ORDER BY CgPodHDOCNO")
mKey = 1
Do Until Rs.EOF
Set oCgPodh = New CgPodh
oCgPodh.CgPodhKey = mKey
oCgPodh.BatchLet Rs!CgPodhDocno, Rs!CgPodhDat, Rs!CgPodh_KhCode, Rs!CgPodh_Khno, Rs!CgPodhSysDat, Rs!CgPodhSysTime, Rs!CgPodhNo
oCgPodhs.Add Item:=oCgPodh, Key:=CStr(mKey)
Rs.MoveNext
mKey = mKey + 1
Loop
Rs.Close
Set Rs = Nothing
Exit Sub
Errorhandle:
If Not Rs Is Nothing Then
Rs.Close
End If
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 = oCgPodhs.[_NewEnum]
End Function
Private Sub Class_Terminate()
ClearAll
Set oCgPodhs = Nothing
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -