kcdbds.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 = "KcDbds"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'QQ:75347626
'MSN:[e-mail]
Option Explicit
Dim OKcDbds As Collection

Public Property Get Name() As String
   Name = "KcDbds"
End Property

Private Sub Class_Initialize()
   Set OKcDbds = New Collection
End Sub

Public Sub Add(oKcDbd As KcDbd, Optional Needsave As Integer = 1)
   Dim mKey As Integer
   Dim vKcDbd As KcDbd
   For Each vKcDbd In OKcDbds
      If mKey < vKcDbd.KcDbdKey Then
         mKey = vKcDbd.KcDbdKey
      End If
   Next
   oKcDbd.KcDbdKey = mKey + 1
   If Needsave = 1 Then
      oKcDbd.Save
   End If
   OKcDbds.Add Item:=oKcDbd, Key:=CStr(mKey + 1)
End Sub

Public Sub Remove(Vindex, Optional Needdel As Integer = 1)
 
   Dim oKcDbd As KcDbd
   Set oKcDbd = Item(Vindex)
   If Needdel = 1 And oKcDbd.KcDbdId = 1 Then
      oKcDbd.Del
   End If
   OKcDbds.Remove (Vindex)
   Set oKcDbd = Nothing
   
End Sub

Public Property Get Count() As Integer
   Count = OKcDbds.Count
End Property

Public Function Item(Vindex) As KcDbd
Attribute Item.VB_UserMemId = 0
   Set Item = OKcDbds.Item(Vindex)
End Function

Public Sub ClearAll()
   Dim I, Vcount As Integer
   Vcount = OKcDbds.Count
   For I = 1 To Vcount
      OKcDbds.Remove (1)
   Next
End Sub

Public Sub Fillbydb(vKcDbdh As KcDbdh)
   Dim oKcDbd As KcDbd
   Dim mRs As ADODB.Recordset
   Dim mKey As Integer
On Error GoTo Errorhandle

   ClearAll
   Set mRs = Conn.Execute("SELECT KcDbd_KcDbdHNO,KcDbd_HwBmCode=HwBmCode,KcDbd_HWBMNO,KcDbd_FromHwCkMc=A.HWCKMC,KcDbd_FromHwCkNO,KcDbd_TOHwCkMc=B.HWCKMC,KcDbd_TOHwCkNO,KcDbdQTY,KcDbdPRICE,KcDbdAMT,KcDbdBZ,KcDbdSYSDAT,KcDbdSYSTIME,KcDbdNO FROM KcDbdREC,HWBMREC,HwCkREC A,HWCKREC B WHERE KcDbd_KcDbdhno=" & CStr(vKcDbdh.KcDbdhNo) & " AND HWBMNO=KcDbd_HWBMNO AND A.HwCkNO=KcDbd_FromHwCkNO AND B.HWCKNO=KCDBD_TOHWCKNO ORDER BY KCDBDNO")
   
   mKey = 1
   Do Until mRs.EOF
      Set oKcDbd = New KcDbd
      Set oKcDbd.KcDbdh = vKcDbdh
      oKcDbd.KcDbdKey = mKey
      oKcDbd.BatchLet mRs!KcDbd_KcDbdhno, mRs!KcDbd_HwBmCode, mRs!KcDbd_HwBmno, mRs!KcDbd_FromHwCkMc, mRs!KcDbd_FromHwCkno, mRs!KcDbd_ToHwCkMc, mRs!KcDbd_ToHwCkno, mRs!KcDbdQty, mRs!KcDbdPrice, mRs!KcDbdAmt, mRs!KcDbdBz, mRs!KcDbdSysDat, mRs!KcDbdSysTime, mRs!KcDbdNo
      OKcDbds.Add Item:=oKcDbd, 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 = OKcDbds.[_NewEnum]
End Function

Private Sub Class_Terminate()
   ClearAll
   Set OKcDbds = Nothing
End Sub

Public Sub Save(vKcDbdh As KcDbdh)
   Dim mNotSaved As Collection
   Dim mKcDbd As KcDbd
On Error GoTo Errorhandle
   
   Set mNotSaved = New Collection
   
   For Each mKcDbd In vKcDbdh.KcDbds
      If mKcDbd.KcDbdId = -1 Then
         mNotSaved.Add mKcDbd
      End If
      mKcDbd.Save
   Next
   
   Set mNotSaved = Nothing
   
Exit Sub
Errorhandle:
   For Each mKcDbd In mNotSaved
      mKcDbd.KcDbdId = -1
   Next
   Set mNotSaved = Nothing
   Err.Raise vbObjectError + 1, , Err.Description
End Sub