home *** CD-ROM | disk | FTP | other *** search
- Option Explicit
- '*******************************************************
- '* Integrated Data Systems, Inc. *
- '* 23875 Ventura Blvd. #102 *
- '* Calabasas, Ca 91302 *
- '* Voice: (818)223-3344 *
- '* BBS: (818)223-3341 *
- '* CIS: 73700,1622 *
- '*******************************************************
- '* *
- '* File Name: Therm.BAS *
- '* Uses Therm.FRM *
- '* *
- '* Created: 12/23/94 By: Robert Vandehey *
- '* *
- '* Comments: Displays a progress thermometer. *
- '* *
- '* InitPercent(MaxValue, Message) - Initializes control*
- '* for percent display*
- '* InitValue(Message) - Initializes control for value *
- '* display *
- '* Tick() - Moves thermometer by one tick *
- '* UpdatePercent(Percent) - Moves thermometer to this *
- '* percent. *
- '* UpdateValue(Value) - Moves thermometer to this * *
- '* value. *
- '* *
- '*******************************************************
-
- ' Variable Declarations
- Dim b_byPercent As Integer
- Dim l_MaxValue As Long
- Dim l_CurrValue As Long
-
- Sub CenterForm (ctrl_item As Form)
- ctrl_item.Left = (screen.Width - ctrl_item.Width) / 2
- ctrl_item.Top = (screen.Height - ctrl_item.Height) / 2
- End Sub
-
- Function Max (ByVal l1 As Long, ByVal l2 As Long) As Long
- Max = IIf(l1 > l2, l1, l2)
- End Function
-
- Function Min (ByVal l1 As Long, ByVal l2 As Long) As Long
- Min = IIf(l1 < l2, l1, l2)
- End Function
-
- Private Sub ShowValue ()
- If b_byPercent Then
- Thermometer!Gauge.FloodPercent = Min(100, Int(l_CurrValue / l_MaxValue * 100 + .5))
- Else
- Thermometer!Gauge.Caption = Str$(l_CurrValue)
- End If
- End Sub
-
- Sub ThermClose ()
- Unload Thermometer
- End Sub
-
- '*******************************************************
- '* *
- '* Procedure Name: InitPercent *
- '* *
- '* Created: 12/22/94 By: RDV *
- '* *
- '* Comments: Initializes control for percent display. *
- '* *
- '*******************************************************
- Sub ThermInitPercent (ByVal l_MaxTicks As Long, ByVal s_Message As String)
- Load Thermometer
- b_byPercent = True
- l_MaxValue = l_MaxTicks
- l_CurrValue = 0
- Thermometer!Gauge.FloodType = 1
- Thermometer!Gauge.FloodShowPct = True
- If Len(s_Message) > 0 Then
- Thermometer!txt_message = s_Message
- End If
- Call CenterForm(Thermometer)
- Thermometer.Show
- If l_MaxValue > 0 Then
- ShowValue
- End If
- Thermometer.Refresh
- End Sub
-
- '*******************************************************
- '* *
- '* Procedure Name: InitValue *
- '* *
- '* Created: 12/22/94 By: RDV *
- '* *
- '* Comments: Initializes control for value display. *
- '* *
- '*******************************************************
- Sub ThermInitValue (ByVal s_Message As String)
- Load Thermometer
- b_byPercent = False
- l_MaxValue = 0
- l_CurrValue = 0
- Thermometer!Gauge.FloodShowPct = False
- Thermometer!Gauge.FloodType = 0
- If Len(s_Message) > 0 Then
- Thermometer!txt_message = s_Message
- End If
- Call CenterForm(Thermometer)
- Thermometer.Show
- ShowValue
- Thermometer.Refresh
- End Sub
-
- '*******************************************************
- '* *
- '* Procedure Name: Tick *
- '* *
- '* Created: 12/22/94 By: RDV *
- '* *
- '* Comments: Moves thermometer by one tick *
- '* *
- '*******************************************************
- Sub ThermTick ()
- l_CurrValue = l_CurrValue + 1
- ShowValue
- End Sub
-
- '*******************************************************
- '* *
- '* Procedure Name: UpdatePercent *
- '* *
- '* Created: 12/22/94 By: RDV *
- '* *
- '* Comments: Moves thermometer to this percent *
- '* *
- '*******************************************************
- Sub ThermUpdatePercent (ByVal i_percent As Integer)
- l_CurrValue = Int(l_MaxValue * i_percent / 100)
- ShowValue
- End Sub
-
- '*******************************************************
- '* *
- '* Procedure Name: UpdateValue *
- '* *
- '* Created: 12/22/94 By: RDV *
- '* *
- '* Comments: Moves thermometer to this value. *
- '* This is used when the total to process *
- '* isn't known. *
- '* *
- '*******************************************************
- Sub ThermUpdateValue (ByVal l_value As Long)
- l_CurrValue = l_value
- ShowValue
- End Sub
-
-