home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD58155152000.psc / CMWndProc.bas next >
Encoding:
BASIC Source File  |  2000-05-09  |  3.9 KB  |  147 lines
  1. Attribute VB_Name = "CMWndProc"
  2. 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
  3.  
  4. Private Const WM_SYSCOLORCHANGE = &H15
  5. Private Const WM_NCMOUSEMOVE = &HA0
  6. Private Const WM_COMMAND = &H111
  7. Private Const WM_CLOSE = &H10
  8. Private Const WM_DRAWITEM = &H2B
  9. Private Const WM_GETFONT = &H31
  10. Private Const WM_MEASUREITEM = &H2C
  11. Private Const WM_NCHITTEST = &H84
  12. Private Const WM_MENUSELECT = &H11F
  13. Private Const WM_MENUCHAR = &H120
  14. Private Const WM_INITMENUPOPUP = &H117
  15. Private Const WM_WININICHANGE = &H1A
  16. Private Const WM_SETCURSOR = &H20
  17. Private Const WM_SETTINGCHANGE = WM_WININICHANGE
  18.  
  19. Private m_CoolMenuObj As CoolMenu
  20.  
  21. Public Property Set CoolMenuObj(ByVal vData As CoolMenu)
  22.     Set m_CoolMenuObj = vData
  23. End Property
  24.  
  25. Public Property Get CoolMenuObj() As CoolMenu
  26.     Set CoolMenuObj = m_CoolMenuObj
  27. End Property
  28.  
  29.  
  30. Public Function WindowProc(ByVal hwnd As Long, ByVal msg As Long, ByVal wparam As Long, ByVal lparam As Long) As Long
  31.   On Error GoTo ErrorHandle
  32.   
  33.   Select Case msg&
  34.   
  35.     'All other info are dynamic (I hope)
  36.     Case WM_SETTINGCHANGE: Call m_CoolMenuObj.GetMenuFont(True)
  37.     Case WM_SYSCOLORCHANGE: Call m_CoolMenuObj.GetMenuFont(True)
  38.     
  39.     Case WM_MEASUREITEM:
  40.  
  41.             If m_CoolMenuObj.OnMeasureItem(lparam&) Then
  42.               WindowProc = True
  43.               Exit Function
  44.             End If
  45.  
  46.             
  47.     Case WM_DRAWITEM:
  48.  
  49.             If m_CoolMenuObj.OnDrawItem(lparam&) Then
  50.               WindowProc = True
  51.               Exit Function
  52.             End If
  53.  
  54.     
  55.     Case WM_INITMENUPOPUP:
  56.  
  57.             Call CallWindowProc(m_CoolMenuObj.PrevWndProc, ByVal hwnd&, ByVal msg&, ByVal wparam&, ByVal lparam&)
  58.             Call m_CoolMenuObj.OnInitMenuPopup(wparam&, LoWord(lparam&), CBool(HiWord(lparam&)))
  59.             WindowProc = 0&
  60.             Exit Function
  61.             
  62.     Case WM_MENUCHAR:
  63.             
  64.             Dim result As Long
  65.             result = m_CoolMenuObj.OnMenuChar(LoWord(wparam&), HiWord(wparam&), lparam&)
  66.  
  67.             If result <> 0 Then
  68.               WindowProc = result
  69.               Exit Function
  70.             End If
  71.             
  72.     Case WM_MENUSELECT:
  73.             
  74.             Call m_CoolMenuObj.OnMenuSelect(LoWord(wparam&), HiWord(wparam&), lparam&)
  75.       
  76.   End Select
  77.   
  78. Continue:
  79.   WindowProc& = CallWindowProc(m_CoolMenuObj.PrevWndProc, hwnd&, msg&, wparam&, lparam&)
  80.   Exit Function
  81.   
  82. ErrorHandle:
  83.   Debug.Print Err.Number; Err.Description
  84.   Err.Clear
  85. '  GoTo Continue
  86.   m_CoolMenuObj.Install 0&
  87. End Function
  88.  
  89.  
  90. Public Function HiWord(LongIn As Long) As Integer
  91.      HiWord% = (LongIn& And &HFFFF0000) \ &H10000
  92. End Function
  93.  
  94. Public Function LoWord(LongIn As Long) As Integer
  95.   Dim l As Long
  96.   
  97.   l& = LongIn& And &HFFFF&
  98.   
  99.   If l& > &H7FFF Then
  100.        LoWord% = l& - &H10000
  101.   Else
  102.        LoWord% = l&
  103.   End If
  104. End Function
  105.  
  106. Public Function HiByte(WordIn As Integer) As Byte
  107.   
  108.   If WordIn% And &H8000 Then
  109.     HiByte = &H80 Or ((WordIn% And &H7FFF) \ &HFF)
  110.   Else
  111.     HiByte = WordIn% \ 256
  112.   End If
  113.  
  114. End Function
  115.  
  116. Public Function LoByte(WordIn As Integer) As Byte
  117.   LoByte = WordIn% And &HFF&
  118. End Function
  119.  
  120. Public Function MakeLong(LoWord As Integer, HiWord As Integer) As Long
  121. 'Useful when converting code from C++
  122.  
  123.   Dim nLoWord As Long
  124.   
  125.   If LoWord% < 0 Then
  126.     nLoWord& = LoWord% + &H10000
  127.   Else
  128.     nLoWord& = LoWord%
  129.   End If
  130.  
  131.   MakeLong& = CLng(nLoWord&) Or (HiWord% * &H10000)
  132. End Function
  133.  
  134. Public Function MakeWord(LoByte As Byte, HiByte As Byte) As Integer
  135. 'Useful when converting code from C++
  136.   Dim nLoByte As Integer
  137.  
  138.   If LoByte < 0 Then
  139.     nLoByte = LoByte + &H100
  140.   Else
  141.     nLoByte = LoByte
  142.   End If
  143.  
  144.   MakeWord = CInt(nLoByte) Or (HiByte * &H100)
  145. End Function
  146.  
  147.