setprogress.f90

来自「Intel Visual Fortran 应用程序开发 周振红编著」· F90 代码 · 共 43 行

integer function SetProgress ( context, value )
  !DEC$ ATTRIBUTES DLLEXPORT::SetProgress
    use ProgressBoxTypes
    use ifwinty
    use user32
    implicit none
    ! Arguments
    type(PBContext) context
    integer value

    ! Variables
    include 'resource.fd'
    type (T_MSG) mesg
    logical lret
    logical lNotQuit
    integer iret

    ! Body of SetProgress
    SetProgress = PBStatus_OK

    ! Set the value of the Progress Bar
    lret = DlgSet( context % PBDlg, IDC_PROGRESS1, value )
    context % iProgress = value
   
    ! Dispatch all pending window messages
    lNotQuit = .true.
    do while ( lNotQuit .and. (PeekMessage(mesg, 0, 0, 0, PM_NOREMOVE) .ne. 0) )
		lNotQuit = GetMessage(mesg, NULL, 0, 0)
		if (lNotQuit) then
			if ( DlgIsDlgMessage(mesg) .EQV. .FALSE. ) then
			   lret = TranslateMessage( mesg )
			   iret = DispatchMessage( mesg )
			end if
        end if
       ! Check to see if the user pressed the Cancel button
        if ( context % bCancelled ) then
            context % bCancelled = .FALSE.      ! Reset
            SetProgress = PBStatus_Aborted
            return
        end if
    end do

end function SetProgress