Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Thisform Gotchas! Wow!
Message
 
 
To
07/12/2000 15:12:32
General information
Forum:
Visual FoxPro
Category:
Forms & Form designer
Miscellaneous
Thread ID:
00450216
Message ID:
00450563
Views:
37
>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, this is better, I hope, though the code so long is still hard to read.
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
If it's not broken, fix it until it is.


My Blog
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform