
'====================================================================
'' Menu demo, fully programmed (no menu resource) with keyboard
'' accelerators, modal dialog as main.
''
'' To avoid the problems with using keyboard accelerators in a
'' modal dialog, where you do not have access to the message
'' loop, this code installs a WH_MSGFILTER hook and handles the
'' accelerators from the callback.
'====================================================================

#include "dialogs.bas"

'====================================================================

Dim Shared As HHOOK g_hHook
Dim Shared As HWND g_hDlg

'====================================================================

Function InitMenu() As HMENU

  Dim As HMENU hMenu, hFileMenu

  hMenu = CreateMenu
  hFileMenu = CreateMenu

  AppendMenu( hMenu, MF_POPUP, cast(UINT_PTR,hFileMenu), "&File" )
  AppendMenu( hFileMenu, MF_STRING, 1000, !"&New\tCtrl+N" )
  AppendMenu( hFileMenu, MF_SEPARATOR, 0, 0 )
  AppendMenu( hFileMenu, MF_STRING, 1001, !"&Open\tCtrl+O" )
  AppendMenu( hFileMenu, MF_SEPARATOR, 0, 0 )
  AppendMenu( hFileMenu, MF_STRING, 1002, !"&Save\tCtrl+S" )
  AppendMenu( hFileMenu, MF_STRING, 1003, !"Save &As" )
  AppendMenu( hFileMenu, MF_SEPARATOR, 0, 0 )
  AppendMenu( hFileMenu, MF_STRING, 1004, !"E&xit\tAlt+F4" )

  Return hMenu

End Function

'====================================================================

Function MessageProc( Byval code As Integer, _
                      Byval wParam As WPARAM, _
                      Byval lParam As LPARAM ) As Integer

  If code = MSGF_DIALOGBOX Then
    If cast(PMSG,lParam)->message = WM_KEYDOWN Then
      If GetAsyncKeyState( VK_CONTROL ) And &h8000 Then
        Select Case cast(PMSG,lParam)->wParam
          Case Asc("N")
            SendMessage( g_hDlg, WM_COMMAND, 1000, 0 )
          Case Asc("O")
            SendMessage( g_hDlg, WM_COMMAND, 1001, 0 )
          Case Asc("S")
            SendMessage( g_hDlg, WM_COMMAND, 1002, 0 )
        End Select
     End If
    End If
  End If

  Return CallNextHookEx( g_hHook, code, wParam, lParam )

End Function

'====================================================================

Function DialogProc( Byval hDlg As  HWND, _
                     Byval uMsg As UINT, _
                     Byval wParam As WPARAM, _
                     Byval lParam As LPARAM ) As Integer

  Select Case uMsg

    Case WM_INITDIALOG

      SetMenu( hDlg, InitMenu )

      g_hHook = SetWindowsHookEx( WH_MSGFILTER, @MessageProc, _
                                  0, GetCurrentThreadId() )
      g_hDlg = hDlg

    Case WM_COMMAND

      Select Case loword(wParam)
        Case 1000
          MessageBox( hDlg, "New", "", 0 )
        Case 1001
          MessageBox( hDlg, "Open", "", 0 )
        Case 1002
          MessageBox( hDlg, "Save", "", 0 )
        Case 1003
          MessageBox( hDlg, "Save As", "", 0 )
        Case 1004
          UnhookWindowsHookEx( g_hHook )
          EndDialog( hDlg, null )
      End Select

    Case WM_CLOSE

      UnhookWindowsHookEx( g_hHook )
      EndDialog( hDlg, null )

  End Select

  Return 0

End Function

'====================================================================

Dim As LPDLGTEMPLATE lpdt

Dialog( 1, 0, 0, 120, 90, "Menu In Modal Dialog Demo", lpdt, _
        WS_OVERLAPPEDWINDOW Or DS_CENTER )

'' The dialog must have at least one control or the menu
'' will not activate correctly with Alt + access key.

LText( 100, 0, 0, 0, 0, "" )

CreateModalDialog( 0, @DialogProc, 0, lpdt )

'====================================================================
 