frmsendmsg.vb

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

    Me.cmdSelectedAll.RightToLeft = System.Windows.Forms.RightToLeft.No
    Me.cmdSelectedAll.Size = New System.Drawing.Size(70, 27)
    Me.cmdSelectedAll.TabIndex = 11
    Me.cmdSelectedAll.Text = "全选(&A)"
    '
    'labReceiveList
    '
    Me.labReceiveList.Anchor = CType((System.Windows.Forms.AnchorStyles.Top Or System.Windows.Forms.AnchorStyles.Right), System.Windows.Forms.AnchorStyles)
    Me.labReceiveList.AutoSize = True
    Me.labReceiveList.BackColor = System.Drawing.SystemColors.Control
    Me.labReceiveList.Cursor = System.Windows.Forms.Cursors.Default
    Me.labReceiveList.ForeColor = System.Drawing.SystemColors.ControlText
    Me.labReceiveList.Location = New System.Drawing.Point(19, 17)
    Me.labReceiveList.Name = "labReceiveList"
    Me.labReceiveList.RightToLeft = System.Windows.Forms.RightToLeft.No
    Me.labReceiveList.Size = New System.Drawing.Size(140, 17)
    Me.labReceiveList.TabIndex = 25
    Me.labReceiveList.Text = "请选择接收本信息的部门"
    '
    'frmSendMsg
    '
    Me.AutoScaleBaseSize = New System.Drawing.Size(6, 14)
    Me.CancelButton = Me.cmdCancel
    Me.ClientSize = New System.Drawing.Size(722, 440)
    Me.Controls.Add(Me.grpInput)
    Me.Controls.Add(Me.grpDeptList)
    Me.Controls.Add(Me.pic)
    Me.Menu = Me.MainMenu1
    Me.Name = "frmSendMsg"
    Me.StartPosition = System.Windows.Forms.FormStartPosition.CenterScreen
    Me.Text = "新信息"
    Me.pic.ResumeLayout(False)
    Me.grpInput.ResumeLayout(False)
    Me.panInput.ResumeLayout(False)
    Me.grpDeptList.ResumeLayout(False)
    Me.ResumeLayout(False)

  End Sub

#End Region

#Region "对外公布函数"

  '设置窗体状态：发送，回复，广播
  Public Sub SetFormSendStatus(ByVal frmStat As SendMsgStatus)
    m_smsStat = frmStat
  End Sub
  '设置被回复的部门ID
  Public Sub SetReplyDeptId(ByVal iReplyDeptId As Int16)
    Me.m_iDeptReplyId = iReplyDeptId
  End Sub
  '设置被回复的信息ID
  Public Sub SetReplyMsgId(ByVal iReplyMsgId As Long)
    Me.m_iReplyInfoId = iReplyMsgId
  End Sub

#End Region

#Region "实用函数/过程"

  '选中所有的部门
  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 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 = m_iReplyInfoId '是否已处理

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

    Return szResultMsg

  End Function

#End Region

#Region "收件部门列表相关事件响应"


  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 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
      If lsvDept.Items(e.Index).Tag = Me.m_iDeptReplyId Then
        e.NewValue = CheckState.Checked
        lsvDept.Items(e.Index).ForeColor = Color.Red
        txtReceiveDept.Text = "发送信息到 " & lsvDept.Items(e.Index).Text
      Else
        e.NewValue = e.CurrentValue
      End If
      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

#End Region

  '初始化窗体
  Private Sub frmSendInfo_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
    Dim ErrMsg As String
    Dim dmRole As New 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
    mdlCtrl.AddDeptsToListView(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 Or m_iReplyInfoId < 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

  End Sub

#Region "菜单响应函数"
  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

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

  '发送信息，包括发送新信息，回复信息和发送广播
  '注意：发送菜单和发送铵钮的消息响应都在这个过程中
  Public Sub SendInfo_Click(ByVal eventSender As System.Object, _
                      ByVal eventArgs As System.EventArgs) _
                      Handles mnuSendInfo.Click, _
                              cmdSend.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
#End Region




End Class