⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmmain.vb

📁 <Visual Basic 数据库开发实例精粹(第二版)>一书首先介绍了Visual Basic(简称VB)开发的技巧和重点技术
💻 VB
📖 第 1 页 / 共 4 页
字号:
      'AddClientToLvw(dmClient, tlvClient, True)
      mdlListView.UpdateClientToLvw(dmClient, tlvClient)
      '如果选择生日提醒,则在数据库中加入提醒规则
      ErrMsg = warnObj.UpdateBrithdayWarn(dmClient, Not dmClient.BirthdayWarn)
    Else
      MsgBox(ErrMsg, MsgBoxStyle.Critical + MsgBoxStyle.OKOnly)
    End If

  End Sub

  '删除客户
  Private Sub DelClient()
    Dim dmClient As New clientMgrBusiness.ClientDataModel

    If MsgBox("确定要删除客户吗?", MsgBoxStyle.Question + MsgBoxStyle.YesNo + MsgBoxStyle.DefaultButton2) = MsgBoxResult.No Then Exit Sub
    '从客户列表中获取选中的客户信息
    If GetClientFromListView(dmClient, tlvClient) = False Then
      Exit Sub
    End If
    '从数据库中删除客户,并从界面中也删除
    '更新数据库
    Dim ErrMsg As String
    Dim clientObj As New clientMgrBusiness.Client
    ErrMsg = clientObj.Delete(dmClient.ID)
    If ErrMsg = "" Then
      tlvClient.SelectedItems(0).Remove()
    Else
      MsgBox(ErrMsg, MsgBoxStyle.Critical + MsgBoxStyle.OKOnly)
    End If
  End Sub

  '查找客户
  Private Sub SearchClient()
    xplSearch.Visible = True
    xplSearch.Left = -xplSearch.Width
    m_SearchAction = SearchAction.Show
    tmrSearch.Enabled = True
  End Sub

  '查看客户信息
  Private Sub ClientInfo()
    Dim dmClient As New clientMgrBusiness.ClientDataModel

    '获取客户列表中选择项的客户信息
    If GetClientFromListView(dmClient, Me.tlvClient) <> "" Then
      Exit Sub
    End If

    '显示客户信息界面
    Dim frm As New frmClient
    If frm.RetriveClient(dmClient, clientMgrBusiness.dmViewType.vtInfo) = False Then
      Exit Sub
    End If

    '如果在查看客户信息时选择修改信息,则进一步保存修改内容
    If frm.ViewType = clientMgrBusiness.dmViewType.vtModify Then
      Dim ErrMsg As String
      Dim clientObj As New clientMgrBusiness.Client
      Dim warnObj As New clientMgrBusiness.Warning
      Dim Ary As New ArrayList
      ErrMsg = clientObj.Update(dmClient)
      If ErrMsg = "" Then
        'AddClientToLvw(dmClient, tlvClient, True)
        mdlListView.UpdateClientToLvw(dmClient, tlvClient)

        '如果选择生日提醒,则在数据库中加入提醒规则
        ErrMsg = warnObj.UpdateBrithdayWarn(dmClient, Not dmClient.BirthdayWarn)
      Else
        MsgBox(ErrMsg, MsgBoxStyle.Critical + MsgBoxStyle.OKOnly)
      End If
    End If
  End Sub
#End Region


#Region "窗体消息响应"

  Private Sub frmMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
    Dim frm As New frmShowWarn
    frm.ShowWarn(Me, True, True)

    InitForm()
  End Sub

  Private Sub frmMain_Closed(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Closed
    Application.Exit()
  End Sub
#End Region


#Region "TreeView/ListView消息响应"

  '当树中节点选择改变时发生
  Private Sub trvType_AfterSelect(ByVal sender As System.Object, ByVal e As System.Windows.Forms.TreeViewEventArgs) Handles trvType.AfterSelect

    If trvType.SelectedNode Is Nothing Then
      Return
    End If

    mdlListView.ClientsToListView(tlvClient, trvType.SelectedNode.Tag, m_bShowInGroup, m_bResverse, m_bShowRoot)
    UpdateCmdUI()

  End Sub

  Private Sub trvDept_SizeChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles trvType.SizeChanged
    xplSearch.Size = trvType.Size
  End Sub

  Private Sub tlvClient_SelectedIndexChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles tlvClient.SelectedIndexChanged
    UpdateCmdUI()
  End Sub

  Private Sub trvType_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles trvType.MouseUp
    trvType.ContextMenu = Nothing
  End Sub

  Private Sub trvType_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles trvType.MouseDown
    '加入点右键选择结点支持
    Dim node As TreeNode
    If e.Button = MouseButtons.Right Then
      node = trvType.GetNodeAt(e.X, e.Y)
      If Not node Is Nothing Then
        trvType.SelectedNode = node
      End If
    End If
  End Sub

  Private Sub trvType_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles trvType.Click
    '设置右键菜单
    trvType.ContextMenu = TreeViewContextMenu
    'trvType.ContextMenu = Nothing
  End Sub

  Private Sub tlvClient_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles tlvClient.DoubleClick
    If tlvClient.SelectedItems.Count = 0 Then
      Return
    End If
    If tlvClient.SelectedItems(0).SubItems.Count > 2 Then
      Me.mnuClientInfo.PerformClick()
    End If
  End Sub

#End Region


#Region "搜索面板相关消息响应代码"

  'Timer事件,用于查询面板的滑出与滑入
  Private Sub tmrSearch_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles tmrSearch.Tick
    '进入窗体中,显示面板
    If m_SearchAction = SearchAction.Show Then
      If xplSearch.Left < 0 Then
        xplSearch.Left += 15
      Else
        xplSearch.Left = 0
        trvType.Visible = False
        xplSearch.Dock = DockStyle.Left
        tmrSearch.Enabled = False
      End If
      '退出窗体,隐藏面板
    ElseIf m_SearchAction = SearchAction.Hide Then
      xplSearch.Dock = DockStyle.None
      trvType.Visible = True
      If xplSearch.Left + xplSearch.Width > 0 Then
        xplSearch.Left -= 15
      Else
        xplSearch.Visible = False
        tmrSearch.Enabled = False
      End If
    End If
  End Sub

  '后退按钮
  Private Sub cmdBack_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdBack.Click
    m_SearchAction = SearchAction.Hide
    tmrSearch.Enabled = True
    labResult1.Visible = False
    labResult.Visible = False
  End Sub

  '查询按钮
  Private Sub cmdSearch_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdSearch.Click
    DoSearchAction()
  End Sub

  '查询面板上所有复选框的消息响应函数
  Private Sub chkSearchOp_CheckedChanged(ByVal sender As Object, _
                              ByVal e As System.EventArgs) _
                              Handles chkClientType.CheckedChanged, _
                              chkName.CheckedChanged

    tcboType.Enabled = chkClientType.Checked
    txtName.Enabled = chkName.Checked

  End Sub

  Private Sub chkSearchAdvOp_CheckedChanged(ByVal sender As System.Object, _
                                ByVal e As System.EventArgs) _
                                Handles chkResverse.CheckedChanged, _
                                chkShowInGroup.CheckedChanged, _
                                chkPhone.CheckedChanged

    txtPhone.Enabled = chkPhone.Checked

    Me.m_bShowInGroup = Me.chkShowInGroup.Checked
    Me.m_bResverse = Me.chkResverse.Checked

    Me.mnuShowInGroup.Checked = Me.chkShowInGroup.Checked
    Me.mnuResverse.Checked = Me.chkResverse.Checked

  End Sub
#End Region


#Region "菜单消息响应"



  Private Sub mnuUserMgr_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuUserMgr.Click
    Dim frm As New frmUserMgr
    frm.ShowDialog()
  End Sub

  Private Sub mnuloginOut_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuloginOut.Click
    Dim frm As New frmLogin
    frm.m_bLoginSuccess = False
    Me.Hide()
    frm.ShowDialog()
    If frm.m_bLoginSuccess = True Then
      Me.Show()
      Me.InitForm()
    End If
  End Sub

  Private Sub mnuExit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuExit.Click
    Application.Exit()
  End Sub

  '客户类型管理消息响应函数
  Private Sub mnuClientTypeCmd_Click(ByVal sender As System.Object, _
                                    ByVal e As System.EventArgs) _
                                    Handles mnuAddClientType.Click, _
                                    mnuModifyClientType.Click, _
                                    mnuDelClientType.Click, _
                                    mnuCtAdd.Click, _
                                    mnuCtModify.Click, _
                                    mnuCtDel.Click, _
                                    mnuTvcmAddType.Click, _
                                    mnuTvcmModifyType.Click, _
                                    mnuTvcmDeleteType.Click
    Dim mnu As MenuItem = sender

    Select Case mnu.Handle.ToInt32
      Case Me.mnuAddClientType.Handle.ToInt32, _
           Me.mnuCtAdd.Handle.ToInt32, _
           Me.mnuTvcmAddType.Handle.ToInt32
        Me.AddClientType()
      Case Me.mnuModifyClientType.Handle.ToInt32, _
            Me.mnuCtModify.Handle.ToInt32, _
            Me.mnuTvcmModifyType.Handle.ToInt32
        Me.ModifyClientType()
      Case Me.mnuDelClientType.Handle.ToInt32, _
           Me.mnuCtDel.Handle.ToInt32, _
           Me.mnuTvcmDeleteType.Handle.ToInt32
        Me.DelCientType()
    End Select


  End Sub


  '与客户相关的所有菜单命令消息响应函数
  Private Sub mnuClient_Click(ByVal sender As System.Object, _
                                ByVal e As System.EventArgs) _
                                Handles mnuAddClient.Click, _
                                mnuModifyClient.Click, _
                                mnuDelClient.Click, _
                                mnuSearchClient.Click, _
                                mnuClientInfo.Click, _
                                mnuTvcmAddClient.Click

    Dim mnu As MenuItem = sender

    Select Case mnu.Handle.ToInt32
      Case Me.mnuAddClient.Handle.ToInt32, _
            Me.mnuTvcmAddClient.Handle.ToInt32
        Me.AddClient()
      Case Me.mnuModifyClient.Handle.ToInt32
        Me.ModifyClient()
      Case Me.mnuDelClient.Handle.ToInt32
        Me.DelCientType()
      Case Me.mnuSearchClient.Handle.ToInt32
        Me.SearchClient()
      Case Me.mnuClientInfo.Handle.ToInt32
        Me.ClientInfo()
    End Select

  End Sub

  Private Sub mnuShowStyle_Click(ByVal sender As System.Object, _
                                ByVal e As System.EventArgs) _
                                Handles mnuShowInGroup.Click, _
                                mnuResverse.Click, _
                                mnuShowRoot.Click

    Dim mnu As MenuItem = sender
    Select Case mnu.Handle.ToInt32
      Case Me.mnuShowInGroup.Handle.ToInt32
        Me.m_bShowInGroup = Not Me.m_bShowInGroup
        Me.mnuShowInGroup.Checked = Me.m_bShowInGroup
      Case Me.mnuResverse.Handle.ToInt32
        Me.m_bResverse = Not Me.m_bResverse
        Me.mnuResverse.Checked = Me.m_bResverse
      Case Me.mnuShowRoot.Handle.ToInt32
        Me.m_bShowRoot = Not Me.m_bShowRoot
        Me.mnuShowRoot.Checked = Me.m_bShowRoot
    End Select

    Dim iTypeId As Integer
    If trvType.SelectedNode Is Nothing Then
      iTypeId = 0
    Else
      iTypeId = trvType.SelectedNode.Tag
    End If
    mdlListView.ClientsToListView(tlvClient, iTypeId, Me.m_bShowInGroup, Me.m_bResverse, Me.m_bShowRoot)

  End Sub


  Private Sub mnuSendEmail_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuSendEmail.Click
    Dim frm As New frmSendEmail
    frm.Show()
  End Sub

  Private Sub mnuOnlineSupport_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuOnlineSupport.Click
    Try
      Dim strUrl As String
      strUrl = "http://www.trfsoft.com"
      System.Diagnostics.Process.Start(strUrl)
    Catch ex2 As Exception
      MsgBox("访问网页时发生错误,请手动访问如下网址:http://www.trfsoft.com", MsgBoxStyle.OKOnly + MsgBoxStyle.Exclamation, "http://www.trfsoft.com")
    End Try

  End Sub

  Private Sub mnuAbout_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuAbout.Click
    ShowAbout(True)
  End Sub

  Private Sub mnuShowWarn_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuShowWarn.Click
    Dim frm As New frmShowWarn
    frm.ShowWarn(Me, False, False)
  End Sub

  Private Sub mnuWarnSetting_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuWarnSetting.Click
    Dim frm As New frmWarn
    frm.ShowDialog()
  End Sub
#End Region


#Region "工具条消息响应"
  Private Sub tbMain_ButtonClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.ToolBarButtonClickEventArgs) Handles tbMain.ButtonClick
    Select Case e.Button.Text
      Case tbnAbout.Text
        mnuAbout.PerformClick()
      Case Me.tbnClientInfo.Text
        Me.mnuClientInfo.PerformClick()
      Case Me.tbnDeleteClient.Text
        Me.mnuDelClient.PerformClick()
      Case Me.tbnModifyClient.Text
        Me.mnuModifyClient.PerformClick()
      Case Me.tbnAddClient.Text
        Me.mnuAddClient.PerformClick()
      Case Me.tbnSearch.Text
        Me.mnuSearchClient.PerformClick()
      Case tbnSupport.Text
        mnuOnlineSupport.PerformClick()
      Case Me.tbnTodayWarning.Text
        Me.mnuShowWarn.PerformClick()
      Case Me.tbnUserMgr.Text
        Me.mnuUserMgr.PerformClick()
      Case Me.tbnWarnSetting.Text
        Me.mnuWarnSetting.PerformClick()
    End Select
  End Sub
#End Region


End Class


⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -