Results 1 to 2 of 2

Thread: adding popup menu?

  1. #1

    Thread Starter
    Lively Member
    Join Date
    Jul 2000
    Location
    Lost in the Mojave Desert
    Posts
    82
    hey how can i add a menu item to the icon menu on top of the form(control menu), any quick and dirty way to accomplish this?
    Don't go away mad, just go away.

    Bam-Bam

  2. #2
    Guest
    To add to the control menu:

    Code:
    'Tip by Steve Anderson
    
    1. Start a new Standard-Exe project, form1 is created by default.
    
    2. Add a standard module to the project, project menu and click 'add module'
    
    3. The new module should open up by default. Add the following code.
    
    Option Explicit
    
    Declare Function AppendMenu Lib "user32" Alias _
    "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags _
    As Long, ByVal wIDNewItem As Long, ByVal _
    lpNewItem As String) As Long
    
    Declare Function GetSystemMenu Lib "user32" _
    (ByVal hWnd As Long, ByVal bRevert As Long) As Long
    
    Declare Function SetWindowLong Lib "user32" _
    Alias "SetWindowLongA" (ByVal hWnd As Long, _
    ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    
    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 Const WM_SYSCOMMAND = &H112
    Public Const MF_SEPARATOR = &H800&
    Public Const MF_STRING = &H0&
    Public Const GWL_WNDPROC = (-4)
    Public Const IDM_ABOUT As Long = 1010
    Public lProcOld As Long
    
    Public Function SysMenuHandler(ByVal hWnd _
    As Long, ByVal iMsg As Long, ByVal wParam _
    As Long, ByVal lParam As Long) As Long
    
    If iMsg = WM_SYSCOMMAND Then
        If wParam = IDM_ABOUT Then
            MsgBox "About . . .", vbInformation, "About"
            Exit Function
        End If
    End If
    
    SysMenuHandler = CallWindowProc(lProcOld, _
    hWnd, iMsg, wParam, lParam)
    End Function
    
    Public Function SubClass(FormName As Form)
    Dim lhSysMenu As Long, lRet As Long
    
    lhSysMenu = GetSystemMenu(FormName.hWnd, 0&)
    lRet = AppendMenu(lhSysMenu, MF_SEPARATOR, 0&, _
    vbNullString)
    lRet = AppendMenu(lhSysMenu, MF_STRING, _
    IDM_ABOUT, "About...")
    
    FormName.Show
    lProcOld = SetWindowLong(FormName.hWnd, GWL_WNDPROC, _
    AddressOf SysMenuCode.SysMenuHandler)
    End Function
    4. Open up the code window for form1 and type the following
    
    Option Explicit
    
    Private Sub Form_Load()
    Dim d As String
    d = SubClass(Form1) 'Type the name of the form d =
    SubClass(<FormName>)
    End Sub
    
    Private Sub Form_Unload(Cancel As Integer)
    SetWindowLong Me.hWnd, GWL_WNDPROC, lProcOld
    End Sub
    5. I have altered the code to work with any form just specify the form name where I have commented the code.
    
    6. Run the project by clicking on run on the toolbar or from the run menu.
    
    If you click on the control menu then you will see two items. One a separator and the other which says 'About...'. Click on about and a message box appears with my copyright.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width