frmmain.frm

一个客户系统,VB+SQL,其中有客户类型分类

End Sub

Private Sub mnuViewStatusBar_Click()
  mnuViewStatusBar.Checked = Not mnuViewStatusBar.Checked
  sbStatusBar.Visible = mnuViewStatusBar.Checked
  SizeControls imgSplitter.Left
End Sub


Private Sub mnuViewToolbar_Click()
  mnuViewToolbar.Checked = Not mnuViewToolbar.Checked
  tbToolBar.Visible = mnuViewToolbar.Checked
  SizeControls imgSplitter.Left
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 系统管理部分
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'退出系统
Private Sub mnuExit_Click()
  End
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 客户类型管理部分
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'添加客户类型
Private Sub mnuAddClientType_Click()
  Call AddClientType
End Sub

'修改客户类型
Private Sub mnuModifyClientType_Click()
  Call ModifyClientType
End Sub

'删除客户类型
Private Sub mnuDelClientType_Click()
  Call DelCientType
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 客户信息管理部分
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'添加客户
Private Sub mnuAddClient_Click()
  Call AddClient
End Sub

'修改客户信息
Private Sub mnuModifyClient_Click()
  Call ModifyClient
End Sub

'删除客户
Private Sub mnuDelClient_Click()
  Call DelClient
End Sub

'查找客户
Private Sub mnuSearchClient_Click()
  Call SearchClient
End Sub

'查看客户信息
Private Sub mnuClientInfo_Click()
  Call ClientInfo
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 提醒管理部分
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'查看今日提醒
Private Sub mnuShowWarn_Click()
  frmTip.ShowWarn Me, False
End Sub

'提醒设置
Private Sub mnuWarnSetting_Click()
  frmWarn.Show vbModal
End Sub


Private Sub tvTreeView_NodeClick(ByVal Node As MSComctlLib.Node)
  Dim Flag As String
  Flag = Left(Node.Key, 1) '得到当前选择的节点类型

  '将所有按钮设为不可用
  Dim ctl As Control
'  For Each ctl In Controls
'    If TypeOf ctl Is Menu Then ctl.Enabled = False
'  Next

  Select Case Flag
    '选择了根节点，此时加以增加客户类型
    Case "O"
      'cmdAddType.Enabled = True
      mnuAddClientType.Enabled = True
      ListAllClients lvListView
    Case "A"
      '选择了客户类型节点，此时可增、删、改客户类型与增人员
      'cmdAddType.Enabled = True
      'cmdEditType.Enabled = True
      'cmdDeleteType.Enabled = True
      'cmdAddClient.Enabled = True
      mnuAddClientType.Enabled = True
      
      

      '显示该客户类型下的所有人员到列表框中
      '此处纯粹是为了演示，实际应用情况可能会有更多要求
      Dim objClients As New CClients
      objClients.Find , , GetID(Node.Key)
      ClientsToListview objClients, lvListView
    Case "B"
      '选择了人员节点，此时可删除、修改人员
      'cmdEditClient.Enabled = True
      'cmdDeleteClient.Enabled = True
  End Select

End Sub

Private Sub lvListView_DblClick()
  mnuClientInfo_Click
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 自定义主界面管理函数

'初始化所有数据函数
Private Sub InitMain()
  InitClientListview lvListView '初始化列表
  ListAllClients lvListView
  TypeToTreeview tvTreeView '将客户类型显示到树型图中
End Sub

'刷新客户列表
Private Sub RefreshListView()
  
  Dim objClients As New CClients
  Dim SuperId As Integer
  If tvTreeView.SelectedItem Is Nothing Then
    SuperId = 0
  Else
    SuperId = GetID(tvTreeView.SelectedItem.Key)
  End If
  objClients.Find , , SuperId
  ClientsToListview objClients, lvListView
  
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 客户类型管理操作函数

'添加客户类型
Private Sub AddClientType()
  Dim strName As String
  '输入客户类型名称
  strName = Trim(InputBox("请输入客户类型名称:"))
  If strName = "" Then Exit Sub

  Dim objType As New CType
  Dim Result As gxcAddNew
  '更新数据库
  Result = objType.AddNew(strName, GetID(tvTreeView.SelectedItem.Key))
  If Result = AddNewOK Then
    '将客户类型加入树型图
    AddTypeToTvw objType, tvTreeView
  ElseIf Result = DuplicateName_AddNew Then
    MsgBox "有重名的客户类型存在，重新命名！", vbOKOnly + vbExclamation
  ElseIf Result = SuperNotExist Then
    MsgBox "上级客户类型不存在，请先选择上级客户类型", vbOKOnly + vbExclamation
  Else
    MsgBox "失败！", vbOKOnly + vbExclamation
  End If

End Sub

'修改客户类型
Private Sub ModifyClientType()
  Dim objType As CType
  Dim strName As String
  '获取客户类型树上选中的客户类型信息
  If GetTypeFromTreeview(tvTreeView, objType) = False Then Exit Sub
  
  '默认显示原客户类型的客户类型名称
  strName = Trim(InputBox("请输入新的客户类型名称:", , objType.TypeName))
  If strName = "" Then Exit Sub
  
  '更新数据库
  Dim Result As gxcUpdate
  objType.TypeName = strName
  Result = objType.Update
  If Result = UpdateOK Then
    '将客户类型加入树型图
    tvTreeView.SelectedItem.Text = objType.TypeName
  ElseIf Result = DuplicateName_Update Then
    MsgBox "有重名的客户类型存在，重新命名！"
  Else
    MsgBox "失败！"
  End If
End Sub

'删除客户类型
Private Sub DelCientType()
  Dim objType As CType
  Dim Result As gxcDelete
  
  If MsgBox("真的要删除客户类型吗？", vbQuestion + vbYesNo + _
            vbDefaultButton2) = vbNo Then Exit Sub
  
  '获取树上选中的客户类型，如果没有选中的对象则退出函数
  If GetTypeFromTreeview(tvTreeView, objType) = False Then Exit Sub
  '从数据库中删除
  Result = objType.Delete
  If Result = DeleteClientExists Then
    MsgBox "存在人员，不能删除"
  ElseIf Result = DeleteSubExists Then
    MsgBox "存在子客户类型，不能删除"
  ElseIf Result = DeleteFail Then
    MsgBox "删除失败！"
  Else
    '来到这，说明删除成功，从树形图中删除节点
    tvTreeView.Nodes.Remove tvTreeView.SelectedItem.Index
  End If

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 客户管理操作函数

'添加客户
Private Sub AddClient()
  Dim objClient As CClient
  '显示添加客户对话框并获取数据
  If frmClient.RetriveClient(objClient, vtadd, GetID(tvTreeView.SelectedItem.Key)) _
                            = False Then Exit Sub
  '更新数据库
  If objClient.AddNew = True Then
    AddClientToLvw objClient, lvListView, False
  Else
    MsgBox "错误"
  End If
End Sub

'修改客户信息
Private Sub ModifyClient()
  Dim objClient As CClient
  Dim objWarn As New cWarning
  
  '从客户列表中获取选中客户信息
  If GetClientFromControl(lvListView, objClient) = False Then Exit Sub
  '显示修改客户信息对话框
  If frmClient.RetriveClient(objClient, vtModify) = False Then Exit Sub
  
  '更新数据库
  If objClient.Update = True Then
      objWarn.ClientId = objClient.ID
      objWarn.ShowDate = objClient.Birthday
      '如果选择生日提醒，则在数据库中加入提醒规则
      objWarn.ShowBirthdayWarn = frmClient.ShowBirthdayWarn
      RefreshListView
  Else
    MsgBox "错误"
  End If
  
  Set objWarn = Nothing
  Set objClient = Nothing

End Sub

'删除客户
Private Sub DelClient()
  Dim objClient As CClient
  
  If MsgBox("确定要删除客户吗？", vbQuestion + vbYesNo + vbDefaultButton2) _
            = vbNo Then Exit Sub
  '从客户列表中获取选中的客户信息
  If GetClientFromControl(lvListView, objClient) = False Then Exit Sub
  '从数据库中删除客户，并从界面中也删除
  If objClient.Delete = True Then
    lvListView.ListItems.Remove (lvListView.SelectedItem.Index)
  Else
    MsgBox "错误"
  End If

End Sub

'查找客户
Private Sub SearchClient()
  Dim objClients As New CClients
  '显示查询对话框
  If frmSearch.RetriveSearch() = False Then Exit Sub
  '返回查询结果
  objClients.Find , frmSearch.SearchName, frmSearch.TypeId
  '将查询结果显示到客户列表中
  ClientsToListview objClients, lvListView

End Sub

'查看客户信息
Private Sub ClientInfo()
  Dim objClient As CClient
  Dim objWarn As New cWarning
  
  '获取客户列表中选择项的客户信息
  If GetClientFromControl(Me.lvListView, objClient) = False Then Exit Sub
  
  '显示客户信息界面
  If frmClient.RetriveClient(objClient, vtInfo) = False Then Exit Sub
  
  '如果在查看客户信息时选择修改信息，则进一步保存修改内容
  If frmClient.ViewType = vtModify Then
    If objClient.Update = True Then
        objWarn.ClientId = objClient.ID
        objWarn.ShowDate = objClient.Birthday
        objWarn.ShowBirthdayWarn = frmClient.ShowBirthdayWarn
        RefreshListView
    Else
      MsgBox "错误"
    End If
  End If
  
  Set objWarn = Nothing
  Set objClient = Nothing
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'查看今日提醒
Private Sub ShowTodayWarn()
  frmTip.ShowWarn Me, False
End Sub

'提醒设置
Private Sub WarnSetting()
  frmWarn.Show
End Sub