WaitBar - ProgressBar einmal anders Eine etwas andere ProgressBar, bei der man keine Min- und Max-Werte benötigt.
Autor:   Dieter Otter	Bewertung:     [ Jetzt bewerten ]	Views:  29.468
www.tools4vb.de	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 33 Bewertung insgesamt: gut Durchschnittliche Bewertung: 3.9 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Immer wenn eine Aktion etwas länger dauert, z.B. Programmstart, Datenbank-Rechereche, ListBoxen füllen usw., sollte man den Anwender irgendwie "ablenken". Meist nimmt man hierfür eine ProgressBar, die den aktuellen Fortschritt anzeigt.

Das klappt auch immer dann, wenn im Vornherein feststeht, wie lange die Aktion dauert bzw. wenn man im Vornherein die Min- und Max-Eigenschaften entsprechend kennt und über die Value-Eigenschaft dann den Fortschritt aktualisiert.

Was aber, wenn man nicht weiß, wie lange die Aktion dauert oder wenn man den Fortschritt nicht "berechnen" kann?

Beispiel:
Beim Starten der Anwendung soll ein kleiner Fortschrittsbalken eingeblendet werden. Folgende 3 Schritte werden beim Programmstart ausgeführt:

1. globale Variablen definieren
2. Datenbank öffnen
3. Mainform laden

Public Sub Main()
  Load frmStatus
  frmStatus.ProgressBar1.Max = 3
 
  ' Globale Variablen deklarieren
  frmStatus.ProgressBar1.Value = 1
  ...
 
  ' Datenbank öffnen
  frmStatus.ProgressBar1.Value = 2
  ...
 
  ' MainForm laden und anzeigen
  frmStatus.ProgressBar1.Value = 3
  Load frmMain
  frmMain.Show 
 
  Unload frmStatus
End Sub

Sind auf der Mainform viele Controls enthalten, dauert der Ladevorgang entsprechend lange, was dem Anwender über die ProgressBar aber nicht mitgeteilt werden kann

In diesem Fall würde sich eine WaitBar vielleicht besser machen, d.h. statt einen echten Fortschritt zeigt man einen Balken an, der sich von links nach rechts bewegt und wieder zurück - solange, bis die einzelnen Aktionen abgeschlossen sind.

Nachfolgender Tipp stellt Ihnen eine universelle WaitBar zur Verfügung. Sie brauchen hierfür lediglich eine Form mit einer PictureBox als Container-Control. Mehr nicht

Bei dem Balken, der im Container-Control (PictureBox) von links nach rechts "läuft", handelt es sich um ein ganz normales "Label"-Control, das zur Laufzeit erstellt wird und sich autom. der Größe der PictureBox (Höhe) anpasst. Damit sich der Balken auch bewegen kann, brauchen wir einen Timer. Hierfür verwenden wir nicht das Timer-Control von VB, sondern den API-Timer. Aus diesem Grund muss der Code auch in ein Modul:

Option Explicit
 
' Benötigte API's für die Timer-Steuerung
Private Declare Function SetTimer Lib "user32" ( _
  ByVal hWnd As Long, _
  ByVal nIDEvent As Long, _
  ByVal uElapse As Long, _
  ByVal lpTimer As Long) As Long
 
Private Declare Function KillTimer Lib "user32" ( _
  ByVal hWnd As Long, _
  ByVal nIDEvent As Long) As Long
 
Private Const MY_NID = 88
 
' Legt fest, in welchen Schritten der 
' Balken bewegt werden soll
Private Const nStep = 3
 
Private m_lblControl As Control

' WaitBar erstellen
Public Sub InitWaitBar(oForm As Form, _
  picContainer As Control, _
  Optional ByVal nBackColor As OLE_COLOR = &HFFC0C0)  
 
  ' Label-Control nur erstellen, falls 
  ' nicht schon erstellt.
  Dim bExists As Boolean
  Dim oControl As Control
 
  For Each oControl In oForm.Controls
    If oControl.Name = "lblWaitBar" Then  
      Set m_lblControl = oControl
      bExists = True: Exit For
    End If
  Next 
 
  ' ScaleMode auf Pixel setzen
  picContainer.ScaleMode = vbPixels
 
  If Not bExists Then  
    ' Label erstellen
    Set m_lblControl = oForm.Controls.Add("VB.Label", _
      "lblWaitBar", picContainer)
  End If
 
  m_lblControl.Caption = ""
  m_lblControl.BackColor = nBackColor
End Sub

' WaitBar starten
Public Sub ShowWaitBar(ByVal hWnd As Long, _
  Optional ByVal nInterval = 15)
 
  Dim nResult As Long
 
  If Not m_lblControl Is Nothing Then
    With m_lblControl
      ' Label zunächst ganz nach links setzen
      .Move -.Width, 0, .Width, .Container.ScaleHeight
      .Visible = True
 
      ' Timer starten
      nResult = SetTimer(hWnd, MY_NID, nInterval, _
        AddressOf WaitBar_TimerEvent)
    End With
  End If
End Sub

' Timer-Event!
Private Sub WaitBar_TimerEvent( _
  ByVal hwnd As Long, _
  ByVal uMsg As Long, _
  ByVal idEvent As Long, _
  ByVal dwTime As Long)
 
  Dim nLeft As Single
 
  With m_lblControl
    ' aktuelle Position
    nLeft = .Left
 
    If .Tag <> "back" Then
      ' Vorwärts! (nach rechts bewegen)
      nLeft = .Left + nStep
      If nLeft + .Width > .Container.ScaleWidth Then
        .Tag = "back"
        nLeft = .Container.ScaleWidth - .Width
      End If
    Else
      ' Rückwärts! (nach links bewegen)
      nLeft = .Left - nStep
      If nLeft < 0 Then .Tag = "": nLeft = 0
    End If
 
    ' Label positionieren
    .Left = nLeft
  End With
End Sub

' WaitBar stoppen
Public Sub StopWaitBar(ByVal hWnd As Long)
  ' Timer stoppen
  KillTimer hWnd, MY_NID
 
  ' Label wieder unsichtbar machen
  If Not m_lblControl Is Nothing Then
    m_lblControl.Visible = False
  End If
End Sub

Beispiel:
Platzieren Sie auf eine Form eine PictureBox und nennen diese picWaitBar. Fügen Sie der Form noch zwei Command-Buttons hinzu (cmdStart und cmdStop).

Private Sub Form_Load()
  ' WaitBar initialisieren
  InitWaitBar Me, picWaitBar
End Sub

Private Sub cmdStart_Click()
  ' WaitBar starten
  ShowWaitBar Me.hWnd, 25
End Sub

Private Sub cmdStop_Click()
  ' WaitBar ausblenden
  StopWaitBar Me.hWnd
End Sub