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

!**********************************************************************
!*  platform.f90 --    platform program template for Windows program  *
!*                                                                    *
!*  Comments:                                                         *
!*                                                                    *
!*  Functions:                                                        *
!*                                                                    *
!*  WinMain()         - Initializes Application                       *
!*  MainWndProc()     - Processes Application Messages                *
!*  AboutDlgProc()    - Processes "About" Dialog Box Messages         *
!*                                                                    *
!*                                                                    *
!* 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 platform.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: int APIENTRY WinMain(HINSTANCE, HINSTANCE, LPSTR, int)  *
!*                                                                    *
!*   Purpose: Initializes Application                                 *
!*                                                                    *
!*  Comments: Standard template                                       *
!*                                                                    *
!*                                                                    *
!**********************************************************************
integer 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
use dfwin
use platinc
integer hInstance, hPrevInstance, lpszCmdLine, nCmdShow

interface
integer(4) function MainWndProc( hwnd, mesg, wParam, lParam )
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_MainWndProc@16' :: MainWndProc
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'MainWndProc' :: MainWndProc
!DEC$ ENDIF
integer  hwnd
integer mesg
integer wParam
integer lParam
end function MainWndProc
end interface

  type(T_WNDCLASS)      wc
  type(T_MSG)               mesg
  integer                   hWnd
  integer hmenu
  integer(4)      bret
  character*100   lpszClassName, lpszMenuNAme, lpszAppName

lpszcmdline = lpszcmdline

   lpszClassName ="Platform"C
   lpszMenuName = "PlatformMenu"C
   lpszAppName = "Platform Sample Application"C
   if(hPrevInstance == 0) then
      wc%lpszClassName = LOC(lpszClassName)
      wc%lpfnWndProc = LOC(MainWndProc)
      wc%style = 0
      wc%hInstance = hInstance

      wc%hIcon = LoadIcon( NULL, IDI_APPLICATION)
      wc%hCursor = LoadCursor( NULL, IDC_ARROW )
      wc%hbrBackground = GetStockObject(WHITE_BRUSH)
      wc%lpszMenuName = LOC(lpszMenuName)
      wc%cbClsExtra = 0
      wc%cbWndExtra = 0

      i2 =  RegisterClass(wc)
    end if

   hmenu = LoadMenu(hInstance, LOC(lpszMenuNAme))

    ghInstance = hInstance

          hWnd = CreateWindowEx(0, lpszClassName,              &
                  lpszAppName,            &
                  INT4(WS_OVERLAPPEDWINDOW),                      &
                  10,                                             &
                  10,                                             &
                  600,                                            &
                  400,                                            &
                  NULL,                                           &
                  hmenu,                                          &
                  hInstance,                                      &
                  NULL                                            &
                )

  i = ShowWindow( hWnd, nCmdShow )

   do while( GetMessage( mesg, NULL, 0, 0 ))
      bret =  TranslateMessage( mesg )
      i =  DispatchMessage( mesg )
   end do

WinMain = mesg%wParam
end


integer function MainWndProc( hWnd, mesg, wParam, lParam )
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_MainWndProc@16' :: MainWndProc
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'MainWndProc' :: MainWndProc
!DEC$ ENDIF
use dfwin
use platinc
integer hWnd, mesg, wParam, lParam

interface
integer(4) function AboutDlgProc( hwnd, mesg, wParam, lParam )
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_AboutDlgProc@16' :: AboutDlgProc
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'AboutDlgProc' :: AboutDlgProc
!DEC$ ENDIF
integer  hwnd
integer mesg
integer wParam
integer lParam
end function AboutDlgProc
end interface

integer*4      ret, version
character*55  buf
character*30  buf1

  select case ( mesg )
      case (WM_COMMAND)
         select case ( INT4(LOWORD(wParam ) ))

            case (IDM_PLATFORM)

               version = GetVersion()
               write(buf,10) LoByte(LoWord(version)), HiByte(LoWord(version))
10             format ('The version of Windows you are running is ',I2,'.',I2)
               ret = MessageBox( hWnd, buf, "Platform"C, MB_OK )

               if ( IAND (version , WIN32S) .NE. 0 ) then
                  write(buf1,20)
20                format ('This is running on Win32S ')
               else
                  write(buf1,30)
30                format ('This is running on Win32/NT ')
               end if
               ret = MessageBox( hWnd, buf1,"Platform"C, MB_OK )

            case (IDM_ABOUT)
               ret = DialogBoxParam(ghInstance, LOC("AboutDlg"C),hWnd, LOC(AboutDlgProc), 0)

            case DEFAULT
               WndProc = DefWindowProc(hWnd, mesg, wParam, lParam)
               return
         end select

!****************************************************************
!*     WM_DESTROY: PostQuitMessage() is called                  *
!****************************************************************

      case (WM_DESTROY)
         call PostQuitMessage( 0 )

!****************************************************************
!*     Let the default window proc handle all other messages    *
!****************************************************************

      case DEFAULT
         MainWndProc =  DefWindowProc( hWnd, mesg, wParam, lParam )
         return
   end select

end

