modpositionmenu.bas

智能邮件管理信息系统

Attribute VB_Name = "ModPositionMenu"
Option Explicit

'创建职位柴单
Public Sub pCreatePositionMenu(lnghwndOwner As Long, x As Long, y As Long)
    Dim i As Long
    
    Dim strsql As String
    Dim lngMenuCounter As Long
    
    
    Set frmMain.mclsPositionMenu = New XpPopMenu.cPopupMenu
    frmMain.mclsPositionMenu.hwndOwner = lnghwndOwner
    frmMain.mclsPositionMenu.OfficeXpStyle = False
    frmMain.mclsPositionMenu.ClearMenuItems
    
    
    
    Dim mclsSystemMenu1 As New PSystemMenu.clsSystemMenu
    Dim mSystemMenus As PSystemMenu.SystemMenus
    Dim mSystemMenu As PSystemMenu.SystemMenu
    
    mclsSystemMenu1.Init gdbCurrentDB
    
    
    strsql = "select * from SystemMenu Where strMenuName='mclsPositionMenu' 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.mclsPositionMenu.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 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.mclsPositionMenu.AddMenuItem Tag, strCaption, "ViewColumn", , , , Checked
       End If
    Next iCol
    
    
    '设置常见只
    Dim blnSelectMail As Boolean
    blnSelectMail = frmMain.ctlMailList.mlngCurrentSelectID > 0
    frmMain.mclsPositionMenu.MenuItemEnabled("Modify") = blnSelectMail
    frmMain.mclsPositionMenu.MenuItemEnabled("Delete") = blnSelectMail
    frmMain.mclsPositionMenu.MenuItemEnabled("DeleteAll") = frmMain.ctlMailList.Rows > 0
    frmMain.mclsPositionMenu.MenuItemEnabled("Group") = frmMain.ctlMailList.AllowGrouping
        
    '设置权限中的可用只
    strsql = "select * from SystemMenu Where strMenuName='mclsPositionMenu' 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.mclsPositionMenu.MenuItemEnabled(mSystemMenu.sKey) = False
            End If
        Next lngMenuCounter
    End If
    
    
    frmMain.mclsPositionMenu.ShowPopupMenu x, y
    Set mclsSystemMenu1 = Nothing
End Sub




Public Sub RaisePositionMenu_Click(ItemNumber As Long)
    Dim strKey As String
    strKey = frmMain.mclsPositionMenu.MenuItemKey(ItemNumber)
    
    Dim mclsPosition1 As PPosition.clsPosition
    Set mclsPosition1 = GetclsPosition
    
    Select Case UCase(strKey)
    Case UCase("NEW")                   '新增
            mclsPosition1.AddPositionShowDialog
            frmMain.RefreshMailList
            frmMain.Status "共有" & frmMain.ctlMailList.Rows & "笔记录."
    Case UCase("MODIFY")                '修改
        If mclsPosition1.EditPositionShowDialog(frmMain.ctlMailList.mlngCurrentSelectID) Then
            frmMain.RefreshMailList
            frmMain.Status "共有" & frmMain.ctlMailList.Rows & "笔记录."
        End If
    Case UCase("DELETE")                '删除
        If mclsPosition1.DeletePosition(frmMain.ctlMailList.mlngCurrentSelectID) Then
            frmMain.ctlMailList.RemoveRow False, True, 0
            frmMain.Status "共有" & frmMain.ctlMailList.Rows & "笔记录."
        End If
    Case UCase("DeleteAll")             '删除
        mclsPosition1.DeletePositions
            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.mclsPositionMenu.MenuItemChecked(ItemNumber) = Not frmMain.mclsPositionMenu.MenuItemChecked(ItemNumber)
            frmMain.mclsPositionMenu.MenuItemChecked(ItemNumber) = Not frmMain.mclsPositionMenu.MenuItemChecked(ItemNumber)
            frmMain.ctlMailList.ColumnVisible(frmMain.mclsPositionMenu.MenuItemKey(ItemNumber)) = frmMain.mclsPositionMenu.MenuItemChecked(ItemNumber)
        End If
        '********************************************************************************
    End Select
    
    Set mclsPosition1 = Nothing
End Sub