vbmail.frm

一款漂亮的控件。 快

Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub About_Click()
MsgBox "电子邮件收发实例" + Chr$(13) + Chr$(10) + "     2001.7.1", 0, "电子邮件"
End Sub

Private Sub EditDelete_Click()
On Error GoTo trap
        '删除邮件
        If TypeOf VBMail.ActiveForm Is MailLst Then
            VBMail.MAPIMess.MsgIndex = MailLst.Mlist.ListIndex
            Call DeleteMessage
        End If
trap:
     Exit Sub
End Sub

Private Sub Exit_Click()
'如果对话未关闭，则调用logoff_Click关闭邮件对话
If MAPISess.SessionID <> 0 Then
    Call Logoff_Click
End If
End
End Sub

Private Sub FontPrt_Click()
On Error Resume Next
'打印字体设置
CMDialog1.Flags = 1
CMDialog1.FontName = Printer.FontName
CMDialog1.FontSize = Printer.FontSize
CMDialog1.FontBold = Printer.FontBold
CMDialog1.FontItalic = Printer.FontItalic
CMDialog1.ShowFont
If Err = 0 Then
    Printer.FontName = CMDialog1.FontName
    Printer.FontSize = CMDialog1.FontSize
    Printer.FontBold = CMDialog1.FontBold
    Printer.FontItalic = CMDialog1.FontItalic
End If
End Sub

Private Sub FontScreen_Click()
'活动窗体中具有输入焦点控件的字体设置
On Error Resume Next
CMDialog1.Flags = 1
CMDialog1.FontName = VBMail.ActiveForm.ActiveControl.FontName
CMDialog1.FontSize = VBMail.ActiveForm.ActiveControl.FontSize
CMDialog1.FontBold = VBMail.ActiveForm.ActiveControl.FontBold
CMDialog1.FontItalic = VBMail.ActiveForm.ActiveControl.FontItalic
CMDialog1.ShowFont
If Err = 0 Then
    VBMail.ActiveForm.ActiveControl.FontName = CMDialog1.FontName
    VBMail.ActiveForm.ActiveControl.FontSize = CMDialog1.FontSize
    VBMail.ActiveForm.ActiveControl.FontBold = CMDialog1.FontBold
    VBMail.ActiveForm.ActiveControl.FontItalic = CMDialog1.FontItalic
End If
End Sub

Private Sub Logoff_Click()
'关闭邮件对话，注销用户
Call LogOffUser
End Sub

Private Sub Logon_Click()
'登录
On Error Resume Next
'打开邮件对话
MAPISess.Action = 1
If Err <> 0 Then
    MsgBox "Logon failure:" + Error$
Else
    Screen.MousePointer = 11
    MAPIMess.SessionID = MAPISess.SessionID
    '取得邮箱中邮件的数量
    GetMessageCount
    Screen.MousePointer = 11
    '将邮件的信息装载到邮件列表窗体中的列表框
    Call LoadList(MAPIMess)
    Screen.MousePointer = 0
    '设置各个按扭及菜单的可用状态
    Logon.Enabled = False
    Logoff.Enabled = True
    ShowAB.Enabled = True
    VBMail.Toolbar1.Buttons("Compose").Enabled = True
    VBMail.Toolbar1.Buttons("Fetch").Enabled = True
    VBMail.Toolbar1.Buttons("ReplyAll").Enabled = True
    VBMail.Toolbar1.Buttons("Reply").Enabled = True
    VBMail.Toolbar1.Buttons("Forward").Enabled = True
    VBMail.EditDelete = True
    VBMail.Toolbar1.Buttons("Delete").Enabled = True
    VBMail.Toolbar1.Buttons("Previous1").Enabled = False
    VBMail.Toolbar1.Buttons("Next1").Enabled = True
    VBMail.EditDelete.Enabled = True
    VBMail.Mforward.Enabled = True
    VBMail.Mreply.Enabled = True
    VBMail.Mreplyall.Enabled = True
    VBMail.Mreplyall.Enabled = True
    VBMail.Mcompose.Enabled = True
    VBMail.PrintMessage.Enabled = True
    VBMail.Mfetch.Enabled = True
End If
End Sub

Private Sub MailOpts_Click()
'调用收发邮件设置对话框
OptionType = conOptionGeneral
MailOptFrm.Show 1
End Sub

Private Sub Mcompose_Click()
'撰写新邮件
VBMail.MAPIMess.Action = 6
If SendWithMapi Then
    '使用MAPI对话框撰写及发送电子邮件
    VBMail.MAPIMess.Action = vbMessageSenddlg
Else
    '使用设计的窗体NewMsg撰写及发送电子邮件
    Call LoadMessage(-1, NewMsg)
End If
End Sub

Private Sub MDIForm_Load()
Logoff.Enabled = False
Statusbar1.Panels(2) = Time$
Statusbar1.Panels(1) = "现处于离线状态"
'初始化各菜单，按扭的可用状态
SendWithMapi = True
ShowAB.Enabled = False
VBMail.Toolbar1.Buttons("Compose").Enabled = False
VBMail.Toolbar1.Buttons("Fetch").Enabled = False
VBMail.Toolbar1.Buttons("ReplyAll").Enabled = False
VBMail.Toolbar1.Buttons("Reply").Enabled = False
VBMail.Toolbar1.Buttons("Forward").Enabled = False
VBMail.Toolbar1.Buttons("Delete").Enabled = False
VBMail.Toolbar1.Buttons("Previous1").Enabled = False
VBMail.Toolbar1.Buttons("Next1").Enabled = False
VBMail.EditDelete.Enabled = False
VBMail.Mforward.Enabled = False
VBMail.Mreply.Enabled = False
VBMail.Mreplyall.Enabled = False
VBMail.Mreplyall.Enabled = False
VBMail.Mcompose.Enabled = False
VBMail.PrintMessage.Enabled = False
VBMail.Mfetch.Enabled = False
End Sub

Private Sub Mfetch_Click()
'从邮箱中读取邮件
VBMail.MAPIMess.Action = 1
'取得邮箱中邮件的数量
GetMessageCount
'将邮件信息装载到邮件列表窗体中
Call LoadList(MAPIMess)
End Sub

Private Sub Mforward_Click()
'转发发邮件
'取得邮件的正文及邮件头
svNote = VBMail.MAPIMess.MsgNoteText
svNote = GetHeader(VBMail.MAPIMess) + svNote
'发送
VBMail.MAPIMess.Action = 9
VBMail.MAPIMess.MsgNoteText = svNote
If SendWithMapi Then
    '使用MAPI对话框撰写及转发电子邮件
    VBMail.MAPIMess.Action = vbMessageSenddlg
Else
    '使用设计的窗体NewMsg撰写及转送电子邮件
    Call LoadMessage(-1, NewMsg)
End If
End Sub

Private Sub Mreply_Click()
'回复邮件
'取得邮件的正文及邮件头
svNote = VBMail.MAPIMess.MsgNoteText
svNote = GetHeader(VBMail.MAPIMess) + svNote
'回复
VBMail.MAPIMess.Action = 7
VBMail.MAPIMess.MsgNoteText = svNote
If SendWithMapi Then
    '使用MAPI对话框撰写及回复电子邮件
    VBMail.MAPIMess.Action = vbMessageSenddlg
Else
    '使用设计的窗体NewMsg撰写及回复电子邮件
    Call LoadMessage(-1, NewMsg)
End If
End Sub

Private Sub Mreplyall_Click()
svNote = VBMail.MAPIMess.MsgNoteText
svNote = GetHeader(VBMail.MAPIMess) + svNote
VBMail.MAPIMess.Action = 8
VBMail.MAPIMess.MsgNoteText = svNote
If SendWithMapi Then
    VBMail.MAPIMess.Action = vbMessageSenddlg
Else
    Call LoadMessage(-1, NewMsg)
End If
End Sub

Private Sub PrintMessage_Click()
'打印邮件
Call Printmail
End Sub

Private Sub PrSetup_Click()
On Error Resume Next
'打印机设置
CMDialog1.Flags = &H40
CMDialog1.ShowPrinter
End Sub

Private Sub ShowAB_Click()
On Error Resume Next
'显示地址簿
VBMail.MAPIMess.Action = vbMessageShowADBook
If Err Then
    If errr <> 32001 Then
        MsgBox "error:" + Error$ + "occured trying to show the address book"
    End If
Else
    '更新收信人地址
    If TypeOf VBMail.ActiveForm Is NewMsg Then
        Call UpdateRecips(VBMail.ActiveForm)
    End If
End If
End Sub

Private Sub Timer1_Timer()
Statusbar1.Panels(2) = Time$
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
On Error Resume Next
Select Case Button.Key
    Case "Fetch"
        Call Mfetch_Click
    Case "Compose"
        Call Mcompose_Click
    Case "Reply"
        Call Mreply_Click
    Case "ReplyAll"
        Call Mreplyall_Click
    Case "Forward"
        Call Mforward_Click
    Case "Previous1"
        '查看前一封邮件
        If MailLst.Mlist.ListCount <> 0 Then
            MailLst.Mlist.ItemData(MailLst.Mlist.ListIndex) = False
            MailLst.Mlist.ListIndex = MailLst.Mlist.ListIndex - 1
        End If
        Call ViewNextMsg
    Case "Next1"
       '查看下一封邮件
        If MailLst.Mlist.ListIndex <> MailLst.Mlist.ListCount - 1 Then
            MailLst.Mlist.ItemData(MailLst.Mlist.ListIndex) = False
            MailLst.Mlist.ListIndex = MailLst.Mlist.ListIndex + 1
        End If
        Call ViewNextMsg
    Case "Delete"
        '删除当前的邮件
        If TypeOf VBMail.ActiveForm Is MsgView Then
            Call DeleteMessage
        ElseIf TypeOf VBMail.ActiveForm Is MailLst Then
            VBMail.MAPIMess.MsgIndex = MailLst.Mlist.ListIndex
            Call DeleteMessage
        End If
End Select
End Sub

Private Sub Wa_Click(Index As Integer)
'排列子窗体
VBMail.Arrange Index
End Sub