home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / sgwnd10 / menusele.cls < prev    next >
Encoding:
Visual Basic class definition  |  1998-08-15  |  3.4 KB  |  129 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "MenuSelect"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
  11. Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
  12. Option Explicit
  13.  
  14. ' SG Window message callback interface
  15. Implements sgWindow.IsgMessageSink
  16.  
  17. ' SG Window object
  18. Private mclsWindow As sgWindow.Window
  19.  
  20. ' MenuSelect Events
  21. Public Event MenuItemSelected(Caption As String)
  22.  
  23. ' API declarations
  24. Private Declare Function GetMenuString Lib "user32" Alias _
  25.    "GetMenuStringA" (ByVal hMenu As Long, ByVal wIDItem As Long, ByVal lpString As String, _
  26.    ByVal nMaxCount As Long, ByVal wFlag As Long) As Long
  27.    
  28. Private Const MF_BYCOMMAND = &H0&
  29. Private Const MF_BYPOSITION = &H400&
  30.  
  31. Private Type MENUITEMINFO
  32.     cbSize As Long
  33.     fMask As Long
  34.     fType As Long
  35.     fState As Long
  36.     wID As Long
  37.     hSubMenu As Long
  38.     hbmpChecked As Long
  39.     hbmpUnchecked As Long
  40.     dwItemData As Long
  41.     dwTypeData As String
  42.     cch As Long
  43. End Type
  44.  
  45. Private Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" _
  46.    (ByVal hMenu As Long, ByVal un As Long, ByVal b As Boolean, _
  47.    lpMenuItemInfo As MENUITEMINFO) As Long
  48.  
  49. Public Property Let hWnd(ByVal vData As Long)
  50.    mclsWindow.hWnd = vData
  51.    If vData <> 0 Then
  52.       mclsWindow.Hooked = True
  53.       mclsWindow.EnableMessage wm_MENUSELECT
  54.    Else
  55.       mclsWindow.Hooked = False
  56.       mclsWindow.EnableMessage wm_MENUSELECT, False
  57.    End If
  58. End Property
  59.  
  60. Public Property Get hWnd() As Long
  61.     hWnd = mclsWindow.hWnd
  62. End Property
  63.  
  64. Private Sub Class_Initialize()
  65.    Set mclsWindow = New sgWindow.Window
  66.    mclsWindow.SetMessageCallback Me
  67. End Sub
  68.  
  69. Private Sub Class_Terminate()
  70.    Set mclsWindow = Nothing
  71. End Sub
  72.  
  73.  
  74. ' Message handler.
  75. ' This method is called when WM_MENUSELECT message arrives
  76. ' in the attached window message queue. Window Message
  77. ' is than translated into the MenuItemSelected event
  78. Private Sub IsgMessageSink_Message(ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long, result As Long)
  79.    Dim sCaption As String * 255
  80.    Dim iPos%
  81.    
  82.    'get menu item caption
  83.    GetMenuString lParam, sgWindow.LowWord(wParam), _
  84.       sCaption, 255, sgWindow.HighWord(wParam)
  85.    '---todo--------------------------------
  86.    Dim mi As MENUITEMINFO
  87.    
  88.    GetMenuItemInfo lParam, 0, False, mi
  89.    '---todo--------------------------------
  90.    Debug.Print mi.dwTypeData
  91.    'check out if menu has shortcut
  92.    iPos = InStr(sCaption, vbTab)
  93.    
  94.    If iPos > 0 Then
  95.       'cut shortcut out
  96.       sCaption = Left$(sCaption, iPos - 1)
  97.    Else
  98.       'remove null chars from string
  99.       sCaption = Left$(sCaption, InStr(sCaption, Chr(0)) - 1)
  100.    End If
  101.    
  102.    'remove '&' char
  103.    sCaption = String_StripChar(sCaption, "&")
  104.    
  105.    RaiseEvent MenuItemSelected(sCaption)
  106. End Sub
  107.  
  108. Private Function String_StripChar(ByVal sOrig As String, sChar As String) As String
  109.    Dim Pos As Integer
  110.    Dim iLen As Integer
  111.  
  112.    On Error Resume Next
  113.    
  114.    iLen = Len(sOrig)
  115.    If iLen > 0 Then
  116.       Pos = InStr(sOrig, sChar)
  117.       Do While (Pos > 0)
  118.          If (Pos <= iLen) Then
  119.             sOrig = VBA.Left$(sOrig, Pos - 1) + VBA.Right$(sOrig, iLen - Pos)
  120.             iLen = iLen - 1
  121.          End If
  122.          Pos = InStr(sOrig, sChar)
  123.       Loop
  124.    End If
  125.    String_StripChar = sOrig
  126. End Function
  127.  
  128.  
  129.