Browse DevX
Sign up for e-mail newsletters from DevX

Tip of the Day
Language: Visual Basic
Expertise: Advanced
Mar 12, 1999



Building the Right Environment to Support AI, Machine Learning and Deep Learning

Provide Status Messages for Menus

Subclassing a form lets you give a helpful message whenever a user highlights a menu item. Use the Caption property to identify the menu item, then display the help message in a label (lblStatus), which is on the form:
' --- Form code
Private Sub Form_Load()
	origWndProc = SetWindowLong(hwnd, GWL_WNDPROC, _
		AddressOf AppWndProc)
End Sub

Private Sub Form_Resize()
	lblStatus.Move 0, ScaleHeight - lblStatus.Height, _
End Sub

Private Sub Form_Unload(Cancel As Integer)
	SetWindowLong hwnd, GWL_WNDPROC, origWndProc
End Sub

'--- Module code
	cbSize As Long
	fMask As Long
	fType As Long
	fState As Long
	wID As Long
	hSubMenu As Long
	hbmpChecked As Long
	hbmpUnchecked As Long
	dwItemData As Long
	dwTypeData As String
	cch As Long
End Type

Public 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
Public Declare Sub CopyMemory Lib "kernel32" Alias _
	"RtlMoveMemory" (hpvDest As Any, hpvSource As Any, _
	ByVal cbCopy As Long)
Public Declare Function GetMenuItemInfo Lib "user32" Alias _
	"GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As _
	Long, ByVal b As Boolean, lpMenuItemInfo As _
Public Declare Function SetWindowLong Lib "user32" Alias _
	"SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As _
	Long, ByVal dwNewLong As Long) As Long

Public Const GWL_WNDPROC = (-4)
Public Const WM_MENUSELECT = &H11F
Public Const MF_SYSMENU = &H2000&
Public Const MIIM_TYPE = &H10
Public Const MIIM_DATA = &H20

Public origWndProc As Long

Public Function AppWndProc(ByVal hwnd As Long, ByVal Msg _
	As Long, ByVal wParam As Long, ByVal lParam As Long) _
	As Long
	Dim iHi As Integer, iLo As Integer
	Select Case Msg
			Form1.lblStatus.Caption = ""
			CopyMemory iLo, wParam, 2
			CopyMemory iHi, ByVal VarPtr(wParam) + 2, 2
			If (iHi And MF_SYSMENU) = 0 Then
				Dim m As MENUITEMINFO, aCap As String
				m.dwTypeData = Space$(64)
				m.cbSize = Len(m)
				m.cch = 64
				m.fMask = MIIM_DATA Or MIIM_TYPE
				If GetMenuItemInfo(lParam, CLng(iLo), _
					False, m) Then
					aCap = m.dwTypeData & Chr$(0)
					aCap = Left$(aCap, _
						InStr(aCap, Chr$(0)) - 1)
					Select Case aCap
						Case "&Open": _
							Form1.lblStatus.Caption = _
							"Open a file"
						Case "&Save": _
							Form1.lblStatus.Caption = _
							"Save a file"
					End Select
				End If
			End If
	End Select
	AppWndProc = CallWindowProc(origWndProc, hwnd, Msg, _
		wParam, lParam)
End Function
Matt Hart
Comment and Contribute






(Maximum characters: 1200). You have 1200 characters left.



Thanks for your registration, follow us on our social networks to keep up-to-date