GFProgressBar2/GFProgressBarcls.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = ‑1 'True
END
Attribute VB_Name = "GFProgressBarcls"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'(c)2001‑2003 by Louis. Behaves like GFProgressBar, but better and without bugs.
'
'NOTE (29.12.2002): added  ‑ (BlockWidth / 2!) somewhere in the code so that
'it is verified that the progress bar does also draw the last block at
'a percentage of e.g. 99.999.
'
'GFProgressBar2Struct
Private Type GFProgressBar2Struct
    ProgressBarPicture As PictureBox
    DrawnBlockNumberOld As Integer
End Type
Dim GFProgressBar2StructVar As GFProgressBar2Struct

Public Sub Define(ByRef ProgressBarPicturePassed As PictureBox)
    'on error resume next 'call at program start up
    Set GFProgressBar2StructVar.ProgressBarPicture = ProgressBarPicturePassed
    GFProgressBar2StructVar.ProgressBarPicture.AutoRedraw = True
    GFProgressBar2StructVar.ProgressBarPicture.ForeColor = &H8000000D 'marking
    GFProgressBar2StructVar.ProgressBarPicture.BackColor = &H8000000F 'control item ("Schaltflaeche")
End Sub

Public Sub Refresh(ByVal ProgressPercentage As Single)
    'on error resume next 'v1.3, if drawn 'forwards' then no blocks will be deleted (maybe some bugs in it)
    Dim ProgressBarPictureWidth As Single 'scale width minus border space
    Dim ProgressBarGapFactor As Single 'blockwidth * gapfactor = gap width
    Dim BlockWidth As Single
    Dim BlockNumber As Integer
    Dim BlockDrawnNumber As Integer 'number of blocks that have been drawn since last call of this sub
    Dim BlockDrawNumber As Integer 'number of blocks to draw
    Dim BlockLoop As Integer
    'verify
    '
    'NOTE: the following line is important to avoid crashes if progress bar not initialized.
    If GFProgressBar2StructVar.ProgressBarPicture Is Nothing Then Exit Sub 'verify (might be important, tested)
    '
    Select Case ProgressPercentage
    Case Is < 0
        ProgressPercentage = 0
    Case Is > 100
        ProgressPercentage = 100
    End Select
    'preset
    ProgressBarPictureWidth = GFProgressBar2StructVar.ProgressBarPicture.ScaleWidth ‑ 2 * Screen.TwipsPerPixelX
    'begin
    'NOTE: GFProgressBar2StructVar.ProgressBarPicture.ScaleWidth Mod BlockWidth must be 0.
    BlockNumber = Int(ProgressBarPictureWidth / (GFProgressBar2StructVar.ProgressBarPicture.ScaleHeight ‑ 2 * Screen.TwipsPerPixelY))
    If BlockNumber = 0 Then Exit Sub 'verify (important if not (correctly) initialized, tested)
    Do
        BlockLoop = BlockLoop + 1
        BlockWidth = (ProgressBarPictureWidth / BlockNumber)
        If (ProgressBarPictureWidth Mod BlockWidth) = 0 Then
            Exit Do
        Else
            BlockNumber = BlockNumber + 1
            If BlockLoop > 7 Then 'prime number
                Exit Do
            End If
        End If
    Loop
    BlockLoop = 0 'reset
    ProgressBarGapFactor = 0.15! 'preset
    Do
        BlockLoop = BlockLoop + 1
        ProgressBarGapFactor = ProgressBarGapFactor + 0.025!
        If ((BlockWidth * ProgressBarGapFactor * 10000!) Mod 10000!) = 0 Then
            Exit Do
        Else
            If BlockLoop > 7 Then 'prime number
                Exit Do
            End If
        End If
    Loop
    BlockDrawNumber = 0 'reset
    For BlockLoop = 1 To BlockNumber 'always loop through all blocks
        If (CSng(BlockLoop) * BlockWidth ‑ (BlockWidth / 2!)) > (ProgressBarPictureWidth * (ProgressPercentage / 100!)) Then
            'delete block
        Else
            'draw block
            BlockDrawNumber = BlockDrawNumber + 1
        End If
    Next BlockLoop
    BlockDrawnNumber = GFProgressBar2StructVar.DrawnBlockNumberOld
    If Not (BlockDrawNumber = BlockDrawnNumber) Then
        'number of blocks to draw has changed since last drawing
        For BlockLoop = 1 To BlockNumber 'always loop through all blocks
            If (CSng(BlockLoop) * BlockWidth ‑ (BlockWidth / 2!)) > (ProgressBarPictureWidth * (ProgressPercentage / 100!)) Then
                'delete block
                If Not (BlockLoop > BlockDrawnNumber) Then 'erase already drawn blocks only
                    If GFProgressBar2StructVar.ProgressBarPicture.Picture.Handle = 0 Then
                        GFProgressBar2StructVar.ProgressBarPicture.Line ( _
                        Screen.TwipsPerPixelX + CSng(BlockLoop ‑ 1) * BlockWidth, Screen.TwipsPerPixelY)‑( _
                        Screen.TwipsPerPixelX + CSng(BlockLoop ‑ 0) * BlockWidth ‑ (BlockWidth * ProgressBarGapFactor), GFProgressBar2StructVar.ProgressBarPicture.ScaleHeight ‑ 2 * Screen.TwipsPerPixelY), _
                        GFProgressBar2StructVar.ProgressBarPicture.BackColor, BF
                    Else
                        Call GFProgressBar2StructVar.ProgressBarPicture.PaintPicture( _
                            GFProgressBar2StructVar.ProgressBarPicture.Picture, _
                            Screen.TwipsPerPixelX + CSng(BlockLoop ‑ 1) * BlockWidth, _
                            Screen.TwipsPerPixelY, BlockWidth, _
                            GFProgressBar2StructVar.ProgressBarPicture.ScaleHeight ‑ 2 * Screen.TwipsPerPixelY, _
                            Screen.TwipsPerPixelX + CSng(BlockLoop ‑ 1) * BlockWidth, _
                            Screen.TwipsPerPixelY, BlockWidth, _
                            GFProgressBar2StructVar.ProgressBarPicture.ScaleHeight ‑ 2 * Screen.TwipsPerPixelY)
                    End If
                End If
            Else
                'draw block
                GFProgressBar2StructVar.ProgressBarPicture.Line ( _
                    Screen.TwipsPerPixelX + CSng(BlockLoop ‑ 1) * BlockWidth, Screen.TwipsPerPixelY)‑ _
                    (Screen.TwipsPerPixelX + CSng(BlockLoop ‑ 0) * BlockWidth ‑ (BlockWidth * ProgressBarGapFactor), GFProgressBar2StructVar.ProgressBarPicture.ScaleHeight ‑ 2 * Screen.TwipsPerPixelY), GFProgressBar2StructVar.ProgressBarPicture.ForeColor, BF
            End If
        Next BlockLoop
        GFProgressBar2StructVar.ProgressBarPicture.Refresh 'important
        GFProgressBar2StructVar.DrawnBlockNumberOld = BlockDrawNumber
    End If
    Exit Sub
End Sub


[END OF FILE]