Tipp 0179 ProgressBar ohne Control
Autor/Einsender:
Datum:
  Klaus Hahnas
29.12.2001
Entwicklungsumgebung:   VB 6
Für die Verwirklichung einer ProgressBar (Fortschrittbalken) steht in Visual Basic ein Steuerelement zur Verfügung. Wer dieses nicht benutzen möchte oder kann, z.B. für Installationen, kann dies auch mit VB-Code verwirklichen. Wie dies geht zeigt dieser Tipp.
Code im Codebereich der Form Form1
 
Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal _
      dwMilliseconds As Long)

Private Sub Command1_Click()
  Dim n As Long
  Const blau = &HC00000

  With frmUpdate
    .Caption = "Progressbar ohne Control"
    .gSubVisiblePicture vbWhite, blau, False
    .lblHinweis = "Installation läuft...bitte warten!"
    .Show
  End With

  Me.Hide

  For n = 1 To 100
    frmUpdate.gSubUpdateStatus n
    DoEvents
    Sleep 40
  Next n

  frmUpdate.lblHinweis = "Installation erfolgreich durchgeführt!"
  DoEvents

  For n = 1 To 4
    frmUpdate.lblHinweis = "Anwendung wird in " & 5 - (n + 1) & _
          " Sekunden beendet...bitte warten!"
    Sleep 1000
    DoEvents
  Next n

  Unload frmUpdate
  End
End Sub
 
Code im Codebereich der Form frmUpdate
 
Option Explicit

Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC _
        As Long, ByVal x As Long, ByVal y As Long, ByVal _
        nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC _
        As Long, ByVal xSrc As Long, ByVal ySrc As Long, _
        ByVal dwRop As Long) As Long

Private Sub Form_Load()
  lblHinweis = ""
  DoEvents
End Sub

Public Sub gSubVisiblePicture(ByVal lngBackColor As Long, ByVal _
        lngForeColor As Long, ByVal lngFontBold As Boolean)
  With Picture1
    .AutoRedraw = True
    .FontBold = lngFontBold
    .BackColor = lngBackColor
    .ForeColor = lngForeColor
    .DrawMode = 10
    .FillStyle = 0
    .ScaleWidth = 100
  End With
End Sub

Public Sub gSubUpdateStatus(ByVal lngProzent As Long)
  Dim Result As Long, strTxt As String
  Const SRCCOPY = &HCC0020

  With Picture1
    If lngProzent > .ScaleWidth Then
        lngProzent = .ScaleWidth
    End If

    strTxt = Format$(CLng((lngProzent / .ScaleWidth) * 100)) + "%"
    .Cls
    .CurrentX = (.ScaleWidth - .TextWidth(strTxt)) \ 2
    .CurrentY = (.ScaleHeight - .TextHeight(strTxt)) \ 2
    Picture1.Print strTxt
    Picture1.Line (0, 0)-(lngProzent, .ScaleHeight), .ForeColor, BF
    Result = BitBlt(.hDC, 0, 0, .ScaleWidth, .ScaleHeight, _
          .hDC, 0, 0, SRCCOPY)
  End With

  DoEvents
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, _
        UnloadMode As Integer)
  If UnloadMode = 0 Then Cancel = 1: Exit Sub
End Sub
 
Weitere Links zum Thema
Fortschrittsanzeige als Tortengrafik

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (4,7 kB) Downloads bisher: [ 4084 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Samstag, 24. September 2011