cPopMenu.cls
资源名称:IE_VB.rar [点击查看]
上传用户:davilee3
上传日期:2015-04-22
资源大小:986k
文件大小:19k
源码类别:
浏览器
开发平台:
Visual Basic
- VERSION 1.0 CLASS
- BEGIN
- MultiUse = -1 'True
- Persistable = 0 'NotPersistable
- DataBindingBehavior = 0 'vbNone
- DataSourceBehavior = 0 'vbNone
- MTSTransactionMode = 0 'NotAnMTSObject
- END
- Attribute VB_Name = "cPopMenu"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = True
- Attribute VB_PredeclaredId = False
- Attribute VB_Exposed = False
- Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
- Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
- 'cPopMenu,用api生成的 popup menu
- '2004-12-18 修正了UnCheckAll的一个错误
- '2004-12-17 修改了popup,popup2函数,增加了enum pmnTPM
- '2004-11-29 增加函数GetItemCount
- '2004-11-28 补充了两种状态 pmsUnChecked pmsPopup,修正了pmsDisabled
- ' 增加了函数:RemoveItems
- ' 增加一参数:NODestroy,可以设置退出时是否destroy menu
- '2004-9-13 发现当使用CheckRadioItem后,UnCheckAll无效,已修正
- '2004-8-11 添加一个函数 Add2,可以指定添加的菜单项的位置
- '2004-6-26 添加了几个函数DeleteItem,ClearItems,CheckItem,
- ' CheckRadioItem,UnCheckAll
- '1:14 2004-3-5
- Option Explicit
- Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
- Private Declare Function SetMenuDefaultItem Lib "user32" (ByVal hMenu As Long, ByVal uItem As Long, ByVal fByPos As Long) As Long
- Private Declare Function EnableMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long
- Private Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal nReserved As Long, ByVal hWnd As Long, lprc As Any) As Long
- Private Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
- Private Declare Function InsertMenu Lib "user32" Alias "InsertMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
- Private Declare Function CreatePopupMenu Lib "user32" () As Long
- Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
- Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
- Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
- Private Declare Function CheckMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDCheckItem As Long, ByVal wCheck As Long) As Long
- Private Declare Function CheckMenuRadioItem Lib "user32" (ByVal hMenu As Long, ByVal un1 As Long, ByVal un2 As Long, ByVal un3 As Long, ByVal un4 As Long) As Long
- Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
- Public Enum pmnTPM
- TPM_BOTTOMALIGN = &H20&
- TPM_CENTERALIGN = &H4&
- TPM_HORIZONTAL = &H0&
- TPM_HORNEGANIMATION = &H800&
- TPM_HORPOSANIMATION = &H400&
- TPM_LEFTALIGN = &H0&
- TPM_LEFTBUTTON = &H0&
- TPM_NOANIMATION = &H4000&
- TPM_NONOTIFY = &H80&
- TPM_RECURSE = &H1&
- TPM_RETURNCMD = &H100&
- TPM_RIGHTALIGN = &H8&
- TPM_RIGHTBUTTON = &H2&
- TPM_TOPALIGN = &H0&
- TPM_VCENTERALIGN = &H10&
- TPM_VERNEGANIMATION = &H2000&
- TPM_VERPOSANIMATION = &H1000&
- TPM_VERTICAL = &H40&
- TPM_Default = TPM_LEFTALIGN Or TPM_RETURNCMD
- End Enum
- Private Const MF_BYCOMMAND = &H0& '菜单条目由菜单的命令ID指定
- Private Const MF_BYPOSITION = &H400& '菜单条目由条目在菜单中的位置决定。零代表菜单中的第一个条目
- Private Const MF_CHECKED = &H8& '检查指定的菜单条目。不能与VB的Checked属性兼容
- Private Const MF_DISABLED = &H2& '禁止指定的菜单条目。不与VB的Enabled属性兼容
- Private Const MF_ENABLED = &H0& '允许指定的菜单条目。不与VB的Enabled属性兼容
- Private Const MF_GRAYED = &H1& '禁止指定的菜单条目,并用浅灰色描述它。不与VB的Enabled属性兼容
- Private Const MF_HILITE = &H80&
- Private Const MF_SEPARATOR = &H800& '在指定的条目处显示一条分隔线
- Private Const MF_STRING = &H0& '在指定的条目处放置一个字串。不与VB的Caption属性兼容
- Private Const MF_UNCHECKED = &H0& '检查指定的条目。不能与VB的Checked属性兼容
- Private Const MF_UNHILITE = &H0&
- Private Const MF_POPUP = &H10& '将一个弹出式菜单置于指定的条目。可用于创建子菜单及弹出式菜单
- Private Type MENUITEMINFO
- cbSize As Long
- fMask As Long
- fType As Long
- fState As Long
- wID As Long
- hSubMenu As Long
- hbmpChecked As Long
- hbmpUnchecked As Long
- dwItemData As Long
- dwTypeData As String
- cch As Long
- End Type
- Private Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal b As Boolean, lpMenuItemInfo As MENUITEMINFO) As Long
- Private Declare Function SetMenuItemInfo Lib "user32" Alias "SetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal bool As Boolean, lpcMenuItemInfo As MENUITEMINFO) As Long
- Private Const MIIM_FTYPE As Long = &H100
- Private Const MIIM_STATE As Long = &H1
- Private Const MFT_RADIOCHECK As Long = &H200&
- Private Const MFS_CHECKED As Long = MF_CHECKED
- Private Const MFS_UNCHECKED = MF_UNCHECKED
- Private Type POINTAPI
- x As Long
- y As Long
- End Type
- Public Enum enumPopMenuMenuStyle
- pmsString = MF_STRING
- pmsSeparator = MF_SEPARATOR
- pmsChecked = MF_CHECKED
- pmsUnChecked = MF_UNCHECKED
- pmsDisabled = MF_DISABLED Or MF_GRAYED
- pmsHilite = MF_HILITE
- pmsPopup = MF_POPUP
- End Enum
- 'local variable(s) to hold property value(s)
- Private mvarhwnd As Long 'local copy
- Private mvarParent As Long
- '退出时不毁灭 menu
- Public NODestroy As Boolean
- Public Function Popup(Optional AutoPos As Boolean = True, _
- Optional x As Long, Optional y As Long, _
- Optional ByVal nFlag As pmnTPM = TPM_Default) As Long
- Dim rtn As Long
- rtn = Popup2(mvarParent, AutoPos, x, y, nFlag)
- Popup = rtn
- End Function
- Public Function Popup2(nParent As Long, Optional AutoPos As Boolean = True, _
- Optional x As Long, Optional y As Long, _
- Optional ByVal nFlag As pmnTPM = TPM_Default) As Long
- Dim tpt As POINTAPI
- Dim rtn As Long
- If AutoPos Then
- Call GetCursorPos(tpt)
- Else
- tpt.x = x
- tpt.y = y
- End If
- 'nFlag = TPM_LEFTALIGN Or TPM_RECURSE Or TPM_RETURNCMD
- rtn = TrackPopupMenu(hWnd, nFlag, tpt.x, tpt.y, 0&, nParent, 0&)
- Debug.Print rtn
- Popup2 = rtn
- End Function
- '在菜单末尾添加
- Public Sub Add(nCaption As String, _
- Optional nFlag As enumPopMenuMenuStyle = pmsString, _
- Optional id As Long, Optional DefaultItem As Boolean = False)
- If mvarhwnd <> 0 Then
- Call AppendMenu(mvarhwnd, nFlag, id, nCaption)
- If DefaultItem Then
- Call SetMenuDefaultItem(mvarhwnd, id, 0)
- End If
- End If
- End Sub
- '可以添加在任何位置
- Public Sub Add2(nCaption As String, _
- uItem As Long, Optional fByPosition As Boolean = True, _
- Optional nFlag As enumPopMenuMenuStyle = pmsString, _
- Optional id As Long)
- If mvarhwnd <> 0 Then
- If fByPosition Then
- nFlag = nFlag Or MF_BYPOSITION
- Else
- nFlag = nFlag Or MF_BYCOMMAND
- End If
- Call InsertMenu(mvarhwnd, uItem, nFlag, id, nCaption)
- End If
- End Sub
- Public Property Get hWnd() As Long
- 'used when retrieving value of a property, on the right side of an assignment.
- 'Syntax: Debug.Print X.hwnd
- hWnd = mvarhwnd
- End Property
- '获得菜单项的数量
- Public Function GetItemCount() As Long
- If mvarhwnd <> 0 Then
- GetItemCount = GetMenuItemCount(mvarhwnd)
- End If
- End Function
- Public Function SetDefault(nID As Long, Optional ByCommand As Boolean = True) As Boolean
- Dim rtn As Boolean
- rtn = False
- If mvarhwnd <> 0 Then
- If SetMenuDefaultItem(mvarhwnd, nID, Not ByCommand) <> 0 Then rtn = True
- End If
- SetDefault = rtn
- End Function
- Public Function EnableItem(uID As Long, nEnable As Boolean, Optional ByCommand As Boolean = True)
- Dim nFlag As Long
- If nEnable Then
- nFlag = MF_ENABLED
- Else
- nFlag = MF_DISABLED Or MF_GRAYED
- End If
- If ByCommand Then
- nFlag = nFlag Or MF_BYCOMMAND
- Else
- nFlag = nFlag Or MF_BYPOSITION
- End If
- Call EnableMenuItem(mvarhwnd, uID, nFlag)
- End Function
- 'check某item(勾)
- Public Function CheckItem(uID As Long, nChecked As Boolean, Optional ByCommand As Boolean = True)
- Dim nFlag As Long
- If mvarhwnd <> 0 Then
- If nChecked Then
- nFlag = MF_CHECKED
- Else
- nFlag = MF_UNCHECKED
- End If
- If ByCommand Then
- nFlag = nFlag Or MF_BYCOMMAND
- Else
- nFlag = nFlag Or MF_BYPOSITION
- End If
- Call CheckMenuItem(mvarhwnd, uID, nFlag)
- End If
- End Function
- Public Function UnCheckAll()
- Dim i&
- Dim tcnt&
- Dim tIIf As MENUITEMINFO
- If mvarhwnd <> 0 Then
- tcnt = GetMenuItemCount(mvarhwnd)
- With tIIf
- .cbSize = Len(tIIf)
- .fMask = MIIM_FTYPE Or MIIM_STATE
- End With
- For i = 0 To tcnt - 1
- GetMenuItemInfo mvarhwnd, i, True, tIIf
- tIIf.fState = tIIf.fState Or MFS_CHECKED Xor MFS_CHECKED
- tIIf.fType = tIIf.fType Or MFT_RADIOCHECK Xor MFT_RADIOCHECK
- Call SetMenuItemInfo(mvarhwnd, i, True, tIIf)
- Next i
- End If
- 'Dim i&
- 'Dim tFlag&, tCnt&
- 'If mvarhwnd <> 0 Then
- ' tCnt = GetMenuItemCount(mvarhwnd)
- ' tFlag = MF_UNCHECKED Or MF_BYPOSITION
- ' For i = 0 To tCnt - 1
- ' Call CheckMenuItem(mvarhwnd, i, tFlag)
- ' Next i
- 'End If
- End Function
- 'check某item,其他un check(圆)
- Public Function CheckRadioItem(uID As Long, Optional ByCommand As Boolean = True)
- Dim tcnt&
- Dim tFlag&
- If mvarhwnd <> 0 Then
- If ByCommand Then
- tFlag = MF_BYCOMMAND
- Else
- tFlag = MF_BYPOSITION
- End If
- tcnt = GetMenuItemCount(mvarhwnd)
- Call CheckMenuRadioItem(mvarhwnd, 0, tcnt - 1, uID, tFlag)
- End If
- End Function
- '删除某项, 会 destroy sub menu
- Public Function DeleteItem(uID As Long, Optional ByCommand As Boolean = True)
- Dim tFlag As Long
- If mvarhwnd <> 0 Then
- If ByCommand Then
- tFlag = MF_BYCOMMAND
- Else
- tFlag = MF_BYPOSITION
- End If
- Call DeleteMenu(mvarhwnd, uID, tFlag)
- End If
- End Function
- '删除多项,index from uPos1 to uPos2,不会 destroy sub menu
- Public Function RemoveItems(uPos1&, uPos2&)
- Dim i&
- If mvarhwnd <> 0 Then
- If uPos1 <= uPos2 Then
- For i = uPos2 To uPos1 Step -1
- Call RemoveMenu(mvarhwnd, i, MF_BYPOSITION)
- Next i
- End If
- End If
- End Function
- '删除全部项
- Public Function ClearItems()
- Dim i&, tcnt&
- If mvarhwnd <> 0 Then
- tcnt = GetMenuItemCount(mvarhwnd)
- For i = tcnt - 1 To 0 Step -1
- Call DeleteMenu(mvarhwnd, i, MF_BYPOSITION)
- Next i
- End If
- End Function
- Public Function Create(Optional nHwdPopMenu As Long = 0) As Boolean
- If mvarhwnd <> 0 Then Call Destroy
- If nHwdPopMenu = 0 Then
- mvarhwnd = CreatePopupMenu
- If mvarhwnd <> 0 Then
- Create = True
- Else
- Create = False
- End If
- Else
- mvarhwnd = nHwdPopMenu
- Create = True
- End If
- End Function
- Public Function Destroy() As Boolean
- If mvarhwnd <> 0 Then
- Call DestroyMenu(mvarhwnd)
- mvarhwnd = 0
- End If
- End Function
- Private Sub Class_Initialize()
- mvarhwnd = 0
- NODestroy = False
- End Sub
- Private Sub Class_Terminate()
- If NODestroy Then
- Else
- Call Destroy
- End If
- End Sub
- Public Property Get Parent() As Long
- Parent = mvarParent
- End Property
- Public Property Let Parent(ByVal vNewValue As Long)
- mvarParent = vNewValue
- End Property
- ''2004-9-13 发现当使用CheckRadioItem后,UnCheckAll无效,已修正
- ''2004-8-11 添加一个函数 Add2,可以指定添加的菜单项的位置
- ''2004-6-26 添加了几个函数DeleteItem,ClearItems,CheckItem,
- '' CheckRadioItem,UnCheckAll
- ''1:14 2004-3-5
- '
- 'Option Explicit
- 'Private Declare Function SetMenuDefaultItem Lib "user32" (ByVal hMenu As Long, ByVal uItem As Long, ByVal fByPos As Long) As Long
- 'Private Declare Function EnableMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long
- 'Private Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal nReserved As Long, ByVal hwnd As Long, lprc As Any) As Long
- 'Private Declare Function CheckMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDCheckItem As Long, ByVal wCheck As Long) As Long
- 'Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
- 'Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
- 'Private Declare Function CheckMenuRadioItem Lib "user32" (ByVal hMenu As Long, ByVal un1 As Long, ByVal un2 As Long, ByVal un3 As Long, ByVal un4 As Long) As Long
- ''Private Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
- '
- 'Private Const TPM_BOTTOMALIGN As Long = &H20&
- 'Private Const TPM_CENTERALIGN As Long = &H4&
- 'Private Const TPM_HORIZONTAL As Long = &H0&
- 'Private Const TPM_HORNEGANIMATION As Long = &H800&
- 'Private Const TPM_HORPOSANIMATION As Long = &H400&
- 'Private Const TPM_LEFTALIGN As Long = &H0&
- 'Private Const TPM_LEFTBUTTON As Long = &H0&
- 'Private Const TPM_NOANIMATION As Long = &H4000&
- 'Private Const TPM_NONOTIFY As Long = &H80&
- 'Private Const TPM_RECURSE As Long = &H1&
- 'Private Const TPM_RETURNCMD As Long = &H100&
- 'Private Const TPM_RIGHTALIGN As Long = &H8&
- 'Private Const TPM_RIGHTBUTTON As Long = &H2&
- 'Private Const TPM_TOPALIGN As Long = &H0&
- 'Private Const TPM_VCENTERALIGN As Long = &H10&
- 'Private Const TPM_VERNEGANIMATION As Long = &H2000&
- 'Private Const TPM_VERPOSANIMATION As Long = &H1000&
- 'Private Const TPM_VERTICAL As Long = &H40&
- '
- 'Public Enum enumPopMenuMenuStyle
- ' pmsString = MF_STRING
- ' pmsSeparator = MF_SEPARATOR
- ' pmsChecked = MF_CHECKED
- ' pmsUnChecked = MF_UNCHECKED
- ' pmsDisabled = MF_DISABLED Or MF_GRAYED
- ' pmsHilite = MF_HILITE
- ' pmsPopup = MF_POPUP
- 'End Enum
- '
- 'Private Type MENUITEMINFO
- ' cbSize As Long
- ' fMask As Long
- ' fType As Long
- ' fState As Long
- ' wID As Long
- ' hSubMenu As Long
- ' hbmpChecked As Long
- ' hbmpUnchecked As Long
- ' dwItemData As Long
- ' dwTypeData As String
- ' cch As Long
- '
- 'End Type
- 'Private Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal b As Boolean, lpMenuItemInfo As MENUITEMINFO) As Long
- 'Private Declare Function SetMenuItemInfo Lib "user32" Alias "SetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal bool As Boolean, lpcMenuItemInfo As MENUITEMINFO) As Long
- 'Private Const MIIM_FTYPE As Long = &H100
- 'Private Const MIIM_STATE As Long = &H1
- 'Private Const MFT_RADIOCHECK As Long = &H200&
- 'Private Const MFS_CHECKED As Long = MF_CHECKED
- '
- '
- ''local variable(s) to hold property value(s)
- 'Private mvarhwnd As Long 'local copy
- '
- 'Public Function Popup(nParent As Long, Optional AutoPos As Boolean = True, _
- ' Optional x As Long, Optional y As Long, _
- ' Optional ByVal nFlag As Long) As Long
- 'Dim tpt As POINTAPI
- 'Dim rtn As Long
- '
- 'If AutoPos Then
- ' Call GetCursorPos(tpt)
- 'Else
- ' tpt.x = x
- ' tpt.y = y
- 'End If
- 'nFlag = TPM_LEFTALIGN Or TPM_RECURSE Or TPM_RETURNCMD
- 'rtn = TrackPopupMenu(hwnd, nFlag, tpt.x, tpt.y, 0&, nParent, 0&)
- 'Debug.Print rtn
- 'Popup = rtn
- 'End Function
- '
- ''在菜单末尾添加
- 'Public Sub Add(nCaption As String, _
- ' Optional nFlag As enumPopMenuMenuStyle = pmsString, _
- ' Optional id As Long, Optional DefaultItem As Boolean = False)
- 'If mvarhwnd <> 0 Then
- ' Call AppendMenu(mvarhwnd, nFlag, id, nCaption)
- ' If DefaultItem Then
- ' Call SetMenuDefaultItem(mvarhwnd, id, 0)
- ' End If
- 'End If
- 'End Sub
- '
- ''可以添加在任何位置
- 'Public Sub Add2(nCaption As String, _
- ' uItem As Long, Optional fByPosition As Boolean = True, _
- ' Optional nFlag As enumPopMenuMenuStyle = pmsString, _
- ' Optional id As Long)
- '
- 'If mvarhwnd <> 0 Then
- ' If fByPosition Then
- ' nFlag = nFlag Or MF_BYPOSITION
- ' Else
- ' nFlag = nFlag Or MF_BYCOMMAND
- ' End If
- '
- ' Call InsertMenu(mvarhwnd, uItem, nFlag, id, nCaption)
- 'End If
- 'End Sub
- '
- '
- 'Public Property Get hwnd() As Long
- ''used when retrieving value of a property, on the right side of an assignment.
- ''Syntax: Debug.Print X.hwnd
- ' hwnd = mvarhwnd
- 'End Property
- '
- 'Public Function SetDefault(nID As Long, Optional ByCommand As Boolean = True) As Boolean
- 'Dim rtn As Boolean
- 'rtn = False
- 'If mvarhwnd <> 0 Then
- ' If SetMenuDefaultItem(mvarhwnd, nID, Not ByCommand) <> 0 Then rtn = True
- 'End If
- 'SetDefault = rtn
- 'End Function
- '
- 'Public Function EnableItem(uID As Long, nEnable As Boolean, Optional ByCommand As Boolean = True)
- 'Dim nFlag As Long
- 'If nEnable Then
- ' nFlag = MF_ENABLED
- 'Else
- ' nFlag = MF_DISABLED Or MF_GRAYED
- 'End If
- '
- 'If ByCommand Then
- ' nFlag = nFlag Or MF_BYCOMMAND
- 'Else
- ' nFlag = nFlag Or MF_BYPOSITION
- 'End If
- '
- 'Call EnableMenuItem(mvarhwnd, uID, nFlag)
- '
- 'End Function
- '
- 'Public Function CheckItem(uID As Long, nChecked As Boolean, Optional ByCommand As Boolean = True)
- 'Dim nFlag As Long
- 'If nChecked Then
- ' nFlag = MF_CHECKED
- 'Else
- ' nFlag = MF_UNCHECKED
- 'End If
- '
- 'If ByCommand Then
- ' nFlag = nFlag Or MF_BYCOMMAND
- 'Else
- ' nFlag = nFlag Or MF_BYPOSITION
- 'End If
- '
- 'Call CheckMenuItem(mvarhwnd, uID, nFlag)
- '
- 'End Function
- 'Public Function UnCheckAll()
- 'Dim i&
- 'Dim tFlag&, tcnt&
- 'Dim tIIf As MENUITEMINFO
- '
- 'If mvarhwnd <> 0 Then
- ' tcnt = GetMenuItemCount(mvarhwnd)
- ' With tIIf
- ' .cbSize = Len(tIIf)
- ' .fMask = MIIM_FTYPE Or MIIM_STATE
- ' End With
- '
- ' tFlag = MF_UNCHECKED Or MF_BYPOSITION
- ' For i = 0 To tcnt - 1
- ' GetMenuItemInfo mvarhwnd, i, True, tIIf
- ' tIIf.fState = tIIf.fState Or MFS_UNCHECKED
- ' tIIf.fType = tIIf.fType Or MFT_RADIOCHECK Xor MFT_RADIOCHECK
- ' Call SetMenuItemInfo(mvarhwnd, i, True, tIIf)
- ' 'Call CheckMenuItem(mvarhwnd, i, tFlag)
- ' Next i
- 'End If
- '
- '
- ''Dim i&
- ''Dim tFlag&, tcnt&
- ''If mvarhwnd <> 0 Then
- '' tcnt = GetMenuItemCount(mvarhwnd)
- '' tFlag = MF_UNCHECKED Or MF_BYPOSITION
- '' For i = 0 To tcnt - 1
- '' Call CheckMenuItem(mvarhwnd, i, tFlag)
- '' Next i
- ''End If
- 'End Function
- '
- ''check某item,其他un check(圆)
- 'Public Function CheckRadioItem(uID As Long, Optional ByCommand As Boolean = True)
- 'Dim tcnt&
- 'Dim tFlag&
- 'If mvarhwnd <> 0 Then
- ' If ByCommand Then
- ' tFlag = MF_BYCOMMAND
- ' Else
- ' tFlag = MF_BYPOSITION
- ' End If
- '
- ' tcnt = GetMenuItemCount(mvarhwnd)
- ' Call CheckMenuRadioItem(mvarhwnd, 0, tcnt - 1, uID, tFlag)
- 'End If
- 'End Function
- '
- '
- 'Public Function DeleteItem(uID As Long, Optional ByCommand As Boolean = True)
- 'Dim tFlag As Long
- 'If mvarhwnd <> 0 Then
- ' If ByCommand Then
- ' tFlag = MF_BYCOMMAND
- ' Else
- ' tFlag = MF_BYPOSITION
- ' End If
- '
- ' Call DeleteMenu(mvarhwnd, uID, tFlag)
- 'End If
- 'End Function
- '
- 'Public Function ClearItems()
- 'Dim i&, tcnt&
- '
- 'If mvarhwnd <> 0 Then
- ' tcnt = GetMenuItemCount(mvarhwnd)
- ' For i = tcnt - 1 To 0 Step -1
- ' Call DeleteMenu(mvarhwnd, i, MF_BYPOSITION)
- ' Next i
- 'End If
- 'End Function
- '
- '
- 'Public Function Create() As Boolean
- 'If mvarhwnd <> 0 Then Call Destroy
- 'mvarhwnd = CreatePopupMenu
- 'If mvarhwnd <> 0 Then
- ' Create = True
- 'Else
- ' Create = False
- 'End If
- 'End Function
- '
- 'Public Function Destroy() As Boolean
- 'If mvarhwnd <> 0 Then
- ' Call DestroyMenu(mvarhwnd)
- ' mvarhwnd = 0
- 'End If
- 'End Function
- '
- 'Private Sub Class_Initialize()
- 'mvarhwnd = 0
- 'End Sub
- '
- 'Private Sub Class_Terminate()
- 'Call Destroy
- 'End Sub