frmmain.vb

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

    Dim str As String
    '“关于”的消息文本
    str = "{\rtf1\ansi\ansicpg936\deff0\deflang1033\deflangfe2052{\fonttbl{\f0\fmodern\fprq6\fcharset134 \'cb\'ce\'cc\'e5;}}"
    str &= "{\*\generator Msftedit 5.41.15.1507;}\viewkind4\uc1\pard\qc\lang2052\b\f0\fs48\'c6\'f3\'d2\'b5\'b0\'ec\'b9\'ab\'c1\'aa\'cf\'b5\'cf\'b5\'cd\'b3V2.0\fs52\par"
    str &= "\pard\b0\fs24\tab\ldblquote\'c6\'f3\'d2\'b5\'b0\'ec\'b9\'ab\'c1\'aa\'cf\'b5\'cf\'b5\'cd\'b3V2.0\rdblquote\'ca\'c7\'d4\'da\'d4\'adV1.0\'bb\'f9\'b4\'a1\'c9\'cf\'d3\'c3VB.NET\'d6\'d8\'d0\'b4\'b4\'fa\'c2\'eb\'a3\'ac\'b2\'c9\'d3\'c3\'c8\'fd\'b2\'e3\'bd\'e1\'b9\'b9\'c9\'e8\'bc\'c6\'a3\'ac\'ca\'b9\'d3\'c3MSSQL\'ca\'fd\'be\'dd\'bf\'e2\'b4\'e6\'b4\'a2\'ca\'fd\'be\'dd\'a3\'ac\'b2\'a2\'be\'df\'d3\'d0XP\'bd\'e7\'c3\'e6\'b7\'e7\'b8\'f1\'a1\'a3\par"
    str &= "\tab\'bd\'e1\'b9\'b9\'c9\'e8\'bc\'c6\'c9\'cf\'b7\'d6\'ce\'aa\'b1\'ed\'ca\'be\'b2\'e3\'a1\'a2\'d2\'b5\'ce\'f1\'b2\'e3\'ba\'cd\'ca\'fd\'be\'dd\'b2\'e3\'a1\'a3\'d4\'da\'ca\'fd\'be\'dd\'bf\'e2\'bc\'bc\'ca\'f5\'b4\'a6\'c0\'ed\'c9\'cf\'ca\'b9\'d3\'c3\'b4\'e6\'b4\'a2\'b9\'fd\'b3\'cc\'ba\'cd\'ca\'d3\'cd\'bc\'b3\'e4\'b7\'d6\'b7\'a2\'bb\'d3\'c1\'cbSQL Server\'b5\'c4\'d0\'d4\'c4\'dc\'a1\'a3\par"
    str &= "\tab\par"
    str &= "\par"
    str &= "\tab\'d4\'da\'d1\'a7\'cf\'b0\'b9\'fd\'b3\'cc\'d6\'d0\'c8\'e7\'b9\'fb\'d3\'f6\'b5\'bd\'c8\'ce\'ba\'ce\'ce\'ca\'cc\'e2\'a3\'ac\'c7\'eb\'c1\'aa\'cf\'b5\'ce\'d2\'c3\'c7\'a3\'ba\par"
    str &= "\tab http://www.trfsoft.com\par"
    str &= "\tab [e-mail]\par"
    str &= "\par"
    str &= "\tab\par"
    str &= "\par"
    str &= "\pard\qc\tab CopyRight Terrificsoft 2006-2008 All right resvered\b\par"
    str &= "\pard\b0\fs48\par"
    str &= "}"

    rtxtContent.Rtf = str

  End Sub

  '执行操作操作，根据部门、关键词等搜索信息
  Private Sub DoSearchAction()
    Dim iDeptSend As Integer = 0
    Dim iDeptReceive As Integer = 0
    Dim strAddresser As String = ""
    Dim strKey As String = ""
    Dim bShowReply As Boolean = True
    Dim ErrMsg As String
    Dim MsgType As MessageType = MessageType.MsgTypeSend

    '根据单选按钮选择状态的不同，指定不同的参数
    If rdiDeptSend.Checked Then
      iDeptSend = LoginedUserInfo.m_iRoleID
      iDeptReceive = cboDept.SelectedValue
      MsgType = MessageType.MsgTypeSend
    ElseIf rdiDeptReceive.Checked Then
      iDeptSend = cboDept.SelectedValue
      iDeptReceive = LoginedUserInfo.m_iRoleID
      MsgType = MessageType.MsgTypeReceive
    End If
    '检查其他查询条件是否有效
    If chkAddresser.Checked Then
      strAddresser = txtAddresser.Text
    End If
    If chkContent.Checked Then
      strKey = txtKeys.Text
    End If
    bShowReply = Not chkExcludeReply.Checked

    '执行查询并返回结果
    Dim msgObj As New InfoProSysBusiness.Message
    Dim Ary As New ArrayList
    ErrMsg = msgObj.Search(Ary, iDeptSend, iDeptReceive, strAddresser, strKey, False)
    If ErrMsg <> "" Then
      MsgBox(ErrMsg, MsgBoxStyle.Critical + MsgBoxStyle.OKOnly)
    End If

    labResult.Text = "本次查询为您找到" & Ary.Count & "条信息"
    labResult1.Visible = True
    labResult.Visible = True

    '显示到信息列表中
    If m_bShowingAbout Then
      DoShowAbout(False)
      rtxtContent.Text = ""
    End If

    '更新控件
    mdlCtrl.InitMsgListView(tlvMsgTitle, MsgType, ViewType.vtSearch)
    mdlCtrl.UpdateMsgListView(tlvMsgTitle, MsgType, Ary, bShowReply)
    UpdateCmdUI()
  End Sub

#End Region

#Region "窗体消息响应"
  Private Sub frmMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
    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 trvDept_AfterSelect(ByVal sender As Object, ByVal e As System.Windows.Forms.TreeViewEventArgs) Handles trvDept.AfterSelect
    If m_bShowingAbout Then
      DoShowAbout(False)
      rtxtContent.Text = ""
    End If

    AutoUpdateMsgList()
    UpdateCmdUI()

  End Sub


  Private Sub tlvMsgTitle_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tlvMsgTitle.SelectedIndexChanged
    UpdateMsgPreview()
    UpdateCmdUI()
  End Sub


  Private Sub tlvMsgTitle_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles tlvMsgTitle.DoubleClick
    Dim frm As New frmRead

    If tlvMsgTitle.SelectedItems.Count <> 1 Then
      Return
    End If

    Dim iMsgId As Integer
    Dim ErrMsg As String
    Dim dmMsg As New InfoProSysBusiness.MessageDataModel
    Dim MsgObj As New InfoProSysBusiness.Message

    iMsgId = tlvMsgTitle.SelectedItems(0).Tag
    ErrMsg = MsgObj.ReceiveMsg(iMsgId, dmMsg)
    If ErrMsg <> "" Then
      MsgBox(ErrMsg)
      Return
    End If

    frm.MessageInfo = dmMsg
    frm.Show()

  End Sub

#End Region

#Region "菜单消息响应"

  Private Sub mnuNewInfo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuNewInfo.Click
    Dim frmSendObj As New frmSendMsg
    frmSendObj.SetFormSendStatus(SendMsgStatus.Send)
    frmSendObj.Show()
  End Sub


  Private Sub mnuReplyInfo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuReply.Click
    Dim frmSendObj As New frmSendMsg
    If tlvMsgTitle.SelectedItems.Count < 1 Then
      Exit Sub
    End If
    Dim iMsgId As Long = tlvMsgTitle.SelectedItems.Item(0).Tag
    Dim MsgObj As New InfoProSysBusiness.Message
    Dim dmMsg As New InfoProSysBusiness.MessageDataModel
    MsgObj.ReceiveMsg(iMsgId, dmMsg)

    frmSendObj.SetReplyDeptId(dmMsg.m_iDeptSendId)
    frmSendObj.SetReplyMsgId(iMsgId)
    frmSendObj.SetFormSendStatus(SendMsgStatus.Reply)
    frmSendObj.Show()
  End Sub

  Private Sub mnuInfoBroardcast_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuBroadcast.Click
    Dim frmSendObj As New frmSendMsg
    frmSendObj.SetFormSendStatus(SendMsgStatus.Broadcast)
    frmSendObj.Show()
  End Sub

  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 mnuGetInfo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuGetInfo.Click
    Dim frmPmtObj As New frmPrompt
    frmPmtObj.SetPromptType(PromptType.ReceiveMsg)
    frmPmtObj.Show()
    System.Windows.Forms.Application.DoEvents()

    '收取信息
    AutoUpdateMsgList()

    TimeDelay(1000)
    frmPmtObj.Close()
  End Sub

  Private Sub mnuDelInfo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuDelete.Click
    Dim ErrMsg As String = ""
    Dim msgObj As New InfoProSysBusiness.Message
    Dim iMsgId As Long = 0
    If tlvMsgTitle.SelectedItems.Count < 1 Then
      Exit Sub
    End If
    iMsgId = tlvMsgTitle.SelectedItems(0).Tag
  End Sub

  '查询菜单项消息响应
  Private Sub mnuInfoQuery_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuSearch.Click
    xplSearch.Visible = True
    '将整个控件置于窗体左侧
    xplSearch.Left = -xplSearch.Width
    '当前动作命令是显示
    m_SearchAction = SearchAction.Show
    '启动Timer控件，面板从左侧滑入窗体内
    tmrSearch.Enabled = True
  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
    DoShowAbout(True)
    m_bShowingAbout = True
    Try
      'rtxtcontent.Rtf = ""
    Catch ex As Exception
      rtxtContent.Text = "欢迎使用企业办公联系统V2.0"
    End Try
  End Sub
#End Region

#Region "工具条消息响应"

  Private Sub tbMain_ButtonClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.ToolBarButtonClickEventArgs) Handles tbMain.ButtonClick
    Dim i As Integer = 0
    Select Case e.Button.Text
      Case tbnReceiveAll.Text
        mnuGetInfo.PerformClick()
      Case tbnNew.Text
        mnuNewInfo.PerformClick()
      Case tbnReply.Text
        mnuReply.PerformClick()
      Case tbnBroadcast.Text
        mnuBroadcast.PerformClick()
      Case tbnDelete.Text
        mnuDelete.PerformClick()
      Case tbnSearch.Text
        mnuSearch.PerformClick()
      Case tbnUserMgr.Text
        mnuUserMgr.PerformClick()
      Case tbnAbout.Text
        mnuAbout.PerformClick()
      Case tbnSupport.Text
        mnuOnlineSupport.PerformClick()
      Case tbnExit.Text
        mnuExit.PerformClick()
    End Select
  End Sub
#End Region

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

  'tmrSearch控件Tick事件，类似VB6中的OnTimer，为产生滑动效果
  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
        trvDept.Visible = False
        xplSearch.Dock = DockStyle.Left
        tmrSearch.Enabled = False
      End If
    ElseIf m_SearchAction = SearchAction.Hide Then
      xplSearch.Dock = DockStyle.None
      trvDept.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

  '注意:此过程响应rdiDeptReceive和rdiDeptSend两个控件的CheckedChanged消息
  Private Sub rdiDept_CheckedChanged(ByVal sender As System.Object, _
                              ByVal e As System.EventArgs) _
                              Handles rdiDeptReceive.CheckedChanged, _
                                      rdiDeptSend.CheckedChanged
    Dim ErrMsg As String
    ErrMsg = mdlCtrl.AddDeptsToCombo(cboDept, False, True)
  End Sub

  '“发件人”复选框，选定后对应文本框才被激活
  Private Sub chkAddresser_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles chkAddresser.CheckedChanged
    txtAddresser.Enabled = chkAddresser.Checked
  End Sub

  '“信件内容”复选框，选定后对应文本框才被激活
  Private Sub chkContent_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles chkContent.CheckedChanged
    txtKeys.Enabled = chkContent.Checked
  End Sub
  '查询面板大小随着TreeView的大小改变而改变
  Private Sub trvDept_SizeChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles trvDept.SizeChanged
    xplSearch.Size = trvDept.Size
  End Sub
#End Region


End Class