home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD83247292000.psc / menu.cls < prev    next >
Encoding:
Visual Basic class definition  |  2000-07-29  |  3.9 KB  |  141 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "menuCls"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = True
  10. 'TechMenus
  11. 'Copyright (C) 2000 Lewis Anthony wilson
  12. '
  13. 'This program is free software; you can redistribute it and/or modify
  14. 'it under the terms of the GNU General Public License as published by
  15. 'the Free Software Foundation; either version 2 of the License, or
  16. '(at your option) any later version.
  17. '
  18. 'This program is distributed in the hope that it will be useful,
  19. 'but WITHOUT ANY WARRANTY; without even the implied warranty of
  20. 'MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21. 'GNU General Public License for more details.
  22. '
  23. 'You should have received a copy of the GNU General Public License
  24. 'along with this program; if not, write to the Free Software
  25. 'Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  26.  
  27.  
  28. Public Enum keyMode
  29. MOD_ALT = &H1
  30. MOD_CONTROL = &H2
  31. MOD_SHIFT = &H4
  32. End Enum
  33. Public AlphaBlendLevel As Long
  34. 'Public Event Key(MenuID As Variant, id As KeyCodeConstants)
  35. Public Event SelectItem(MenuID As Variant, id As Variant)
  36. Public Event Error(MenuID As Variant, ErrorNum As Long, Error As String)
  37.  
  38. Public OwnerHwnd As Long
  39.  
  40.  
  41. 'Public ImageItem As String
  42. 'Public Hlightimage As String
  43. 'Public Creadits As String
  44. Private ret As Long
  45. Public Sub AddMenu(MenuName As String, MenuID As Variant, MenuTextColor As Long, Optional Hotkey As KeyCodeConstants, Optional HotkeyMod As keyMode)
  46. If NewMenu(MenuID, MenuName, MenuTextColor, OwnerHwnd, Hotkey, HotkeyMod) = False Then RaiseEvent Error(MenuID, 3, "Menu Already Exists"):
  47.  
  48. End Sub
  49. Public Sub AddItem(MenuID As Variant, Item As String, id As Variant)
  50.  
  51. ret = GetMenu(MenuID)
  52.  
  53.  
  54. If ret = 0 Then RaiseEvent Error(MenuID, 1, "Unable to Add Menu Item"): Exit Sub
  55. Xm(ret).Additems Item, id
  56. End Sub
  57. Public Sub Addsubitem(MenuID, Item As String, ToID As Variant, id As Variant)
  58.  
  59.  
  60. ret = GetMenu(MenuID)
  61. If ret = 0 Then RaiseEvent Error(MenuID, 2, "Unable to Add Menu Sub Item"): Exit Sub
  62. Xm(ret).Addsubitem Item, ToID, id
  63.  
  64. End Sub
  65.  
  66.  
  67.  
  68. Public Function Init() As Boolean
  69. Creadits = "ToidyMan BigAl ThornBlade"
  70. For ret = 1 To MenuCount
  71. 'Xm(ret).Hotkey = Hotkey
  72. 'Xm(ret).HotkeyMod = HotkeyMod
  73.  
  74. Xm(ret).Init
  75. Next ret
  76.  
  77.  
  78. If OldWndProc <> 0 Then Exit Function
  79. '//////////////////////////////////////////////////////////////////////////
  80. OldWndProc = SetWindowLong(OwnerHwnd, GWL_WNDPROC, AddressOf WindowProc) '/
  81. '//////////////////////////////////////////////////////////////////////////
  82. SetTimer OwnerHwnd, 1, 350, 0
  83. 'MsgBox "This a Product is in Preview mode !!!!" + vbCrLf + "TechSun Technologys. www.TechSun.co.uk"
  84. End Function
  85.  
  86.  
  87. Sub Set_Extents(MenuID As Variant, Left As Long, Top As Long, Hieght As Long, Width As Long)
  88.  
  89. ret = GetMenu(MenuID)
  90. Xm(ret).Left = Left
  91. Xm(ret).Top = Top
  92. Xm(ret).ItemHeight = Hieght
  93. Xm(ret).ItemWidth = Width
  94.  
  95. Xm(ret).SetFont
  96.  
  97. End Sub
  98. Private Sub Class_Initialize()
  99. Hack = ObjPtr(Me)
  100.  
  101. End Sub
  102. Sub I_eventS(MenuID As Variant, id As Variant)
  103. RaiseEvent SelectItem(MenuID, id)
  104. End Sub
  105. Sub Set_textures(MenuID, Image_Background As String, Image_Selected As String, Optional AlphaBlendLevel As Long = 160)
  106.  
  107. ret = GetMenu(MenuID)
  108. Xm(ret).ItemImage = Image_Background
  109. Xm(ret).Hlightimage = Image_Selected
  110. Xm(ret).SetTextures
  111. Xm(ret).alphablendLev = AlphaBlendLevel
  112.  
  113. End Sub
  114. Function Pop(MenuID As Variant)
  115.  
  116. If Popup = True Then
  117.     ret = GetMenu(MenuID)
  118.     Xm(ret).Pop
  119. End If
  120.  
  121. End Function
  122. 'Property Let RoundedMenus(round As Boolean)
  123. 'RoundMenus = round
  124. 'End Property
  125. Property Let Popupmode(PopupMenu As Boolean)
  126. Popup = PopupMenu
  127. End Property
  128.  
  129. Property Let TransLucient(Transparent As Boolean)
  130. Trans = Transparent
  131. End Property
  132.  
  133. Private Sub Class_Terminate()
  134.  
  135. KillTimer OwnerHwnd, 1
  136. For X = 1 To MenuCount
  137. Call UnregisterHotKey(Xm(X).gethwnd, Xm(X).gethwnd)
  138. Next X
  139. End Sub
  140.  
  141.