mdlshowmodify.bas

visual basic +sql sever2000开发的商品进销存管理系统

Attribute VB_Name = "mdlShowModify"
Option Explicit

'根据当前操作状态显示不同的修改界面
Public Sub ShowModifyInterface()
  '如果列表视图没有选中的项目，则退出过程的执行
  If frmMain.ListView.SelectedItem Is Nothing Then Exit Sub
  '如果数据库中不存在用户要修改的项目，则退出过程的执行
  If Not ItemExist Then Exit Sub
  
  Dim lvw As ListView
  Dim frm As Form
  Dim i As Long
  
  Set lvw = frmMain.ListView
  
  '按照当前操作状态初始化并显示不同的窗体作为修改界面
  Select Case CurrentOperation
    Case BrowseUser:
         If UserType = 0 And UserID <> GetIDFromLvw Then
            MsgBox "普通用户仅能修改自己的密码！", vbInformation
            Exit Sub
         End If
         '初始化修改界面
         Set frm = frmUser
         frm.lblTitle = "修改用户"
         frm.cmdUser.Caption = "修改(&M)"
         frm.txt(0).Enabled = False
         If UserType = 0 Then frm.txt(3).Enabled = False: frm.cbo.Enabled = False
         frm.txt(0) = lvw.SelectedItem.Text
         frm.txt(3) = lvw.SelectedItem.ListSubItems(1).Text
         frm.cbo.ListIndex = IIf(lvw.SelectedItem.ListSubItems(3).Text = "普通用户", 0, 1)
         '把要修改的项目的ID值存储到修改界面（窗体）的Tag当中
         frm.Tag = GetIDFromLvw
         '有模式显示修改界面
         frm.Show vbModal, frmMain
    Case BrowseSupplier:
         Set frm = frmSupplier
         frm.lblTitle = "修改供货商"
         frm.cmdSupplier.Caption = "修改(&M)"
         frm.txt(0) = lvw.SelectedItem.Text
         frm.txt(1) = lvw.SelectedItem.ListSubItems(1).Text
         frm.txt(2) = lvw.SelectedItem.ListSubItems(2).Text
         frm.txt(3) = lvw.SelectedItem.ListSubItems(3).Text
         frm.Tag = GetIDFromLvw
         frm.Show vbModal, frmMain
    Case BrowseType:
         Set frm = frmType
         frm.lblTitle = "修改商品类型"
         frm.cmdType.Caption = "修改(&M)"
         frm.txt(0) = lvw.SelectedItem.Text
         frm.txt(1) = lvw.SelectedItem.ListSubItems(1).Text
         frm.Tag = GetIDFromLvw
         frm.Show vbModal, frmMain
    Case BrowseBuy:
         Set frm = frmBuy
         frm.lblTitle = "修改进货信息"
         frm.cmdBuy.Caption = "修改(&M)"
         Dim Buys As New clsBuys
         Buys.Query GetIDFromLvw
         For i = 0 To frm.cbo.ListCount - 1
           If frm.cbo.ItemData(i) = Buys.Item(1).GoodsID Then
              frm.cbo.ListIndex = i
              Exit For
           End If
         Next i
         frm.txt(0) = lvw.SelectedItem.ListSubItems(2).Text
         frm.txt(1) = lvw.SelectedItem.ListSubItems(3).Text
         frm.txt(2) = lvw.SelectedItem.ListSubItems(6).Text
         frm.txt(3) = lvw.SelectedItem.ListSubItems(7).Text
         frm.txt(4) = lvw.SelectedItem.ListSubItems(12).Text
         frm.Tag = GetIDFromLvw
         frm.Show vbModal, frmMain
    Case BrowseSale:
         Set frm = frmSale
         frm.lblTitle = "修改销售信息"
         frm.cmdSale.Caption = "修改(&M)"
         Dim Sales As New clsSales
         Sales.Query GetIDFromLvw
         For i = 0 To frm.cbo.ListCount - 1
             If frm.cbo.ItemData(i) = Sales.Item(1).GoodsID Then
                frm.cbo.ListIndex = i
                Exit For
             End If
         Next i
         frm.txt(0) = lvw.SelectedItem.ListSubItems(1).Text
         frm.txt(1) = lvw.SelectedItem.ListSubItems(2).Text
         frm.txt(2) = lvw.SelectedItem.ListSubItems(9).Text
         frm.Tag = GetIDFromLvw
         frm.Show vbModal, frmMain
    Case BrowseGoods:
         Set frm = frmGoods
         frm.lblTitle = "修改商品信息"
         frm.cmdGoods.Caption = "修改(&M)"
         frm.txt(0) = lvw.SelectedItem.Text
         frm.txt(1) = lvw.SelectedItem.ListSubItems(1).Text
         Dim Goodses As New clsGoodses
         Goodses.Query GetIDFromLvw
         For i = 0 To frm.cbo(0).ListCount - 1
           If frm.cbo(0).ItemData(i) = Goodses.Item(1).TypeId Then
              frm.cbo(0).ListIndex = i
              Exit For
           End If
         Next i
         For i = 0 To frm.cbo(1).ListCount - 1
           If frm.cbo(1).ItemData(i) = Goodses.Item(1).SupplierID Then
              frm.cbo(1).ListIndex = i
              Exit For
           End If
         Next i
         frm.txt(2).Text = lvw.SelectedItem.ListSubItems(2).Text
         frm.txt(3).Text = lvw.SelectedItem.ListSubItems(5).Text
         frm.txt(4).Text = lvw.SelectedItem.ListSubItems(6).Text
         frm.Tag = GetIDFromLvw
         frm.Show vbModal, frmMain
    Case BrowseSpoilage:
         Set frm = frmSpoilage
         frm.lblTitle = "修改商品报损"
         frm.cmdSpoilage.Caption = "修改(&M)"
         Dim Spoilages As New clsSpoilages
         Spoilages.Query GetIDFromLvw
         frm.txt(0) = Format(Spoilages.Item(1).BuyId, "000000")
         frm.txt(1) = lvw.SelectedItem.Text
         frm.txt(2) = lvw.SelectedItem.ListSubItems(1).Text
         frm.txt(3) = lvw.SelectedItem.ListSubItems(3).Text
         frm.txt(4) = lvw.SelectedItem.ListSubItems(8).Text
         frm.Tag = GetIDFromLvw
         frm.Show vbModal, frmMain
    Case Else:
  End Select
End Sub

'验证用户要修改的项目是否存在的函数
'该函数和数据库相应存储过程在执行更新操作时都对要修改的项目是否存在进行验证。
'为什么呢？
'因为在修改界面显示时就验证，而不是用户填写完新值并由存储过程执行更新时才验证可
'以避免用户徒劳对修改界面进行新值的填写和提交更新请求
'而存储过程进行验证是为防止在显示修改界面和用户填写完新值并单击“修改”按钮的
'时间范围内，对应项目被其他用户删除
Private Function ItemExist() As Boolean
  '根据当前操作状态确定要验证何种项目是否存在
  Dim objs As Variant
  
  Select Case CurrentOperation
  Case BrowseUser:
       Set objs = New clsUsers
  Case BrowseSupplier:
       Set objs = New clsSuppliers
  Case BrowseType:
       Set objs = New clsGoodsTypes
  Case BrowseBuy:
       Set objs = New clsBuys
  Case BrowseSale:
       Set objs = New clsSales
  Case BrowseGoods:
       Set objs = New clsGoodses
  Case BrowseSpoilage:
       Set objs = New clsSpoilages
  Case Else:
       Exit Function
  End Select
  '按照ID查询并返回对象的集合
  objs.Query GetIDFromLvw
  '如果集合元素数目为0，说明要修改的项目不存在
  If objs.Count = 0 Then
     MsgBox "您要修改的项目不存在，可能已经被别的用户删除！", vbInformation
     '该项目在数据库中已不存在，故从列表视图中删除
     DelObjFromLvw
     Exit Function
  End If
  '返回函数值
  ItemExist = True
End Function