displayprogressbox.f90

Intel Visual Fortran 应用程序开发 周振红编著

integer function DisplayProgressBox(    &
                    context,            &
                    hwndParent,         &
                    title,              &
                    bCancelButton ) 
  !DEC$ ATTRIBUTES DLLEXPORT::DisplayProgressBox
    use ProgressBoxTypes
    use user32

    implicit none

  ! Arguments
    type(PBContext) context
    integer hwndParent
    character*(*) title
    logical bCancelButton

  ! Variables
    include 'resource.fd'
    external PBDlgSub
    external CancelSub
    logical lret
    integer hwnd

  ! Body of DisplayProgressBox

    DisplayProgressBox = PBStatus_OK

  ! Initialize the context structure
    allocate( context % PBDlg )
    context % bCancelButton = bCancelButton
    context % hwndParent = hwndParent
    context % bCancelled = .FALSE.
    context % iProgress = 0

  ! Initialize the progress dialog box
    lret = DlgInitWithResourceHandle( IDD_PROGRESS_DIALOG, ghinst, context % PBDlg )
    if ( .not. lret ) then
        DisplayProgressBox = PBStatus_Failed
        return 
    end if
    CALL DLGSETTITLE( context % PBDlg, title )
    lret = DlgSetSub( context % PBDlg, IDD_PROGRESS_DIALOG, PBDlgSub)
    if ( .not. lret ) then
        DisplayProgressBox = PBStatus_Failed
        return 
    end if
    lret = DlgSetSub( context % PBDlg, IDCANCEL, CancelSub)
    if ( .not. lret ) then
        DisplayProgressBox = PBStatus_Failed
        return 
    end if

  !  Disable the parent window
	context % bEnableParent = .FALSE.
	if ( hwndParent .ne. 0 ) then
        lret = IsWindowEnabled( hwndParent )
        if ( lret ) then
		    lret = EnableWindow( hwndParent, .FALSE. )
    	    context % bEnableParent = .TRUE.
        end if
    end if

  !  Display the progress dialog box
    lret = DlgModeless( context % PBDlg, SW_SHOWNORMAL, hwndParent)
    if ( .not. lret ) then
        DisplayProgressBox = PBStatus_Failed
        return 
    end if

  !  Display the Cancel button if the caller requested it
    if ( bCancelButton ) then
	    hwnd = GetDlgItem( context % PBDlg % hwnd, IDCANCEL )
        lret = ShowWindow( hwnd, SW_SHOWNA )
    end if

  !  Save the address of the context block as a property of the window
  !  We will retrieve it from there in our callbacks
    lret = SetProp( context % PBDlg % hwnd, "PBContext", %loc(context) )

end function DisplayProgressBox