
!/******************************************************************************\
!*       This is a part of the Compaq Visual Fortran Source Code Samples.
!\******************************************************************************/

!/***************************************************************************
! *                                                                         *
! *  PROGRAM     : Menu.c                                                   *
! *                                                                         *
! *  PURPOSE     : To give a demonstration of the use of popup menus, user  *
! *                defined menus and menu functions.                        *
! *                                                                         *
! *  FUNCTIONS   : WinMain()           - Calls the initialization function  *
! *                                      and enters the message loop.       *
! *                                                                         *
! *                MenuInit()          - Registers the app. window class.   *
! *                                                                         *
! *                About()             - Dialog function for the About..    *
! *                                      dialog.                            *
! *                                                                         *
! *                ShrinkBitmap()      - Shrinks a 64x64 bitmap to a size   *
! *                                      useable for a user-defined menu    *
! *                                      checkmark.                         *
! *                                                                         *
! *                HandleCreate()      - Creates a new menu and appends it  *
! *                                      to the main menu                   *
! *                                                                         *
! *                HandlePaint()       - Handles repainting the app's client*
! *                                      area                               *
! *                                                                         *
! *                HandleChangeColors()- Changes the state of the "colors"  *
! *                                      menu item.                         *
! *                                                                         *
! *                HandleDrawItem()    - Redraws the menu items in the      *
! *                                      "colors" menu                      *
! *                                                                         *
! *                HandlePopupMenu()   - handles display of the "floating"  *
! *                                      popup.                             *
! *                                                                         *
! *                MenuWndProc()       - Window function for the app.       *
! *                                                                         *
! *                                                                         *
! * It is best to use the Developer Studio to create this program, using the project supplied
! *
! * If this is built as a project or by compiling each unit, use the following switches:
! *  df /winapp /c menu.f90
!
! ***************************************************************************/
interface
integer(4) function WinMain (hInstance, hPrevInstance, lpszCmdLine, nCmdShow)
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_WinMain@16' :: WinMain
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'WinMain' :: WinMain
!DEC$ ENDIF
integer(4) hInstance
integer(4) hPrevInstance
integer(4) lpszCmdLine
integer(4) nCmdShow
end function WinMain
end interface
end

!/****************************************************************************
! *                                                                          *
! *  FUNCTION   : WinMain(HANDLE, HANDLE, LPSTR, int)                        *
! *                                                                          *
! *  PURPOSE    : Creates the main app. window, calls an initialization      *
! *               function and enters the message loop.                      *
! *                                                                          *
! ****************************************************************************/
integer*4 function WinMain( hInstance, hPrevInstance, lpCmdLine, nCmdShow )
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_WinMain@16' :: WinMain
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'WinMain' :: WinMain
!DEC$ ENDIF
use dfwin
use menuinc

interface
integer(4) function MenuWndProc ( hwnd, message, wParam, lParam)
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_MenuWndProc@16' :: MenuWndProc
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'MenuWndProc' :: MenuWndProc
!DEC$ ENDIF
integer*4   hwnd
integer*4   message
integer*4   wParam
integer*4   lParam
end function MenuWndProc
end interface

integer*4   hInstance, hPrevInstance, lpCmdLine, nCmdShow
type (T_WNDCLASS)  wc
integer*4   hWnd
type (T_MSG) message
logical(4)  bret
character*100  lpszClassName, lpszMenuName, lpszIconName

lpcmdline = lpcmdline

!/* Register main window class if this is the first instance of the app. */
lpszClassName ="menu"C
lpszMenuName = "MenuMenu"C
lpszIconName ="menu"C
if (hPrevInstance == 0) then
    wc%style         = 0
    wc%lpfnWndProc   = LOC(MenuWndProc)
    wc%hInstance     = hInstance
    wc%hIcon         = LoadIcon (hInstance, LOC(lpszIconName))
    wc%hCursor       = LoadCursor (NULL, IDC_ARROW)
    wc%hbrBackground = GetStockObject (WHITE_BRUSH)
    wc%lpszMenuName  = LOC(lpszMenuName)
    wc%lpszClassName = LOC(lpszClassName)

    if (RegisterClass (wc) == 0 ) then
        WinMain = 0
        return
    end if
endif

hInst = hInstance

!/* Create the app. window */
hWnd = CreateWindow (                                             &
                    lpszClassName,                                &
                     "Menu Example"C,                             &
                    INT4(WS_OVERLAPPEDWINDOW),                    &
                    CW_USEDEFAULT,                                &
                    CW_USEDEFAULT,                                &
                    CW_USEDEFAULT,                                &
                    CW_USEDEFAULT,                                &
                    NULL,                                         &
                    NULL,                                         &
                    hInstance,                                    &
                    NULL)

if (hWnd == 0) then
    WinMain = 0
    return
end if

bret = ShowWindow (hWnd, nCmdShow)
bret = UpdateWindow (hWnd)

do while (GetMessage (message, NULL, 0, 0))
  !/* Since we have no accelerators, no need to call
  ! * TranslateAccelerator here.
  ! */
    bret = TranslateMessage (message)
    ret = DispatchMessage (message)
end do

WinMain = message%wParam
return
end



!/****************************************************************************
! *                                                                          *
! *  FUNCTION   : About (hDlg, message, wParam, lParam)                      *
! *                                                                          *
! *  PURPOSE    : Dialog function for the About menu... dialog.              *
! *                                                                          *
! ****************************************************************************/
integer*4 function About(hDlg, message, wParam, lParam )
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_About@16' :: About
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'About' :: About
!DEC$ ENDIF
use dfwin
use menuinc
integer*4 hDlg
integer*4 message
integer*4 wParam
integer*4 lParam
logical(4)  bret

lParam = lParam
select case (message)
    case (WM_INITDIALOG)
        About = 1
        return

    case (WM_COMMAND)
          !// LoWord added for portability
          if (LoWord(wParam) == IDOK) then
              bret = EndDialog(hDlg,0)
              About = 1
              return
          end if
end select
About = 0
return
end




