clsopmerch.cls

《超市进销存管理系统的开发与实现》 2、开发工具 Microsoft Visual Basic 6.0 3、运行环境 （1）、硬件环境 486DX/66MHz或更高

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

'==============================================================
'
' 处理增、删、改
'
'===============================================================
'管理增加操作
Public Sub Add(ctl As Object, nTypeId As Long)
  Dim obj As clsMerch
  Dim Result As gxcAddNew
  
  If nTypeId = 0 Then
    MsgBox "请选择商品类型"
    Exit Sub
  End If
   '显示添商品对话框并获取数据
  If Not frmMerch.ShowDlg(obj, vtadd, nTypeId) Then Exit Sub
  '更新数据库
  Result = obj.AddNew
  If Result = AddNewOK Then
    AddToLvw obj, ctl, False
  ElseIf Result = DuplicateName_AddNew Then
    MsgBox "名称重复"
  Else
    MsgBox "错误"
  End If

End Sub

'管理修改操作
Public Sub Modify(ctl As Object)
  Dim obj As clsMerch
  Dim strName As String
  
  '获取列表框选中的商品，如果没有选中的对象则退出函数
  If GetObjFromControl(ctl, obj) = False Then
    MsgBox "请选择商品类型"
    Exit Sub
  End If
  
  '显示添加客户对话框并获取数据
  If Not frmMerch.ShowDlg(obj, vtModify) Then Exit Sub
  '更新数据库
  Dim Result As gxcUpdate
  Result = obj.Update
  If Result = UpdateOK Then
    '将商品在更表框中更新
    AddToLvw obj, ctl, True
  ElseIf Result = DuplicateName_Update Then
    MsgBox "名称重复"
  Else
    MsgBox "错误"
  End If
  
End Sub

'管理删除操作
Public Sub Delete(ctl As Object)
  Dim obj As clsMerch
  Dim Result As gxcDelete
  
  '获取列表框中选中的商品，如果没有选中的对象则退出函数
  If GetObjFromControl(ctl, obj) = False Then
    MsgBox "请选择商品类型"
    Exit Sub
  End If
  
  If MsgBox("真的要删除吗？", vbQuestion + vbYesNo + _
            vbDefaultButton2) = vbNo Then Exit Sub
  
  '从数据库中删除
  Result = obj.Delete
  If Result = DeleteFail Then
    MsgBox "删除失败！"
  ElseIf Result = DeleteOK Then
    '来到这，说明删除成功，从树形图中删除节点
    ctl.ListItems.Remove ctl.SelectedItem.index
  End If

End Sub


'==============================================================
'
' 处理ListView控件：AddToLvw，InitListview, ObjsToListView,
'                   FillListView, GetObjFromControl
'
'===============================================================

'将单个对象加入列表，或在列表中更新
Public Sub AddToLvw(ByVal obj As clsMerch, _
                          ByRef lvw As Object, _
                          ByVal IsOverWrite As Boolean)
  '第三个参数如果是TRUE，则说明是更新当前已存在的某个列表项，否则是新加一个列表项
  Dim Itm As ListItem
  Dim sIcon As String
  Dim bIcon As String
  
  '图标关键字
  sIcon = "sboy"
  bIcon = "bboy"
  
  '如果是更新（即覆盖），则使用当前选种的元素
  If IsOverWrite Then
    Set Itm = lvw.SelectedItem
    If Itm Is Nothing Then Exit Sub
  Else
    Set Itm = lvw.ListItems.Add(, "A" & obj.ID, , bIcon, sIcon)
  End If
  With obj  '这里要与InitListview相对应
    Itm.SmallIcon = sIcon
    Itm.Icon = bIcon
    Itm.Text = .MerchName
    Itm.SubItems(1) = .TypeName
    Itm.SubItems(2) = .Storage
    Itm.SubItems(3) = "件/个"
    Itm.SubItems(4) = .Introduce
    Itm.SubItems(5) = .Remark
  End With
  Set Itm = Nothing
End Sub


'设置ListView的显示样式
Public Sub InitListview(ByRef lvw As Object)
  With lvw
    .ColumnHeaders.Clear
    '加入列首
    .ColumnHeaders.Add , , "名称", 1200
    .ColumnHeaders.Add , , "类别", 1500
    .ColumnHeaders.Add , , "库存量", 1500
    .ColumnHeaders.Add , , "单位", 1300
    .ColumnHeaders.Add , , "介绍", 1500
    .ColumnHeaders.Add , , "备注", 1000
  End With
End Sub

'将对象集合显示到ListView中
Public Sub ObjsToListView(ByVal objs As clsMerchs, ByRef lvw As Object)
  '传入参数为商品的集合类与列表框
  Dim i As Long
  
  '如果列表还未初始化，则初始化之(你可以采用其它方法判断是否初始化，这里是个笨办法)
  If lvw.ColumnHeaders.Count < 6 Then InitListview lvw
  lvw.ListItems.Clear '清除当前的列表内容
  
  For i = 1 To objs.Count
    '将每个“商品”都加入到该列表中，调用了单独的函数，没有全部做到这
    '个函数中，为什么呢？参看AddToLvw函数
    AddToLvw objs.Item(i), lvw, False
  Next i
End Sub

'显示指定类型对象到列表控件
Public Sub FillListView(ByRef lvw As Object, Optional lngTypeId As Long = 0)
  Dim objs As New clsMerchs
  Dim rstObjs As clsMerchs
  
  'Find的参数取默认值，此时查找全部
  Set rstObjs = objs.Find(, lngTypeId)
  
  '检查是否找到数据
  If rstObjs Is Nothing Then
    Exit Sub
  End If
  
  '将查找到的商品集合添加到列表控件中
  ObjsToListView rstObjs, lvw
  
  Set objs = Nothing
  Set rstObjs = Nothing
  
End Sub

'库存量排行
Public Sub FindStorage(ByRef lvw As Object, _
                      Optional IsDesc As Boolean = True, _
                      Optional nCount As Integer = 10)
  Dim objs As New clsMerchs
  Dim rstObjs As clsMerchs
  
  'Find的参数取默认值，此时查找全部
  Set rstObjs = objs.FindStorage(IsDesc, nCount)
  
  '检查是否找到数据
  If rstObjs Is Nothing Then
    Exit Sub
  End If
  
  '将查找到的客户集合添加到列表控件中
  ObjsToListView rstObjs, lvw
  
  Set objs = Nothing
  Set rstObjs = Nothing
                      
End Sub

'从列表或树型图中得到一个对象
Public Function GetObjFromControl(ByVal lvw As Object, _
                                    ByRef obj As clsMerch) As Boolean
  '如果列表中没有被选择的项，则直接退出
  If lvw.SelectedItem Is Nothing Then
    GetObjFromControl = False
    Exit Function
  End If

  Dim objs As New clsMerchs
  Dim ID As Long
  '去除Listview中列表项的KEY属性前的字母“A”，即为该商品的ID值
  ID = GetID(lvw.SelectedItem.Key)

  On Error Resume Next '为了防止未查找到，因此加入了错误判断语句
  Set obj = objs.Find(ID).Item(1)
  GetObjFromControl = (Err.Number = 0)
End Function

'==============================================================
'
' 处理Combo控件：FillCombo，ObjsToCombo
'
'===============================================================

'传入参数为对象的集合类与组合框
Private Sub ObjsToCombo(ByVal objs As clsMerchs, ByRef cbo As ComboBox)
  Dim i As Long
  
  cbo.Clear '清除当前的列表内容
  
  For i = 1 To objs.Count
    Call cbo.AddItem(objs.Item(i).MerchName, i - 1)
    cbo.ItemData(i - 1) = objs.Item(i).ID
  Next i
  
End Sub

'将数据库中全部对象加入到组合框中
Public Sub FillCombo(ByRef cbo As Object)
  Dim objs As New clsMerchs
  Dim rstObjs As clsMerchs
  
  Set rstObjs = objs.Find
  ObjsToCombo rstObjs, cbo
  
  Set objs = Nothing
  Set rstObjs = Nothing
  
End Sub