ERP-EIP-OA-Portal

Development Platform:
Visual Basic

clsOpBuy.cls：Code Content
							VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsOpBuy"
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, strUser As String)
  Dim obj As clsBuy
  Dim Result As gxcAddNew
  
  '显示添加对话框并获取数据
  If Not frmBuy.ShowDlg(obj, vtadd, strUser) 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, strUser As String)
  Dim obj As clsBuy
  Dim strName As String
  
  '获取选中元素，如果没有选中的对象则退出函数
  If GetObjFromControl(ctl, obj) = False Then
    MsgBox "请选择商品类型"
    Exit Sub
  End If
  
  '显示添加对话框并获取数据
  If Not frmBuy.ShowDlg(obj, vtModify, strUser) 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 clsBuy
  Dim Result As gxcDelete
  
  '获取选中的XXX，如果没有选中的对象则退出函数
  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
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'将单个客户加入列表，或在列表中更新
'特意将该函数单独做出来，而没有将本函数中的代码完全在MerchsToListview函数中实现
'Why?
'因为在设计该功能时，你还应考虑到在以后的编程过程中，很可能要用到
'将某个单独的“商品”对象加入列表框（比如新增加了一个客户）。
Public Sub AddToLvw(ByVal obj As clsBuy, _
                          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) = .ProviderName
    Itm.SubItems(2) = .StockDate
    Itm.SubItems(3) = .Count
    Itm.SubItems(4) = "件/个"
    Itm.SubItems(5) = .StockPrice
    Itm.SubItems(6) = .Deliver
    Itm.SubItems(7) = .Consignee
    Itm.SubItems(8) = .Remark
  End With
  Set Itm = Nothing
End Sub
'设置ListView的显示样式
Public Sub InitListview(ByRef lvw As Object)
  With lvw
    .ColumnHeaders.Clear
    '加入四个列首
    .ColumnHeaders.Add , , "商品名称", 1500
    .ColumnHeaders.Add , , "供货商", 1500
    .ColumnHeaders.Add , , "进化时间", 1200
    .ColumnHeaders.Add , , "进货数量", 1000
    .ColumnHeaders.Add , , "单位", 800
    .ColumnHeaders.Add , , "单价(元)", 800
    .ColumnHeaders.Add , , "送货人", 1000
    .ColumnHeaders.Add , , "经手人", 1000
    .ColumnHeaders.Add , , "备注", 4000
  End With
End Sub
'将进货信息集合显示到ListView中
Public Sub ObjsToListView(ByVal objs As clsBuys, ByRef lvw As Object)
  '传入参数为进货信息的集合类与列表框
  Dim i As Long
  
  '如果列表还未初始化，则初始化之(你可以采用其它方法判断是否初始化，这里是个笨办法)
  If lvw.ColumnHeaders.Count = 0 Then InitListview lvw
  lvw.ListItems.Clear '清除当前的列表内容
  
  For i = 1 To objs.Count
    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 clsBuys
  Dim rstObjs As clsBuys
  
  '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 clsBuys
  Dim rstObjs As clsBuys
  
  'Find的参数取默认值，此时查找全部
  Set rstObjs = objs.FindStorage(IsDesc, nCount)
  
  '检查是否找到数据
  If rstObjs Is Nothing Then
    Exit Sub
  End If
  
  '将查找到的客户集合添加到列表控件中
  AnaObjsToListView rstObjs, lvw
  
  Set objs = Nothing
  Set rstObjs = Nothing
  
End Sub
'从列表或树型图中得到一个对象
Public Function GetObjFromControl(ByVal lvw As Object, _
                                    ByRef obj As clsBuy) As Boolean
  '如果列表中没有被选择的项，则直接退出
  If lvw.SelectedItem Is Nothing Then
    GetObjFromControl = False
    Exit Function
  End If
  Dim objs As New clsBuys
  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
'=====================================================================
'
' 以下以Ana开头的方法是供分析使用，
' 因为所显示的内容与列都不相同，所以另外做一套函数，
' 其实与clsOpBuy关系不很大
'
'=====================================================================
Public Sub AnaAddToLvw(ByVal obj As clsBuy, _
                          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  '这里要与InitMerchListview相对应
    Itm.SmallIcon = sIcon
    Itm.Icon = bIcon
    Itm.Text = .TypeName
    Itm.SubItems(1) = .MerchName
    Itm.SubItems(2) = .StockTimes
    Itm.SubItems(3) = .TotalPrice
    Itm.SubItems(4) = "元"
 End With
  Set Itm = Nothing
End Sub
'按照“商品”设置ListView的显示样式
Public Sub AnaInitListview(ByRef lvw As Object)
  With lvw
    .ColumnHeaders.Clear
    '加入列首
    .ColumnHeaders.Add , , "商品类型", 1500
    .ColumnHeaders.Add , , "商品名称", 1500
    .ColumnHeaders.Add , , "进货登记次数", 1500
    .ColumnHeaders.Add , , "进货总价", 1500
    .ColumnHeaders.Add , , "单位", 800
  End With
  
End Sub
'将进货信息集合显示到ListView中
Public Sub AnaObjsToListView(ByVal objs As clsBuys, ByRef lvw As Object)
  '传入参数为进货信息的集合类与列表框
  Dim i As Long
  
  '如果列表还未初始化，则初始化之(你可以采用其它方法判断是否初始化，这里是个笨办法)
  AnaInitListview lvw
  lvw.ListItems.Clear '清除当前的列表内容
  
  For i = 1 To objs.Count
    '将每个“商品”都加入到该列表中，调用了单独的函数，没有全部做到这
    '个函数中，为什么呢？参看AddMerchToLvw函数
    AnaAddToLvw objs.Item(i), lvw, False
  Next i
End Sub

						