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

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

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

Public Sub Add(oCgShd As CgShd, Optional Needsave As Integer = 1)
   Dim mKey As Integer
   Dim vCgShd As CgShd
   For Each vCgShd In OCgShds
      If mKey < vCgShd.CgShdKey Then
         mKey = vCgShd.CgShdKey
      End If
   Next
   oCgShd.CgShdKey = mKey + 1
   If Needsave = 1 Then
      oCgShd.Save
   End If
   OCgShds.Add Item:=oCgShd, Key:=CStr(mKey + 1)
End Sub

Public Sub Remove(Vindex, Optional Needdel As Integer = 1)
 
   Dim oCgShd As CgShd
   Set oCgShd = Item(Vindex)
   If Needdel = 1 And oCgShd.CgShdId = 1 Then
      oCgShd.Del
   End If
   OCgShds.Remove (Vindex)
   Set oCgShd = Nothing
   
End Sub

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

Public Function Item(Vindex) As CgShd
Attribute Item.VB_UserMemId = 0
   Set Item = OCgShds.Item(Vindex)
End Function

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

Public Sub Fillbydb(vCgShdh As CgShdh)
   Dim oCgShd As CgShd
   Dim mRs As ADODB.Recordset
   Dim mKey As Integer
On Error GoTo Errorhandle

   ClearAll
   Set mRs = Conn.Execute("SELECT CgShd_CgShdHNO,CgShd_CGPODDOCNO=COALESCE((SELECT CGPODHDOCNO FROM CGPODHREC,CGPODREC WHERE CGPODNO=CgShd_CGPODNO AND CGPODHNO=CGPOD_CGPODHNO),''),CgShd_CGPODNO,CgShd_HWBMCODE=HWBMCODE,CgShd_HWBMNO,CgShd_HWCKMC=HWCKMC,CgShd_HWCKNO,CgShdQTY,CgShdPRICE,CgShdAMT,CgShdBZ,CgShdSYSDAT,CgShdSYSTIME,CgShdNO FROM CgShdREC,HWBMREC,HWCKREC WHERE CgShd_CgShdHNO=" & CStr(vCgShdh.CgShdhNo) & " AND HWBMNO=CgShd_HWBMNO AND HWCKNO=CgShd_HWCKNO")
   
   mKey = 1
   Do Until mRs.EOF
      Set oCgShd = New CgShd
      Set oCgShd.CgShdh = vCgShdh
      oCgShd.CgShdKey = mKey
      oCgShd.BatchLet mRs!CgShd_CgShdhno, mRs!CgShd_CgPodDocno, mRs!CgShd_CgPodno, mRs!CgShd_HwBmCode, mRs!CgShd_HwBmno, mRs!CgShd_HwCkMc, mRs!CgShd_HwCkno, mRs!CgShdQty, mRs!CgShdPrice, mRs!CgShdAmt, mRs!CgShdBz, mRs!CgShdSysDat, mRs!CgShdSysTime, mRs!CgShdNo
      OCgShds.Add Item:=oCgShd, 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 = OCgShds.[_NewEnum]
End Function

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

Public Sub Save(vCgShdh As CgShdh)
   Dim mNotSaved As Collection
   Dim mCgShd As CgShd
On Error GoTo Errorhandle
   
   Set mNotSaved = New Collection
   
   For Each mCgShd In vCgShdh.CgShds
      If mCgShd.CgShdId = -1 Then
         mNotSaved.Add mCgShd
      End If
      mCgShd.Save
   Next
   
   Set mNotSaved = Nothing
   
Exit Sub
Errorhandle:
   For Each mCgShd In mNotSaved
      mCgShd.CgShdId = -1
   Next
   Set mNotSaved = Nothing
   Err.Raise vbObjectError + 1, , Err.Description
End Sub