home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD152462202001.psc / CoolMenu / mCoolMenu.bas < prev   
Encoding:
BASIC Source File  |  2001-02-20  |  16.3 KB  |  353 lines
  1. Attribute VB_Name = "mCoolMenu"
  2. '''''''''''''''''''''''''''''''''''''''''''''''''''''
  3. '''''''''''''''''''''''''''''''''''''''''''''''''''''
  4. ''  mCoolMenu Module v1.3.1
  5. ''
  6. ''  Copyright Olivier Martin 2000
  7. ''
  8. ''  martin.olivier@bigfoot.com
  9. ''
  10. ''  Code based on Paul Dilascia's work from the
  11. ''  Microsoft System Journal January 1998
  12. ''  Visit Paul's page at www.dilascia.com
  13. ''
  14. ''  This module allows an application to show
  15. ''  icons in menus just like the VB IDE and
  16. ''  MS Office applications.  The link between
  17. ''  the menus and an ImageList is the image tag.
  18. ''  The test forms show all the possibilities.
  19. ''
  20. ''  People who contributed with suggestions :
  21. ''  Herman Eldering(aka BodyCheck):
  22. ''       -Solved disabled topmenu problem
  23. ''  Pietro Cecchi : help callback
  24. ''  Kayl Magnus : separator font; sub menu help bug;
  25. ''                main bar icon bug
  26. ''  Nabil AbuSharane : Right to left property
  27. ''  Kenneth (aka Maverick) : MDI window lists bug
  28. ''
  29. '''''''''''''''''''''''''''''''''''''''''''''''''''''
  30. '''''''''''''''''''''''''''''''''''''''''''''''''''''
  31.  
  32. Option Explicit
  33.  
  34. Public CoolMenu As cCoolMenu
  35.  
  36. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
  37. Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
  38. Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  39. Private Declare Function ChildWindowFromPoint Lib "user32" (ByVal hWndParent As Long, pt As POINTAPI) As Long
  40. Private Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
  41. Private Declare Function CreateBrushIndirect Lib "gdi32" (lpLogBrush As LOGBRUSH) As Long
  42. Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
  43. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
  44. Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
  45. Private Declare Function CreateHatchBrush Lib "gdi32" (ByVal nIndex As Long, ByVal crColor As Long) As Long
  46. Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long
  47. Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
  48. Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
  49. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  50. Private Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Long
  51. Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
  52. Private Declare Function DrawState Lib "user32" Alias "DrawStateA" (ByVal hdc As Long, ByVal hBrush As Long, ByVal lpDrawStateProc As Long, ByVal lParam As Long, ByVal wParam As Long, ByVal x As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal fuFlags As Long) As Long
  53. Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
  54. Private Declare Function ExcludeClipRect Lib "gdi32" (ByVal hdc As Long, ByVal x1 As Long, ByVal Y1 As Long, ByVal x2 As Long, ByVal Y2 As Long) As Long
  55. Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
  56. Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
  57. Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
  58. Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
  59. Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
  60. Private Declare Function GetLastError Lib "kernel32" () As Long
  61. Private Declare Function GetMenu Lib "user32" (ByVal hWnd As Long) As Long
  62. Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
  63. Private Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
  64. Private Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal uItem As Long, ByVal ByPosition As Long, ByRef lpMenuItemInfo As MENUITEMINFO) As Boolean
  65. Private Declare Function GetMenuItemRect Lib "user32" (ByVal hWnd As Long, ByVal hMenu As Long, ByVal uItem As Long, lprcItem As RECT) As Long
  66. Private Declare Function GetMenuState Lib "user32" (ByVal hMenu As Long, ByVal wID As Long, ByVal wFlags As Long) As Long
  67. Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
  68. Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
  69. Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
  70. Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
  71. Private Declare Function GetTextColor Lib "gdi32" (ByVal hdc As Long) As Long
  72. Private Declare Function GetTextFace Lib "gdi32" Alias "GetTextFaceA" (ByVal hdc As Long, ByVal nCount As Long, ByVal lpFacename As String) As Long
  73. Private Declare Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" (ByVal hdc As Long, lpMetrics As TEXTMETRIC) As Long
  74. Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
  75. Private Declare Function GetWindowDC Lib "user32" (ByVal hWnd As Long) As Long
  76. Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
  77. Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
  78. Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hinst As Long, ByVal lpszName As Any, ByVal uType As Long, ByVal cxDesired As Long, ByVal cyDesired As Long, ByVal fuLoad As Long) As Long
  79. Private Declare Function MenuItemFromPoint Lib "user32" (ByVal hWnd As Long, ByVal hMenu As Long, ByVal ptScreen As Double) As Long
  80. Private Declare Function MulDiv Lib "kernel32" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
  81. Private Declare Function PatBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As Long
  82. Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  83. Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
  84. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  85. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  86. Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
  87. Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
  88. 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
  89. Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
  90. Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  91. Private Declare Function WindowFromDC Lib "user32" (ByVal hdc As Long) As Long
  92.  
  93. Private Declare Function ImageList_GetIcon Lib "comctl32.dll" (ByVal himl As Long, ByVal i As Long, ByVal diIgnore As Long) As Long
  94. Private Declare Function ImageList_Draw Lib "comctl32.dll" (ByVal himl As Long, ByVal i As Long, ByVal hdcDst As Long, ByVal x As Long, ByVal Y As Long, ByVal fStyle As Long) As Long
  95. Private Declare Function ImageList_GetImageInfo Lib "comctl32.dll" (ByVal himl As Long, ByVal i As Long, IMAGEINFO As Any) As Long
  96.  
  97. 'Used by CreateBrushIndirect
  98. Private Type LOGBRUSH
  99.   lbStyle As Long
  100.   lbColor As Long
  101.   lbHatch As Long
  102. End Type
  103.  
  104. 'LOGBRUSH constants
  105. Private Const BS_SOLID = 0
  106. Private Const BS_NULL = 1
  107. Private Const BS_HOLLOW = BS_NULL
  108. Private Const BS_HATCHED = 2
  109. Private Const BS_PATTERN = 3
  110. Private Const BS_INDEXED = 4
  111. Private Const BS_DIBPATTERN = 5
  112. Private Const BS_DIBPATTERNPT = 6
  113. Private Const BS_PATTERN8X8 = 7
  114. Private Const BS_DIBPATTERN8X8 = 8
  115.  
  116. 'LoadImage constants
  117. Private Const IMAGE_BITMAP = 0&
  118. Private Const IMAGE_ICON = 1&
  119. Private Const IMAGE_CURSOR = 2&
  120.  
  121. 'LoadImage constants
  122. Private Const LR_DEFAULTCOLOR = &H0
  123. Private Const LR_MONOCHROME = &H1
  124. Private Const LR_COLOR = &H2
  125. Private Const LR_COPYRETURNORG = &H4
  126. Private Const LR_COPYDELETEORG = &H8
  127. Private Const LR_LOADFROMFILE = &H10
  128. Private Const LR_LOADTRANSPARENT = &H20
  129. Private Const LR_DEFAULTSIZE = &H40
  130. Private Const LR_VGACOLOR = &H80
  131. Private Const LR_LOADMAP3DCOLORS = &H1000
  132. Private Const LR_CREATEDIBSECTION = &H2000
  133. Private Const LR_COPYFROMRESOURCE = &H4000
  134. Private Const LR_SHARED = &H8000
  135.  
  136. 'LoadImage constants
  137. Private Const OBM_LFARROWI = 32734
  138. Private Const OBM_RGARROWI = 32735
  139. Private Const OBM_DNARROWI = 32736
  140. Private Const OBM_UPARROWI = 32737
  141. Private Const OBM_COMBO = 32738
  142. Private Const OBM_MNARROW = 32739
  143. Private Const OBM_LFARROWD = 32740
  144. Private Const OBM_RGARROWD = 32741
  145. Private Const OBM_DNARROWD = 32742
  146. Private Const OBM_UPARROWD = 32743
  147. Private Const OBM_RESTORED = 32744
  148. Private Const OBM_ZOOMD = 32745
  149. Private Const OBM_REDUCED = 32746
  150. Private Const OBM_RESTORE = 32747
  151. Private Const OBM_ZOOM = 32748
  152. Private Const OBM_REDUCE = 32749
  153. Private Const OBM_LFARROW = 32750
  154. Private Const OBM_RGARROW = 32751
  155. Private Const OBM_DNARROW = 32752
  156. Private Const OBM_UPARROW = 32753
  157. Private Const OBM_CLOSE = 32754
  158. Private Const OBM_OLD_RESTORE = 32755
  159. Private Const OBM_OLD_ZOOM = 32756
  160. Private Const OBM_OLD_REDUCE = 32757
  161. Private Const OBM_BTNCORNERS = 32758
  162. Private Const OBM_CHECKBOXES = 32759
  163. Private Const OBM_CHECK = 32760
  164. Private Const OBM_BTSIZE = 32761
  165. Private Const OBM_OLD_LFARROW = 32762
  166. Private Const OBM_OLD_RGARROW = 32763
  167. Private Const OBM_OLD_DNARROW = 32764
  168. Private Const OBM_OLD_UPARROW = 32765
  169. Private Const OBM_SIZE = 32766
  170. Private Const OBM_OLD_CLOSE = 32767
  171.  
  172. ' GetSystemMetrics() constants
  173. Private Const SM_CXSCREEN = 0
  174. Private Const SM_CYSCREEN = 1
  175. Private Const SM_CXVSCROLL = 2
  176. Private Const SM_CYHSCROLL = 3
  177. Private Const SM_CYCAPTION = 4
  178. Private Const SM_CXBORDER = 5
  179. Private Const SM_CYBORDER = 6
  180. Private Const SM_CXDLGFRAME = 7
  181. Private Const SM_CYDLGFRAME = 8
  182. Private Const SM_CYVTHUMB = 9
  183. Private Const SM_CXHTHUMB = 10
  184. Private Const SM_CXICON = 11
  185. Private Const SM_CYICON = 12
  186. Private Const SM_CXCURSOR = 13
  187. Private Const SM_CYCURSOR = 14
  188. Private Const SM_CYMENU = 15
  189. Private Const SM_CXFULLSCREEN = 16
  190. Private Const SM_CYFULLSCREEN = 17
  191. Private Const SM_CYKANJIWINDOW = 18
  192. Private Const SM_MOUSEPRESENT = 19
  193. Private Const SM_CYVSCROLL = 20
  194. Private Const SM_CXHSCROLL = 21
  195. Private Const SM_DEBUG = 22
  196. Private Const SM_SWAPBUTTON = 23
  197. Private Const SM_RESERVED1 = 24
  198. Private Const SM_RESERVED2 = 25
  199. Private Const SM_RESERVED3 = 26
  200. Private Const SM_RESERVED4 = 27
  201. Private Const SM_CXMIN = 28
  202. Private Const SM_CYMIN = 29
  203. Private Const SM_CXSIZE = 30
  204. Private Const SM_CYSIZE = 31
  205. Private Const SM_CXFRAME = 32
  206. Private Const SM_CYFRAME = 33
  207. Private Const SM_CXMINTRACK = 34
  208. Private Const SM_CYMINTRACK = 35
  209. Private Const SM_CXDOUBLECLK = 36
  210. Private Const SM_CYDOUBLECLK = 37
  211. Private Const SM_CXICONSPACING = 38
  212. Private Const SM_CYICONSPACING = 39
  213. Private Const SM_MENUDROPALIGNMENT = 40
  214. Private Const SM_PENWINDOWS = 41
  215. Private Const SM_DBCSENABLED = 42
  216. Private Const SM_CMOUSEBUTTONS = 43
  217.  
  218. Private Const SM_CXFIXEDFRAME = SM_CXDLGFRAME
  219. Private Const SM_CYFIXEDFRAME = SM_CYDLGFRAME
  220. Private Const SM_CXSIZEFRAME = SM_CXFRAME
  221. Private Const SM_CYSIZEFRAME = SM_CYFRAME
  222.  
  223. Private Const SM_SECURE = 44
  224. Private Const SM_CXEDGE = 45
  225. Private Const SM_CYEDGE = 46
  226. Private Const SM_CXMINSPACING = 47
  227. Private Const SM_CYMINSPACING = 48
  228. Private Const SM_CXSMICON = 49
  229. Private Const SM_CYSMICON = 50
  230. Private Const SM_CYSMCAPTION = 51
  231. Private Const SM_CXSMSIZE = 52
  232. Private Const SM_CYSMSIZE = 53
  233. Private Const SM_CXMENUSIZE = 54
  234. Private Const SM_CYMENUSIZE = 55
  235. Private Const SM_ARRANGE = 56
  236. Private Const SM_CXMINIMIZED = 57
  237. Private Const SM_CYMINIMIZED = 58
  238. Private Const SM_CXMAXTRACK = 59
  239. Private Const SM_CYMAXTRACK = 60
  240. Private Const SM_CXMAXIMIZED = 61
  241. Private Const SM_CYMAXIMIZED = 62
  242. Private Const SM_NETWORK = 63
  243. Private Const SM_CLEANBOOT = 67
  244. Private Const SM_CXDRAG = 68
  245. Private Const SM_CYDRAG = 69
  246. Private Const SM_SHOWSOUNDS = 70
  247. Private Const SM_CXMENUCHECK = 71  'Use instead of GetMenuCheckMarkDimensions()!
  248. Private Const SM_CYMENUCHECK = 72
  249. Private Const SM_SLOWMACHINE = 73
  250. Private Const SM_MIDEASTENABLED = 74
  251.  
  252. ' Return values for ExcludeClipRect
  253. Private Const NULLREGION = 1
  254. Private Const SIMPLEREGION = 2
  255. Private Const COMPLEXREGION = 3
  256.  
  257. ' Hatch constants for CreateHatchBrush
  258. Private Const HS_HORIZONTAL = 0
  259. Private Const HS_VERTICAL = 1
  260. Private Const HS_FDIAGONAL = 2
  261. Private Const HS_BDIAGONAL = 3
  262. Private Const HS_CROSS = 4
  263. Private Const HS_DIAGCROSS = 5
  264. Private Const HS_FDIAGONAL1 = 6
  265. Private Const HS_BDIAGONAL1 = 7
  266. Private Const HS_SOLID = 8
  267. Private Const HS_DENSE1 = 9
  268. Private Const HS_DENSE2 = 10
  269. Private Const HS_DENSE3 = 11
  270. Private Const HS_DENSE4 = 12
  271. Private Const HS_DENSE5 = 13
  272. Private Const HS_DENSE6 = 14
  273. Private Const HS_DENSE7 = 15
  274. Private Const HS_DENSE8 = 16
  275. Private Const HS_NOSHADE = 17
  276. Private Const HS_HALFTONE = 18
  277. Private Const HS_SOLIDCLR = 19
  278. Private Const HS_DITHEREDCLR = 20
  279. Private Const HS_SOLIDTEXTCLR = 21
  280. Private Const HS_DITHEREDTEXTCLR = 22
  281. Private Const HS_SOLIDBKCLR = 23
  282. Private Const HS_DITHEREDBKCLR = 24
  283. Private Const HS_API_MAX = 25
  284.  
  285. ' Image List draw constants
  286. Private Const ILD_NORMAL = &H0
  287. Private Const ILD_TRANSPARENT = &H1
  288. Private Const ILD_MASK = &H10
  289. Private Const ILD_IMAGE = &H20
  290.  
  291. '' Image type for DrawState
  292. Private Const DST_COMPLEX = &H0
  293. Private Const DST_TEXT = &H1
  294. Private Const DST_PREFIXTEXT = &H2
  295. Private Const DST_ICON = &H3
  296. Private Const DST_BITMAP = &H4
  297.  
  298. ' ' State type for DrawState
  299. Private Const DSS_NORMAL = &H0
  300. Private Const DSS_UNION = &H10
  301. Private Const DSS_DISABLED = &H20
  302. Private Const DSS_MONO = &H80
  303. Private Const DSS_RIGHT = &H8000
  304.  
  305. ' SysColor constants *some could be wrong in the code*
  306. Private Const COLOR_ACTIVEBORDER = 10
  307. Private Const COLOR_ACTIVECAPTION = 2
  308. Private Const COLOR_ADJ_MAX = 100
  309. Private Const COLOR_ADJ_MIN = -100
  310. Private Const COLOR_APPWORKSPACE = 12
  311. Private Const COLOR_BACKGROUND = 1
  312. Private Const COLOR_BTNFACE = 15
  313. Private Const COLOR_BTNHIGHLIGHT = 20
  314. Private Const COLOR_BTNSHADOW = 16
  315. Private Const COLOR_BTNTEXT = 18
  316. Private Const COLOR_CAPTIONTEXT = 9
  317. Private Const COLOR_GRAYTEXT = 17
  318. Private Const COLOR_HIGHLIGHT = 13
  319. Private Const COLOR_HIGHLIGHTTEXT = 14
  320. Private Const COLOR_INACTIVEBORDER = 11
  321. Private Const COLOR_INACTIVECAPTION = 3
  322. Private Const COLOR_INACTIVECAPTIONTEXT = 19
  323. Private Const COLOR_BTNDKSHADOW = 21
  324. Private Const COLOR_BTNLIGHT = 22
  325. Private Const COLOR_MENU = 4
  326. Private Const COLOR_MENUTEXT = 7
  327. Private Const COLOR_SCROLLBAR = 0
  328. Private Const COLOR_WINDOW = 5
  329. Private Const COLOR_WINDOWFRAME = 6
  330. Private Const COLOR_WINDOWTEXT = 8
  331.  
  332. ' Owner draw actions
  333. Private Const ODA_DRAWENTIRE = &H1
  334. Private Const ODA_SELECT = &H2
  335. Private Const ODA_FOCUS = &H4
  336.  
  337. ' Owner draw state
  338. Private Const ODS_SELECTED = &H1
  339. Private Const ODS_GRAYED = &H2
  340. Private Const ODS_DISABLED = &H4
  341. Private Const ODS_CHECKED = &H8
  342. Private Const ODS_FOCUS = &H10
  343. Private Const ODS_DEFAULT = &H20
  344. Private Const ODS_COMBOBOXEDIT = &H1000
  345.  
  346. 'required for font API functions
  347. Private Const LF_FACESIZE = 32
  348. Private Const SYMBOL_CHARSET = 2
  349.  
  350. Private Const LSYMF  _SELECT = &H2
  351. PrivatnSect
  352. Private Const NULa  _SELECT 6onsTt
  353. PriCoItO