Scan
lcMainID =
loThermo.Task = 'Processing ' + + ' items'

Select
Scan For
*-- Update thermo or early abort.
lnItem = lnItem + 1
If Mod(lnItem, lnInterval) = 0 Then
If loThermo.Abort Then
llAbort = vfpTrue
Exit
Else
loThermo.Percent = 100 * (lnItem / lnTotalCount)
Endif
EndIf

....
EndScan
EndScan

If VarType(loThermo) = 'O' Then
If Not loThermo.Abort Then
loThermo.Percent = 100
Else
llAbort = vfpTrue
EndIf
loThermo.Release()
loThermo = vfpNull
EndIf


********************************
The dlgThermo class definition
********************************
DEFINE CLASS dlgThermo AS form


DoCreate = .T.
Caption = ""
ControlBox = .F.
FontSize = 10
Height = 107
Width = 301
DoCreate = .T.
AutoCenter = .T.
BorderStyle = 0
Caption = ""
Closable = .F.
MaxButton = .F.
MinButton = .F.
Movable = .F.
TitleBar = 0
AlwaysOnTop = .T.
WindowType = 0
*-- Numeric. Number of milliseconds to wait before displaying a bar.
interval = 100
*-- Numeric. An integer between 0 and 100 representing the completness of the task.
percent = 0
*-- Character. The text to display in Title label.
title = ""
*-- Character. Describes the task in progress.
task = ""
*-- Reference to the calling form. The form is activated in the Destroy event.
HIDDEN callingform
callingform = .NULL.
*-- Numeric. Number of muilliseconds to wait when the thermometer reaches a 100%.
timetostop = 100
Name = "dlgThermo"

*-- Logical. Specifies if the user press the Esc key cancel the process.
abort = .F.

*-- Logical. Specifies if the user is allowed to cancel the process.
allowcancel = .F.


ADD OBJECT shape1 AS shape WITH ;
Top = 0, ;
Left = 1, ;
Height = 107, ;
Width = 299, ;
BackStyle = 0, ;
SpecialEffect = 1, ;
ZOrderSet = 0, ;
Name = "shape1"


ADD OBJECT shpbar1 AS shape WITH ;
Top = 55, ;
Left = 12, ;
Height = 16, ;
Width = 10, ;
BorderStyle = 0, ;
FillStyle = 0, ;
FillColor = RGB(0,0,128), ;
ZOrderSet = 1, ;
Name = "shpBar1"


ADD OBJECT linhb1 AS line WITH ;
Height = 0, ;
Left = 10, ;
Top = 53, ;
Width = 277, ;
BorderColor = RGB(128,128,128), ;
ZOrderSet = 2, ;
Name = "linHB1"


ADD OBJECT linhw1 AS line WITH ;
Height = 0, ;
Left = 10, ;
Top = 72, ;
Width = 277, ;
BorderColor = RGB(255,255,255), ;
ZOrderSet = 3, ;
Name = "linHW1"


ADD OBJECT linvb1 AS line WITH ;
Height = 18, ;
Left = 10, ;
Top = 54, ;
Width = 0, ;
BorderColor = RGB(128,128,128), ;
ZOrderSet = 4, ;
Name = "linVB1"


ADD OBJECT linvw1 AS line WITH ;
Height = 20, ;
Left = 287, ;
Top = 53, ;
Width = 0, ;
BorderColor = RGB(255,255,255), ;
ZOrderSet = 5, ;
Name = "linVW1"


ADD OBJECT shpbar2 AS shape WITH ;
Top = 55, ;
Left = 23, ;
Height = 16, ;
Width = 10, ;
BorderStyle = 0, ;
FillStyle = 0, ;
FillColor = RGB(0,0,128), ;
ZOrderSet = 6, ;
Name = "shpBar2"


ADD OBJECT shpbar3 AS shape WITH ;
Top = 55, ;
Left = 34, ;
Height = 16, ;
Width = 10, ;
BorderStyle = 0, ;
FillStyle = 0, ;
FillColor = RGB(0,0,128), ;
ZOrderSet = 7, ;
Name = "shpBar3"


ADD OBJECT shpbar4 AS shape WITH ;
Top = 55, ;
Left = 45, ;
Height = 16, ;
Width = 10, ;
BorderStyle = 0, ;
FillStyle = 0, ;
FillColor = RGB(0,0,128), ;
ZOrderSet = 8, ;
Name = "shpBar4"


ADD OBJECT shpbar5 AS shape WITH ;
Top = 55, ;
Left = 56, ;
Height = 16, ;
Width = 10, ;
BorderStyle = 0, ;
FillStyle = 0, ;
FillColor = RGB(0,0,128), ;
ZOrderSet = 9, ;
Name = "shpBar5"


ADD OBJECT shpbar6 AS shape WITH ;
Top = 55, ;
Left = 67, ;
Height = 16, ;
Width = 10, ;
BorderStyle = 0, ;
FillStyle = 0, ;
FillColor = RGB(0,0,128), ;
ZOrderSet = 10, ;
Name = "shpBar6"


ADD OBJECT shpbar7 AS shape WITH ;
Top = 55, ;
Left = 78, ;
Height = 16, ;
Width = 10, ;
BorderStyle = 0, ;
FillStyle = 0, ;
FillColor = RGB(0,0,128), ;
ZOrderSet = 11, ;
Name = "shpBar7"


ADD OBJECT shpbar8 AS shape WITH ;
Top = 55, ;
Left = 89, ;
Height = 16, ;
Width = 10, ;
BorderStyle = 0, ;
FillStyle = 0, ;
FillColor = RGB(0,0,128), ;
ZOrderSet = 12, ;
Name = "shpBar8"


ADD OBJECT shpbar9 AS shape WITH ;
Top = 55, ;
Left = 100, ;
Height = 16, ;
Width = 10, ;
BorderStyle = 0, ;
FillStyle = 0, ;
FillColor = RGB(0,0,128), ;
ZOrderSet = 13, ;
Name = "shpBar9"


ADD OBJECT shpbar10 AS shape WITH ;
Top = 55, ;
Left = 111, ;
Height = 16, ;
Width = 10, ;
BorderStyle = 0, ;
FillStyle = 0, ;
FillColor = RGB(0,0,128), ;
ZOrderSet = 14, ;
Name = "shpBar10"


ADD OBJECT shpbar11 AS shape WITH ;
Top = 55, ;
Left = 122, ;
Height = 16, ;
Width = 10, ;
BorderStyle = 0, ;
FillStyle = 0, ;
FillColor = RGB(0,0,128), ;
ZOrderSet = 15, ;
Name = "shpBar11"


ADD OBJECT shpbar12 AS shape WITH ;
Top = 55, ;
Left = 133, ;
Height = 16, ;
Width = 10, ;
BorderStyle = 0, ;
FillStyle = 0, ;
FillColor = RGB(0,0,128), ;
ZOrderSet = 16, ;
Name = "shpBar12"


ADD OBJECT shpbar13 AS shape WITH ;
Top = 55, ;
Left = 144, ;
Height = 16, ;
Width = 10, ;
BorderStyle = 0, ;
FillStyle = 0, ;
FillColor = RGB(0,0,128), ;
ZOrderSet = 17, ;
Name = "shpBar13"


ADD OBJECT shpbar14 AS shape WITH ;
Top = 55, ;
Left = 155, ;
Height = 16, ;
Width = 10, ;
BorderStyle = 0, ;
FillStyle = 0, ;
FillColor = RGB(0,0,128), ;
ZOrderSet = 18, ;
Name = "shpBar14"


ADD OBJECT shpbar15 AS shape WITH ;
Top = 55, ;
Left = 166, ;
Height = 16, ;
Width = 10, ;
BorderStyle = 0, ;
FillStyle = 0, ;
FillColor = RGB(0,0,128), ;
ZOrderSet = 19, ;
Name = "shpBar15"


ADD OBJECT shpbar16 AS shape WITH ;
Top = 55, ;
Left = 177, ;
Height = 16, ;
Width = 10, ;
BorderStyle = 0, ;
FillStyle = 0, ;
FillColor = RGB(0,0,128), ;
ZOrderSet = 20, ;
Name = "shpBar16"


ADD OBJECT shpbar17 AS shape WITH ;
Top = 55, ;
Left = 188, ;
Height = 16, ;
Width = 10, ;
BorderStyle = 0, ;
FillStyle = 0, ;
FillColor = RGB(0,0,128), ;
ZOrderSet = 21, ;
Name = "shpBar17"


ADD OBJECT shpbar18 AS shape WITH ;
Top = 55, ;
Left = 199, ;
Height = 16, ;
Width = 10, ;
BorderStyle = 0, ;
FillStyle = 0, ;
FillColor = RGB(0,0,128), ;
ZOrderSet = 22, ;
Name = "shpBar18"


ADD OBJECT shpbar19 AS shape WITH ;
Top = 55, ;
Left = 210, ;
Height = 16, ;
Width = 10, ;
BorderStyle = 0, ;
FillStyle = 0, ;
FillColor = RGB(0,0,128), ;
ZOrderSet = 23, ;
Name = "shpBar19"


ADD OBJECT shpbar20 AS shape WITH ;
Top = 55, ;
Left = 221, ;
Height = 16, ;
Width = 10, ;
BorderStyle = 0, ;
FillStyle = 0, ;
FillColor = RGB(0,0,128), ;
ZOrderSet = 24, ;
Name = "shpBar20"


ADD OBJECT shpbar21 AS shape WITH ;
Top = 55, ;
Left = 232, ;
Height = 16, ;
Width = 10, ;
BorderStyle = 0, ;
FillStyle = 0, ;
FillColor = RGB(0,0,128), ;
ZOrderSet = 25, ;
Name = "shpBar21"


ADD OBJECT shpbar22 AS shape WITH ;
Top = 55, ;
Left = 243, ;
Height = 16, ;
Width = 10, ;
BorderStyle = 0, ;
FillStyle = 0, ;
FillColor = RGB(0,0,128), ;
ZOrderSet = 26, ;
Name = "shpBar22"


ADD OBJECT shpbar23 AS shape WITH ;
Top = 55, ;
Left = 254, ;
Height = 16, ;
Width = 10, ;
BorderStyle = 0, ;
FillStyle = 0, ;
FillColor = RGB(0,0,128), ;
ZOrderSet = 27, ;
Name = "shpBar23"


ADD OBJECT shpbar24 AS shape WITH ;
Top = 55, ;
Left = 265, ;
Height = 16, ;
Width = 10, ;
BorderStyle = 0, ;
FillStyle = 0, ;
FillColor = RGB(0,0,128), ;
ZOrderSet = 28, ;
Name = "shpBar24"


ADD OBJECT shpbar25 AS shape WITH ;
Top = 55, ;
Left = 276, ;
Height = 16, ;
Width = 10, ;
BorderStyle = 0, ;
FillStyle = 0, ;
FillColor = RGB(0,0,128), ;
ZOrderSet = 29, ;
Name = "shpBar25"


ADD OBJECT lbltask AS label WITH ;
FontBold = .F., ;
Caption = "Task", ;
Left = 10, ;
Top = 30, ;
Width = 280, ;
ZOrderSet = 30, ;
Name = "lblTask"


ADD OBJECT lbltitle AS label WITH ;
FontBold = .T., ;
Caption = "Title", ;
Left = 10, ;
Top = 10, ;
Width = 280, ;
ZOrderSet = 30, ;
Name = "lblTitle"


ADD OBJECT shape3 AS shape WITH ;
Top = 3, ;
Left = 3, ;
Height = 1, ;
Width = 294, ;
SpecialEffect = 1, ;
BorderColor = RGB(128,128,128), ;
ZOrderSet = 31, ;
Name = "shape3"


ADD OBJECT shape2 AS shape WITH ;
Top = 1, ;
Left = 1, ;
Height = 1, ;
Width = 297, ;
SpecialEffect = 1, ;
BorderColor = RGB(255,255,255), ;
ZOrderSet = 32, ;
Name = "shape2"


ADD OBJECT shape4 AS shape WITH ;
Top = 105, ;
Left = 1, ;
Height = 1, ;
Width = 297, ;
BackStyle = 0, ;
SpecialEffect = 1, ;
BorderColor = RGB(255,255,255), ;
ZOrderSet = 33, ;
Name = "shape4"


ADD OBJECT shape6 AS shape WITH ;
Top = 3, ;
Left = 3, ;
Height = 101, ;
Width = 1, ;
BackStyle = 0, ;
SpecialEffect = 1, ;
BorderColor = RGB(128,128,128), ;
ZOrderSet = 34, ;
Name = "shape6"


ADD OBJECT shape5 AS shape WITH ;
Top = 1, ;
Left = 1, ;
Height = 104, ;
Width = 1, ;
BackStyle = 0, ;
SpecialEffect = 1, ;
BorderColor = RGB(255,255,255), ;
ZOrderSet = 35, ;
Name = "shape5"


ADD OBJECT shape7 AS shape WITH ;
Top = 3, ;
Left = 296, ;
Height = 191, ;
Width = 1, ;
BackStyle = 0, ;
SpecialEffect = 1, ;
BorderColor = RGB(128,128,128), ;
ZOrderSet = 36, ;
Name = "shape7"


ADD OBJECT shape8 AS shape WITH ;
Top = 1, ;
Left = 298, ;
Height = 104, ;
Width = 1, ;
BackStyle = 0, ;
SpecialEffect = 1, ;
BorderColor = RGB(255,255,255), ;
ZOrderSet = 37, ;
Name = "shape8"


ADD OBJECT shape9 AS shape WITH ;
Top = 103, ;
Left = 3, ;
Height = 1, ;
Width = 294, ;
BackStyle = 0, ;
SpecialEffect = 1, ;
BorderColor = RGB(128,128,128), ;
ZOrderSet = 38, ;
Name = "shape9"


ADD OBJECT lblescape AS label WITH ;
FontBold = .F., ;
Caption = "Press the ESC key to cancel this process.", ;
Left = 10, ;
Top = 82, ;
Width = 280, ;
ZOrderSet = 30, ;
Name = "lblEscape"


*-- Returns a reference to one of the bar used to fill the thermometer.
PROCEDURE getbar
*==============================================================================
* GetBar
* ------
*
* Purpose.......: Retrieves a reference to a bar used to fill the
* thermometer
* Author........: Daniel Rouleau - Metro Information Services
* Last Revision.: 1999-04-28
*
* Syntax........: object.GetBar( tnBarNumber )
* Returns.......: object or null
* Arguments.....: tnBarNumber
* Specifies the number of th3e bar to return. An integer
* between 1 and 25.
*
* Remarks.......: Building a control array makes more sense. However, I
* don't know how to build one from the design environment.
*==============================================================================
LParameters tnBarNumber

Local loRetVal && Object reference returned by this method.

loRetVal = .Null.

If VarType(tnBarNumber) = 'N' Then
If Between(tnBarNumber, 1, 25) Then
loRetVal = Evaluate('Thisform.shpBar' + LTrim(Str(tnBarNumber, 2, 0)))
EndIf
EndIf


Return ( loRetVal )
ENDPROC


PROCEDURE percent_assign
*==============================================================================
* Percent_Assign
* --------------
*
* Purpose.......: Updates the Percent property and fills the thermometer.
* Author........: Daniel Rouleau - Metro Information Services
* Last Revision.: 1999-04-28
*
* Remarks.......:
*==============================================================================
LParameters tnNewValue

Local lnBar && Loop counter.
Local loBar && A reference to a bar object.
Local lcCursor && The current Cursor setting.
Local lnNewBars && Number of bars to display.
Local lnNewValue && New value to set.
Local lnOldBars && Number of bars previously displayed.
Local lnOldValue && Percentage current value.
Local lnTimeToStop && Number of milliseconds to wait when the
&& thermometer reaches 100%.

*---------------
*-- Early abort
*---------------
If LastKey() = 27 Then
If This.AllowCancel Then
This.OnCancel()
Return
EndIf
EndIf


With This
lnOldValue = Max(0, Min(100, .Percent))
lnOldBars = Int(lnOldValue / 4)
lnNewValue = Max(0, Min(100, tnNewValue))
lnNewBars = Int(lnNewValue / 4)

If lnNewBars > lnOldBars Then
*------------------------------
*-- Progress
*-- --------
*-- Wait a litle bit between
*-- display of each bar.
*--
*-- If showing 100%, wait a
*-- a little afterwards.
*------------------------------

For lnBar = lnOldBars + 1 To lnNewBars
loBar = .GetBar(lnBar)
If VarType(loBar) = 'O'
loBar.FillStyle = 0
.Refresh()
lcCursor = Set('Cursor')
Set Cursor Off
=Inkey(.Interval / 1000)
Set Cursor &lcCursor
EndIf

If lnNewValue = 100 Then
lcCursor = Set('Cursor')
Set Cursor Off
=Inkey(.TimeToStop / 1000)
Set Cursor &lcCursor
EndIf
EndFor
Else
*---------------------------
*-- Regress
*-- -------
*-- 'Hide' bar immediatly.
*---------------------------
For lnBar = lnNewBars + 1 TO 25
loBar = .GetBar(lnBar)
If VarType(loBar) = 'O'
loBar.FillStyle = 1
.Refresh()

If lnBar <= lnOldBars Then
lcCursor = Set('Cursor')
Set Cursor Off
=Inkey(.Interval / 1000)
Set Cursor &lcCursor
EndIf
EndIf
EndFor
EndIf

.Percent = lnNewValue
EndWith
ENDPROC


PROCEDURE title_assign
*==============================================================================
* Title_Assign
* ------------
*
* Purpose.......: Displays the new title.
* Author........: Daniel Rouleau - Metro Information Services
* Last Revision.: 1999-04-28
*
* Remarks.......:
*==============================================================================
LParameters tcTitle

If VarType(tcTitle) = 'C' Then
With This
.Title = tcTitle
.lblTitle.Caption = tcTitle
EndWith
EndIf
ENDPROC


*-- Resets all properties.
PROCEDURE reset
*==============================================================================
* Reset
* -----
*
* Purpose.......: Resets all properties to their default values.
* Author........: Daniel Rouleau - Metro Information Services
* Last Revision.: 1999-04-28
*
* Syntax........: object.Reset( )
* Returns.......: nothing
* Arguments.....: n/a
*
* Remarks.......: Setting .Percent = 0 restores all bars.
*
* See also......: Percent_Assign( )
*==============================================================================

Local llLockScreen && Current LockScreen status.

With This
*-----------------
*-- Lock Screen.
*-----------------
llLockScreen = .LockScreen
.LockScreen = .T.

*------------------
*-- Reset values.
*------------------
.Title = ''
.Task = ''
.Percent = 0

*------------------------
*-- Restore LockScreen.
*------------------------
.LockScreen = llLockScreen
EndWith
ENDPROC


PROCEDURE task_assign
*==============================================================================
* Task_Assign
* -----------
*
* Purpose.......: Displays the new task.
* Author........: Daniel Rouleau - Metro Information Services
* Last Revision.: 1999-04-28
*
* Remarks.......:
*==============================================================================
LParameters tcTask

If VarType(tcTask) = 'C' Then
With This
.Task = tcTask
.lblTask.Caption = tcTask
EndWith
EndIf
ENDPROC


PROCEDURE oncancel
*==============================================================================
* OnCancel
* --------
*
* Purpose.......: Actions to perform if Cancel is clicked.
* Author........: Daniel Rouleau - Metro Information Services
* Last Revision.: 2000-11-15
*
* Remarks.......:
*==============================================================================

With This
.Abort = .T.
.Hide()
EndWith
ENDPROC


PROCEDURE Init
*==============================================================================
* Init
* ----
*
* Purpose.......: Sets custom properties.
* Author........: Daniel Rouleau - Metro Information Services
* Last Revision.: 1999-04-28
*
* Arguments.....: toForm
* A reference to the form to activate when the
* thermometer is released.
*
* tlAllowCancel
* Specifies whether the user is allow to cancel the
* process. Default is False.
*
* Remarks.......:
*==============================================================================
LParameters toForm, tlAllowCancel

Local lnExtraHeight && Shrink by factor if the Cancel button is removed.

With This
*-- Save a reference to the calling form.
If (VarType(toForm) = 'O') And Lower(toForm.BaseClass) = 'form' Then
.CallingForm = toForm
Else
.CallingForm = .Null.
EndIf

*-- Remove Cancel biutton unless specifically told we can cancel the process.
If VarType(tlAllowCancel) <> 'L' Or Not tlAllowCancel Then
.RemoveObject('lblEscape')
.AllowCancel = .F.

lnExtraHeight = 20
.Shape1.Height = .Shape1.Height - lnExtraHeight
.Shape5.Height = .Shape5.Height - lnExtraHeight
.Shape6.Height = .Shape6.Height - lnExtraHeight
.Shape7.Height = .Shape7.Height - lnExtraHeight
.Shape8.Height = .Shape8.Height - lnExtraHeight
.Shape4.Top = .Shape4.Top - lnExtraHeight
.Shape9.Top = .Shape9.Top - lnExtraHeight
.Height = .Height - lnExtraHeight
Else
.AllowCancel = .T.
Keyboard '{SpaceBar}' Plain Clear
EndIf

*-- Reset values.
.Reset()
EndWith


Return ( DoDefault() )
ENDPROC


PROCEDURE Destroy
*==============================================================================
* Destroy
* -------
*
* Purpose.......: Activates the calling form.
* Author........: Daniel Rouleau - Metro Information Services
* Last Revision.: 1999-04-28
*
* Remarks.......:
*==============================================================================

Local loForm && Reference to the calling form.

Set Escape Off
loForm = This.CallingForm
If VarType(loForm) = 'O' Then
loForm.Activate()
EndIf


Return ( DoDefault() )
ENDPROC


ENDDEFINE