?? modcontactmenu.bas
字號:
Attribute VB_Name = "ModContactMenu"
Option Explicit
'創(chuàng)建職位柴單
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
'設(shè)置常見只
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
'設(shè)置列 的彩旦
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
'設(shè)置權(quán)限中的可用只
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
'**************************************************************************
'將聯(lián)系人分配給職員
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
'點擊的是顯示列設(shè)置
'********************************************************************************
'設(shè)置列可見
If frmMain.ctlMailList.ColumnVisibleCount = 1 Then
ShowMessageBoxEx "至少必須有一列可見!", vbOKOnly, "設(shè)置列可見"
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
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -