modcontactmenu.bas

智能邮件管理信息系统

Attribute VB_Name = "ModContactMenu"
Option Explicit

'创建职位柴单
Public Sub pCreateContactMenu(lnghwndOwner As Long, x As Long, y As Long)
    Dim i As Long
    
    Dim strsql As String
    Dim lngMenuCounter As Long
    
    Dim mclsEmployee As New PEmployee.clsEmployee
    Set mclsEmployee = GetclsEmployee
    Dim mEmployee  As PEmployee.Employee
    Dim mEmployees  As PEmployee.Employees
    
    Set frmMain.mclsContactMenu = New XpPopMenu.cPopupMenu
    frmMain.mclsContactMenu.hwndOwner = lnghwndOwner
    frmMain.mclsContactMenu.OfficeXpStyle = False
    frmMain.mclsContactMenu.ClearMenuItems
    
    
    
    Dim mclsSystemMenu1 As New PSystemMenu.clsSystemMenu
    Dim mSystemMenus As PSystemMenu.SystemMenus
    Dim mSystemMenu As PSystemMenu.SystemMenu
    
    mclsSystemMenu1.Init gdbCurrentDB
    
    
    If m_E_ViewMode = m_ServerMode Then
        strsql = "select * from SystemMenu Where strMenuName='mclsContactMenuSever' order by intorder"
    ElseIf m_E_ViewMode = m_CliendMode Then
        strsql = "select * from SystemMenu Where strMenuName='mclsContactMenu' order by intorder"
    End If
    
    
    
    mclsSystemMenu1.GetSystemMenus strsql, mSystemMenus
    If mSystemMenus.Count > 0 Then
        For lngMenuCounter = 0 To mSystemMenus.Count
            LSet mSystemMenu = mSystemMenus.SystemMenu(lngMenuCounter)
            If mSystemMenu.lngSystemMenuID > 0 Then
                frmMain.mclsContactMenu.AddMenuItem mSystemMenu.sKey, IIf(BlnEnglishVersion, mSystemMenu.sEnglishCaption, mSystemMenu.sCaption), mSystemMenu.strParenetKey, mSystemMenu.sHelptext, mSystemMenu.lItemData, mSystemMenu.iIconIndex, mSystemMenu.bChecked, True, mSystemMenu.bVisable
            End If
        Next lngMenuCounter
    End If
    
     '设置常见只
    Dim blnSelectMail As Boolean
    blnSelectMail = frmMain.ctlMailList.mlngCurrentSelectID > 0
    
    If m_E_ViewMode = m_ServerMode Then
        strsql = "select * from Employee"
        mclsEmployee.GetEmployees strsql, mEmployees
        If mEmployees.Count > 0 Then
            For i = 0 To mEmployees.Count - 1
                LSet mEmployee = mEmployees.Employee(i)
                frmMain.mclsContactMenu.AddMenuItem "EmployeeContact" & mEmployee.LngEmployeeID, mEmployee.strEmployeeName & "(" & mEmployee.strEmail & ")", "EmployeeCustomer", , 100
            Next i
        End If
    End If
    
    '设置列 的彩旦
    Dim iCol As Long
    Dim strCaption As String
    Dim Checked As Boolean
    Dim Tag As String '为KEY
     ' add to columns menu:
    For iCol = 1 To frmMain.ctlMailList.Columns
       strCaption = IIf(Len(frmMain.ctlMailList.ColumnHeader(iCol)) = 0, frmMain.ctlMailList.ColumnKey(iCol), frmMain.ctlMailList.ColumnHeader(iCol))
       Checked = frmMain.ctlMailList.ColumnVisible(iCol)
       Tag = frmMain.ctlMailList.ColumnKey(iCol)
       If UCase(strCaption) <> UCase("ID") And Trim(strCaption) <> "" Then
            frmMain.mclsContactMenu.AddMenuItem Tag, strCaption, "ViewColumn", , , , Checked
       End If
    Next iCol
    
    
    frmMain.mclsContactMenu.MenuItemEnabled("Modify") = blnSelectMail
    frmMain.mclsContactMenu.MenuItemEnabled("Delete") = blnSelectMail
    frmMain.mclsContactMenu.MenuItemEnabled("DeleteAll") = frmMain.ctlMailList.Rows > 0
    frmMain.mclsContactMenu.MenuItemEnabled("Group") = frmMain.ctlMailList.AllowGrouping
        
    '设置权限中的可用只
    strsql = "select * from SystemMenu Where strMenuName='mclsContactMenu' And bEnabled=0 order by intorder"
    mclsSystemMenu1.GetSystemMenus strsql, mSystemMenus
    If mSystemMenus.Count > 0 Then
        For lngMenuCounter = 0 To mSystemMenus.Count
            LSet mSystemMenu = mSystemMenus.SystemMenu(lngMenuCounter)
            If mSystemMenu.lngSystemMenuID > 0 Then
                frmMain.mclsContactMenu.MenuItemEnabled(mSystemMenu.sKey) = False
            End If
        Next lngMenuCounter
    End If
    
    
    frmMain.mclsContactMenu.ShowPopupMenu x, y
    Set mclsSystemMenu1 = Nothing
End Sub




Public Sub RaiseContactMenu_Click(ItemNumber As Long)
    Dim strKey As String
    strKey = frmMain.mclsContactMenu.MenuItemKey(ItemNumber)
    
   Dim mclsEmployee As New PEmployee.clsEmployee
   Dim mEmployee As PEmployee.Employee
   Set mclsEmployee = GetclsEmployee
   Dim LngEmployeeID As Long
   
            
             
    
    '**************************************************************************
    '将联系人分配给职员
    Dim mclsContact As PContact.clsContact
    Dim mContact As PContact.Contact
    Set mclsContact = GetclsContact

    If InStr(1, UCase(strKey), UCase("EmployeeContact")) > 0 Then
        LngEmployeeID = Val(Replace(UCase(strKey), UCase("EmployeeContact"), ""))
        If LngEmployeeID > 0 Then
            mclsContact.GetContact frmMain.ctlMailList.mlngCurrentSelectID, mContact
            If mContact.lngContactID > 0 Then
                mContact.LngEmployeeID = LngEmployeeID
                If mclsContact.SaveContact(mContact, False) Then
                    frmMain.RefreshMailList
                End If
            End If
        End If
        Exit Sub
    End If
    '**************************************************************************
                
    Select Case UCase(strKey)
    Case UCase("NEW")                   '新增
            Call mclsContact.ShowAddContactDialog(m_E_ViewMode, gLngEmployeeID1)
            frmMain.RefreshMailList
            frmMain.Status "共有" & frmMain.ctlMailList.Rows & "笔记录."
    Case UCase("MODIFY")                '修改
        If mclsContact.ShowEditContactDialog(frmMain.ctlMailList.mlngCurrentSelectID, gLngEmployeeID1) Then
            frmMain.RefreshMailList
            frmMain.Status "共有" & frmMain.ctlMailList.Rows & "笔记录."
        End If
    Case UCase("DELETE")                '删除
        If mclsContact.DeleteContact(frmMain.ctlMailList.mlngCurrentSelectID, gLngEmployeeID1, True) Then
            frmMain.ctlMailList.RemoveRow False, True, 0
            frmMain.Status "共有" & frmMain.ctlMailList.Rows & "笔记录."
        End If
    Case UCase("DeleteAll")             '删除
        Call mclsContact.DeleteContacts(gLngEmployeeID1, True)
            frmMain.RefreshMailList
            frmMain.Status "共有" & frmMain.ctlMailList.Rows & "笔记录."
    Case UCase("Refreshdata")           '刷新
        frmMain.RefreshMailList
        frmMain.Status "共有" & frmMain.ctlMailList.Rows & "笔记录."
    Case UCase("GROUP")                 '分组
        frmMain.ctlMailList.AllowGrouping = True
    Case Else
        '点击的是显示列设置
        '********************************************************************************
       '设置列可见
        If frmMain.ctlMailList.ColumnVisibleCount = 1 Then
            ShowMessageBoxEx "至少必须有一列可见！", vbOKOnly, "设置列可见"
        ElseIf frmMain.ctlMailList.ColumnVisibleCount > 1 Then
            frmMain.mclsContactMenu.MenuItemChecked(ItemNumber) = Not frmMain.mclsContactMenu.MenuItemChecked(ItemNumber)
            frmMain.ctlMailList.ColumnVisible(frmMain.mclsContactMenu.MenuItemKey(ItemNumber)) = frmMain.mclsContactMenu.MenuItemChecked(ItemNumber)
        End If
        '********************************************************************************
    End Select
    

    Set mclsContact = Nothing
End Sub