Alex:
Below is the preformatted class code. Note that the sample usage code (no longer included) is the only place where you will find the SELECT and ALIAS key words; the thermometer class code does
not contain any "data" commands (SELECT, SCAN, ALIAS, RECNO, etc). Please refer to the my previous post for sample usage code.
Daniel
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 clicked the Cancel button.
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
