📄 hwbfds.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 = "HwBfds"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Dim OHwBfds As Collection
Public Property Get Name() As String
Name = "HwBfds"
End Property
Private Sub Class_Initialize()
Set OHwBfds = New Collection
End Sub
Public Sub Add(oHwBfd As HwBfd, Optional Needsave As Integer = 1)
Dim mKey As Integer
Dim vHwBfd As HwBfd
For Each vHwBfd In OHwBfds
If mKey < vHwBfd.HwBfdKey Then
mKey = vHwBfd.HwBfdKey
End If
Next
oHwBfd.HwBfdKey = mKey + 1
If Needsave = 1 Then
oHwBfd.Save
End If
OHwBfds.Add Item:=oHwBfd, Key:=CStr(mKey + 1)
End Sub
Public Sub Remove(Vindex, Optional Needdel As Integer = 1)
Dim oHwBfd As HwBfd
Set oHwBfd = Item(Vindex)
If Needdel = 1 And oHwBfd.HwBfdId = 1 Then
oHwBfd.Del
End If
OHwBfds.Remove (Vindex)
Set oHwBfd = Nothing
End Sub
Public Property Get Count() As Integer
Count = OHwBfds.Count
End Property
Public Function Item(Vindex) As HwBfd
Attribute Item.VB_UserMemId = 0
Set Item = OHwBfds.Item(Vindex)
End Function
Public Sub ClearAll()
Dim i, Vcount As Integer
Vcount = OHwBfds.Count
For i = 1 To Vcount
OHwBfds.Remove (1)
Next
End Sub
Public Sub Fillbydb(vHwBfdh As HwBfdh)
Dim oHwBfd As HwBfd
Dim mRs As DbRs
Dim mKey As Integer
Dim mSqlStr As String
On Error GoTo Errorhandle
ClearAll
mSqlStr = "SELECT HwBfd_HwBfdHNO,HwBfd_HwBmCode=COALESCE((SELECT HwBmCode FROM HWBMREC WHERE HWBMNO=HwBfd_HWBMNO),''),HwBfd_HwBmMc=COALESCE((SELECT HwBmMc FROM HWBMREC WHERE HWBMNO=HwBfd_HWBMNO),''),HwBfd_HWBMNO,"
mSqlStr = mSqlStr & "HwBfd_HwDwCode=COALESCE((SELECT HWDWCode FROM HWDWREC WHERE HWDWNO=HwBfd_HWDWNO),''),HwBfd_HWDWNO,HwBfd_HWDWCONV,"
mSqlStr = mSqlStr & "HwBfdQTY,HwBfdPRICE,HwBfdAMT,"
mSqlStr = mSqlStr & "HwBfdBZ,HwBfdMIONO,HwBfdNO FROM HwBfdREC WHERE HwBfd_HwBfdHNO=" & CStr(vHwBfdh.HwBfdhNo)
Set mRs = New DbRs
mRs.Fillbydb mSqlStr
mRs.MoveFirst
mKey = 1
Do Until mRs.EOF
Set oHwBfd = New HwBfd
Set oHwBfd.HwBfdh = vHwBfdh
oHwBfd.HwBfdKey = mKey
oHwBfd.BatchLet mRs!HwBfd_HwBfdhno, mRs!HwBfd_HwBmCode, mRs!HwBfd_HwBmMc, mRs!HwBfd_HwBmno, _
mRs!HwBfd_HwDwCode, mRs!HwBfd_HwDwno, mRs!HwBfd_HwDwConv, _
mRs!HwBfdQty, mRs!HwBfdPrice, mRs!HwBfdAmt, _
mRs!HwBfdBz, mRs!HwBfdMioNo, mRs!HwBfdNo
OHwBfds.Add Item:=oHwBfd, 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 = OHwBfds.[_NewEnum]
End Function
Private Sub Class_Terminate()
ClearAll
Set OHwBfds = Nothing
End Sub
Public Sub Save(vHwBfdh As HwBfdh)
Dim mNotSaved As Collection
Dim mHwBfd As HwBfd
On Error GoTo Errorhandle
Set mNotSaved = New Collection
For Each mHwBfd In vHwBfdh.HwBfds
If mHwBfd.HwBfdId = -1 Then
mNotSaved.Add mHwBfd
End If
mHwBfd.Save
Next
Set mNotSaved = Nothing
Exit Sub
Errorhandle:
For Each mHwBfd In mNotSaved
mHwBfd.HwBfdId = -1
Next
Set mNotSaved = Nothing
Err.Raise vbObjectError + 1, , Err.Description
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -