📄 kcpdds.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 = "Kcpdds"
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 OKcPdds As Collection
Public Property Get Name() As String
Name = "KcPdds"
End Property
Private Sub Class_Initialize()
Set OKcPdds = New Collection
End Sub
Public Sub Add(oKcPdd As KcPdd, Optional Needsave As Integer = 1)
Dim mKey As Integer
Dim vKcPdd As KcPdd
For Each vKcPdd In OKcPdds
If mKey < vKcPdd.KcPddKey Then
mKey = vKcPdd.KcPddKey
End If
Next
oKcPdd.KcPddKey = mKey + 1
If Needsave = 1 Then
oKcPdd.Save
End If
OKcPdds.Add Item:=oKcPdd, Key:=CStr(mKey + 1)
End Sub
Public Sub Remove(Vindex, Optional Needdel As Integer = 1)
Dim oKcPdd As KcPdd
Set oKcPdd = Item(Vindex)
If Needdel = 1 And oKcPdd.KcPddId = 1 Then
oKcPdd.Del
End If
OKcPdds.Remove (Vindex)
Set oKcPdd = Nothing
End Sub
Public Property Get Count() As Integer
Count = OKcPdds.Count
End Property
Public Function Item(Vindex) As KcPdd
Attribute Item.VB_UserMemId = 0
Set Item = OKcPdds.Item(Vindex)
End Function
Public Sub ClearAll()
Dim I, Vcount As Integer
Vcount = OKcPdds.Count
For I = 1 To Vcount
OKcPdds.Remove (1)
Next
End Sub
Public Sub Fillbydb(vKcPddh As KcPddh)
Dim oKcPdd As KcPdd
Dim mRs As ADODB.Recordset
Dim mKey As Integer
On Error GoTo Errorhandle
ClearAll
Set mRs = Conn.Execute("SELECT KcPdd_HwBmCode=HwBmCode,KcPdd_HWBMNO,KcPddQTY1,KCPDDQTY2,KcPddPRICE,KcPddAMT1,KCPDDAMT2,KCPDD_HWPDRCMC=HWPDRCMC,KCPDD_HWPDRCNO,KcPddBZ,KcPddSYSDAT,KcPddSYSTIME,KcPddNO FROM KcPddREC,HWBMREC,HWPDRCREC WHERE KcPdd_KCPDDHNO=" & CStr(vKcPddh.KcPddhNo) & " AND HWBMNO=KcPdd_HWBMNO AND HWPDRCNO=KCPDD_HWPDRCNO")
mKey = 1
Do Until mRs.EOF
Set oKcPdd = New KcPdd
Set oKcPdd.KcPddh = vKcPddh
oKcPdd.KcPddKey = mKey
oKcPdd.BatchLet mRs!KcPdd_HwBmCode, mRs!KcPdd_HwBmno, mRs!KcPddQty1, mRs!KcPddQty2, mRs!KcPddPrice, mRs!KcPddAmt1, mRs!KcPddAmt2, mRs!KcPdd_HwPdrcMc, mRs!KcPdd_HwPdRcno, mRs!KcPddBz, mRs!KcPddSysDat, mRs!KcPddSysTime, mRs!KcPddNo
OKcPdds.Add Item:=oKcPdd, Key:=CStr(mKey)
mRs.MoveNext
mKey = mKey + 1
Loop
mRs.Close
Set mRs = Nothing
Exit Sub
Errorhandle:
If Not mRs Is Nothing Then
mRs.Close
End If
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 = OKcPdds.[_NewEnum]
End Function
Private Sub Class_Terminate()
ClearAll
Set OKcPdds = Nothing
End Sub
Public Sub Save(vKcPddh As KcPddh)
Dim mNotSaved As Collection
Dim mKcPdd As KcPdd
On Error GoTo Errorhandle
Set mNotSaved = New Collection
For Each mKcPdd In vKcPddh.KcPdds
If mKcPdd.KcPddId = -1 Then
mNotSaved.Add mKcPdd
End If
mKcPdd.Save
Next
Set mNotSaved = Nothing
Exit Sub
Errorhandle:
For Each mKcPdd In mNotSaved
mKcPdd.KcPddId = -1
Next
Set mNotSaved = Nothing
Err.Raise vbObjectError + 1, , Err.Description
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -