Add run-time make a Menu Item

edderic · Jan 17, 2000

can i with VB6 at run -time create a Menu Item ? 
 
thanks 
 
Eric 
 
<A HREF="mailto:vbg.be@vbgroup.nl">vbg.be@vbgroup.nl</A>

VhdlForLife · Jan 17, 2000

You can make it look like you have run-time menu items by actually creating menu items that are hidden when the application is first executed and then made visible by your code. The name of the item can also be changed by setting the appropriate property of the menu item.

edderic · Jan 17, 2000

To VhdIForLife : 
 
The question is : ho can a user at run-time create a Menu Item that execute like Word or Access ? with my project. 
 
Eric 
 
<A HREF="mailto:vbg.be@vbgroup.nl">vbg.be@vbgroup.nl</A>

VhdlForLife · Jan 18, 2000

You mean create a new menu item that the user defines? Like a macro?

MikeLacey · Jan 19, 2000

This can be done but is not easy. 
 
Dan Appleman's Book - Win32 API for VB5 - has a whole chapter on how to manipulate menus at run-time. 
 
I've never done it, not had a project that needed it; looks like hard work to me. 
 
Mike Mike Lacey <a href=mailto:Mike_Lacey@Cargill.Com>Mike_Lacey@Cargill.Com</a> <a href=

http://www.cargill.com/>

Cargill's Corporate Web Site</a>

edderic · Jan 25, 2000

here is it : 
 
Take a module and declare : 
 
'Note, MS stresses that a few of the API's used here, will be obsolete in future versions of Windows. 
'(AppendMenu for example) 
 
Option Explicit 
 
Public Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long 
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 Function CreateMenu Lib "user32" () As Long 
Public Declare Function CreatePopupMenu Lib "user32" () As Long 
Public Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long 
Public Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long 
Public Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long 
Public Declare Function SetMenu Lib "user32" (ByVal hwnd As Long, ByVal hMenu As Long) As Long 
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 MF_ENABLED = &H0& 
Public Const MF_POPUP = &H10& 
Public Const MF_STRING = &H0& 
Public Const WM_COMMAND = &H111 
Public Const WM_USER = &H400 
 
Public lpPrevWndProc As Long 
 
ad a procedure : 
 
'A must! 
Sub DiscardMenu(hMenu As Long) 
 
On Error Resume Next 
 
If hMenu Then 
 
Call DestroyMenu(hMenu) 
hMenu = 0 
 
End If 
 
End Sub 
 
Next procedure : 
 
Public Function WindowProc(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 
 
On Error Resume Next 
 
Dim T As String 
 
If lpPrevWndProc = 0 Then Exit Function 
 
'Return windows messages. 
WindowProc = CallWindowProc(lpPrevWndProc, hwnd, wMsg, wParam, lParam) 
 
'Menu clicked? 
Select Case wMsg 
Case WM_COMMAND 
 
'Just for fun. 
If wParam - WM_USER > 1000 Then 
 
T = "Menuhandle: " & GetMenu(hwnd) & vbCrLf & vbCrLf 
T = T & "MenuID: " & wParam - WM_USER 
 
Form1.Label1.Caption = T 
Form1.Label1.Refresh 
 
End If 
 
'Distinct menuitem.. 
Select Case wParam - WM_USER 
Case 1001 
 
MsgBox "Hello World" 
 
Case 1002 
End Select 
 
End Select 
 
End Function 
 
Form declarations : 
 
Option Explicit 
 
Dim hMenu As Long 
Dim hPopupMenu1 As Long 
 
Private Sub Form_Load() 
 
'If we want to detect a click on a menuitem, we need to subclass this form. 
lpPrevWndProc = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf WindowProc) 
 
End Sub 
 
Private Sub Form_Unload(Cancel As Integer) 
 
'UnHook, be sure you don't use End in this procedure! 
If lpPrevWndProc Then Call SetWindowLong(Me.hwnd, GWL_WNDPROC, lpPrevWndProc) 
 
DiscardMenu hPopupMenu1 
DiscardMenu hMenu 
 
End Sub 
 
set two options on the form : option1(0) and option1(1) 
 
Private Sub Option1_Click(Index As Integer) 
 
Dim a As Long 
Dim lpNewItem As String 
 
'To prevent memory leaks, we need to destroy the current handles. 
DiscardMenu hPopupMenu1 
DiscardMenu GetMenu(Me.hwnd) 
 
Select Case Index 
Case 0 
 
'Wipe existing menu. 
Call SetMenu(Me.hwnd, ByVal 0&) 
 
Case 1 
 
'Required, create menuhandle first. 
hMenu = CreateMenu() 
If hMenu = 0 Then Exit Sub 
 
'Now we create the first topmenu. 
hPopupMenu1 = CreatePopupMenu() 
 
Debug.Print "hMenu " & hMenu 
Debug.Print "hPopupMenu1 " & hPopupMenu1 
 
'Topmenu caption. 
lpNewItem = "POPUPMENU 1" 
 
Call AppendMenu(hMenu, MF_STRING Or MF_POPUP, hPopupMenu1, lpNewItem) 
 
'Add submenu items.. 
'VB generates his own unique control id's, be sure you use different numbers. 
'This example add's WM_USER to be safe. (Good idea?) 
For a = 1 To 4 
 
lpNewItem = "SubMenu " & a 
 
Call AppendMenu(hPopupMenu1, MF_STRING, WM_USER + 1000 + a, lpNewItem) 
 
Next a 
 
End Select 
 
If hMenu Then Call SetMenu(Me.hwnd, hMenu) 
 
Call DrawMenuBar(Me.hwnd) 
 
End Sub 
 
do not close with VB DE it crasht ,close with form X 
 
Eric De Decker

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Add run-time make a Menu Item

edderic

Programmer

VhdlForLife

Programmer

edderic

Programmer

VhdlForLife

Programmer

MikeLacey

MIS

edderic

Programmer

Similar threads

Part and Inventory Search

Sponsor