clsbuys.cls

<Visual Basic 数据库开发实例精粹（第二版）>一书首先介绍了Visual Basic(简称VB)开发的技巧和重点技术

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsBuys"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Collection" ,"clsBuy"
Attribute VB_Ext_KEY = "Member0" ,"clsBuy"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit

'局部变量，保存集合
Private mCol As Collection

'查询进货信息（按输入的参数查询，并返回一个集合类）
Public Function Query(Optional lngID As Long = -1, Optional GoodsName As String = "", _
                      Optional BeginningDate As Date = "1/1/1900", Optional EndingDate As Date = "1/1/1900") As clsBuys
'参数说明：lngID为进货编号，GoodsName为商品名称，BeginningDate和EndingDate为进货时间范围
  On Error Resume Next
  Dim rs As Recordset       '查询返回的记录集
  Dim obj As clsBuy         '进货对象
  Dim index As Long         '要生成的集合索引
  Dim strSQL As String      'SQL字符串
    
  '构造SQL语句
  strSQL = "SELECT * FROM fn_BuyQuery"
  If lngID = -1 Then
     strSQL = strSQL & "(NULL"
  Else
     strSQL = strSQL & "(" & lngID
  End If
  If GoodsName = "" Or BeginningDate = "1/1/1900" Or EndingDate = "1/1/1900" Then
     strSQL = strSQL & ",NULL,NULL,NULL"
  Else
     strSQL = strSQL & ",'" & GoodsName & "', '" & BeginningDate & "', '" & EndingDate & "'"
  End If
  strSQL = strSQL & ")"
  
  '清空当前集合
  Me.Clear
  '执行查询并返回查询结果
  Set rs = g_Conn.Execute(strSQL)
  
  '往集合中添加查询结果
  For index = 1 To rs.RecordCount
    Set obj = New clsBuy
    '为单个对象的属性赋值
    With obj
      .ID = rs("BuyID").Value
      .GoodsID = rs("GoodsID").Value
      .GoodsName = Trim(rs("GoodsName").Value)
      .UnitName = Trim(rs("UnitName").Value)
      .UnitPrice = rs("UnitPrice").Value
      .Amount = rs("Amount").Value
      .TotalPrice = rs("TotalPrice").Value
      .Deliverer = Trim(rs("Deliverer").Value)
      .Transactor = Trim(rs("Transactor").Value)
      .RegistrarID = rs("RegistrarID").Value
      .RegistrarName = GetValueByID("UserInfo", "UserID", .RegistrarID, "TrueName")
      .RegDate = rs("RegDate").Value
      .TypeID = rs("TypeID").Value
      .TypeName = GetValueByID("GoodsType", "TypeID", .TypeID, "TypeName")
      .SupplierID = rs("SupplierID").Value
      .SupplierName = GetValueByID("Supplier", "SupplierID", .SupplierID, "SupplierName")
      .Remark = Trim(rs("Remark").Value)
    End With
    '添加单个对象到集合中
    Me.Add obj
    '释放对象
    Set obj = Nothing
    rs.MoveNext
  Next index
  
  '释放查询结果集
  Set rs = Nothing
  '函数返回值
  Set Query = Me
End Function

'统计各种商品的进货次数和进货总价格，返回一个集合类
Public Function Statistic() As clsBuys
  On Error Resume Next
  Dim rs As Recordset       '查询返回的记录集
  Dim obj As clsBuy         '进货对象
  Dim index As Long         '要生成的集合索引
  Dim strSQL As String      'SQL字符串
    
  '构造SQL语句
  strSQL = "SELECT * FROM fn_BuyStatistic()"
  
  '清空当前集合
  Me.Clear
  '执行查询并返回查询结果
  Set rs = g_Conn.Execute(strSQL)

  For index = 1 To rs.RecordCount
    Set obj = New clsBuy
    '为单个对象的属性赋值
    With obj
      '此时ID属性是商品编号,而非sale表中的销售编号
      .ID = rs("GoodsID").Value
      .GoodsName = Trim(rs("GoodsName").Value)
      .TypeName = GetValueByID("GoodsType", "TypeID", rs("TypeID").Value, "TypeName")
      .UnitName = Trim(rs("UnitName").Value)
      .AverageBuyPrice = rs("AverageBuyPrice").Value
      .TotalBuyTimes = rs("TotalBuyTimes").Value
      .TotalBuyAmount = rs("TotalBuyAmount").Value
      .GrossBuyPrice = rs("GrossBuyPrice").Value
    End With
    '添加单个对象到集合中
    Me.Add obj
    '释放对象
    Set obj = Nothing
    rs.MoveNext
  Next index
  
  '释放查询结果集
  Set rs = Nothing
  '函数返回值
  Set Statistic = Me
End Function

Private Sub Class_Initialize()
  '创建类后创建集合
  Set mCol = New Collection
End Sub

Private Sub Class_Terminate()
  '类终止后破坏集合
  Set mCol = Nothing
End Sub

Public Sub Add(obj As clsBuy)
  mCol.Add obj, "K" & obj.ID
  '在加入对象是，最好同时加入其“KEY”属性
  '“KEY”属性不可以是数字，因此在前面加一
  '个辅助字母“K”
End Sub

Public Property Get Item(vntIndexKey As Variant) As clsBuy
  '引用集合中的一个元素时使用。
  'vntIndexKey 包含集合的索引或关键字，
  '这是为什么要声明为 Variant 的原因
  '语法：Set foo = x.Item(xyz) or Set foo = x.Item(5)
  Set Item = mCol(vntIndexKey)
End Property

Public Property Get NewEnum() As IUnknown
  '本属性允许用 For...Each 语法枚举该集合。
  Set NewEnum = mCol.[_NewEnum]
End Property

Public Property Get Count() As Long
  '检索集合中的元素数时使用。语法：Debug.Print x.Count
  Count = mCol.Count
End Property

Public Sub Remove(vntIndexKey As Variant)
  '删除集合中的元素时使用。
  'vntIndexKey 包含索引或关键字，这是为什么要声明为 Variant 的原因
  '语法：x.Remove(xyz)
  mCol.Remove vntIndexKey
End Sub

Public Sub Clear()
  '清除集合中的全部元素
  Dim i As Long
  For i = 1 To mCol.Count
    mCol.Remove 1
  Next i
End Sub