frmmain.frm

<Visual Basic 数据库开发实例精粹（第二版）>一书首先介绍了Visual Basic(简称VB)开发的技巧和重点技术

Private Sub mnuAddSale_Click()
  frmSale.Show vbModal, Me
End Sub

Private Sub mnuAddSpoilage_Click()
  frmSpoilage.Show vbModal, Me
End Sub

Private Sub mnuAddSupplier_Click()
  frmSupplier.Show vbModal, Me
End Sub

Private Sub mnuAddType_Click()
  frmType.Show vbModal, Me
End Sub

Private Sub mnuAddUser_Click()
  frmUser.Show vbModal, Me
End Sub
'============================================================================

'============================================================================
'设置列表视图为大图标显示项目
Private Sub mnuBigIcon_Click()
  mnuBigIcon.Checked = True
  mnuSmallIcon.Checked = False
  mnuList.Checked = False
  mnuDetail.Checked = False
  ListView.View = lvwIcon
End Sub

'设置列表视图为小图标显示项目
Private Sub mnuSmallIcon_Click()
  mnuSmallIcon.Checked = True
  mnuBigIcon.Checked = False
  mnuList.Checked = False
  mnuDetail.Checked = False
  ListView.View = lvwSmallIcon
End Sub

'设置列表视图为列表显示项目
Private Sub mnuList_Click()
  mnuList.Checked = True
  mnuSmallIcon.Checked = False
  mnuBigIcon.Checked = False
  mnuDetail.Checked = False
  ListView.View = lvwList
End Sub

'设置列表视图为详细资料显示项目
Private Sub mnuDetail_Click()
  mnuDetail.Checked = True
  mnuList.Checked = False
  mnuSmallIcon.Checked = False
  mnuBigIcon.Checked = False
  ListView.View = lvwReport
End Sub
'============================================================================

'============================================================================
'浏览所有进货信息，以下菜单响应代码与之类似
Private Sub mnuBrowseBuy_Click()
  Dim AllBuys As New clsBuys
  '不带查询条件查询所有进货信息
  AllBuys.Query
  
  '设置当前操作状态为浏览进货信息
  CurrentOperation = BrowseBuy
  '在列表视图显示查询返回的进货信息
  AddObjsToLvw AllBuys
End Sub

Private Sub mnuBrowseSale_Click()
  Dim AllSales As New clsSales
  AllSales.Query
  
  CurrentOperation = BrowseSale
  AddObjsToLvw AllSales
End Sub

Private Sub mnuBrowseSpoilage_Click()
  Dim AllSpoilages As New clsSpoilages
  AllSpoilages.Query
  
  CurrentOperation = BrowseSpoilage
  AddObjsToLvw AllSpoilages
End Sub

Private Sub mnuBrowseGoods_Click()
  Dim AllGoodses As New clsGoodses
  AllGoodses.Query
  
  CurrentOperation = BrowseGoods
  AddObjsToLvw AllGoodses
End Sub

Private Sub mnuBrowseSupplier_Click()
  Dim AllSuppliers As New clsSuppliers
  AllSuppliers.Query
  
  CurrentOperation = BrowseSupplier
  AddObjsToLvw AllSuppliers
End Sub

Private Sub mnuBrowseType_Click()
  Dim AllTypes As New clsGoodsTypes
  AllTypes.Query
  
  CurrentOperation = BrowseType
  AddObjsToLvw AllTypes
  '与其他项目的浏览相比，浏览商品类型要考虑须同时重新加载树形视图的节点
  TreeView.Nodes.Clear
  InitTvwEx
End Sub

Private Sub mnuBrowseUser_Click()
  Dim AllUsers As New clsUsers
  AllUsers.Query
  
  CurrentOperation = BrowseUser
  AddObjsToLvw AllUsers
End Sub
'============================================================================

'============================================================================
'删除进货信息，以下菜单响应代码与之类似
Private Sub mnuDelBuy_Click()
  '列表视图显示进货时才能选择项目并删除
  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 & "\Help.txt", 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
End Sub

Private Sub mnuQuerySpoilage_Click()
  If MsgBox("请参考“查询进货”的功能实现部分。" & Chr(13) & "是否立即查看？", vbQuestion + vbYesNo) = vbYes Then mnuQueryBuy_Click
End Sub

Private Sub mnuQueryGoods_Click()
  If MsgBox("请参考“查询进货”的功能实现部分。" & Chr(13) & "是否立即查看？", vbQuestion + vbYesNo) = vbYes Then mnuQueryBuy_Click
End Sub

Private Sub mnuQuerySupplier_Click()
  If MsgBox("请参考“查询进货”的功能实现部分。" & Chr(13) & "是否立即查看？", vbQuestion + vbYesNo) = vbYes Then mnuQueryBuy_Click
End Sub

Private Sub mnuQueryType_Click()
  If MsgBox("请参考“查询进货”的功能实现部分。" & Chr(13) & "是否立即查看？", vbQuestion + vbYesNo) = vbYes Then mnuQueryBuy_Click
End Sub

Private Sub mnuQueryUser_Click()
  If MsgBox("请参考“查询进货”的功能实现部分。" & Chr(13) & "是否立即查看？", vbQuestion + vbYesNo) = vbYes Then mnuQueryBuy_Click
End Sub
'============================================================================

Private Sub mnuRefresh_Cl