frmsendmsg3.vb

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

    Me.mnuOperate.Index = 0
    Me.mnuOperate.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.mnuSendInfo, Me.ln1, Me.mnuReturn})
    Me.mnuOperate.Text = "操作(&O)"
    '
    'mnuSendInfo
    '
    Me.mnuSendInfo.Index = 0
    Me.mnuSendInfo.Shortcut = System.Windows.Forms.Shortcut.CtrlS
    Me.mnuSendInfo.Text = "立即发送(&S)"
    '
    'ln1
    '
    Me.ln1.Index = 1
    Me.ln1.Text = "-"
    '
    'mnuReturn
    '
    Me.mnuReturn.Index = 2
    Me.mnuReturn.Shortcut = System.Windows.Forms.Shortcut.CtrlR
    Me.mnuReturn.Text = "返回(&R)"
    '
    'mnuHelp
    '
    Me.mnuHelp.Index = 1
    Me.mnuHelp.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.mnuHelpInfo})
    Me.mnuHelp.Text = "帮助(&H)"
    '
    'mnuHelpInfo
    '
    Me.mnuHelpInfo.Index = 0
    Me.mnuHelpInfo.Shortcut = System.Windows.Forms.Shortcut.CtrlH
    Me.mnuHelpInfo.Text = "帮助文档(&H)"
    '
    'frmSendInfo
    '
    Me.AutoScaleBaseSize = New System.Drawing.Size(6, 14)
    Me.BackColor = System.Drawing.SystemColors.Control
    Me.ClientSize = New System.Drawing.Size(722, 420)
    Me.Controls.Add(Me.pic)
    Me.Controls.Add(Me.grpInput)
    Me.Controls.Add(Me.grpDeptList)
    Me.Cursor = System.Windows.Forms.Cursors.Default
    Me.Location = New System.Drawing.Point(3, 33)
    Me.Menu = Me.MainMenu1
    Me.Name = "frmSendInfo"
    Me.StartPosition = System.Windows.Forms.FormStartPosition.CenterScreen
    Me.Text = "新信息"
    Me.pic.ResumeLayout(False)
    Me.grpInput.ResumeLayout(False)
    Me.Panel1.ResumeLayout(False)
    Me.Panel2.ResumeLayout(False)
    Me.grpDeptList.ResumeLayout(False)
    Me.ResumeLayout(False)

  End Sub
#End Region

  '****************************************
  '*      企业内部业务联系系统 1.0版      *
  '*                                      *
  '*  作者：郭文云(云南电信昭通分公司)    *
  '*  日期：2004年8月                     *
  '*  版权：Terrificsoft                  *
  '*          版权所有  侵权必究          *
  '****************************************


  Private Sub InitFontNameCombo()
    Dim i As Integer
    Dim fontFamilies() As FontFamily
    Dim FontInstalled As New System.Drawing.Text.InstalledFontCollection
    fontFamilies = FontInstalled.Families
    Dim count As Integer = fontFamilies.Length

    cboFontName.Items.Clear()

    While i < count
      cboFontName.Items.Add(fontFamilies(i))
    End While

  End Sub

  Private Sub InitFontSizeCombo()
    Dim i As Integer
    cboFontSize.Items.Clear()
    For i = 8 To 22
      cboFontSize.Items.Add(i)
    Next
  End Sub


  '选中所有的部门
  Private Sub CheckAllDepts()
    Dim i As Integer
    For i = 0 To lsvDept.Items.Count - 1
      lsvDept.Items(i).Checked = True
      lsvDept.Items(i).Selected = False
    Next i

    txtReceiveDept.Text = "发送信息到 " & lsvDept.Items.Count & " 个部门]"
  End Sub

  Private Sub cmdSelectedAll_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdSelectedAll.Click
    CheckAllDepts()
  End Sub

  Private Sub cmdCancel_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdCancel.Click
    Me.Close()
  End Sub

  '设置收件部门文本框的提示
  Private Sub cmdSelectedClear_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdSelectedClear.Click
    Dim i As Integer
    For i = 0 To lsvDept.Items.Count - 1
      lsvDept.Items(i).Checked = False
      lsvDept.Items(i).Selected = False
    Next i
    txtReceiveDept.Text = "发送信息到 0 个部门"
  End Sub

  '发送信息菜单单击事件
  Private Sub cmdSend_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdSend.Click
    mnuSendInfo_Click(mnuSendInfo, New System.EventArgs)
  End Sub

  '初始化窗体
  Private Sub frmSendInfo_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
    Dim ErrMsg As String
    Dim dmRole As InfoProSysBusiness.RoleDataModel
    Dim roleObj As New InfoProSysBusiness.Role

    '初台化控件公共数据
    ErrMsg = roleObj.getRoleInfo(LoginedUserInfo.m_iRoleID, dmRole)
    txtSendDept.Text = dmRole.m_szRoleName
    txtAddresser.Text = LoginedUserInfo.m_szTrueName
    AddListItems(lsvDept, m_iDeptReplyId)
    If lsvDept.Columns.Count < 1 Then
      lsvDept.Columns.Add("收件部门", -1, HorizontalAlignment.Left)
    End If
    lsvDept.Columns(0).Width = -1
    dptProcLimeTime.Value = Now.AddDays(2)  '默认在2天内处理

    '根据窗体模式初始化控件数据
    Select Case m_smsStat
      Case SendMsgStatus.Send
        Me.Text = "发送信息"
        lsvDept.MultiSelect = False
      Case SendMsgStatus.Reply
        If m_iDeptReplyId <= 0 Then
          If MsgBox("操作错误，无法回复信息，只能以新信息来发送，继续吗？", _
              MsgBoxStyle.Question + MsgBoxStyle.YesNo) = MsgBoxResult.No Then
            Me.Close()
          Else
            Me.Text = "发送信息"
            m_smsStat = SendMsgStatus.Send
            Exit Select
          End If
        End If
        Me.Text = "回复信息"
        cmdSelectedAll.Enabled = False
        cmdSelectedClear.Enabled = False
      Case SendMsgStatus.Broadcast
        Me.Text = "发送广播"
        lsvDept.MultiSelect = True
        CheckAllDepts()
    End Select

    '初始化字体下拉列表框
    InitFontNameCombo()
    InitFontSizeCombo()

  End Sub

  Public Sub mnuHelpInfo_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles mnuHelpInfo.Click
    ShellExecute(Me.Handle.ToInt32, "open", Environment.CurrentDirectory & "\readme.txt", "", "", SW_SHOW)
  End Sub

  '设置收件部门文本框的提示
  Private Sub lsvDept_ItemCheck(ByVal sender As Object, ByVal e As System.Windows.Forms.ItemCheckEventArgs) Handles lsvDept.ItemCheck
    '根据lsvDept的选择计算发送要广播的部门数
    Dim iCount As Int16 = lsvDept.CheckedItems.Count

    '如果是回复状态，则无法改变其现有选择状态
    If m_smsStat = SendMsgStatus.Reply Then
      e.NewValue = e.CurrentValue
      Return
    End If

    iCount = IIf(e.NewValue = CheckState.Checked, iCount + 1, iCount - 1)
    If e.NewValue = CheckState.Checked Then
      lsvDept.Items(e.Index).ForeColor = Color.Red
    ElseIf e.NewValue = CheckState.Unchecked Then
      lsvDept.Items(e.Index).ForeColor = Color.Black
    End If

    txtReceiveDept.Text = "发送信息到 " & iCount & " 个部门"
  End Sub

  Public Sub mnuReturn_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles mnuReturn.Click
    Me.Close()
  End Sub

  '发送信息，包括发送新信息，回复信息和发送广播
  Public Sub mnuSendInfo_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles mnuSendInfo.Click
    '检查信息填写是否完整
    If txtAddresserTel.Text = "" _
       Or rtxtContent.Text = "" Then
      MsgBox("请将每一项目都填写完整。", MsgBoxStyle.Information, Me.Text)
      Exit Sub
    End If
    '判断是否至少选择了一个接收部门
    If lsvDept.CheckedItems.Count < 1 Then
      MsgBox("请至少选择一个部门进行发送。", MsgBoxStyle.Information, "发送广播")
      Exit Sub
    End If

    Dim frmPmtObj As New frmPrompt
    frmPmtObj.SetPromptType(PromptType.SendMsg)
    frmPmtObj.Show()
    System.Windows.Forms.Application.DoEvents()

    '发送信息
    Dim Errmsg As String
    Errmsg = SendMessage()



    TimeDelay(1000)
    frmPmtObj.Close()
    MsgBox(Errmsg, MsgBoxStyle.Information, Me.Text)

    Me.Close()

  End Sub

  '发送信息
  Private Function SendMessage() As String
    Dim MsgObj As New InfoProSysBusiness.Message
    Dim dmMsg As New InfoProSysBusiness.MessageDataModel
    Dim i As Integer
    Dim szResultMsg As String = ""
    Dim thisMsg As String
    Dim lstItem As ListViewItem

    szResultMsg = "共发送了[" & lsvDept.CheckedItems.Count & "]条信息，结果如下：" & vbLf
    For i = 0 To lsvDept.CheckedItems.Count - 1
      lstItem = lsvDept.CheckedItems(i)
      '给dmMsg赋值 
      dmMsg.m_bProcessed = False
      dmMsg.m_iDeptSendId = LoginedUserInfo.m_iRoleID  '发件部门
      dmMsg.m_iDeptReceiveId = lstItem.Tag  '收件部门
      dmMsg.m_iAddresserID = LoginedUserInfo.m_iUserID  '发件人
      dmMsg.m_szAddresserAccount = LoginedUserInfo.m_szUserAccount  '发件人
      dmMsg.m_szAddresserTel = txtAddresserTel.Text  '发件人电话
      dmMsg.m_dtProcTimeLimit = dptProcLimeTime.Value   '处理时限
      dmMsg.m_dtSendTime = Now '发送时间
      dmMsg.m_szInfoContent = rtxtContent.Rtf   '联系内容 
      dmMsg.m_iReplyInfoID = 0 '是否已处理

      thisMsg = MsgObj.SendMsg(dmMsg)
      If thisMsg = "" Then
        thisMsg = "发送成功！"
      End If
      szResultMsg &= "信息" & i & " ：" & thisMsg & vbLf
    Next i

    Return szResultMsg

  End Function

  Public Sub SetFormSendStatus(ByVal frmStat As SendMsgStatus)
    m_smsStat = frmStat
  End Sub

  Public Sub SetReplyDeptId(ByVal iReplyDeptId As Int16)
    Me.m_iDeptReplyId = iReplyDeptId
  End Sub


End Class