frmmain.frm

网上购物管理系统做的很一般 见谅

  '列表视图显示进货时才能选择项目并删除
  If (CurrentOperation <> BrowseBuy And CurrentOperation <> QueryBuy) Or ListView.SelectedItem Is Nothing Then
     MsgBox "请把列表视图切换到进货信息显示状态，然后选择您要删除的进货信息。", vbInformation
     Exit Sub
  End If
  '用户单击消息框的“否”按钮则退出该过程的执行
  If MsgBox("删除操作不可恢复。确定要删除选定项目吗？", vbQuestion + vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub
  
  Dim Buy As New clsBuy         '进货信息
  Dim Result As gxcDelete       '删除结果
  
  '删除进货信息并返回删除结果
  Result = Buy.Delete(GetIDFromLvw)
  
  '根据删除结果提示用户
  ProcDeleteResult Result
End Sub

Private Sub mnuDelSale_Click()
  If CurrentOperation <> BrowseSale Or ListView.SelectedItem Is Nothing Then
     MsgBox "请把列表视图切换到销售信息显示状态，然后选择您要删除的销售信息。", vbInformation
     Exit Sub
  End If
  If MsgBox("删除操作不可恢复。确定要删除选定项目吗？", vbQuestion + vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub
  
  Dim Sale As New clsSale
  Dim Result As gxcDelete
  
  Result = Sale.Delete(GetIDFromLvw)
  
  ProcDeleteResult Result
End Sub

Private Sub mnuDelSpoilage_Click()
  If CurrentOperation <> BrowseSpoilage Or ListView.SelectedItem Is Nothing Then
     MsgBox "请把列表视图切换到报损信息显示状态，然后选择您要删除的报损信息。", vbInformation
     Exit Sub
  End If
  If MsgBox("删除操作不可恢复。确定要删除选定项目吗？", vbQuestion + vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub
  
  Dim Spoilage As New clsSpoilage
  Dim Result As gxcDelete
  
  Result = Spoilage.Delete(GetIDFromLvw)
  
  ProcDeleteResult Result
End Sub

Private Sub mnuDelGoods_Click()
  If CurrentOperation <> BrowseGoods Or ListView.SelectedItem Is Nothing Then
     MsgBox "请把列表视图切换到商品信息显示状态，然后选择您要删除的商品信息。", vbInformation
     Exit Sub
  End If
  If MsgBox("删除操作不可恢复。确定要删除选定项目吗？", vbQuestion + vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub
  
  Dim Goods As New clsGoods
  Dim Result As gxcDelete
  
  Result = Goods.Delete(GetIDFromLvw)
  
  ProcDeleteResult Result
End Sub

Private Sub mnuDelSupplier_Click()
  If CurrentOperation <> BrowseSupplier Or ListView.SelectedItem Is Nothing Then
     MsgBox "请把列表视图切换到供货商显示状态，然后选择您要删除的供货商。", vbInformation
     Exit Sub
  End If
  If MsgBox("删除操作不可恢复。确定要删除选定项目吗？", vbQuestion + vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub
  
  Dim Supplier As New clsSupplier
  Dim Result As gxcDelete
  
  Result = Supplier.Delete(GetIDFromLvw)
  
  ProcDeleteResult Result
End Sub

Private Sub mnuDelType_Click()
  If CurrentOperation <> BrowseType Or ListView.SelectedItem Is Nothing Then
     MsgBox "请把列表视图切换到商品类型显示状态，然后选择您要删除的商品类型。", vbInformation
     Exit Sub
  End If
  If MsgBox("删除操作不可恢复。确定要删除选定项目吗？", vbQuestion + vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub
  
  Dim GoodsType As New clsGoodsType
  Dim Result As gxcDelete
  
  Result = GoodsType.Delete(GetIDFromLvw)
  
  '与其他项目的删除相比，浏览商品类型要考虑须同时删除树形视图的相关节点
  If Result = DeleteOK Then
     DelTypeFromTvwEx
  End If
  ProcDeleteResult Result
End Sub

Private Sub mnuDelUser_Click()
  If CurrentOperation <> BrowseUser Or ListView.SelectedItem Is Nothing Then
     MsgBox "请把列表视图切换到用户显示状态，然后选择您要删除的用户信息。", vbInformation
     Exit Sub
  End If
  If MsgBox("删除操作不可恢复。确定要删除选定项目吗？", vbQuestion + vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub
  
  Dim User As New clsUser
  Dim Result As gxcDelete
 
  Result = User.Delete(GetIDFromLvw)
  
  ProcDeleteResult Result
End Sub
'============================================================================

Private Sub mnuExit_Click()
  Unload Me
End Sub

Private Sub mnuHelpFile_Click()
  '打开同路径下的帮助文件Help.txt
  ShellExecute Me.hwnd, "open", App.Path & "hh", vbNullString, vbNullString, vbNormalFocus
End Sub

'============================================================================
'修改进货信息，以下菜单响应代码与之类似
Private Sub mnuModifyBuy_Click()
  '列表视图显示进货信息时才能选择项目并修改
  If (CurrentOperation <> BrowseBuy And CurrentOperation <> QueryBuy) Or ListView.SelectedItem Is Nothing Then
     MsgBox "请把列表视图切换到进货信息显示状态，然后选择您要修改的进货信息。", vbInformation
     Exit Sub
  End If
  '根据选择的项目显示修改界面
  ShowModifyInterface
End Sub

Private Sub mnuModifySale_Click()
  If CurrentOperation <> BrowseSale Or ListView.SelectedItem Is Nothing Then
     MsgBox "请把列表视图切换到销售信息显示状态，然后选择您要修改的销售信息。", vbInformation
     Exit Sub
  End If
  ShowModifyInterface
End Sub

Private Sub mnuModifySpoilage_Click()
  If CurrentOperation <> BrowseSpoilage Or ListView.SelectedItem Is Nothing Then
     MsgBox "请把列表视图切换到报损信息显示状态，然后选择您要修改的报损信息。", vbInformation
     Exit Sub
  End If
  ShowModifyInterface
End Sub

Private Sub mnuModifyGoods_Click()
  If CurrentOperation <> BrowseGoods Or ListView.SelectedItem Is Nothing Then
     MsgBox "请把列表视图切换到商品信息显示状态，然后选择您要修改的商品信息。", vbInformation
     Exit Sub
  End If
  ShowModifyInterface
End Sub

Private Sub mnuModifySupplier_Click()
  If CurrentOperation <> BrowseSupplier Or ListView.SelectedItem Is Nothing Then
     MsgBox "请把列表视图切换到供货商显示状态，然后选择您要修改的供货商。", vbInformation
     Exit Sub
  End If
  ShowModifyInterface
End Sub

Private Sub mnuModifyType_Click()
  If CurrentOperation <> BrowseType Or ListView.SelectedItem Is Nothing Then
     MsgBox "请把列表视图切换到商品类型显示状态，然后选择您要修改的商品类型。", vbInformation
     Exit Sub
  End If
  ShowModifyInterface
End Sub

Private Sub mnuModifyUser_Click()
  If CurrentOperation <> BrowseUser Or ListView.SelectedItem Is Nothing Then
     MsgBox "请把列表视图切换到用户显示状态，然后选择您要修改的用户。", vbInformation
     Exit Sub
  End If
  ShowModifyInterface
End Sub
'============================================================================

'============================================================================
'显示进货信息查询界面
Private Sub mnuQueryBuy_Click()
  picQuery.Visible = True
  TreeView.Visible = False
  dtBegin.Value = Date
  dtEnd.Value = Date
  lblQuery(5) = ""
  txtGoodsName.SetFocus
End Sub

Private Sub mnuQuerySale_Click()
  'If MsgBox("请参考“查询进货”的功能实现部分。" & Chr(13) & "是否立即查看？", vbQuestion + vbYesNo) = vbYes Then mnuQueryBuy_Click
picQuery.Visible = True
  TreeView.Visible = False
  dtBegin.Value = Date
  dtEnd.Value = Date
  lblQuery(5) = ""
  txtGoodsName.SetFocus
End Sub

Private Sub mnuQuerySpoilage_Click()
  'If MsgBox("请参考“查询进货”的功能实现部分。" & Chr(13) & "是否立即查看？", vbQuestion + vbYesNo) = vbYes Then mnuQueryBuy_Click
picQuery.Visible = True
  TreeView.Visible = False
  dtBegin.Value = Date
  dtEnd.Value = Date
  lblQuery(5) = ""
  txtGoodsName.SetFocus
End Sub

Private Sub mnuQueryGoods_Click()
  'If MsgBox("请参考“查询进货”的功能实现部分。" & Chr(13) & "是否立即查看？", vbQuestion + vbYesNo) = vbYes Then mnuQueryBuy_Click
picQuery.Visible = True
  TreeView.Visible = False
  dtBegin.Value = Date
  dtEnd.Value = Date
  lblQuery(5) = ""
  txtGoodsName.SetFocus
End Sub

Private Sub mnuQuerySupplier_Click()
  'If MsgBox("请参考“查询进货”的功能实现部分。" & Chr(13) & "是否立即查看？", vbQuestion + vbYesNo) = vbYes Then mnuQueryBuy_Click
picQuery.Visible = True
  TreeView.Visible = False
  dtBegin.Value = Date
  dtEnd.Value = Date
  lblQuery(5) = ""
  txtGoodsName.SetFocus
End Sub

Private Sub mnuQueryType_Click()
  'If MsgBox("请参考“查询进货”的功能实现部分。" & Chr(13) & "是否立即查看？", vbQuestion + vbYesNo) = vbYes Then mnuQueryBuy_Click
picQuery.Visible = True
  TreeView.Visible = False
  dtBegin.Value = Date
  dtEnd.Value = Date
  lblQuery(5) = ""
  txtGoodsName.SetFocus
End Sub

Private Sub mnuQueryUser_Click()
  'If MsgBox("请参考“查询进货”的功能实现部分。" & Chr(13) & "是否立即查看？", vbQuestion + vbYesNo) = vbYes Then mnuQueryBuy_Click
picQuery.Visible = True
  TreeView.Visible = False
  dtBegin.Value = Date
  dtEnd.Value = Date
  lblQuery(5) = ""
  txtGoodsName.SetFocus
End Sub
'============================================================================

Private Sub mnuRefresh_Click()
  ListView.Refresh
End Sub

Private Sub mnuShowSBar_Click()
  mnuShowSBar.Checked = Not mnuShowSBar.Checked
  SBar.Visible = mnuShowSBar.Checked
  ResizeForm
End Sub

Private Sub mnuShowTBar_Click()
  mnuShowTBar.Checked = Not mnuShowTBar.Checked
  TBar.Visible = mnuShowTBar.Checked
  ResizeForm
End Sub

'============================================================================
'统计进货信息，以下菜单响应代码与之类似
Private Sub mnuStatBuy_Click()
  Dim BuyStatInfo As New clsBuys
  '统计进货信息
  BuyStatInfo.Statistic
   
  '设置当前操作状态为浏览进货统计信息
  CurrentOperation = BuyStat
  '在列表视图显示返回的统计信息
  AddObjsToLvw BuyStatInfo
End Sub

Private Sub mnuStatSale_Click()
  Dim BuySaleInfo As New clsSales
  BuySaleInfo.Statistic
  
  CurrentOperation = SaleStat
  AddObjsToLvw BuySaleInfo
End Sub

Private Sub mnuStatSpoilage_Click()
  Dim BuySpoilageInfo As New clsSpoilages
  BuySpoilageInfo.Statistic
  
  CurrentOperation = SpoilageStat
  AddObjsToLvw BuySpoilageInfo
End Sub
'============================================================================

'工具栏单击响应代码
Private Sub TBar_ButtonClick(ByVal Button As MSComctlLib.Button)
  Select Case Button.Key
    Case "User":
          mnuBrowseUser_Click
    Case "Supplier":
          mnuBrowseSupplier_Click
    Case "Type":
          mnuBrowseType_Click
    Case "Goods":
          mnuBrowseGoods_Click
    Case "Buy":
          mnuBrowseBuy_Click
    Case "Sale":
          mnuBrowseSale_Click
    Case "Spoilage":
          mnuBrowseSpoilage_Click
    Case "Stat":
          mnuStatBuy_Click
    Case "About":
          mnuAbout_Click
    Case "Exit":
          mnuExit_Click
    Case Else:
  End Select
End Sub

'工具栏按钮菜单单击响应代码
Private Sub TBar_ButtonMenuClick(ByVal ButtonMenu As MSComctlLib.ButtonMenu)
  Select Case ButtonMenu.Key
    Case "BrowseUser":
          mnuBrowseUser_Click
    Case "AddUser":
          mnuAddUser_Click
    Case "QueryUser":
          mnuQueryUser_Click
    Case "ModifyUser":
          mnuModifyUser_Click
    Case "DelUser":
          mnuDelUser_Click
    Case "BrowseSupplier":
          mnuBrowseSupplier_Click
    Case "AddSupplier":
          mnuAddSupplier_Click
    Case "QuerySupplier":
          mnuQuerySupplier_Click
    Case "ModifySupplier":
          mnuModifySupplier_Click
    Case "DelSupplier":
          mnuDelSupplier_Click
    Case "BrowseType":
          mnuBrowseType_Click
    Case "AddType":
          mnuAddType_Click
    Case "QueryType":
          mnuQueryType_Click
    Case "ModifyType":
          mnuModifyType_Click
    Case "DelType":
          mnuDelType_Click
    Case "BrowseGoods":
          mnuBrowseGoods_Click
    Case "AddGoods":
          mnuAddGoods_Click
    Case "QueryGoods":
          mnuQueryGoods_Click
    Case "ModifyGoods":
          mnuModifyGoods_Click
    Case "DelGoods":
          mnuDelGoods_Click
    Case "BrowseBuy":
          mnuBrowseBuy_Click
    Case "AddBuy":
          mnuAddBuy_Click
    Case "QueryBuy":
          mnuQueryBuy_Click
    Case "ModifyBuy":
          mnuModifyBuy_Click
    Case "DelBuy":
          mnuDelBuy_Click
    Case "BrowseSale":
          mnuBrowseSale_Click
    Case "AddSale":
          mnuAddSale_Click
    Case "QuerySale":
          mnuQuerySale_Click
    Case "ModifySale":
          mnuModifySale_Click
    Case "DelSale":
          mnuDelSale_Click
    Case "BrowseSpoilage":
          mnuBrowseSpoilage_Click
    Case "AddSpoilage":
          mnuAddSpoilage_Click
    Case "QuerySpoilage":
          mnuQuerySpoilage_Click
    Case "ModifySpoilage":
          mnuModifySpoilage_Click
    Case "DelSpoilage":
          mnuDelSpoilage_Click
    Case "StatBuy":
          mnuStatBuy_Click
    Case "StatSale":
          mnuStatSale_Click
    Case "StatSpoilage":
          mnuStatSpoilage_Click
    Case Else:
  End Select
End Sub

'实时更新状态栏上显示的当前时间
Private Sub tmrTime_Timer()
  SBar.Panels(3).Text = Format(Now, "yyyy年mm月dd日 hh:mm:ss")
  SBar.Panels(2).Text = ""
End Sub