cPopMenu.cls
上传用户:davilee3
上传日期:2015-04-22
资源大小:986k
文件大小:19k
源码类别:

浏览器

开发平台:

Visual Basic

  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "cPopMenu"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
  15. Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
  16. 'cPopMenu,用api生成的 popup menu
  17. '2004-12-18 修正了UnCheckAll的一个错误
  18. '2004-12-17 修改了popup,popup2函数,增加了enum pmnTPM
  19. '2004-11-29 增加函数GetItemCount
  20. '2004-11-28 补充了两种状态 pmsUnChecked pmsPopup,修正了pmsDisabled
  21. '           增加了函数:RemoveItems
  22. '           增加一参数:NODestroy,可以设置退出时是否destroy menu
  23. '2004-9-13  发现当使用CheckRadioItem后,UnCheckAll无效,已修正
  24. '2004-8-11  添加一个函数 Add2,可以指定添加的菜单项的位置
  25. '2004-6-26  添加了几个函数DeleteItem,ClearItems,CheckItem,
  26. '    CheckRadioItem,UnCheckAll
  27. '1:14 2004-3-5
  28. Option Explicit
  29. Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  30. Private Declare Function SetMenuDefaultItem Lib "user32" (ByVal hMenu As Long, ByVal uItem As Long, ByVal fByPos As Long) As Long
  31. Private Declare Function EnableMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long
  32. 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
  33. 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
  34. 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
  35. Private Declare Function CreatePopupMenu Lib "user32" () As Long
  36. Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
  37. Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
  38. Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
  39. Private Declare Function CheckMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDCheckItem As Long, ByVal wCheck As Long) As Long
  40. 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
  41. Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
  42. Public Enum pmnTPM
  43.     TPM_BOTTOMALIGN = &H20&
  44.     TPM_CENTERALIGN = &H4&
  45.     TPM_HORIZONTAL = &H0&
  46.     TPM_HORNEGANIMATION = &H800&
  47.     TPM_HORPOSANIMATION = &H400&
  48.     TPM_LEFTALIGN = &H0&
  49.     TPM_LEFTBUTTON = &H0&
  50.     TPM_NOANIMATION = &H4000&
  51.     TPM_NONOTIFY = &H80&
  52.     TPM_RECURSE = &H1&
  53.     TPM_RETURNCMD = &H100&
  54.     TPM_RIGHTALIGN = &H8&
  55.     TPM_RIGHTBUTTON = &H2&
  56.     TPM_TOPALIGN = &H0&
  57.     TPM_VCENTERALIGN = &H10&
  58.     TPM_VERNEGANIMATION = &H2000&
  59.     TPM_VERPOSANIMATION = &H1000&
  60.     TPM_VERTICAL = &H40&
  61.     
  62.     TPM_Default = TPM_LEFTALIGN Or TPM_RETURNCMD
  63. End Enum
  64. Private Const MF_BYCOMMAND = &H0&         '菜单条目由菜单的命令ID指定
  65. Private Const MF_BYPOSITION = &H400&      '菜单条目由条目在菜单中的位置决定。零代表菜单中的第一个条目
  66. Private Const MF_CHECKED = &H8&           '检查指定的菜单条目。不能与VB的Checked属性兼容
  67. Private Const MF_DISABLED = &H2&          '禁止指定的菜单条目。不与VB的Enabled属性兼容
  68. Private Const MF_ENABLED = &H0&           '允许指定的菜单条目。不与VB的Enabled属性兼容
  69. Private Const MF_GRAYED = &H1&            '禁止指定的菜单条目,并用浅灰色描述它。不与VB的Enabled属性兼容
  70. Private Const MF_HILITE = &H80&
  71. Private Const MF_SEPARATOR = &H800&       '在指定的条目处显示一条分隔线
  72. Private Const MF_STRING = &H0&            '在指定的条目处放置一个字串。不与VB的Caption属性兼容
  73. Private Const MF_UNCHECKED = &H0&         '检查指定的条目。不能与VB的Checked属性兼容
  74. Private Const MF_UNHILITE = &H0&
  75. Private Const MF_POPUP = &H10&            '将一个弹出式菜单置于指定的条目。可用于创建子菜单及弹出式菜单
  76. Private Type MENUITEMINFO
  77.     cbSize As Long
  78.     fMask As Long
  79.     fType As Long
  80.     fState As Long
  81.     wID As Long
  82.     hSubMenu As Long
  83.     hbmpChecked As Long
  84.     hbmpUnchecked As Long
  85.     dwItemData As Long
  86.     dwTypeData As String
  87.     cch As Long
  88. End Type
  89. 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
  90. 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
  91. Private Const MIIM_FTYPE As Long = &H100
  92. Private Const MIIM_STATE As Long = &H1
  93. Private Const MFT_RADIOCHECK As Long = &H200&
  94. Private Const MFS_CHECKED As Long = MF_CHECKED
  95. Private Const MFS_UNCHECKED = MF_UNCHECKED
  96. Private Type POINTAPI
  97.     x As Long
  98.     y As Long
  99. End Type
  100. Public Enum enumPopMenuMenuStyle
  101.     pmsString = MF_STRING
  102.     pmsSeparator = MF_SEPARATOR
  103.     pmsChecked = MF_CHECKED
  104.     pmsUnChecked = MF_UNCHECKED
  105.     pmsDisabled = MF_DISABLED Or MF_GRAYED
  106.     pmsHilite = MF_HILITE
  107.     pmsPopup = MF_POPUP
  108. End Enum
  109. 'local variable(s) to hold property value(s)
  110. Private mvarhwnd As Long 'local copy
  111. Private mvarParent As Long
  112. '退出时不毁灭 menu
  113. Public NODestroy As Boolean
  114. Public Function Popup(Optional AutoPos As Boolean = True, _
  115.         Optional x As Long, Optional y As Long, _
  116.         Optional ByVal nFlag As pmnTPM = TPM_Default) As Long
  117. Dim rtn As Long
  118. rtn = Popup2(mvarParent, AutoPos, x, y, nFlag)
  119. Popup = rtn
  120. End Function
  121. Public Function Popup2(nParent As Long, Optional AutoPos As Boolean = True, _
  122.         Optional x As Long, Optional y As Long, _
  123.         Optional ByVal nFlag As pmnTPM = TPM_Default) As Long
  124. Dim tpt As POINTAPI
  125. Dim rtn As Long
  126. If AutoPos Then
  127.     Call GetCursorPos(tpt)
  128. Else
  129.     tpt.x = x
  130.     tpt.y = y
  131. End If
  132. 'nFlag = TPM_LEFTALIGN Or TPM_RECURSE Or TPM_RETURNCMD
  133. rtn = TrackPopupMenu(hWnd, nFlag, tpt.x, tpt.y, 0&, nParent, 0&)
  134. Debug.Print rtn
  135. Popup2 = rtn
  136. End Function
  137. '在菜单末尾添加
  138. Public Sub Add(nCaption As String, _
  139.     Optional nFlag As enumPopMenuMenuStyle = pmsString, _
  140.     Optional id As Long, Optional DefaultItem As Boolean = False)
  141. If mvarhwnd <> 0 Then
  142.     Call AppendMenu(mvarhwnd, nFlag, id, nCaption)
  143.     If DefaultItem Then
  144.         Call SetMenuDefaultItem(mvarhwnd, id, 0)
  145.     End If
  146. End If
  147. End Sub
  148. '可以添加在任何位置
  149. Public Sub Add2(nCaption As String, _
  150.     uItem As Long, Optional fByPosition As Boolean = True, _
  151.     Optional nFlag As enumPopMenuMenuStyle = pmsString, _
  152.     Optional id As Long)
  153. If mvarhwnd <> 0 Then
  154.     If fByPosition Then
  155.         nFlag = nFlag Or MF_BYPOSITION
  156.     Else
  157.         nFlag = nFlag Or MF_BYCOMMAND
  158.     End If
  159.     
  160.     Call InsertMenu(mvarhwnd, uItem, nFlag, id, nCaption)
  161. End If
  162. End Sub
  163. Public Property Get hWnd() As Long
  164. 'used when retrieving value of a property, on the right side of an assignment.
  165. 'Syntax: Debug.Print X.hwnd
  166.     hWnd = mvarhwnd
  167. End Property
  168. '获得菜单项的数量
  169. Public Function GetItemCount() As Long
  170. If mvarhwnd <> 0 Then
  171.     GetItemCount = GetMenuItemCount(mvarhwnd)
  172. End If
  173. End Function
  174. Public Function SetDefault(nID As Long, Optional ByCommand As Boolean = True) As Boolean
  175. Dim rtn As Boolean
  176. rtn = False
  177. If mvarhwnd <> 0 Then
  178.     If SetMenuDefaultItem(mvarhwnd, nID, Not ByCommand) <> 0 Then rtn = True
  179. End If
  180. SetDefault = rtn
  181. End Function
  182. Public Function EnableItem(uID As Long, nEnable As Boolean, Optional ByCommand As Boolean = True)
  183. Dim nFlag As Long
  184. If nEnable Then
  185.     nFlag = MF_ENABLED
  186. Else
  187.     nFlag = MF_DISABLED Or MF_GRAYED
  188. End If
  189. If ByCommand Then
  190.     nFlag = nFlag Or MF_BYCOMMAND
  191. Else
  192.     nFlag = nFlag Or MF_BYPOSITION
  193. End If
  194. Call EnableMenuItem(mvarhwnd, uID, nFlag)
  195. End Function
  196. 'check某item(勾)
  197. Public Function CheckItem(uID As Long, nChecked As Boolean, Optional ByCommand As Boolean = True)
  198. Dim nFlag As Long
  199. If mvarhwnd <> 0 Then
  200.     If nChecked Then
  201.         nFlag = MF_CHECKED
  202.     Else
  203.         nFlag = MF_UNCHECKED
  204.     End If
  205.     
  206.     If ByCommand Then
  207.         nFlag = nFlag Or MF_BYCOMMAND
  208.     Else
  209.         nFlag = nFlag Or MF_BYPOSITION
  210.     End If
  211.     
  212.     Call CheckMenuItem(mvarhwnd, uID, nFlag)
  213. End If
  214. End Function
  215. Public Function UnCheckAll()
  216. Dim i&
  217. Dim tcnt&
  218. Dim tIIf As MENUITEMINFO
  219. If mvarhwnd <> 0 Then
  220.     tcnt = GetMenuItemCount(mvarhwnd)
  221.     With tIIf
  222.         .cbSize = Len(tIIf)
  223.         .fMask = MIIM_FTYPE Or MIIM_STATE
  224.     End With
  225.     
  226.     For i = 0 To tcnt - 1
  227.         GetMenuItemInfo mvarhwnd, i, True, tIIf
  228.         tIIf.fState = tIIf.fState Or MFS_CHECKED Xor MFS_CHECKED
  229.         tIIf.fType = tIIf.fType Or MFT_RADIOCHECK Xor MFT_RADIOCHECK
  230.         Call SetMenuItemInfo(mvarhwnd, i, True, tIIf)
  231.     Next i
  232. End If
  233. 'Dim i&
  234. 'Dim tFlag&, tCnt&
  235. 'If mvarhwnd <> 0 Then
  236. '    tCnt = GetMenuItemCount(mvarhwnd)
  237. '    tFlag = MF_UNCHECKED Or MF_BYPOSITION
  238. '    For i = 0 To tCnt - 1
  239. '        Call CheckMenuItem(mvarhwnd, i, tFlag)
  240. '    Next i
  241. 'End If
  242. End Function
  243. 'check某item,其他un check(圆)
  244. Public Function CheckRadioItem(uID As Long, Optional ByCommand As Boolean = True)
  245. Dim tcnt&
  246. Dim tFlag&
  247. If mvarhwnd <> 0 Then
  248.     If ByCommand Then
  249.         tFlag = MF_BYCOMMAND
  250.     Else
  251.         tFlag = MF_BYPOSITION
  252.     End If
  253.     
  254.     tcnt = GetMenuItemCount(mvarhwnd)
  255.     Call CheckMenuRadioItem(mvarhwnd, 0, tcnt - 1, uID, tFlag)
  256. End If
  257. End Function
  258. '删除某项, 会 destroy sub menu
  259. Public Function DeleteItem(uID As Long, Optional ByCommand As Boolean = True)
  260. Dim tFlag As Long
  261. If mvarhwnd <> 0 Then
  262.     If ByCommand Then
  263.         tFlag = MF_BYCOMMAND
  264.     Else
  265.         tFlag = MF_BYPOSITION
  266.     End If
  267.     
  268.     Call DeleteMenu(mvarhwnd, uID, tFlag)
  269. End If
  270. End Function
  271. '删除多项,index from uPos1 to uPos2,不会 destroy sub menu
  272. Public Function RemoveItems(uPos1&, uPos2&)
  273. Dim i&
  274. If mvarhwnd <> 0 Then
  275.     If uPos1 <= uPos2 Then
  276.         For i = uPos2 To uPos1 Step -1
  277.             Call RemoveMenu(mvarhwnd, i, MF_BYPOSITION)
  278.         Next i
  279.     End If
  280. End If
  281. End Function
  282. '删除全部项
  283. Public Function ClearItems()
  284. Dim i&, tcnt&
  285. If mvarhwnd <> 0 Then
  286.     tcnt = GetMenuItemCount(mvarhwnd)
  287.     For i = tcnt - 1 To 0 Step -1
  288.         Call DeleteMenu(mvarhwnd, i, MF_BYPOSITION)
  289.     Next i
  290. End If
  291. End Function
  292. Public Function Create(Optional nHwdPopMenu As Long = 0) As Boolean
  293. If mvarhwnd <> 0 Then Call Destroy
  294. If nHwdPopMenu = 0 Then
  295.     mvarhwnd = CreatePopupMenu
  296.     If mvarhwnd <> 0 Then
  297.         Create = True
  298.     Else
  299.         Create = False
  300.     End If
  301. Else
  302.     mvarhwnd = nHwdPopMenu
  303.     Create = True
  304. End If
  305. End Function
  306. Public Function Destroy() As Boolean
  307. If mvarhwnd <> 0 Then
  308.     Call DestroyMenu(mvarhwnd)
  309.     mvarhwnd = 0
  310. End If
  311. End Function
  312. Private Sub Class_Initialize()
  313. mvarhwnd = 0
  314. NODestroy = False
  315. End Sub
  316. Private Sub Class_Terminate()
  317. If NODestroy Then
  318. Else
  319.     Call Destroy
  320. End If
  321. End Sub
  322. Public Property Get Parent() As Long
  323.     Parent = mvarParent
  324. End Property
  325. Public Property Let Parent(ByVal vNewValue As Long)
  326.     mvarParent = vNewValue
  327. End Property
  328. ''2004-9-13  发现当使用CheckRadioItem后,UnCheckAll无效,已修正
  329. ''2004-8-11  添加一个函数 Add2,可以指定添加的菜单项的位置
  330. ''2004-6-26  添加了几个函数DeleteItem,ClearItems,CheckItem,
  331. ''    CheckRadioItem,UnCheckAll
  332. ''1:14 2004-3-5
  333. '
  334. 'Option Explicit
  335. 'Private Declare Function SetMenuDefaultItem Lib "user32" (ByVal hMenu As Long, ByVal uItem As Long, ByVal fByPos As Long) As Long
  336. 'Private Declare Function EnableMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long
  337. '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
  338. 'Private Declare Function CheckMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDCheckItem As Long, ByVal wCheck As Long) As Long
  339. 'Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
  340. 'Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
  341. '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
  342. ''Private Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
  343. '
  344. 'Private Const TPM_BOTTOMALIGN As Long = &H20&
  345. 'Private Const TPM_CENTERALIGN As Long = &H4&
  346. 'Private Const TPM_HORIZONTAL As Long = &H0&
  347. 'Private Const TPM_HORNEGANIMATION As Long = &H800&
  348. 'Private Const TPM_HORPOSANIMATION As Long = &H400&
  349. 'Private Const TPM_LEFTALIGN As Long = &H0&
  350. 'Private Const TPM_LEFTBUTTON As Long = &H0&
  351. 'Private Const TPM_NOANIMATION As Long = &H4000&
  352. 'Private Const TPM_NONOTIFY As Long = &H80&
  353. 'Private Const TPM_RECURSE As Long = &H1&
  354. 'Private Const TPM_RETURNCMD As Long = &H100&
  355. 'Private Const TPM_RIGHTALIGN As Long = &H8&
  356. 'Private Const TPM_RIGHTBUTTON As Long = &H2&
  357. 'Private Const TPM_TOPALIGN As Long = &H0&
  358. 'Private Const TPM_VCENTERALIGN As Long = &H10&
  359. 'Private Const TPM_VERNEGANIMATION As Long = &H2000&
  360. 'Private Const TPM_VERPOSANIMATION As Long = &H1000&
  361. 'Private Const TPM_VERTICAL As Long = &H40&
  362. '
  363. 'Public Enum enumPopMenuMenuStyle
  364. '    pmsString = MF_STRING
  365. '    pmsSeparator = MF_SEPARATOR
  366. '    pmsChecked = MF_CHECKED
  367. '    pmsUnChecked = MF_UNCHECKED
  368. '    pmsDisabled = MF_DISABLED Or MF_GRAYED
  369. '    pmsHilite = MF_HILITE
  370. '    pmsPopup = MF_POPUP
  371. 'End Enum
  372. '
  373. 'Private Type MENUITEMINFO
  374. '    cbSize As Long
  375. '    fMask As Long
  376. '    fType As Long
  377. '    fState As Long
  378. '    wID As Long
  379. '    hSubMenu As Long
  380. '    hbmpChecked As Long
  381. '    hbmpUnchecked As Long
  382. '    dwItemData As Long
  383. '    dwTypeData As String
  384. '    cch As Long
  385. '
  386. 'End Type
  387. '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
  388. '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
  389. 'Private Const MIIM_FTYPE As Long = &H100
  390. 'Private Const MIIM_STATE As Long = &H1
  391. 'Private Const MFT_RADIOCHECK As Long = &H200&
  392. 'Private Const MFS_CHECKED As Long = MF_CHECKED
  393. '
  394. '
  395. ''local variable(s) to hold property value(s)
  396. 'Private mvarhwnd As Long 'local copy
  397. '
  398. 'Public Function Popup(nParent As Long, Optional AutoPos As Boolean = True, _
  399. '        Optional x As Long, Optional y As Long, _
  400. '        Optional ByVal nFlag As Long) As Long
  401. 'Dim tpt As POINTAPI
  402. 'Dim rtn As Long
  403. '
  404. 'If AutoPos Then
  405. '    Call GetCursorPos(tpt)
  406. 'Else
  407. '    tpt.x = x
  408. '    tpt.y = y
  409. 'End If
  410. 'nFlag = TPM_LEFTALIGN Or TPM_RECURSE Or TPM_RETURNCMD
  411. 'rtn = TrackPopupMenu(hwnd, nFlag, tpt.x, tpt.y, 0&, nParent, 0&)
  412. 'Debug.Print rtn
  413. 'Popup = rtn
  414. 'End Function
  415. '
  416. ''在菜单末尾添加
  417. 'Public Sub Add(nCaption As String, _
  418. '    Optional nFlag As enumPopMenuMenuStyle = pmsString, _
  419. '    Optional id As Long, Optional DefaultItem As Boolean = False)
  420. 'If mvarhwnd <> 0 Then
  421. '    Call AppendMenu(mvarhwnd, nFlag, id, nCaption)
  422. '    If DefaultItem Then
  423. '        Call SetMenuDefaultItem(mvarhwnd, id, 0)
  424. '    End If
  425. 'End If
  426. 'End Sub
  427. '
  428. ''可以添加在任何位置
  429. 'Public Sub Add2(nCaption As String, _
  430. '    uItem As Long, Optional fByPosition As Boolean = True, _
  431. '    Optional nFlag As enumPopMenuMenuStyle = pmsString, _
  432. '    Optional id As Long)
  433. '
  434. 'If mvarhwnd <> 0 Then
  435. '    If fByPosition Then
  436. '        nFlag = nFlag Or MF_BYPOSITION
  437. '    Else
  438. '        nFlag = nFlag Or MF_BYCOMMAND
  439. '    End If
  440. '
  441. '    Call InsertMenu(mvarhwnd, uItem, nFlag, id, nCaption)
  442. 'End If
  443. 'End Sub
  444. '
  445. '
  446. 'Public Property Get hwnd() As Long
  447. ''used when retrieving value of a property, on the right side of an assignment.
  448. ''Syntax: Debug.Print X.hwnd
  449. '    hwnd = mvarhwnd
  450. 'End Property
  451. '
  452. 'Public Function SetDefault(nID As Long, Optional ByCommand As Boolean = True) As Boolean
  453. 'Dim rtn As Boolean
  454. 'rtn = False
  455. 'If mvarhwnd <> 0 Then
  456. '    If SetMenuDefaultItem(mvarhwnd, nID, Not ByCommand) <> 0 Then rtn = True
  457. 'End If
  458. 'SetDefault = rtn
  459. 'End Function
  460. '
  461. 'Public Function EnableItem(uID As Long, nEnable As Boolean, Optional ByCommand As Boolean = True)
  462. 'Dim nFlag As Long
  463. 'If nEnable Then
  464. '    nFlag = MF_ENABLED
  465. 'Else
  466. '    nFlag = MF_DISABLED Or MF_GRAYED
  467. 'End If
  468. '
  469. 'If ByCommand Then
  470. '    nFlag = nFlag Or MF_BYCOMMAND
  471. 'Else
  472. '    nFlag = nFlag Or MF_BYPOSITION
  473. 'End If
  474. '
  475. 'Call EnableMenuItem(mvarhwnd, uID, nFlag)
  476. '
  477. 'End Function
  478. '
  479. 'Public Function CheckItem(uID As Long, nChecked As Boolean, Optional ByCommand As Boolean = True)
  480. 'Dim nFlag As Long
  481. 'If nChecked Then
  482. '    nFlag = MF_CHECKED
  483. 'Else
  484. '    nFlag = MF_UNCHECKED
  485. 'End If
  486. '
  487. 'If ByCommand Then
  488. '    nFlag = nFlag Or MF_BYCOMMAND
  489. 'Else
  490. '    nFlag = nFlag Or MF_BYPOSITION
  491. 'End If
  492. '
  493. 'Call CheckMenuItem(mvarhwnd, uID, nFlag)
  494. '
  495. 'End Function
  496. 'Public Function UnCheckAll()
  497. 'Dim i&
  498. 'Dim tFlag&, tcnt&
  499. 'Dim tIIf As MENUITEMINFO
  500. '
  501. 'If mvarhwnd <> 0 Then
  502. '    tcnt = GetMenuItemCount(mvarhwnd)
  503. '    With tIIf
  504. '        .cbSize = Len(tIIf)
  505. '        .fMask = MIIM_FTYPE Or MIIM_STATE
  506. '    End With
  507. '
  508. '    tFlag = MF_UNCHECKED Or MF_BYPOSITION
  509. '    For i = 0 To tcnt - 1
  510. '        GetMenuItemInfo mvarhwnd, i, True, tIIf
  511. '        tIIf.fState = tIIf.fState Or MFS_UNCHECKED
  512. '        tIIf.fType = tIIf.fType Or MFT_RADIOCHECK Xor MFT_RADIOCHECK
  513. '        Call SetMenuItemInfo(mvarhwnd, i, True, tIIf)
  514. '        'Call CheckMenuItem(mvarhwnd, i, tFlag)
  515. '    Next i
  516. 'End If
  517. '
  518. '
  519. ''Dim i&
  520. ''Dim tFlag&, tcnt&
  521. ''If mvarhwnd <> 0 Then
  522. ''    tcnt = GetMenuItemCount(mvarhwnd)
  523. ''    tFlag = MF_UNCHECKED Or MF_BYPOSITION
  524. ''    For i = 0 To tcnt - 1
  525. ''        Call CheckMenuItem(mvarhwnd, i, tFlag)
  526. ''    Next i
  527. ''End If
  528. 'End Function
  529. '
  530. ''check某item,其他un check(圆)
  531. 'Public Function CheckRadioItem(uID As Long, Optional ByCommand As Boolean = True)
  532. 'Dim tcnt&
  533. 'Dim tFlag&
  534. 'If mvarhwnd <> 0 Then
  535. '    If ByCommand Then
  536. '        tFlag = MF_BYCOMMAND
  537. '    Else
  538. '        tFlag = MF_BYPOSITION
  539. '    End If
  540. '
  541. '    tcnt = GetMenuItemCount(mvarhwnd)
  542. '    Call CheckMenuRadioItem(mvarhwnd, 0, tcnt - 1, uID, tFlag)
  543. 'End If
  544. 'End Function
  545. '
  546. '
  547. 'Public Function DeleteItem(uID As Long, Optional ByCommand As Boolean = True)
  548. 'Dim tFlag As Long
  549. 'If mvarhwnd <> 0 Then
  550. '    If ByCommand Then
  551. '        tFlag = MF_BYCOMMAND
  552. '    Else
  553. '        tFlag = MF_BYPOSITION
  554. '    End If
  555. '
  556. '    Call DeleteMenu(mvarhwnd, uID, tFlag)
  557. 'End If
  558. 'End Function
  559. '
  560. 'Public Function ClearItems()
  561. 'Dim i&, tcnt&
  562. '
  563. 'If mvarhwnd <> 0 Then
  564. '    tcnt = GetMenuItemCount(mvarhwnd)
  565. '    For i = tcnt - 1 To 0 Step -1
  566. '        Call DeleteMenu(mvarhwnd, i, MF_BYPOSITION)
  567. '    Next i
  568. 'End If
  569. 'End Function
  570. '
  571. '
  572. 'Public Function Create() As Boolean
  573. 'If mvarhwnd <> 0 Then Call Destroy
  574. 'mvarhwnd = CreatePopupMenu
  575. 'If mvarhwnd <> 0 Then
  576. '    Create = True
  577. 'Else
  578. '    Create = False
  579. 'End If
  580. 'End Function
  581. '
  582. 'Public Function Destroy() As Boolean
  583. 'If mvarhwnd <> 0 Then
  584. '    Call DestroyMenu(mvarhwnd)
  585. '    mvarhwnd = 0
  586. 'End If
  587. 'End Function
  588. '
  589. 'Private Sub Class_Initialize()
  590. 'mvarhwnd = 0
  591. 'End Sub
  592. '
  593. 'Private Sub Class_Terminate()
  594. 'Call Destroy
  595. 'End Sub