Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0468: Picturebox als Progressbar

VB 5/6-Tipp 0468: Picturebox als Progressbar

 von Pochtl

Schwierigkeitsgrad:

Verwendete API-Aufrufe: RtlMoveMemory (CopyMemory)

Download: Download des Beispielprojektes [3,08 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------ Anfang Projektdatei picturebox-progressbar.vbp ------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Bildfeld-Steuerelement "PicProgress"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Textfeld "Text2"
' Steuerelement: Textfeld "Text1"
' Steuerelement: Beschriftungsfeld "Label2"
' Steuerelement: Beschriftungsfeld "Label1"

Option Explicit

Private Sub Command1_Click()
   Dim i As Long
   
   Dim Min As Long
   Dim Max As Long
   
   Min = Val(Text1)
   Max = Val(Text2)
   
   For i = Min To Max
       ShowProgress PicProgress, i, Min, Max
       DoEvents
   Next
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'--------- Anfang Modul "Module1" alias Module1.bas ---------

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias _
        "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal _
        ByteLen As Long)

Public Function ShowProgress(PicProgress As PictureBox, _
  ByVal Value As Long, ByVal Min As Long, ByVal Max As Long, _
  Optional ByVal bShowProzent As Boolean = True)
    
    Dim pWidth As Long
    Dim intProz As Integer
    Dim strProz As String
    Dim Farblong As Long
    Dim cRGB(0 To 3) As Byte
    Dim Grauwert As Long
    
    ' Farben
    Const progBackColor = &HC00000
    
    ' Plausibilitätsprüfungen
    If Value < Min Then Value = Min
    If Value > Max Then Value = Max
    
    ' Prozentwert ausrechnen
    If Max > 0 Then
        intProz = Int(Value / Max * 100 + 0.5)
    Else
        intProz = 100
    End If
    
    With PicProgress
        ' Prüfen, ob AutoReadraw=True
        If .AutoRedraw = False Then .AutoRedraw = True
        
        ' Inhalt löschen
        PicProgress.Cls
        
        If Value > 0 Then
            
            ' Balkenbreite
            pWidth = .ScaleWidth / 100 * intProz
            
            ' Balken anzeigen
            PicProgress.Line (0, 0)-(pWidth, .ScaleHeight), _
              progBackColor, BF
            
            ' Prozentanzeige
            If bShowProzent Then
                strProz = CStr(intProz) & " %"
                .CurrentX = (.ScaleWidth - .TextWidth(strProz)) / 2
                .CurrentY = (.ScaleHeight - .TextHeight(strProz)) / 2
                
                ' Vordergrundfarbe
                Farblong = PicProgress.Point(.CurrentX, .CurrentY)
                
                ' in RGB Werte splitten
                Call CopyMemory(cRGB(0), Farblong, 4)
                
                ' den Graustufenwert nach Gewichtung für Monitore berechnen
                Grauwert = (0.3 * cRGB(0)) + (0.59 * cRGB(1)) + (0.11 * cRGB(2))
                .ForeColor = IIf(Grauwert > 127, vbBlack, vbWhite)
                
                PicProgress.Print strProz
            End If
        End If
    End With
End Function


'---------- Ende Modul "Module1" alias Module1.bas ----------
'------- Ende Projektdatei picturebox-progressbar.vbp -------

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 2 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.