Build as a console application.

!ThreadDlg is a sample program for executing a lengthy computation in 
!a separate thread while providing the user to cancel the calculation.
!The sample is now updated to display a progress bar as well.

!INTRODUCTION
!A GUI program is not quite like an ordinary, linear-flow console program.
!A GUI program can have two states; let's call them "Idle" and "Busy".
!When in "Idle" state, the program is in the message loop (do while 
!GetMessage thingo) and it waits for user input, i.e. it is responsive.
!When in "Busy" state, it does something else, like your lengthy 
!calculation. A GUI should not be "Busy" for a long time, since it appears
!frozen and user-unfriendly. A busy program cannot even draw its window --
!that's why your progress bar would never be updated until the end.
!So, when you have to perform a lengthy number-crunching, and want your 
!program responsive, you can:
!a) Break your calculation into small chunks and let the program process
!   user input in the meantime
!b) Spawn a separate ("worker") thread for calculation
!Actually, a) and b) rely on the same principle, however, in case b)
!Windows takes care about timeslicing.
!
!You are free to use this code in any way you see fit. No waranties 
!included.
!Jugoslav Dujic, 2002.
!------------------------------------------------------
MODULE STUFF

INTEGER:: hThread
LOGICAL:: bStopped

END MODULE STUFF
!------------------------------------------------------

PROGRAM ThreadDlg

USE DFLOGM

IMPLICIT NONE

INTEGER::         iDummy
TYPE (DIALOG)::   Dlg
EXTERNAL          OnRun, OnStop

INCLUDE "Resource.fd"

iDummy=DlgInit(IDD_DIALOG1, Dlg)

iDummy=DlgSet(Dlg,IDC_PROGRESS,0,DLG_RANGEMIN)
iDummy=DlgSet(Dlg,IDC_PROGRESS,100,DLG_RANGEMAX)
iDummy=DlgSet(Dlg,IDC_PROGRESS,0)

iDummy = DlgSet(Dlg, IDC_BUTTON_STOP, .FALSE., DLG_ENABLE)

iDummy=DlgSetSub(Dlg, IDC_BUTTON_RUN, OnRun)
iDummy=DlgSetSub(Dlg, IDC_BUTTON_STOP, OnStop)

iDummy=DlgModal(Dlg)

END PROGRAM ThreadDlg

!------------------------------------------------------

SUBROUTINE OnRun(Dlg, ID, iAction)
USE DFWIN
USE DFLOGM
USE STUFF

IMPLICIT NONE

INCLUDE "Resource.fd"

TYPE(Dialog):: Dlg
INTEGER::      ID, iAction, idThread, iDummy
TYPE (T_SECURITY_ATTRIBUTES),POINTER::   NULL_SA

INTERFACE
    INTEGER(4) FUNCTION Worker(h)
    !DEC$ATTRIBUTES STDCALL:: Worker
    INTEGER h
    END FUNCTION
END INTERFACE

bStopped = .FALSE.
!Here, we start Worker routine, but in a new thread
hThread = CreateThread(NULL_SA, 0, LOC(Worker), LOC(Dlg), 0, LOC(idThread))

! Disable 'Run' Button so that another calculation cannot be
! concurrently started
iDummy = DlgSet(Dlg, ID, .FALSE., DLG_ENABLE)
iDummy = DlgSet(Dlg, IDC_BUTTON_STOP, .TRUE., DLG_ENABLE)

END SUBROUTINE OnRun
!------------------------------------------------------
SUBROUTINE OnStop(Dlg, ID, iAction)

USE DFWIN
USE DFLOGM
USE STUFF

IMPLICIT NONE

TYPE(Dialog):: Dlg
INTEGER::      ID, iAction, idThread, iDummy

INCLUDE "Resource.fd"

!Setting event (raising its state to TRUE) will cause
!the thread to exit when first testing event state
bStopped = .TRUE.

!Disable "Stop" button while terminating thread
iDummy = DlgSet(Dlg, ID, .FALSE., DLG_ENABLE)

iDummy = WaitForSingleObject(hThread, 500)
IF (iDummy.EQ.WAIT_TIMEOUT) THEN
     !Thread didn't exit within 0.5s , kill it (_DANGEROUS_)
     iDummy = TerminateThread(hThread, 0)
END IF

!Reenable buttons
iDummy = DlgSet(Dlg, IDC_BUTTON_RUN, .TRUE., DLG_ENABLE)
iDummy = DlgSet(Dlg, ID, .FALSE., DLG_ENABLE)
iDummy = DlgSet(Dlg, IDC_PROGRESS, 0)
iDummy = CloseHandle(hThread)

END SUBROUTINE OnStop
!------------------------------------------------------
!Finally, you'll have to redesign your Worker so that it 
!looks like this. It _mustn't_ have more than one argument.
!------------------------------------------------------
INTEGER(4) FUNCTION Worker(Dlg)
!DEC$ATTRIBUTES STDCALL:: Worker
!DEC$ATTRIBUTES REFERENCE:: Dlg

USE DFLOGM
USE DFWIN
USE STUFF

TYPE(DIALOG):: Dlg
!------------------------------------------------------
!You'll have to test whether bStopped is TRUE
!every while in the routine. If there's main iterative
!loop(s), putting it there would be OK. Note that
!thread can't be terminated at any time - it has to 
!"cooperate".
!------------------------------------------------------

!The following can speed up the calculation but at expense of
!responsiveness
!i = SetThreadPriority(GetCurrentThread(),THREAD_PRIORITY_ABOVE_NORMAL)
Sec0 = SECNDS(0.)
DO i=1,100
   !Your number crunching here 
   f=0.
   DO k=1,2000000
      CALL RANDOM_NUMBER(f2)
      f = f+f2
   END DO
   IF (IsCancelSignalled(Dlg,i).EQ.1) THEN
      Worker=0
      RETURN
   END IF
END DO
WRITE(*,*) "Time = ",SECNDS(Sec0)

Worker=1

CALL OnThreadEnd(Dlg)

END FUNCTION Worker
!------------------------------------------------------
!It's usually a good idea to wrap some system-specific 
!code in a separate routine.
INTEGER(4) FUNCTION IsCancelSignalled(Dlg, nStep)

USE DFWIN
USE DFLOGM
USE STUFF

IMPLICIT NONE

INCLUDE "Resource.fd"

TYPE(DIALOG):: Dlg
INTEGER::      nStep, iDummy

IF (bStopped) THEN
   IsCancelSignalled=1
ELSE
   IsCancelSignalled=0
END IF
iDummy = DlgSet(Dlg,IDC_PROGRESS,nStep)

END FUNCTION IsCancelSignalled

!------------------------------------------------------
!Called when the thread is about to end in order to 
!reenable controls
SUBROUTINE OnThreadEnd(Dlg)

USE DFLOGM
TYPE(DIALOG):: Dlg

INCLUDE "Resource.fd"

iDummy = DlgSet(Dlg, IDC_BUTTON_STOP, .FALSE., DLG_ENABLE)
iDummy = DlgSet(Dlg, IDC_BUTTON_RUN, .TRUE., DLG_ENABLE)

END SUBROUTINE OnThreadEnd