frmmain1.frm

智能邮件管理信息系统

    
    Dim i As Long
    Dim m_UserTypes As Account.UserTypes
    Dim m_UserType As Account.UserType
    
    
    Dim strsql As String
    
    If UCase(ctlTopToolBar.ButtonKey(lButton)) = UCase("TOOLSSENDANDREC") Then
        strsql = "select * from [user]"
        
        With mclsSendMailMenu
            .OfficeXpStyle = False
            .ImageList = m_CImageListHot.hIml
            .hwndOwner = Me.hwnd
            .AddMenuItem "SendReceiveAll", "发送和接收所有邮件", "None", , , 37
            .AddMenuItem "ReceiveAll", "接收全部邮件", "None"
            .AddMenuItem "SendAll", "发送全部邮件", "None", , , 13
            
               
            mclsMailAccount.GetUsers strsql, m_UserTypes
            If m_UserTypes.Count >= 1 Then
                .AddMenuItem "Sep1", "-", "None"
                For i = 0 To m_UserTypes.Count - 1
                    LSet m_UserType = m_UserTypes.UserType(i)
                    
                    If m_UserType.lngUserID > 0 Then .AddMenuItem m_UserType.lngUserID, m_UserType.AccountName & IIf(m_UserType.BlnDefault, "(默认)", ""), "None", , , IIf(m_UserType.BlnDefault, 60, -1)
                Next i
            End If
        End With
        mclsSendMailMenu.ShowPopupMenu x, y
    ElseIf UCase(ctlTopToolBar.ButtonKey(lButton)) = UCase("ViewMail") Then
        With mclsMailViewMenu
             .ShowPopupMenu x, y
        End With
        
    ElseIf UCase(ctlTopToolBar.ButtonKey(lButton)) = UCase("TOOLSNEW") Then '邮件模板
        strsql = "select * from MailTemplate"
        
        Dim m_cSysIls As ImageListClass.cSysImageList
        Set m_cSysIls = New ImageListClass.cSysImageList
        m_cSysIls.IconSizeX = 16
        m_cSysIls.IconSizeY = 16
        m_cSysIls.Create
        
        
        With mclsMailTemplateMenu
            .OfficeXpStyle = False
            .hwndOwner = Me.hwnd
            .ImageList = m_cSysIls.hIml
            mclsMailTemplate.GetMailTemplates strsql, m_MailTemplates
            If m_MailTemplates.Count >= 1 Then
                For i = 0 To m_MailTemplates.Count - 1
                    LSet m_MailTemplate = m_MailTemplates.MailTemplate(i)
                    
                    If m_MailTemplate.lngMailTemplateID > 0 Then
                        .AddMenuItem m_MailTemplate.lngMailTemplateID, "(&" & i + 1 & ")" & vbTab & m_MailTemplate.strMailTemplateName, "None", , m_MailTemplate.lngMailTemplateID, m_cSysIls.ItemIndex("*.html")
                    End If
                Next i
'                .AddMenuItem "Sep1", "-", "None"
            End If
             .ShowPopupMenu x, y
        End With
        

    End If
End Sub
'********************************************************************************




Private Sub ctlTreeTab_Click(x As Long, y As Long, RightButton As Boolean, hItem As Long)
    If hItem = 0 Then '表示没有选择任何节点,退出
        Exit Sub
    End If
    #If SimpleVersion = 0 Then
    If RightButton Then
        Set mnuTreePopMenu = New XpPopMenu.cPopupMenu
        
        '设置TAG为选择的树型INDEX
        mnuTreePopMenu.Tag = hItem
        With mnuTreePopMenu
            .OfficeXpStyle = True
            .MenuBackgroundColor = -1
            .InActiveMenuForeColor = -1
            .ActiveMenuForeColor = -1
            .ActiveMenuBackgroundColor = -1
            .Font = Nothing
            .BackgroundPicture = Nothing
            .HeaderStyle = ecnmHeaderSeparator

            .HideInfrequentlyUsed = True
            .OfficeXpStyle = False
            Dim blnSelectMail As Boolean
            MOwnDefineTree.GetOwnDefineTree ctlTreeTab.ItemData(ctlTreeTab.ItemKey(hItem)), MOwnDefineTree.m_OwnDefineTree
            blnSelectMail = (MOwnDefineTree.m_OwnDefineTree.BlnIsSystem <> 1)



            .ClearMenuItems
            .ImageList = m_CImageListHot.hIml
            .hwndOwner = ctlTreeTab.hwnd
            .AddMenuItem "Find", "查找(&F)", "EditMail", , , 8
            .AddMenuItem "Sep001", "-", "EditMail"
            .AddMenuItem "NewDir", "新建文件夹(&N)", "EditMail"
            .AddMenuItem "RenameDir", "重命名文件夹(&R)", "EditMail", , , , , blnSelectMail
            .AddMenuItem "DelDir", "删除(&D)", "EditMail", , , 6, , blnSelectMail
            .AddMenuItem "Sep004", "-", "EditMail"
            .AddMenuItem "Per", "属性(&R)", "EditMail", , , , , blnSelectMail
            .ShowPopupMenu x * Screen.TwipsPerPixelX, y * Screen.TwipsPerPixelY
        End With
    End If
    #End If
End Sub

Private Sub ctlTreeTab_DragMove(x As Long, y As Long)
    Debug.Print "dd'"
End Sub

Private Sub ctlTreeTab_ItemClick(hItem As Long, RightButton As Boolean)
    ctlMailList.gdbCurrentDB = gdbCurrentDB
    Dim lngContactID  As Long
    lngContactID = 0
    
    gLngOwnDefineTreeID = ctlTreeTab.ItemData(ctlTreeTab.ItemKey(hItem))
    
    If m_E_TreeViewType = m_OutlookTreeView Then
        '系统文件夹
        Select Case UCase(ctlTreeTab.ItemKey(hItem))
        Case UCase("PERSONAL")
        Case UCase("InMailBox") '收件箱
            ctlMailList.mlngViewID = 2
        Case UCase("OutMailBox") '发件箱
            
            ctlMailList.mlngViewID = 3
        Case UCase("SendMail") '已经发件箱
            ctlMailList.mlngViewID = 4
        Case UCase("DeletedMail") '删除箱
            
            ctlMailList.mlngViewID = 5
        Case UCase("WriteBox")  '草稿
            
            ctlMailList.mlngViewID = 46
        Case UCase("TRACKMAIL")  '跟踪
            ctlMailList.mlngViewID = 44
        Case UCase("TASKMAIL") '任务
            ctlMailList.mlngViewID = 3
        End Select
        
        '非系统文件夹
        If InStr(1, UCase(ctlTreeTab.ItemKey(hItem)), UCase("PERSONAL")) > 0 Then
        ElseIf InStr(1, UCase(ctlTreeTab.ItemKey(hItem)), UCase("InMailBox")) > 0 Then '收件箱
            ctlMailList.mlngViewID = 2
        ElseIf InStr(1, UCase(ctlTreeTab.ItemKey(hItem)), UCase("OutMailBox")) > 0 Then '发件箱
            ctlMailList.mlngViewID = 3
        ElseIf InStr(1, UCase(ctlTreeTab.ItemKey(hItem)), UCase("SendMail")) > 0 Then '已经发件箱
            ctlMailList.mlngViewID = 4
        ElseIf InStr(1, UCase(ctlTreeTab.ItemKey(hItem)), UCase("DeletedMail")) > 0 Then '删除箱
            ctlMailList.mlngViewID = 5
        ElseIf InStr(1, UCase(ctlTreeTab.ItemKey(hItem)), UCase("WriteBox")) > 0 Then '草稿
            ctlMailList.mlngViewID = 46
        ElseIf InStr(1, UCase(ctlTreeTab.ItemKey(hItem)), UCase("TRACKMAIL")) > 0 Then '跟踪
            ctlMailList.mlngViewID = 44
        ElseIf InStr(1, UCase(ctlTreeTab.ItemKey(hItem)), UCase("TASKMAIL")) > 0 Then '任务
            ctlMailList.mlngViewID = 3
        End If
        
        '此为服务器模式,不能新增
        RefreshMailList
        RefreshShowColumns
        RefreshOrderStyle
        RefreshMenuToolbar
        Exit Sub
    Else
        
        If InStr(UCase(ctlTreeTab.ItemKey(hItem)), UCase("EMPLOYEE")) > 0 And Len(ctlTreeTab.ItemKey(hItem)) > Len("EMPLOYEE") Then
            If InStr(UCase(ctlTreeTab.ItemKey(hItem)), UCase("InMailBox")) > 0 Then   '收件箱
                lngContactID = Val(Replace(UCase(ctlTreeTab.ItemKey(hItem)), UCase("EMPLOYEEInMailBox"), "", 1))
                ctlMailList.mlngViewID = 2
            ElseIf InStr(UCase(ctlTreeTab.ItemKey(hItem)), UCase("OutMailBox")) > 0 Then '发件箱
                lngContactID = Val(Replace(UCase(ctlTreeTab.ItemKey(hItem)), UCase("EMPLOYEEOutMailBox"), "", 1))
                ctlMailList.mlngViewID = 3
            ElseIf InStr(UCase(ctlTreeTab.ItemKey(hItem)), UCase("SendMail")) > 0 Then '已经发件箱
                lngContactID = Val(Replace(UCase(ctlTreeTab.ItemKey(hItem)), UCase("EMPLOYEESendMail"), "", 1))
                ctlMailList.mlngViewID = 4
            ElseIf InStr(UCase(ctlTreeTab.ItemKey(hItem)), UCase("DeletedMail")) > 0 Then   '删除箱
                lngContactID = Val(Replace(UCase(ctlTreeTab.ItemKey(hItem)), UCase("EMPLOYEEDeletedMail"), "", 1))
                ctlMailList.mlngViewID = 5
            ElseIf InStr(UCase(ctlTreeTab.ItemKey(hItem)), UCase("Writed")) > 0 Then '草稿
                ctlMailList.mlngViewID = 46
            ElseIf InStr(UCase(ctlTreeTab.ItemKey(hItem)), UCase("EMPLOYEE")) > 0 Then   '职员
                lngContactID = Val(Replace(UCase(ctlTreeTab.ItemKey(hItem)), UCase("EMPLOYEE"), "", 1))
'                ctlMailList.mlngViewID = 44
'            Case nStr(UCase(ctlTreeTab.ItemKey(hItem)), UCase("EMPLOYEE")) > 0 UCase("TASKMAIL") '任务
'                ctlMailList.mlngViewID = 3
            
            End If
            '得到当前操作员
            gLngContactID = lngContactID
            Dim strMailFilter As String
            If lngContactID > 0 Then
                strMailFilter = "   lngContactID=" & lngContactID
            End If
        
            ctlMailList.RefreshData IIf(lngContactID > 0, strMailFilter, "")
            
            ctlLeftList.gdbCurrentDB = gdbCurrentDB
            ctlLeftList.mlngViewID = 42
            '将当前选择的操作员加入联系人中进行查找
            ctlLeftList.RefreshData IIf(m_E_ViewMode = m_CliendMode, " LngContactID=" & gLngContactID & " AND lngType=0", "")
            
    
            RefreshShowColumns
            RefreshOrderStyle
            RefreshMenuToolbar
            Exit Sub
        ElseIf InStr(UCase(ctlTreeTab.ItemKey(hItem)), UCase("TRACKMAIL")) > 0 Then '此处默认只有一个帐户
            ctlMailList.mlngViewID = 44
            ctlMailList.RefreshData
            RefreshShowColumns
            RefreshOrderStyle
            RefreshMenuToolbar
        End If
        
    End If
    
End Sub

Private Sub ctlTreeTab_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
'    If BlnInDrag Then
'        ctlTreeTab.ItemSelected

'    End If
End Sub

Private Sub ctlTreeTab_OLEDragDrop(data As DataObject, effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
  If data.GetFormat(vbCFText) Then
  
    Dim sFileName$
    
    '只读取第一条记录的信息
    sFileName = data.GetData(1)
    
  End If
  
End Sub

Private Sub Form_Activate()
    If blnIsFormLoad Then
        mclsMailSplit.Position = 200
        blnIsFormLoad = False
    End If
    
    Debug.Print Screen.MousePointer
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    
    If Shift = 1 Then
        Select Case KeyCode
        Case vbKeyDelete  '用Shift＋Delete进行彻底删除
            SendRecycle True
        End Select
    Else
        Select Case KeyCode
            Case vbKeyDelete   '用Delete进行彻底删除
                SendRecycle False
        End Select
    End If
End Sub

Private Sub Form_Load()
    #If OneUser = 1 Then
        BlnOneUser = True
    #Else
        BlnOneUser = False
    #End If
        
    Me.Caption = "SmartMail"
    Load frmRefresh
    frmRefresh.Show
    #If SubClass = 0 Then
    frmRefresh.Hide
    #End If
    frmRefresh.LabLoading.Caption = "正在加载..."
    frmRefresh.Refresh
'    Set mnuTrayMenu = New cPopupMenu
    ReDim m_lngSelectionID(0)
    frmRefresh.ProgressBar1.Max = 17
    frmRefresh.LabLoading.Caption = "正在加载数据库..."
    frmRefresh.Refresh
    OpenMyDatabase
    frmRefresh.ProgressBar1.Value = 1
    
    PCreateTimer
        
    '邮件帐户
    Set mclsMailAccount = New Account.AccountClass
    mclsMailAccount.Init gdbCurrentDB
    ShowProgramInTray
    
    
    frmRefresh.LabLoading.Caption = "正在加载图标集合..."
    frmRefresh.Refresh
    pCreateImageList
    frmRefresh.ProgressBar1.Value = 2
    
    m_E_ViewMode = m_ServerMode