访问进度指示器

程序员文章站 2024-02-05 20:43:40

...

访问 简介中的 进度指示器

Access有一个坏习惯，即束缚其处理，不提供有关它是否崩溃的线索（操作系统和工具只是表明该应用程序已

不响应 ，与应用程序真正崩溃时看到的相同消息）。从某种程度上可以理解，不幸的结果是，许多用户认为它没有崩溃就崩溃了。不幸的是，他们对此的反应通常是无论如何都会强行崩溃，然后重新开始。这可能是一个很大的问题，除了事实是这是导致数据库损坏的最可靠方法之外，它还可能由于代码不经常被设计为可自我恢复而引发问题（IE。如果代码由A，B和C块组成，则有必要按顺序依次运行这些块；如果A运行，则B无法运行，从而导致该过程再次开始，则块A将再次运行。该代码从未被设计为在块B运行之前支持A运行两次。顺便说一句，Access（DAO和ADODB）确实支持事务处理-（ BeginTrans，CommitTrans，Rollback Methods ，但是许多数据库在其设计中并未包含此功能）。 建议的解决方案

让我先介绍一下

状态栏中的进度指示器 。 Application.SysCmd()提供了该功能。我无意在此处对此进行任何进一步的详细说明，但“帮助”系统将对感兴趣的任何人进行完整描述。

我打算讨论的替代概念使用非模式形式。我在此处包括该设计的图像以说明基本概念。这是比基本要求更复杂的版本，但是随着时间的推移，我添加了有用的复杂性，并且由于它们已经可用，因此我认为它们也可能会包含在内。

访问进度指示器

想法是在运行代码的开头显示该表格，并预先传递主要步骤的描述，并在每个步骤完成时调用以更新显示。当控制权最终返回给操作员时，允许表单在预定时间段内保持可见状态（默认为两秒钟），但随后将其关闭。操作员可以根据需要选择在该最终延迟时间内清除该标题。此处包括一个实时运行时的图像（这是在完成全部任务之后）。

访问进度指示器

为了避免表单丢失的问题，例如，当操作员在应用程序上的其他位置单击时，将计时器例程设置为每1/4秒重新选择一次表单。这样可以确保操作员永远不会因任何原因而惊慌并使应用程序崩溃。

实作

请注意，顶部标签下方的列表中显示了许多控件，显示

请稍候...每行包含两个控件：一个用于指示状态（未开始；正在运行；已完成；已隐藏（在这种情况下将不运行）），另一个仅用于显示每个任务的标题。总共有25行，每行由lblTick nn和lblLabel nn组成，其中nn反映从00开始的两位数字行号（lblTick00，lblLabel00，lblTick01，...，lblTick24，lblLabel24）。

在显示表单之前，所有不必要的行都会被隐藏起来，因此它的大小只能满足当前任务的需要。

表单本身的代码包含在这里：

Option Compare Database
Option Explicit
'The frmProgress form is designed to stay visible for about 2" after it expires.
'However, the operator can cancel the delay if he clicks on the form's title.
'11/5/2006  Allows ten entries.
'15/5/2006  Resize form to handle only the number of entries required.
'           This cannot work as the form size itself never changes on screen.
'18/08/2008 Tried again using Access 2003 
Private Const conMaxStep As Integer = 24    'Steps = conMaxSteps + 1 (From 0)
Private Const conDelSecs As Integer = 2     'Default delay in secs
Private Const conProgSep As String = "~"    'Separator character within strMsgs
Private Const conCross As Long = &HFB       'Wingdings cross
Private Const conTick As Long = &HFC        'Wingdings tick
Private Const conCM As Long = &H238         'Centimeter 
'intPeriod 1/4"s counted after completion; intDelay 1/4"s to count;
'intLastStep is the last step used on the form
Private intPeriod As Integer, intDelay As Integer, intLastStep As Integer
Private lblTicks(0 To conMaxStep) As Label, lblSteps(0 To conMaxStep) As Label 
Private Sub Form_Open(Cancel As Integer)
    Dim strStep As String
    Dim ctlThis As Control 
    'Assign all labels to the arrays.  Ignore any failures.
    On Error Resume Next
    For Each ctlThis In Controls
        strStep = Right(ctlThis.Name, 2)
        Select Case Left(ctlThis.Name, 7)
        Case "lblTick"
            Set lblTicks(CInt(strStep)) = ctlThis
        Case "lblStep"
            Set lblSteps(CInt(strStep)) = ctlThis
        End Select
    Next ctlThis
    On Error GoTo 0
End Sub 
'intStep = 0            Reset all and set up captions
'intStep = Positive     Operate on relevant (intStep-1) line of the display
'intStep = Negative     Close Progress form after processing -intStep 
'  intState = 0         Not started yet - visible / dim
'  intState = 1         In progress     - visible / bold
'  intState = 2         Completed       - visible / ticked
'  intState = 3         Hidden          - visible / dim / crossed
'  intState = 4         In progress for intStep - Completed for previous step
'  intState = 5         In progress for intStep - Hidden for previous step
Public Sub SetStep(ByVal intStep As Integer, _
                   Optional ByVal intState As Integer = -1, _
                   Optional ByRef strMsgs As String = "", _
                   Optional ByVal intDelSecs As Integer = -1, _
                   Optional ByVal dblCM As Double = 0)
    Dim intIdx As Integer, intTop As Integer
    Dim lngSize As Long
    Dim blnClose As Boolean 
    'Cancel any pending close (see Timer code)
    intPeriod = 0
    'Default intDelSecs if not set
    If intDelSecs = -1 Then intDelSecs = conDelSecs
    'Default intState depending on intStep
    If intState = -1 Then
        Select Case intStep
        Case 0              'Open - Default = 1 In progress
            intState = 1
        Case Is > 0         'Change step - Default = 4 Complete & In progress
            intState = 4
        Case Is < 0         'Close - Default = 2 Complete
            intState = 2
        End Select
    End If
    Select Case Abs(intStep)
    Case 0      'Reset all and set up captions
        intDelay = intDelSecs * 4 + Sgn(intDelSecs)
        'find number of elements in strMsgs
        intTop = UBound(Split(strMsgs, conProgSep))
        If intTop > conMaxStep Then intTop = conMaxStep
        For intIdx = 0 To conMaxStep
            If intIdx > intTop Then
                lblTicks(intIdx).Visible = False
                lblSteps(intIdx).Visible = False
            Else
                lblSteps(intIdx).Visible = True
                lblSteps(intIdx).Caption = Split(strMsgs, conProgSep)(intIdx)
                Call SetState(intStep:=intIdx, _
                              intState:=IIf(intIdx = 0, intState, 0))
            End If
        Next intIdx
        'Resize form depending on # of lines used and lngWidth passed
        With Me
            If intTop < conMaxStep Then
                lngSize = (conMaxStep - intTop) * conCM / 2
                .boxInner.Height = .boxInner.Height - lngSize
                .boxOuter.Height = .boxOuter.Height - lngSize
                .InsideHeight = .InsideHeight - lngSize
                'Following line depends on Access 2003
                Call .Move(Left:=.WindowLeft, Top:=.WindowTop + lngSize / 2)
            End If
            If dblCM > 0 Then
                lngSize = dblCM * conCM
                .lblTitle.Width = .lblTitle.Width - lngSize
                .boxInner.Width = .boxInner.Width - lngSize
                .boxOuter.Width = .boxOuter.Width - lngSize
                .InsideWidth = .InsideWidth - lngSize
                For intTop = intTop To 0 Step -1
                    lblSteps(intTop).Width = lblSteps(intTop).Width - lngSize
                Next intTop
                'Following line depends on Access 2003
                Call .Move(Left:=.WindowLeft + lngSize / 2)
            End If
        End With
    Case 1 To conMaxStep + 1
        Call SetState(Abs(intStep) - 1, intState)
    End Select
    If intStep < 0 Then     'Close Progress form
        If intDelay = 0 Then Call CloseMe
        'Otherwise start timer
        intPeriod = 1
    End If
    'Update the screen
    DoEvents
End Sub 
Private Sub SetState(intStep As Integer, intState As Integer)
    lblTicks(intStep).Caption = Chr(conTick)
    lblSteps(intStep).FontBold = False
    Select Case intState
    Case 0          'Not started yet (dim)
        lblTicks(intStep).Visible = False
        lblSteps(intStep).ForeColor = vbBlue
    Case 1, 4, 5    'In progress (bold)
        lblTicks(intStep).Visible = False
        lblSteps(intStep).ForeColor = vbRed
        lblSteps(intStep).FontBold = True
        If intState > 3 And intStep > 0 Then _
            Call SetState(intStep:=intStep - 1, intState:=intState - 2)
    Case 2      'Completed (Tick)
        lblTicks(intStep).Visible = True
        lblSteps(intStep).ForeColor = vbRed
    Case 3      'Hidden (dim / cross)
        lblTicks(intStep).Caption = Chr(conCross)
        lblTicks(intStep).Visible = True
        lblSteps(intStep).ForeColor = vbBlue
    End Select
    'Always bring frmProgress to front when updating
    Call DoCmd.SelectObject(ObjectType:=acForm, ObjectName:=Me.Name)
    'Update the screen
    DoEvents
End Sub 
Private Sub lblTitle_Click()
    If intPeriod > 0 Then Call CloseMe
End Sub 
Private Sub Form_Timer()
    Select Case intPeriod
    Case 0
        Exit Sub
    Case Is < intDelay
        intPeriod = intPeriod + 1
        Call DoCmd.SelectObject(ObjectType:=acForm, ObjectName:=Me.Name)
    Case Else
        Call CloseMe
    End Select
End Sub 
Private Sub CloseMe()
    Call DoCmd.Close(ObjectType:=acForm, ObjectName:=Me.Name)
End Sub

使用说明

使用此代码的最基本的要求很简单，但是确实为包含许多任务的复杂流程提供了灵活性。

范例程式码

这是附加的示例数据库中使用的代码：

Option Compare Database
Option Explicit 
Private frmProg As Form_frmProgress 
Private Sub Form_Open(Cancel As Integer)
    Call DoCmd.Restore
    If DBWindowVisible() Then
        Call DoCmd.SelectObject(ObjectType:=acForm, InDatabaseWindow:=True)
        Call DoCmd.RunCommand(Command:=acCmdWindowHide)
    End If
End Sub 
Private Sub cmdTest_Click()
    Dim strMsgs As String
    Dim datStart As Date 
    strMsgs = "Task taking 5 seconds~" & _
              "This task takes just 1 second~" & _
              "This task is skipped~" & _
              "This task takes 20 seconds"
    Set frmProg = New Form_frmProgress
    Call frmProg.SetStep(intStep:=0, strMsgs:=strMsgs)
    datStart = Now()
    Do
        DoEvents
    Loop While Now() < (datStart + (5 / 86400))
    Call frmProg.SetStep(intStep:=2)
    datStart = Now()
    Do
        DoEvents
    Loop While Now() < (datStart + (1 / 86400))
    Call frmProg.SetStep(intStep:=3, intState:=4)
    Call frmProg.SetStep(intStep:=4, intState:=5)
    datStart = Now()
    Do
        DoEvents
    Loop While Now() < (datStart + (20 / 86400))
    Call frmProg.SetStep(intStep:=-4)
End Sub 
Private Sub cmdExit_Click()
    Call DoCmd.Close
End Sub 
Private Sub Form_Close()
    'Method must exist in order for container to handle event.
    If Not DBWindowVisible() Then _
        Call DoCmd.SelectObject(ObjectType:=acForm, InDatabaseWindow:=True)
End Sub