📄 kcbfds.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 = "KcBfds"
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 OKcBfds As Collection
Public Property Get Name() As String
Name = "KcBfds"
End Property
Private Sub Class_Initialize()
Set OKcBfds = New Collection
End Sub
Public Sub Add(oKcBfd As KcBfd, Optional Needsave As Integer = 1)
Dim mKey As Integer
Dim vKcBfd As KcBfd
For Each vKcBfd In OKcBfds
If mKey < vKcBfd.KcBfdKey Then
mKey = vKcBfd.KcBfdKey
End If
Next
oKcBfd.KcBfdKey = mKey + 1
If Needsave = 1 Then
oKcBfd.Save
End If
OKcBfds.Add Item:=oKcBfd, Key:=CStr(mKey + 1)
End Sub
Public Sub Remove(Vindex, Optional Needdel As Integer = 1)
Dim oKcBfd As KcBfd
Set oKcBfd = Item(Vindex)
If Needdel = 1 And oKcBfd.KcBfdId = 1 Then
oKcBfd.Del
End If
OKcBfds.Remove (Vindex)
Set oKcBfd = Nothing
End Sub
Public Property Get Count() As Integer
Count = OKcBfds.Count
End Property
Public Function Item(Vindex) As KcBfd
Attribute Item.VB_UserMemId = 0
Set Item = OKcBfds.Item(Vindex)
End Function
Public Sub ClearAll()
Dim I, Vcount As Integer
Vcount = OKcBfds.Count
For I = 1 To Vcount
OKcBfds.Remove (1)
Next
End Sub
Public Sub Fillbydb(vKcBfdh As KcBfdh)
Dim oKcBfd As KcBfd
Dim mRs As ADODB.Recordset
Dim mKey As Integer
On Error GoTo Errorhandle
ClearAll
Set mRs = Conn.Execute("SELECT KcBfd_HwBmCode=HwBmCode,KcBfd_HWBMNO,KcBfdQTY,KcBfdPRICE,KcBfdAMT,KCBFD_HWBFRCMC=HWBFRCMC,KCBFD_HWBFRCNO,KcBfdBZ,KcBfdSYSDAT,KcBfdSYSTIME,KcBfdNO FROM KcBfdREC,HWBMREC,HWBFRCREC WHERE KcBfd_KcBfdHNO=" & CStr(vKcBfdh.KcBfdhNo) & " AND HWBMNO=KcBfd_HWBMNO AND HWBFRCNO=KCBFD_HWBFRCNO")
mKey = 1
Do Until mRs.EOF
Set oKcBfd = New KcBfd
Set oKcBfd.KcBfdh = vKcBfdh
oKcBfd.KcBfdKey = mKey
oKcBfd.BatchLet mRs!KcBfd_HwBmCode, mRs!KcBfd_HwBmno, mRs!KcBfdQty, mRs!KcBfdPrice, mRs!KcBfdAmt, mRs!KcBfd_HwBfrcMc, mRs!KcBfd_HwBfRcno, mRs!KcBfdBz, mRs!KcBfdSysDat, mRs!KcBfdSysTime, mRs!KcBfdNo
OKcBfds.Add Item:=oKcBfd, 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 = OKcBfds.[_NewEnum]
End Function
Private Sub Class_Terminate()
ClearAll
Set OKcBfds = Nothing
End Sub
Public Sub Save(vKcBfdh As KcBfdh)
Dim mNotSaved As Collection
Dim mKcBfd As KcBfd
On Error GoTo Errorhandle
Set mNotSaved = New Collection
For Each mKcBfd In vKcBfdh.KcBfds
If mKcBfd.KcBfdId = -1 Then
mNotSaved.Add mKcBfd
End If
mKcBfd.Save
Next
Set mNotSaved = Nothing
Exit Sub
Errorhandle:
For Each mKcBfd In mNotSaved
mKcBfd.KcBfdId = -1
Next
Set mNotSaved = Nothing
Err.Raise vbObjectError + 1, , Err.Description
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -