UtterAccess HomeUtterAccess Wiki

Welcome Guest ( Log In | Register )

Custom Search
Edit Discussion
> Progress Meter    

Attached is an mdb in 2000 format demonstrating a progress meter which utilizes a class wrapper. Use the class properties and methods to initialize, show, update and format the meter as desired. The Class can be used as is (with the two accompanying forms), or as an example of the benefits and usage of a class object to manage a progress bar.

The progress bar in this example was provided by Stuart McCall. The code which drives the progress meter is his, and has been modified only slightly for this demonstration. The original cannot be located on the internet.

The demonstration file (Access 2000 format) is here:
Media:ClsProgress_Demo.zip

A snapshot of the progress bar in process:
Image:ProgDemoSS.jpg


Usage Example:

CODE
Public Function ProgressDemo()
 Dim prg As clsProgress
 Dim i As Integer
 
 Set prg = New clsProgress
 
 prg.Init 100, "Progress Demo", "Demonstrating..."
 prg.Show
 
 'demo 1
 For i = 1 To 100
   prg.SecondaryText = "Demonstrating " & i & " of " & prg.Total
   Sleep 50
   prg.Update
 Next i
 
 'demo 2
 prg.Clear
 prg.FloodColor = vbRed
 prg.BarTextColor = vbBlue
 For i = 1 To 100
   prg.SecondaryText = "Demonstrating #2: " & i & " of " & prg.Total
   Sleep 50
   prg.Update
 Next i
 
 Set prg = Nothing
 
End Function

The Class Module:

CODE
Option Compare Database
Option Explicit


'Constants to reference the progress form and
'it's objects/properties.
Const PRG_HOSTFORM = "frmProgress"  'Name of the mainform
Const PRG_METER_CONTROL = "ctlMeter"  'Name of the subform control
Const PRG_TXT_PRIMARY_LABEL = "lblPrimaryText"  'Name of the first text label
Const PRG_TXT_SECONDARY_LABEL = "lblSecondaryText"  'Name of the second text label

'property variables
Private m_Total As Long               'RW
Private m_PrimaryText As String       'RW
Private m_SecondaryText As String     'RW
Private m_FloodColor As Long          'RW
Private m_BarText As String           'RW
Private m_BarTextColor As Long        'RW

'private variables (not exposed)
Private frm As Access.Form  'the main form
Private meter As Object 'the subform (form, not control)

'not exposed, used to set the text on the primary or secondary control
Private Enum TextType
 Primary = 0
 Secondary = 1
End Enum


'========================
Public Sub Init( _
   TotalCount As Long, _
   Optional PrimaryTxt As String = "", _
   Optional SecondaryTxt As String = "", _
   Optional FloodColorCode As Long = 4259584, _
   Optional BarTxt As String = "", _
   Optional BarTxtColor As Long = 0 _
   )

 'init the objects
 DoCmd.OpenForm PRG_HOSTFORM, acNormal, , , , acHidden
 Set frm = Forms(PRG_HOSTFORM)
 Set meter = frm.Controls(PRG_METER_CONTROL).Form

 'init the properties
 PrimaryText = PrimaryTxt
 SecondaryText = SecondaryTxt
 FloodColor = FloodColorCode
 Total = TotalCount
 BarText = BarTxt
 BarTextColor = BarTxtColor

End Sub
 
Public Sub Show()
 frm.Visible = True
 frm.Repaint
End Sub

Public Sub Clear()
 meter.Clear
 Total = Total 'forces a reset of the meter counts
End Sub

Public Sub Update()
 meter.Update
End Sub

Private Sub UpdateText(tt As TextType, text As String)
 Dim sControl As String
 
 If tt = Primary Then
   sControl = PRG_TXT_PRIMARY_LABEL
 Else
   sControl = PRG_TXT_SECONDARY_LABEL
 End If
 
 frm.Controls(sControl).Caption = text
 frm.Repaint
End Sub

Private Sub UpdateFloodColor(l As Long)
 meter.FloodColor = l
 frm.Repaint
End Sub

Private Sub UpdateMaxCount(l As Long)
 meter.MaxCount = l
End Sub

Private Sub UpdateBarText(s As String)
 meter.text = s
 meter.Repaint
End Sub

Private Sub UpdateBarTextColor(l As Long)
 meter.TextColor = l
 meter.Repaint
End Sub

'=============================

Public Property Get BarTextColor() As Long
 BarTextColor = m_BarTextColor
End Property
Public Property Let BarTextColor(l As Long)
 m_BarTextColor = l
 UpdateBarTextColor l
End Property

Public Property Get BarText() As String
 BarText = m_BarText
End Property
Public Property Let BarText(s As String)
 m_BarText = s
 UpdateBarText s
End Property

Public Property Get FloodColor() As Long
 FloodColor = m_FloodColor
End Property
Public Property Let FloodColor(l As Long)
 m_FloodColor = l
 UpdateFloodColor l
End Property

Public Property Get PrimaryText() As String
 PrimaryText = m_PrimaryText
End Property
Public Property Let PrimaryText(s As String)
 m_PrimaryText = s
 UpdateText Primary, s
End Property

Public Property Get SecondaryText() As String
 SecondaryText = m_SecondaryText
End Property
Public Property Let SecondaryText(s As String)
 m_SecondaryText = s
 UpdateText Secondary, s
End Property

Public Property Get Total() As Long
 Total = m_Total
End Property
Public Property Let Total(l As Long)
 m_Total = l
 UpdateMaxCount l
End Property




Private Sub Class_Initialize()
 '
End Sub

Private Sub Class_Terminate()
 Set meter = Nothing
 Set frm = Nothing
 If pfIsFormOpen(PRG_HOSTFORM) Then DoCmd.Close acForm, PRG_HOSTFORM, acSaveNo
End Sub


Private Function pfIsFormOpen(sFormName As String) As Boolean
 On Error Resume Next
 Dim x
 x = Forms(sFormName).Caption
 pfIsFormOpen = Not CBool(Err.Number)
End Function


Creative Commons License
Progress Meter by UtterAccess Wiki is licensed under a Creative Commons Attribution-ShareAlike 3.0 Unported License.
Editing and revision of the content is freely encouraged; for details, see Expected Usage.

Edit Discussion
Custom Search
Thank you for your support!
This page has been accessed 6,818 times.  This page was last modified 12:45, 7 April 2013 by Glenn Lloyd. Contributions by Jack Leach  Disclaimers