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