! This software PROGRESS.F90 is part of the Compaq Visual Fortran kit.
! 
! This software is provided as an example that demonstrates a particular
! feature/function of the licensed product. The software is not intended to
! provide a complete solution to any application problem but rather is provided
! as a teaching mechanism.
! 
! Users may incorporate any part of this sample into their own source after 
! making appropriate changes to make it suitable for the intended application.
!
! This sample program demonstrates a "dialog-based" Fortran application using
! the Visual Fortran Dialog Functions.  The main window of the application
! is a dialog box.  It contains "Start", "Stop", and "Exit" buttons plus a
! progress bar.  The "Start" button begins a "lengthy" operation which is
! broken up into 100 steps.  In this simple example, each step is "sleeping" 
! for .25 seconds.
!
! The basic structure of this application was generated using the Fortran
! Windows Application project wizard.
!
!
!  FUNCTIONS:
!	WinMain()      - Entry point for the application;
!                    displays the main window; processes the message loop
!	ProgressSub()  - Callback routine for the main dialog box
!	StartWork()    - Setup for beginning the operation
!	ProgressStart()- Callback routine for the Start button
!	StopWork()     - Cleanup for stopping the operation
!	ProgressStop() - Callback routine for the Stop button
!

!****************************************************************************
!
!  FUNCTION: WinMain( hInstance, hPrevInstance, lpszCmdLine, nCmdShow )
!
!  PURPOSE:  Entry point for the application
!
!  COMMENTS: Displays the main window and processes the message loop
!
!****************************************************************************

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

	use dfwin
	use dflogm
	use progressGlobals

	implicit none

	integer*4 hInstance
	integer*4 hPrevInstance
	integer*4 lpszCmdLine
	integer*4 nCmdShow

	include 'resource.fd'

	external ProgressSub
	external ProgressStart
	external ProgressStop

	! Variables
	type (dialog)			dlg
	type (T_MSG)            mesg
	integer*4			    ret
	integer*4			    hwnd
	logical*4				lret
	logical*4				lNotQuit

	ghInstance = hInstance
	ghModule = GetModuleHandle(NULL)
	gSetFocus = 0

	! Display the main dialog box
	lret = DlgInit(IDD_PROGRESS_DIALOG, dlg)
	lret = DlgSetSub(dlg, IDD_PROGRESS_DIALOG, ProgressSub)
	lret = DlgSetSub(dlg, IDM_START, ProgressStart)
	lret = DlgSetSub(dlg, IDM_STOP, ProgressStop)
	call StopWork( dlg )
	lret = DlgModeless(dlg, nCmdShow)

	! Read and process messsages
	! If there are no messages waiting, go off and do a
	! little bit of work.  We don't want it to take too
	! long, or the Dialog Box will not be responsive.
	lNotQuit = .true.
	do while (lNotQuit) 
		if (gDoWork) then
			do while (PeekMessage(mesg, 0, 0, 0, PM_NOREMOVE) == 0 .and. gDoWork)
				! Do work here....
				call sleepqq(250)		! Wait .25 seconds, 100 times
				! Update the progress bar as we proceed...
				gCurrentPercentage = gCurrentPercentage + 1
				lret = DlgSet(dlg, IDC_PROGRESS1, gCurrentPercentage)
				if (gCurrentPercentage == 100) then
					call StopWork( dlg )
				end if
			end do
		end if;

		! There is at least one message waiting; process it
		! Note that DlgIsDlgMessage must be called in order to give
		! the dialog box first chance at the message.
		lNotQuit = GetMessage(mesg, NULL, 0, 0)
		if (lNotQuit) then
			if ( DlgIsDlgMessage(mesg) .EQV. .FALSE. ) then
			   lret = TranslateMessage( mesg )
			   ret  = DispatchMessage( mesg )
			end if
			! This code is used to move the input focus to an enabled button
			! It calls Win32 APIs directly.
			if (gSetFocus .ne. 0) then
				hwnd = GetDlgItem(dlg % hwnd, gSetFocus)
				hwnd = SetFocus(hwnd)
				gSetFocus = 0
			end if
		end if
	end do

	! Cleanup dialog box memory
	call DlgUninit(dlg)

	WinMain = mesg.wParam
	return

99999 &

	ret = MessageBox(ghwndMain, "Error initializing application progress"C, &
					 "Error"C, MB_OK)
	WinMain = 0

end 

!****************************************************************************
!
!  FUNCTION: ProgressSub ( dlg, id, callbacktype )
!
!  PURPOSE:  Dialog box callback for initialization and destroy
!
!  COMMENTS:
!
!****************************************************************************

SUBROUTINE ProgressSub( dlg, id, callbacktype )
!DEC$ ATTRIBUTES DEFAULT :: ProgressSub

  use dfwin
  use dflogm
  use progressGlobals

  implicit none

  type (dialog) dlg
  integer id, callbacktype

  ! When the user presses the "Exit" button, the default callback
  ! calls DLGEXIT which calls this callback with 
  ! callbacktype == dlg_destroy.  We call PostQuitMessage to cause
  ! the message loop in WinMain to terminate.
  if (callbacktype == dlg_destroy) then
	call PostQuitMessage(0)
  end if

  END SUBROUTINE ProgressSub

!****************************************************************************
!
!  FUNCTION: StartWork ( dlg )
!
!  PURPOSE:  Set up for starting work
!
!  COMMENTS:
!
!****************************************************************************

SUBROUTINE StartWork( dlg )

  use dflogm
  use progressGlobals

  implicit none

  include 'resource.fd'

  type (dialog) dlg

  integer hwnd
  logical lret

	gDoWork = .true.
	gCurrentPercentage = 0
	lret = DlgSet(dlg, IDM_START, .false., DLG_ENABLE)
	lret = DlgSet(dlg, IDM_EXIT, .false., DLG_ENABLE)
	lret = DlgSet(dlg, IDM_STOP, .true., DLG_ENABLE)
	gSetFocus = IDM_STOP

  END SUBROUTINE StartWork

!****************************************************************************
!
!  FUNCTION: ProgressStart ( dlg, id, callbacktype )
!
!  PURPOSE:  Dialog box callback for Start button
!
!  COMMENTS:
!
!****************************************************************************

SUBROUTINE ProgressStart( dlg, id, callbacktype )
!DEC$ ATTRIBUTES DEFAULT :: ProgressStart

  use dflogm
  use progressGlobals

  implicit none

  include 'resource.fd'

  type (dialog) dlg
  integer id, callbacktype

  logical lret

  if (callbacktype == dlg_clicked) then
	  call StartWork( dlg )
  end if

  END SUBROUTINE ProgressStart

!****************************************************************************
!
!  FUNCTION: StopWork ( dlg )
!
!  PURPOSE:  Cleanup when stopping
!
!  COMMENTS:
!
!****************************************************************************

SUBROUTINE StopWork( dlg )

  use dflogm
  use progressGlobals

  implicit none

  include 'resource.fd'

  type (dialog) dlg

  integer hwnd
  logical lret

	gDoWork = .false.
	lret = DlgSet(dlg, IDM_START, .true., DLG_ENABLE)
	lret = DlgSet(dlg, IDM_EXIT, .true., DLG_ENABLE)
	lret = DlgSet(dlg, IDM_STOP, .false., DLG_ENABLE)
	gSetFocus = IDM_START

  END SUBROUTINE StopWork

!****************************************************************************
!
!  FUNCTION: ProgressStop ( dlg, id, callbacktype )
!
!  PURPOSE:  Dialog box callback for Stop button
!
!  COMMENTS:
!
!****************************************************************************

SUBROUTINE ProgressStop( dlg, id, callbacktype )
!DEC$ ATTRIBUTES DEFAULT :: ProgressStop

  use dflogm
  use progressGlobals

  implicit none

  include 'resource.fd'

  type (dialog) dlg
  integer id, callbacktype

  if (callbacktype == dlg_clicked) then
	call StopWork( dlg )
  end if

  END SUBROUTINE ProgressStop


