📄 xssodhs.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 = "XsSodhs"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Dim oXsSodhs As Collection
Public Property Get Name() As String
Name = "XsSodhs"
End Property
Private Sub Class_Initialize()
Set oXsSodhs = New Collection
End Sub
Public Sub Add(oXsSodh As XsSodh, Optional Needsave As Integer = 1)
Dim mKey As Integer
Dim vXsSodh As XsSodh
For Each vXsSodh In oXsSodhs
If mKey < vXsSodh.XsSodhKey Then
mKey = vXsSodh.XsSodhKey
End If
Next
oXsSodh.XsSodhKey = mKey + 1
If Needsave = 1 Then
oXsSodh.Save
End If
oXsSodhs.Add Item:=oXsSodh, Key:=CStr(mKey + 1)
End Sub
Public Sub Remove(Vindex, Optional Needdel As Integer = 1)
Dim oXsSodh As XsSodh
Set oXsSodh = Item(Vindex)
If Needdel = 1 And oXsSodh.XsSodhId = 1 Then
oXsSodh.Del
End If
oXsSodhs.Remove (Vindex)
Set oXsSodh = Nothing
End Sub
Public Property Get Count() As Integer
Count = oXsSodhs.Count
End Property
Public Function Item(Vindex) As XsSodh
Attribute Item.VB_UserMemId = 0
Set Item = oXsSodhs.Item(Vindex)
End Function
Public Sub ClearAll()
Dim i, Vcount As Integer
Vcount = oXsSodhs.Count
For i = 1 To Vcount
oXsSodhs.Remove (1)
Next
End Sub
Public Sub Fillbydb(Optional vWhereStr As String = "")
Dim oXsSodh As XsSodh
Dim mRs As DbRs
Dim mKey As Integer
Dim mSqlStr As String
On Error GoTo Errorhandle
ClearAll
mSqlStr = "SELECT XsSodHDOCNO,XsSodHDAT,XsSodH_KHCODE=COALESCE((SELECT KHCODE FROM KHREC WHERE KHNO=XsSodH_KHNO),''),XsSodH_KHNO,"
mSqlStr = mSqlStr & "XsSodh_CwBzCode=COALESCE((SELECT CWBZCODE FROM CWBZREC WHERE CWBZNO=XsSodh_CwBzno),''),XsSodh_CwBzno,"
mSqlStr = mSqlStr & "XsSodh_SalerCode=COALESCE((SELECT SalerCODE FROM SalerREC WHERE SalerNO=XsSodh_Salerno),''),XsSodh_Salerno,"
mSqlStr = mSqlStr & "XsSodHFORM,XsSodHNO FROM XsSodHREC"
If vWhereStr <> "" Then
mSqlStr = mSqlStr & " WHERE " & vWhereStr
End If
mSqlStr = mSqlStr & " ORDER BY XsSodHDOCNO"
Set mRs = New DbRs
mRs.Fillbydb mSqlStr
mRs.MoveFirst
mKey = 1
Do Until mRs.EOF
Set oXsSodh = New XsSodh
oXsSodh.XsSodhKey = mKey
oXsSodh.BatchLet mRs!XsSodhDocno, mRs!XsSodhDat, mRs!XsSodh_KhCode, mRs!XsSodh_Khno, mRs!XsSodh_CwBzCode, mRs!XsSodh_CwBzno, mRs!XsSodh_SalerCode, mRs!XsSodh_SalerNo, mRs!XsSodhForm, mRs!XsSodhNo
oXsSodhs.Add Item:=oXsSodh, 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 = oXsSodhs.[_NewEnum]
End Function
Private Sub Class_Terminate()
ClearAll
Set oXsSodhs = Nothing
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -