Co ai biet cach tao menu luc chay khong ? [Archive]

crazyman

30-06-2003, 09:37

' Module : modMenus
' Description : Routines for working with VB menus
' Source : Total VB SourceBook 6
'
Private Declare Function GetMenu _
Lib "user32" _
(ByVal hwnd As Long) _
As Long

Private Declare Function GetMenuItemID _
Lib "user32" _
(ByVal hMenu As Long, _
ByVal nPos As Long) _
As Long

Private Declare Function GetSubMenu _
Lib "user32" _
(ByVal hMenu As Long, _
ByVal nPos As Long) _
As Long

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

Private Declare Function SendMessage _
Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) _
As Long

Private Const MF_BYCOMMAND = &H0&
Private Const EM_CANUNDO = &HC6

Public Sub AddBitmapToMenu( _
lnghWnd As Long, _
lngBitmapUnchecked As Long, _
lngBitmapChecked As Long, _
lngMainMenuItem As Long, _
lngMenuItem As Long)
' Comments : Sets the 'checked' and 'unchecked' bitmaps to be used
' with a form's menus
' Parameters: lnghWnd - handle to the window of the form
' lngBitmapUnchecked - the Picture property of a bitmap
' used to display the unchecked state of the menu. May be
' the value returned from LoadPicture. The bitmap should
' be 13x13 pixels. Monochrome bitmaps work best
' lngBitmapChecked - the Picture property of a bitmap
' used to display the checked state of the menu. May be the
' value returned from LoadPicture. The bitmap should be 13x13
' pixels. Monochrome bitmaps work best
' lngMainMenuItem - the ordinal position of the main
' menu on the form, starting with 0
' lngMenuItem - the ordinal position of the subitem on
' the main menu, starting with 0
' Returns : Nothing
' Source : Total VB SourceBook 6
'
Dim lnghMenu As Long
Dim lnghSubMenu As Long
Dim lngMenuID As Long
Dim lngResult As Long

On Error GoTo PROC_ERR

' get handle to the form's menu
lnghMenu = GetMenu(lnghWnd)

' get handle to the main submenu for the form
lnghSubMenu = GetSubMenu(lnghMenu, lngMainMenuItem)

' get the MenuID for the selected subitem
lngMenuID = GetMenuItemID(lnghSubMenu, lngMenuItem)

' set the bitmaps
lngResult = SetMenuItemBitmaps( _
lnghMenu, _
lngMenuID, _
MF_BYCOMMAND, _
lngBitmapUnchecked, _
lngBitmapChecked)

PROC_EXIT:
Exit Sub

PROC_ERR:
MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
"AddBitmapToMenu"
Resume PROC_EXIT

End Sub

Public Sub SetEditMenuItemStates( _
ctlIn As Control, _
mnuCut As Menu, _
mnuCopy As Menu, _
mnuPaste As Menu, _
mnuUndo As Menu)
' Comments : Tests a control (text box or rtf control) to set
' the Enabled property of an Edit menu's Cut, Copy,
' Paste, and Undo buttons appropriately. This function
' should be called from top-level Click event of the Edit
' menu (which normally has no other code associated with it)
' Parameters: ctlIn - control to test. Must have a .sellength
' property and respond to the EM_CANUNDO message. Usually
' this is a text box or an RTF control
' mnuCut - the Edit, Cut menu
' mnuCopy - the Edit, Copy menu
' mnuPaste - the Edit, Paste menu
' mnuUndo - the Edit, Undo menu
' Returns : Nothing
' Source : Total VB SourceBook 6
'
Dim fTest As Boolean

On Error GoTo PROC_ERR

' check for text available to cut or copy
fTest = (ctlIn.SelLength <> 0)
mnuCut.Enabled = fTest
mnuCopy.Enabled = fTest

' check for something available to be undone
fTest = CBool(SendMessage(ctlIn.hwnd, EM_CANUNDO, 0&, ByVal 0))
mnuUndo.Enabled = fTest

' check if anything is available on the clipboard for pasting
fTest = Len(Clipboard.GetText) <> 0
mnuPaste.Enabled = fTest

' required so that the menu states can be changed before being shown
DoEvents

PROC_EXIT:
Exit Sub

PROC_ERR:
MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
"SetEditMenuItemStates"
Resume PROC_EXIT

End Sub