! This software CALLDLG.f90 is part of the 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 using the Visual Fortran Dialog Procedures
! in a DLL.  The public routines in the DLL can be called to:
!  o  DisplayProgressBox - Display a dialog box containing a progress bar 
!  o  SetProgress - Set the current progress bar value
!  o  DestroyProgressBox - Destroy the dialog box
! CallDlg is a Win32 application that calls the public routines in the
! DLLPRGRS DLL.
!
! This sample was generated by the Fortran Windows AppWizard.  The only
! significant changes are to the calldlgStart subroutine.
!
!
!  FUNCTIONS:
!   WinMain()     - Entry point for the application;
!                   displays the main window; processes the message loop
!   calldlgSub()  - Callback routine for the main dialog box
!   calldlgStart()- Callback routine for the Start 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 user32
    use kernel32
    use dflogm
    use calldlgGlobals

    implicit none

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

    include 'resource.fd'

    external calldlgSub
    external calldlgStart

    ! Variables
    type (T_MSG)            mesg
    integer*4               ret
    logical*4               lret


    ghInstance = hInstance
    ghModule = GetModuleHandle(NULL)
    ghwndMain = NULL

    lret = DlgInit(IDD_CALLDLG_DIALOG, gdlg)
    if (lret == .FALSE.) goto 99999
    lret = DlgSetSub(gdlg, IDD_CALLDLG_DIALOG, calldlgSub)
    lret = DlgSetSub(gdlg, IDC_START, calldlgStart)
    lret = DlgModeless(gdlg, nCmdShow)
    if (lret == .FALSE.) goto 99999

    ! Read and process messsages
    do while( GetMessage (mesg, NULL, 0, 0) ) 
       if ( DlgIsDlgMessage(mesg) .EQV. .FALSE. ) then
           lret = TranslateMessage( mesg )
           ret  = DispatchMessage( mesg )
       end if
    end do
    call DlgUninit(gdlg)

    WinMain = mesg.wParam
    return

99999 &

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

end 

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

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

  use user32
  use dflogm

  implicit none

  type (dialog) dlg
  integer id, callbacktype

  if (callbacktype == dlg_destroy) then
    call PostQuitMessage(0)
  endif

  END SUBROUTINE calldlgSub

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

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

  use dflogm
  use ProgressBox

  implicit none

  ! Arguments
  type (dialog) dlg
  integer id, callbacktype

  ! Variables
  include 'resource.fd'
  type (PBContext) context
  integer iret
  logical lret
  integer progress
  logical bCancelled

  if (callbacktype == dlg_clicked) then

    ! Change the dialog message
    lret = DlgSet( dlg, IDC_MESSAGE, "Working..." )
    call DlgFlush( dlg )

    ! Create the progress dialog box
    ! We specify the main dialog as the parent window
    iret = DisplayProgressBox( context, dlg % hwnd, &
                                    "Win32 Progress Bar Test", .TRUE.) 
    if ( iret == PBStatus_OK ) then
        bCancelled = .FALSE.
        progress = 0

        ! Perform the work, updating the progress bar as we go along...
        do while ( ( bCancelled == .FALSE. ) .and. ( progress < 101 ) )
            iret = SetProgress ( context, progress )

            if ( iret == PBStatus_Aborted ) then
                bCancelled = .TRUE.
            else
                ! You would do real work here....
                ! Ideally, you should keep each increment of work to
                ! to under .25 seconds.  This keeps the user interface
                ! responsive.
			    call sleepqq(250)		! Wait .25 seconds, 100 times
            end if

            progress = progress + 1
        end do

        ! Destroy the progress box
        iret = DestroyProgressBox( context )

    end if

    ! Change the dialog message
    lret = DlgSet( dlg, IDC_MESSAGE, "Press the Start button to do some work" )

  endif

  END SUBROUTINE calldlgStart


