A useful question I'm sure anybody'd like to know the answer too...

[Phobic]

Ok, ya know how some applications have their own menus embedded in some of Window's standard menus? Take Winamp for example: If you have Winamp displayed in the Taskbar, and you right click on its button, you'll get the standard Windows menu (close, restore, maximize, etc.). But you also get another menu seperated followed by the Winamp menu. How is this done? Do you create your own new menu, with the Windows standard options along with your new one, or add it to the Windows standard menu? I know theres a way to remove certain options from a Windos standard menu, because that's a way you can disable the X in a form. So VB masters, who can do this? (Heh, I could probably waste my time figuring this out, but then I couldn't ask the question and get a reply from every one, and somebody already knows how to do it I'm sure...)

[Cbomb]

Well, I don't have an exact answer but I'm VERY sure it will involve subclassing the window procedure. Hope that tid bit helps!

[This message has been edited by Cbomb (edited 11-23-1999).]

[Serge]

Cbomb is right. It is possible but will require a bit of work. Here is the sample. This sample will require 2 forms (frmMain and frmCustom) and a Label on the frmMain called Label1.

Module Code

Public Declare Function GetProp Lib "User32" Alias "GetPropA" (ByVal hWnd As Long, ByVal lpString As String) 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
Private Declare Function SetProp Lib "User32" Alias "SetPropA" (ByVal hWnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal wNewWord As Long) As Long
Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Const GWL_WNDPROC  As Long = (-4)

Public Function ProcessMessages(ByVal hWnd As Long, ByVal msg As Long, _
                                    ByVal wParam As Long, ByVal lParam As Long) As Long
    'this MUST be dimmed as the object passed!!!
    Dim obj As frmMain
    Dim lDummy As Long
    lDummy = GetProp(hWnd, "ObjectPointer")
    'Ignore "impossible" bogus case
    If (lDummy <> 0) Then
        CopyMem obj, lDummy, 4

        On Error Resume Next

        ProcessMessages = obj.WindowProc(hWnd, msg, wParam, lParam)
        If (Err) Then
            UnhookWindow hWnd
            Debug.Print "Unhook on Error, #"; CStr(Err.Number)
            Debug.Print "  Desc: "; Err.Description
            Debug.Print "  Message, hWnd: &h"; Hex(hWnd), _
            "Msg: &h"; Hex(msg), "Params:"; wParam; lParam
        End If
        'Reinitialize lDummy
        lDummy = 0
        CopyMem obj, lDummy, 4
    End If
End Function
Public Sub HookWindow(hWnd As Long, thing As Object)
    Dim lDummy As Long

   CopyMem lDummy, thing, 4
   Call SetProp(hWnd, "ObjectPointer", lDummy)
   Call SetProp(hWnd, "OldWindowProc", GetWindowLong(hWnd, GWL_WNDPROC))
   Call SetWindowLong(hWnd, GWL_WNDPROC, AddressOf ProcessMessages)
End Sub

Public Sub UnhookWindow(hWnd As Long)
    Dim lDummy As Long
    lDummy = GetProp(hWnd, "OldWindowProc")
    If (lDummy <> 0) Then
        Call SetWindowLong(hWnd, GWL_WNDPROC, lDummy)
    End If
End Sub
Public Function InvokeWindowProc(hWnd As Long, msg As Long, wParam As Long, lParam As Long) As Long
   InvokeWindowProc = CallWindowProc(GetProp(hWnd, "OldWindowProc"), _
                                                                            hWnd, msg, wParam, lParam)
End Function

Form Code

Private Const MF_STRING = &H0
Private Const WM_SYSCOMMAND = &H112
Private Const MF_SEPARATOR = &H800
Private Const ID_CUSTOM = 1000 'the value must be less then integer
Private Declare Function GetSystemMenu Lib "User32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
Private Declare Function AppendMenu Lib "User32" Alias "AppendMenuA" (ByVal lSystemMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As String) As Long

Private Sub Form_Load()
    Dim lRet As Long
    Dim lSystemMenu As Long  'Add an "About" command to the system menu
   
    lSystemMenu = GetSystemMenu(Me.hWnd, False)
    lRet = AppendMenu(lSystemMenu, MF_SEPARATOR, 0, 0&)
    lRet = AppendMenu(lSystemMenu, MF_STRING, ID_CUSTOM, "&My Custom Form...")
  
    'if OK, then subclass the form to  'catch this menuitem selection
    If lRet Then
        Call HookWindow(Me.hWnd, Me)
        Label1.Caption = "Select a new menu from the Sytem Menu..."
    End If
End Sub

Friend Function WindowProc(hWnd As Long, msg As Long, wParam As Long, lParam As Long) As Long
    Select Case msg
        Case WM_SYSCOMMAND
            If wParam = ID_CUSTOM Then
                'show your custom form form
                frmCustom.Show vbModal
                WindowProc = 1
                Exit Function
            End If
        Case Else
    End Select     ' Pass along to default window procedure.
    WindowProc = CallWindowProc(GetProp(hWnd, "OldWindowProc"), hWnd, msg, wParam, lParam)
End Function

Private Sub Form_Unload(Cancel As Integer)
    Call UnhookWindow(Me.hWnd)
    Set frmMain = Nothing
End Sub

------------------

Serge

Software Developer
[email protected]
[email protected]
ICQ#: 51055819



[This message has been edited by Serge (edited 11-24-1999).]