home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / DHTML_Edit18343612292004.psc / API.bas < prev    next >
BASIC Source File  |  2004-09-02  |  4KB  |  140 lines
  1. Attribute VB_Name = "API_Functions"
  2. Option Explicit
  3.  
  4. Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
  5. Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
  6. Private Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
  7. Private Declare Function SetMenuItemBitmaps Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long
  8.  
  9.  
  10.  
  11.  
  12. Public Type ColorVals
  13.     ColorName As String
  14.     ColorLong As Long
  15.     ColorHex As String
  16. End Type
  17.  
  18. Public ga_ColorVals(0 To 15) As ColorVals
  19.  
  20. Private Const MF_BITMAP = &H4&
  21. Public Sub InitColors()
  22.  
  23. 'ga_ColorVals().ColorName=
  24. 'ga_ColorVals().ColorHex=
  25. 'ga_ColorVals().ColorLong=
  26.  
  27. ga_ColorVals(1).ColorName = "Black"
  28. ga_ColorVals(1).ColorHex = "#000000"
  29. ga_ColorVals(1).ColorLong = &H0&
  30.  
  31. ga_ColorVals(12).ColorName = "Silver"
  32. ga_ColorVals(12).ColorHex = "#C0C0C0"
  33. ga_ColorVals(12).ColorLong = &HC0C0C0
  34.  
  35. ga_ColorVals(4).ColorName = "Gray"
  36. ga_ColorVals(4).ColorHex = "#808080"
  37. ga_ColorVals(4).ColorLong = &H808080
  38.  
  39. ga_ColorVals(14).ColorName = "White"
  40. ga_ColorVals(14).ColorHex = "#FFFFFF"
  41. ga_ColorVals(14).ColorLong = &HFFFFFF
  42.  
  43. ga_ColorVals(7).ColorName = "Maroon"
  44. ga_ColorVals(7).ColorHex = "#800000"
  45. ga_ColorVals(7).ColorLong = &H80&
  46.  
  47. ga_ColorVals(11).ColorName = "Red"
  48. ga_ColorVals(11).ColorHex = "#FF0000"
  49. ga_ColorVals(11).ColorLong = &HFF&
  50.  
  51. ga_ColorVals(10).ColorName = "Purple"
  52. ga_ColorVals(10).ColorHex = "#800080"
  53. ga_ColorVals(10).ColorLong = &H800080
  54.  
  55. ga_ColorVals(3).ColorName = "Fuchsia"
  56. ga_ColorVals(3).ColorHex = "#FF00FF "
  57. ga_ColorVals(3).ColorLong = &HFF00FF
  58.  
  59. ga_ColorVals(5).ColorName = "Green"
  60. ga_ColorVals(5).ColorHex = "#008000"
  61. ga_ColorVals(5).ColorLong = &H8000&
  62.  
  63. ga_ColorVals(6).ColorName = "Lime"
  64. ga_ColorVals(6).ColorHex = "#00FF00"
  65. ga_ColorVals(6).ColorLong = &HFF00&
  66.  
  67. ga_ColorVals(9).ColorName = "Olive"
  68. ga_ColorVals(9).ColorHex = "#808000"
  69. ga_ColorVals(9).ColorLong = &H8080&
  70.  
  71. ga_ColorVals(15).ColorName = "Yellow"
  72. ga_ColorVals(15).ColorHex = "#FFFF00"
  73. ga_ColorVals(15).ColorLong = &HFFFF&
  74.  
  75. ga_ColorVals(8).ColorName = "Navy"
  76. ga_ColorVals(8).ColorHex = "#000080"
  77. ga_ColorVals(8).ColorLong = &H800000
  78.  
  79. ga_ColorVals(2).ColorName = "Blue"
  80. ga_ColorVals(2).ColorHex = "#0000FF"
  81. ga_ColorVals(2).ColorLong = &HFF0000
  82.  
  83. ga_ColorVals(13).ColorName = "Teal"
  84. ga_ColorVals(13).ColorHex = "#008080"
  85. ga_ColorVals(13).ColorLong = &H808000
  86.  
  87. ga_ColorVals(0).ColorName = "Aqua"
  88. ga_ColorVals(0).ColorHex = "#00FFFF"
  89. ga_ColorVals(0).ColorLong = &HFFFF00
  90.  
  91.  
  92. End Sub
  93.  
  94.  
  95. Function RevRGB(ByVal VBHexRGB As String) As String
  96. ' VB generated Hex RGB must be reversed to be used in HTML
  97.  
  98. Dim var1 As String
  99. Dim var2 As String
  100. Dim Var3 As String
  101.  
  102. var1 = Left$(VBHexRGB, 2)
  103. var2 = Mid$(VBHexRGB, 3, 2)
  104. Var3 = Right$(VBHexRGB, 2)
  105.  
  106. RevRGB = Var3 & var2 & var1
  107.  
  108. End Function
  109.  
  110.  
  111. Public Function ColorToHex(ByVal lColor As Long) As String
  112. Dim sTemp As String
  113.  
  114. sTemp = Hex$(lColor)
  115.  
  116. If Len(sTemp) < 6 Then sTemp = String$(6 - Len(sTemp), "0") + sTemp
  117. sTemp = "#" & RevRGB(sTemp)
  118.  
  119. ColorToHex = sTemp
  120.  
  121. End Function
  122.  
  123. Public Sub SetMenuIcon(hwnd As Long, MenuIndex As Long, SubIndex As Long, pic As Picture)
  124. Dim hMenu As Long, hSubMenu As Long, hID As Long
  125.  
  126. 'Get the menuhandle of the form
  127. hMenu = GetMenu(hwnd)
  128.  
  129. 'Get the handle of the first submenu
  130. hSubMenu = GetSubMenu(hMenu, MenuIndex)
  131.  
  132. 'Get the menuId of the first entry
  133. hID = GetMenuItemID(hSubMenu, SubIndex)
  134.  
  135. 'Add the bitmap
  136. SetMenuItemBitmaps hMenu, hID, MF_BITMAP, pic, pic
  137.  
  138. End Sub
  139.  
  140.