 |
 |
 | |
 | |
 | |
 |
|
|
| |
| |
| |
|
Last updated: before December, 1998
The following script and class is an reusable progress bar. It is called by script and will divide you data to progress into 10 parts. Run the Sub
CreatePBar to make the screen objects on a form. Include the Class "Progress" in your Global declarations. Look at the sample On Click Script at end to see usage example.
Jerry Sikes
'-----Progress Bar Class
'-----Jerry Sikes 2.18.98
'Install Class in Global Declarations
Class Progress
Public ProgressName As String
Public pb(10) As display
Public sb(3) As display
Private maxValue As Long
Private js As Integer
Private Sub CheckMax
If maxValue = 0 Then Error 999
End Sub
Sub Value(v)
CheckMax
Select Case v
Case Is > maxValue * 0.9
pb(10).visible = True
Case Is > maxValue * 0.8
pb(9).visible = True
Case Is > maxValue *0.7
pb(8).visible = True
Case Is > maxValue * 0.6
pb(7).visible = True
Case Is > maxValue * 0.5
pb(6).visible = True
Case Is > maxValue * 0.4
pb(5).visible = True
Case Is > maxvalue * 0.3
pb(4).visible = True
Case Is > maxValue * 0.2
pb(3).visible = True
Case Is > maxValue * 0.1
pb(2).visible = True
Case Else
pb(1).visible = True
End Select
End Sub
Sub Max(m)
maxValue = m
End Sub
Sub reset
For js% = 1 To 10
pb(js%).visible = False
Next
End Sub
Sub ReplaceText(t)
sb(3).text = t
End Sub
Sub New
Set pb(1) = currentview.body.Pbar1
Set pb(2) = currentview.body.Pbar11
Set pb(3) = currentview.body.Pbar12
Set pb(4) = currentview.body.Pbar13
Set pb(5) = currentview.body.Pbar14
Set pb(6) = currentview.body.Pbar15
Set pb(7) = currentview.body.Pbar16
Set pb(8) = currentview.body.Pbar17
Set pb(9) = currentview.body.Pbar18
Set pb(10) = currentview.body.Pbar19
Set sb(1) = currentview.body.Sbar
Set sb(2) = currentview.body.Sbar2
Set sb(3) = currentview.body.SText1
For js% = 1 To 3
sb(js%).visible = True
Next
sb(3).text = "Loading..."
End Sub
Sub delete
For js% = 1 To 10
pb(js%).visible = False
Next
For js% = 1 To 3
sb(js%).visible = False
Next
End Sub
End Class
Sub CreatePbar
'-----Progress Bar Objects
'-----Jerry Sikes 2.18.98
'-----Install As Global Sub
'-----Run From Script Editor to create objects on
'-----each desired form
'-----I usually group these items after creation to
'-----place where I want it to appear.
Dim MyRect(12) As rectangle
Dim MyText As textbox
Dim pb(13) As display
For i% = 1 To 12
Set MyRect(i%) = New Rectangle(currentview.body)
Set pb(i%) = MyRect(i%)
Next
Set MyText = New Textbox(currentview.body)
Set pb(13) = MyText
With pb(11)
.name = "SBar"
.height = 810
.width = 2250
.left = 4590
.top = 3420
.visible = False
.NamedStyle = "Default"
.BackGround.Color.SetRGB(COLOR_25_GRAY)
.border.pattern = $LtsBorderPatternRaised
End With
With pb(13)
.name = "SText1"
.height = 420
.width = 1110
.left = 4680
.top = 3510
.visible = False
.text = "Loading..."
.border.left = False
.border.right = False
.border.top = False
.border.bottom = False
.BackGround.Color.SetRGB(COLOR_25_GRAY)
End With
With pb(12)
.name = "SBar2"
.height = 360
.width = 2070
.left = 4680
.top = 3780
.visible = False
End With
With pb(1)
.name = "PBar1"
.height = 180
.width = 90
.left = 4860
.top = 3870
.visible = False
.BackGround.Color.SetRGB(COLOR_BLUE)
.border.pattern = $LtsBorderPatternSolid
.Border.Color.SetRGB(COLOR_BLUE)
End With
With pb(2)
.name ="PBar11"
.height = 180
.width = 90
.left = 5040
.top = 3870
.visible = False
.BackGround.Color.SetRGB(COLOR_BLUE)
.border.pattern = $LtsBorderPatternSolid
.Border.Color.SetRGB(COLOR_BLUE)
End With
With pb(3)
.name ="PBar12"
.height = 180
.width = 90
.left = 5220
.top = 3870
.visible = False
.BackGround.Color.SetRGB(COLOR_BLUE)
.border.pattern = $LtsBorderPatternSolid
.Border.Color.SetRGB(COLOR_BLUE)
End With
With pb(4)
.name = "PBar13"
.height = 180
.width = 90
.left = 5400
.top = 3870
.visible = False
.BackGround.Color.SetRGB(COLOR_BLUE)
.border.pattern = $LtsBorderPatternSolid
.Border.Color.SetRGB(COLOR_BLUE)
End With
With pb(5)
.name = "PBar14"
.height = 180
.width = 90
.left = 5580
.top = 3870
.visible = False
.BackGround.Color.SetRGB(COLOR_BLUE)
.border.pattern = $LtsBorderPatternSolid
.Border.Color.SetRGB(COLOR_BLUE)
End With
With pb(6)
.name = "PBar15"
.height = 180
.width = 90
.left = 5760
.top = 3870
.visible = False
.BackGround.Color.SetRGB(COLOR_BLUE)
.border.pattern = $LtsBorderPatternSolid
.Border.Color.SetRGB(COLOR_BLUE)
End With
With pb(7)
.name = "PBar16"
.height = 180
.width = 90
.left = 5940
.top = 3870
.visible = False
.BackGround.Color.SetRGB(COLOR_BLUE)
.border.pattern = $LtsBorderPatternSolid
.Border.Color.SetRGB(COLOR_BLUE)
End With
With pb(8)
.name = "PBar17"
.height = 180
.width = 90
.left = 6120
.top = 3870
.visible = False
.BackGround.Color.SetRGB(COLOR_BLUE)
.border.pattern = $LtsBorderPatternSolid
.Border.Color.SetRGB(COLOR_BLUE)
End With
With pb(9)
.name = "PBar18"
.height = 180
.width = 90
.left = 6300
.top = 3870
.visible = False
.BackGround.Color.SetRGB(COLOR_BLUE)
.border.pattern = $LtsBorderPatternSolid
.Border.Color.SetRGB(COLOR_BLUE)
End With
With pb(10)
.name = "PBar19"
.height = 180
.width = 90
.left = 6480
.top = 3870
.visible = False
.BackGround.Color.SetRGB(COLOR_BLUE)
.border.pattern = $LtsBorderPatternSolid
.Border.Color.SetRGB(COLOR_BLUE)
End With
pb(12).SendToBack
pb(13).SendToBack
pb(11).SendToBack
End Sub
Usage Sample:
Sub Click(Source As Button, X As Long, Y As Long, Flags As Long)
Dim LocalRS as New ResultSet
Dim IsJob List As Long
Dim b As New progress
CurrentWindow.Repaint
Set LocalRS =CurrentDocument.Tables(0).CreateResultSet()
localrs.lastrow
Call b.max (LocalRs.CurrentRow)
localrs.firstrow
Call b.ReplaceText("Loading Jobs...")
Do
Call b.value(LocalRs.CurrentRow)
IsJob(LocalRs.GetValue(1)) = LocalRs.CurrentRow
Loop While LocalRs.NextRow
localrs.firstrow
Call b.reset
CurrentWindow.Repaint
'The sub could continue with reuse of the Progress bar
End Sub