salers.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 = "Salers"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Dim OSalers As Collection

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

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

Public Sub Add(OSaler As Saler, Optional Needsave As Integer = 1)
   Dim mKey As Integer
   Dim vSaler As Saler
   For Each vSaler In OSalers
      If mKey < vSaler.SalerKey Then
         mKey = vSaler.SalerKey
      End If
   Next
   OSaler.SalerKey = mKey + 1
   If Needsave = 1 Then
      OSaler.Save
   End If
   OSalers.Add Item:=OSaler, Key:=CStr(mKey + 1)
End Sub

Public Sub Remove(Vindex, Optional Needdel As Integer = 1)
 
   Dim OSaler As Saler
   Set OSaler = Item(Vindex)
   If Needdel = 1 And OSaler.SalerId = 1 Then
      OSaler.Del
   End If
   OSalers.Remove (Vindex)
   Set OSaler = Nothing
   
End Sub

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

Public Function Item(Vindex) As Saler
Attribute Item.VB_UserMemId = 0
   Set Item = OSalers.Item(Vindex)
End Function

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

Public Sub Fillbydb()
   Dim OSaler As Saler
   Dim Rs As DbRs
   Dim mKey As Integer
On Error GoTo Errorhandle

   ClearAll
   Set Rs = New DbRs
   Rs.Fillbydb "SELECT SalerCODE,SalerMC,SalerISSTOP,SalerNO FROM SalerREC ORDER BY SalerCODE"
   Rs.MoveFirst
   
   mKey = 1
   Do Until Rs.EOF
      Set OSaler = New Saler
      OSaler.SalerKey = mKey
      OSaler.BatchLet Rs!SalerCode, Rs!SalerMc, Rs!SalerIsStop, Rs!SalerNo
      OSalers.Add Item:=OSaler, Key:=CStr(mKey)
      Rs.MoveNext
      mKey = mKey + 1
   Loop

   Set Rs = Nothing

Exit Sub
Errorhandle:
   Set Rs = 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 = OSalers.[_NewEnum]
End Function

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