Add run-time make a Menu Item

[edderic]

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

 

[VhdlForLife]

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]

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

 

[VhdlForLife]

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

 

[MikeLacey]

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

http://www.cargill.com/>

Cargill's Corporate Web Site</a><br>

 

[edderic]

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