mdllistview.bas

配置数据库参数 采用VB6.0 ADO+SQL Server 2000数据库实现程序功能

Attribute VB_Name = "mdlListView"
Option Explicit

'添加单一对象到列表视图
Public Sub ShowObjInLvw(ByRef obj As Object, Optional Flag As Boolean = True)
'参数说明：obj是在列表视图中显示的对象，Flag是添加或更新的标识（True为添加，False为更新）
  On Error Resume Next
  Dim lvw As ListView
  Dim Itm As ListItem          '列表视图的项目
  
  '设置列表视图为主界面的视图
  '这里可以把lvw作为该过程的一个参数来提升可移植性
  '请参照mdlTreeView模块InitTvwEx函数的实现
  Set lvw = frmMain.ListView
  
  '根据标识来确定列表项目是新添加项目还是当前选择项目
  If Flag Then
     Set Itm = lvw.ListItems.Add(, "K" & obj.ID)
  Else
     Set Itm = lvw.SelectedItem
  End If
  
  '按照当前操作状态添加对象的属性到列表视图
  Select Case CurrentOperation
    Case BrowseUser:
         Itm.Icon = 5
         Itm.SmallIcon = IIf(obj.UserType = 0, 2, 1)
         Itm.Text = obj.UserName
         Itm.ForeColor = IIf(obj.UserType = 0, vbBlack, vbRed)
         Itm.SubItems(1) = obj.TrueName
         Itm.SubItems(2) = IIf(obj.LastLoginTime = #1/1/1900#, "尚未登录过", obj.LastLoginTime)
         Itm.SubItems(3) = IIf(obj.UserType = 0, "普通用户", "系统管理员")
    Case BrowseSupplier:
         Itm.Icon = 1
         Itm.SmallIcon = 1
         Itm.Text = obj.SupplierName
         Itm.SubItems(1) = obj.Contact
         Itm.SubItems(2) = obj.Introduce
         Itm.SubItems(3) = obj.Remark
    Case BrowseType:
         Itm.Icon = 3
         Itm.SmallIcon = 1
         Itm.Text = obj.TypeName
         Itm.SubItems(1) = obj.Remark
    Case BrowseGoods:
         Itm.Icon = 7
         Itm.SmallIcon = IIf(obj.Amount > 10, 3, 4)
         Itm.Text = obj.GoodsName
         Itm.SubItems(1) = obj.Amount
         Itm.SubItems(2) = obj.UnitName
         Itm.SubItems(3) = obj.TypeName
         Itm.SubItems(4) = obj.SupplierName
         Itm.SubItems(5) = obj.Introduce
         Itm.SubItems(6) = obj.Remark
    Case BrowseBuy, QueryBuy:
         Itm.Icon = 7
         Itm.SmallIcon = IIf(obj.Amount > 10, 3, 4)
         Itm.Text = Format(obj.ID, "000000")
         Itm.SubItems(1) = obj.GoodsName
         Itm.SubItems(2) = obj.UnitPrice
         Itm.SubItems(3) = obj.Amount
         Itm.SubItems(4) = obj.UnitName
         Itm.SubItems(5) = obj.TotalPrice
         Itm.SubItems(6) = obj.Deliverer
         Itm.SubItems(7) = obj.Transactor
         Itm.SubItems(8) = obj.RegistrarName
         Itm.SubItems(9) = obj.RegDate
         Itm.SubItems(10) = obj.TypeName
         Itm.SubItems(11) = obj.SupplierName
         Itm.SubItems(12) = obj.Remark
    Case BrowseSale:
         Itm.Icon = 7
         Itm.SmallIcon = IIf(obj.Amount > 10, 3, 4)
         Itm.Text = obj.GoodsName
         Itm.SubItems(1) = obj.UnitPrice
         Itm.SubItems(2) = obj.Amount
         Itm.SubItems(3) = obj.UnitName
         Itm.SubItems(4) = obj.TotalPrice
         Itm.SubItems(5) = obj.RegistrarName
         Itm.SubItems(6) = obj.RegDate
         Itm.SubItems(7) = obj.TypeName
         Itm.SubItems(8) = obj.SupplierName
         Itm.SubItems(9) = obj.Remark
    Case BrowseSpoilage:
         Itm.Icon = 7
         Itm.SmallIcon = IIf(obj.Amount > 10, 3, 4)
         Itm.Text = obj.GoodsName
         Itm.SubItems(1) = obj.Amount
         Itm.SubItems(2) = obj.UnitName
         Itm.SubItems(3) = obj.Reportor
         Itm.SubItems(4) = obj.RegistrarName
         Itm.SubItems(5) = obj.RegDate
         Itm.SubItems(6) = obj.TypeName
         Itm.SubItems(7) = obj.SupplierName
         Itm.SubItems(8) = obj.Reason
    Case BuyStat:
         Itm.Icon = 7
         Itm.SmallIcon = IIf(obj.TotalBuyAmount > 100, 3, 4)
         Itm.Text = obj.GoodsName
         Itm.SubItems(1) = obj.TypeName
         Itm.SubItems(2) = obj.AverageBuyPrice
         Itm.SubItems(3) = obj.TotalBuyTimes
         Itm.SubItems(4) = obj.TotalBuyAmount
         Itm.SubItems(5) = obj.UnitName
         Itm.SubItems(6) = obj.GrossBuyPrice
    Case SaleStat:
         Itm.Icon = 7
         Itm.SmallIcon = IIf(obj.TotalSaleAmount > 100, 3, 4)
         Itm.Text = obj.GoodsName
         Itm.SubItems(1) = obj.TypeName
         Itm.SubItems(2) = obj.AverageSalePrice
         Itm.SubItems(3) = obj.TotalSaleTimes
         Itm.SubItems(4) = obj.TotalSaleAmount
         Itm.SubItems(5) = obj.UnitName
         Itm.SubItems(6) = obj.GrossSalePrice
    Case SpoilageStat:
         Itm.Icon = 7
         Itm.SmallIcon = IIf(obj.TotalRegAmount > 100, 3, 4)
         Itm.Text = obj.GoodsName
         Itm.SubItems(1) = obj.TypeName
         Itm.SubItems(2) = obj.TotalRegTimes
         Itm.SubItems(3) = obj.TotalRegAmount
         Itm.SubItems(4) = obj.UnitName
    Case Else:
  End Select
End Sub

'添加对象集合到列表视图
Public Sub AddObjsToLvw(ByRef objs As Variant, Optional Flag As Boolean = True)
'参数说明：objs是要添加的对象集合
'          Flag是当前操作状态提示标签的文字是否设置为浏览所有信息，True为设置，False为不设置
'          由于单击树形视图的节点调用该过程时，需要设置当前操作状态提示标签为浏览商品分类信息
'          故此处不有选择设置当前操作状态提示标签的文字，则会先显示浏览所有信息再显示为浏览商
'          品分类信息，从而产生闪烁感

  Dim i As Long
  '添加列表视图的列首
  InitLvw frmMain.ListView
  DoEvents
  
  '标识为True则设置当前操作状态提示标签的文字为浏览所有信息
  If Flag Then SetLbl frmMain.lblDescribe
  
  '添加对象集合内的每一对象到列表视图
  For i = 1 To objs.Count
    ShowObjInLvw objs.Item(i)
  Next
  
  '设置提示信息
  frmMain.lblCount = Space(5) & frmMain.ListView.ListItems.Count & "个项目"
  frmMain.SBar.Panels(1) = frmMain.lblDescribe
End Sub

'初始化列表视图
Public Sub InitLvw(ByRef lvw As ListView)
  frmMain.picAbout.Visible = False
  frmMain.lblCount = ""
  '清空并按照当前操作状态重新添加列首
  With lvw
    .ColumnHeaders.Clear
    .ListItems.Clear
    Select Case CurrentOperation
      Case BrowseUser:
          .ColumnHeaders.Add , , "用户名", 1500
          .ColumnHeaders.Add , , "真实姓名", 1500
          .ColumnHeaders.Add , , "上次登录时间", 2100
          .ColumnHeaders.Add , , "用户类型", 1200
      Case BrowseSupplier:
          .ColumnHeaders.Add , , "供应商名称", 3500
          .ColumnHeaders.Add , , "联系方式", 3000
          .ColumnHeaders.Add , , "简要介绍", 3000
          .ColumnHeaders.Add , , "备注", 4000
      Case BrowseType:
          .ColumnHeaders.Add , , "类型名称", 1500
          .ColumnHeaders.Add , , "备注", 12000
      Case BrowseBuy, QueryBuy:
          .ColumnHeaders.Add , , "进货编号", 1000
          .ColumnHeaders.Add , , "商品名称", 3500
          .ColumnHeaders.Add , , "单价(元)", 1000
          .ColumnHeaders.Add , , "数量", 750
          .ColumnHeaders.Add , , "单位", 750
          .ColumnHeaders.Add , , "总金额(元)", 1200
          .ColumnHeaders.Add , , "送货员", 800
          .ColumnHeaders.Add , , "办理员", 800
          .ColumnHeaders.Add , , "登记员", 800
          .ColumnHeaders.Add , , "登记时间", 2000
          .ColumnHeaders.Add , , "商品类型", 1000
          .ColumnHeaders.Add , , "供货商", 1250
          .ColumnHeaders.Add , , "备注", 3000
      Case BrowseSale:
          .ColumnHeaders.Add , , "商品名称", 3500
          .ColumnHeaders.Add , , "单价(元)", 1000
          .ColumnHeaders.Add , , "数量", 750
          .ColumnHeaders.Add , , "单位", 750
          .ColumnHeaders.Add , , "总金额(元)", 1200
          .ColumnHeaders.Add , , "登记员", 800
          .ColumnHeaders.Add , , "登记时间", 2000
          .ColumnHeaders.Add , , "商品类型", 1000
          .ColumnHeaders.Add , , "供货商", 1250
          .ColumnHeaders.Add , , "备注", 3000
      Case BrowseGoods:
          .ColumnHeaders.Add , , "商品名称", 3500
          .ColumnHeaders.Add , , "库存量", 1000
          .ColumnHeaders.Add , , "单位", 750
          .ColumnHeaders.Add , , "商品类型", 1200
          .ColumnHeaders.Add , , "供货商", 2000
          .ColumnHeaders.Add , , "商品介绍", 2000
          .ColumnHeaders.Add , , "备注", 3000
      Case BrowseSpoilage:
          .ColumnHeaders.Add , , "商品名称", 3500
          .ColumnHeaders.Add , , "报损数量", 1000
          .ColumnHeaders.Add , , "单位", 750
          .ColumnHeaders.Add , , "报损人", 800
          .ColumnHeaders.Add , , "登记员", 1000
          .ColumnHeaders.Add , , "登记时间", 2000
          .ColumnHeaders.Add , , "商品类型", 1000
          .ColumnHeaders.Add , , "供货商", 1250
          .ColumnHeaders.Add , , "报损原因", 2200
      Case BuyStat:
          .ColumnHeaders.Add , , "商品名称", 3500
          .ColumnHeaders.Add , , "商品类型", 1250
          .ColumnHeaders.Add , , "平均单价(元)", 1500
          .ColumnHeaders.Add , , "进货次数", 1000
          .ColumnHeaders.Add , , "进货总量", 1000
          .ColumnHeaders.Add , , "单位", 1000
          .ColumnHeaders.Add , , "进货总金额(元)", 1600
      Case SaleStat:
          .ColumnHeaders.Add , , "商品名称", 3500
          .ColumnHeaders.Add , , "商品类型", 1250
          .ColumnHeaders.Add , , "平均单价(元)", 1500
          .ColumnHeaders.Add , , "销售次数", 1000
          .ColumnHeaders.Add , , "销售总量", 1000
          .ColumnHeaders.Add , , "单位", 1000
          .ColumnHeaders.Add , , "销售总金额(元)", 1600
      Case SpoilageStat:
          .ColumnHeaders.Add , , "商品名称", 3500
          .ColumnHeaders.Add , , "商品类型", 1250
          .ColumnHeaders.Add , , "报损次数", 1000
          .ColumnHeaders.Add , , "报损总量", 1000
          .ColumnHeaders.Add , , "单位", 1000
      Case Else:
    End Select
  End With
End Sub

'设置用户操作状态提示标签
Private Sub SetLbl(ByRef lbl As Label)
  Select Case CurrentOperation
    Case BrowseUser:
         lbl = "浏览所有用户"
    Case BrowseSupplier:
         lbl = "浏览所有供货商"
    Case BrowseType:
         lbl = "浏览所有商品类型"
    Case BrowseBuy, QueryBuy:
         lbl = IIf(CurrentOperation = BrowseBuy, "浏览所有进货", "查询进货信息")
    Case BrowseSale:
         lbl = "浏览所有商品销售"
    Case BrowseGoods:
         lbl = "浏览所有商品"
    Case BrowseSpoilage:
         lbl = "浏览所有商品报损"
    Case BuyStat:
         lbl = "商品进货统计"
    Case SaleStat:
         lbl = "商品销售统计"
    Case SpoilageStat:
         lbl = "商品报损统计"
    Case Else:
  End Select
  '设置标签的位置
  frmMain.lblCount.Left = lbl.Left + lbl.Width
End Sub

'从列表视图获取选择项目的ID值
Public Function GetIDFromLvw() As Long
  GetIDFromLvw = Mid(frmMain.ListView.SelectedItem.Key, 2)
End Function

'从列表视图删除单一对象
Public Sub DelObjFromLvw()
  On Error Resume Next
  frmMain.ListView.ListItems.Remove frmMain.ListView.SelectedItem.Index
  frmMain.lblCount = Space(5) & frmMain.ListView.ListItems.Count & "个项目"
End Sub