
'====================================================================
'' Menu demo, fully programmed (no menu resource) with keyboard
'' accelerators, modeless dialog as main.
''
'' Keyboard accelerators are easier to implement in a modeless
'' dialog because you have direct access to the message loop.
'====================================================================

#include "dialogs.bas"

'' For 0.15b through 0.17b July 30, 2006, uncomment the following
'' option escape and remove the "!" prefix on the AppendMenu string
'' arguments.

'option escape

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

Dim Shared As HACCEL g_hAccel

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

'' The ACCEL structure, as defined in the 0.16b winuser.bi, is
'' padded to a length of 8 bytes, instead of the 6 bytes that
'' the API expects. This definition corrects the problem, so
'' in an array elements beyond the first will work correctly.
''
Type _ACCEL Field = 2
    fVirt As Byte
    Key As WORD
    cmd As WORD
End Type

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

Function InitMenu() As HMENU

  Dim As HMENU hMenu, hFileMenu
  Dim As _ACCEL accl( 0 To 2)

  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" )

  accl(0).fVirt = FCONTROL Or FVIRTKEY
  accl(0).key = Asc("N")
  accl(0).cmd = 1000
  accl(1).fVirt = FCONTROL Or FVIRTKEY
  accl(1).key = Asc("O")
  accl(1).cmd = 1001
  accl(2).fVirt = FCONTROL Or FVIRTKEY
  accl(2).key = Asc("S")
  accl(2).cmd = 1002

  g_hAccel = CreateAcceleratorTable( cast(LPACCEL,@accl(0)), 3 )

  Return hMenu

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() )

      Return true

    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
          DestroyWindow( hDlg )
      End Select

    Case WM_CLOSE

      DestroyWindow( hDlg )

    Case WM_DESTROY

      DestroyAcceleratorTable( g_hAccel )
      PostQuitMessage( null )

  End Select

  Return 0

End Function

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

Dim As LPDLGTEMPLATE lpdt
Dim As HWND hDlg
Dim As MSG wMsg

Dialog( 1, 0, 0, 150, 100, "Menu Demo", lpdt, _
        WS_OVERLAPPEDWINDOW Or DS_CENTER Or WS_VISIBLE )

'' 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, "" )

hDlg = CreateModelessDialog( 0, @DialogProc, 0, lpdt )

Do While GetMessage( @wMsg, null, 0, 0 ) <> 0
  If TranslateAccelerator( hDlg, g_hAccel, @wMsg ) = 0 Then
    If IsDialogMessage( hDlg,  @wMsg ) = 0 Then
      TranslateMessage( @wMsg )
      DispatchMessage( @wMsg )
    End If
  End If
Loop

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