Progressbar Value-Change-Event

  • VB.NET

Es gibt 30 Antworten in diesem Thema. Der letzte Beitrag () ist von Facebamm.

    Ich habe jetzt einfach mal ein neues einfaches Projekt gemacht, da ist das selbe Verhalten.

    Ich hab ne Progressbar, einen Button und ein NumericUpDown zum einstellen der PB.maximum
    Wenn der Wert auf 1000 steht füllt sich die PB nicht mal zur Hälfte bei 10000 schon fast bis zum Ende aber halt nicht ganz

    Hier der Code, im Anhang das Projekt

    VB.NET-Quellcode

    1. ​Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
    2. ProgressBar1.Maximum = NumericUpDown1.Value
    3. ProgressBar1.Visible = True
    4. For a As Integer = 1 To NumericUpDown1.Value
    5. ProgressBar1.Value = a ' / 100
    6. Button1.Text = ProgressBar1.Value & " / " & ProgressBar1.Maximum
    7. My.Application.DoEvents()
    8. ProgressBar1.Refresh()
    9. Next
    10. My.Application.DoEvents()
    11. ProgressBar1.Refresh()
    12. ProgressBar1.Visible = False
    13. End Sub
    Dateien
    • Progressbar.zip

      (416,34 kB, 5 mal heruntergeladen, zuletzt: )
    Ich habe selber eine Programmiert, läuft schnelle als die Normal :D

    Spoiler anzeigen

    Translate by converter.telerik.com/

    C#-Quellcode

    1. Imports System
    2. Imports System.Drawing
    3. Imports System.Windows.Forms
    4. Namespace UI
    5. Public Class Processbar
    6. Inherits Control
    7. Private Event ValueChange As Action(Of Processbar, Double)
    8. Private _textloc As Point
    9. Private _deltaValue As Double
    10. Private _processRect As Rectangle
    11. Private _text As String
    12. Private _maxValue As Double = 100
    13. Public Property MaxValue As Double
    14. Get
    15. Return _maxValue
    16. End Get
    17. Set(ByVal value As Double)
    18. If MaxValue < Value Then
    19. _maxValue = Value
    20. Else
    21. _maxValue = value
    22. End If
    23. UpdateDeltaValue()
    24. Invalidate()
    25. End Set
    26. End Property
    27. Private _minValue As Double = 0
    28. Public Property MinValue As Double
    29. Get
    30. Return _minValue
    31. End Get
    32. Set(ByVal value As Double)
    33. If MinValue > Value Then
    34. _minValue = Value
    35. Else
    36. _minValue = value
    37. End If
    38. UpdateDeltaValue()
    39. Invalidate()
    40. End Set
    41. End Property
    42. Private _Value As Double
    43. Public Property Value As Double
    44. Get
    45. Return _Value
    46. End Get
    47. Set(ByVal value As Double)
    48. If Value < MinValue Then Throw New IndexOutOfRangeException()
    49. If Value > MaxValue Then Throw New IndexOutOfRangeException()
    50. _Value = value
    51. ValueChange?.Invoke(Me, value)
    52. UpdateRect()
    53. Invalidate()
    54. End Set
    55. End Property
    56. Private _ProcessColor As Color
    57. Public Property ProcessColor As Color
    58. Get
    59. Return _ProcessColor
    60. End Get
    61. Set(ByVal value As Color)
    62. _ProcessColor = value
    63. BrushProcess = New SolidBrush(value)
    64. Invalidate()
    65. End Set
    66. End Property
    67. Private _ValueVisible As Boolean
    68. Public Property ValueVisible As Boolean
    69. Get
    70. Return _ValueVisible
    71. End Get
    72. Set(ByVal value As Boolean)
    73. _ValueVisible = value
    74. Invalidate()
    75. End Set
    76. End Property
    77. Private BrushProcess As SolidBrush
    78. Public Sub New()
    79. Dim styles As ControlStyles = ControlStyles.ResizeRedraw Or ControlStyles.SupportsTransparentBackColor Or ControlStyles.UserPaint Or ControlStyles.OptimizedDoubleBuffer
    80. SetStyle(styles, True)
    81. _maxValue = 100
    82. _minValue = 0
    83. _Value = 20
    84. ValueVisible = False
    85. End Sub
    86. Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
    87. Dim graphics As Graphics = e.Graphics
    88. If BrushProcess IsNot Nothing Then
    89. graphics.FillRectangle(BrushProcess, _processRect)
    90. If ValueVisible Then
    91. TextRenderer.DrawText(graphics, _text, Font, _textloc, ForeColor)
    92. End If
    93. End If
    94. End Sub
    95. Protected Overrides Sub OnSizeChanged(ByVal e As EventArgs)
    96. UpdateRect()
    97. End Sub
    98. Private Sub UpdateRect()
    99. Dim [step] As Double = Width / _deltaValue
    100. Dim width As Double = (Value - MinValue) * [step]
    101. Dim topcorner As Point = Point.Empty
    102. Dim progressSize As Size = New Size(CInt(width), Height)
    103. _processRect = New Rectangle(Point.Empty, progressSize)
    104. UpdateText()
    105. End Sub
    106. Private Sub UpdateDeltaValue()
    107. _deltaValue = MaxValue - MinValue
    108. UpdateText()
    109. End Sub
    110. Private Sub UpdateText()
    111. Dim textValue As Double = 100 * Value / _deltaValue
    112. _text = $"{Math.Round(textValue, 1)}%"
    113. Dim sizeText As Size = TextRenderer.MeasureText(_text, Font)
    114. Dim textX As Integer = (Width - sizeText.Width) / 2
    115. Dim textY As Integer = (Height - sizeText.Height) / 2
    116. _textloc = New Point(textX, textY)
    117. End Sub
    118. End Class
    119. End Namespace

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „Facebamm“ ()

    @Humax Mach mit jedem Klick genau einen Schritt:

    VB.NET-Quellcode

    1. Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
    2. ProgressBar1.Value += 1
    3. End Sub
    und den Rest außerhalb.
    Falls Du diesen Code kopierst, achte auf die C&P-Bremse.
    Jede einzelne Zeile Deines Programms, die Du nicht explizit getestet hast, ist falsch :!:
    Ein guter .NET-Snippetkonverter (der ist verfügbar).
    VB-Fragen über PN / Konversation werden ignoriert!

    Humax schrieb:

    Sollte das deklarieren heißen?
    Nö.
    Kompilieren.
    Danach ist das Control in der Werkzeugleiste verfügbar.
    ======
    @Facebamm OK.
    @Humax Dann mach ProgressBar1.Update().
    Falls Du diesen Code kopierst, achte auf die C&P-Bremse.
    Jede einzelne Zeile Deines Programms, die Du nicht explizit getestet hast, ist falsch :!:
    Ein guter .NET-Snippetkonverter (der ist verfügbar).
    VB-Fragen über PN / Konversation werden ignoriert!

    RodFromGermany schrieb:

    Nö.
    Kompilieren.
    Danach ist das Control in der Werkzeugleiste verfügbar.

    Das hatte nicht funktioniert, wenn ich es auf die Form ziehen wollte kam ne Fehlermeldung und das das Control wieder entfernt wird ( so hab ich das im Gedächtnis)

    VB.NET-Quellcode

    1. progressbar1.update
    muss ich morgen mal testen, ebenso so die selbst gebastelte PB von @Facebamm

    Humax schrieb:

    Das hatte nicht funktioniert
    Da haste wohl was falsch gemacht.
    Bei mir geht das immer.
    Probier noch mal und erstell Dir ein leeres Control:

    VB.NET-Quellcode

    1. Public Class MyProgressBar
    2. Inherits ProgressBar
    3. End Class

    (fast) feddich.
    Falls Du diesen Code kopierst, achte auf die C&P-Bremse.
    Jede einzelne Zeile Deines Programms, die Du nicht explizit getestet hast, ist falsch :!:
    Ein guter .NET-Snippetkonverter (der ist verfügbar).
    VB-Fragen über PN / Konversation werden ignoriert!

    RodFromGermany schrieb:

    Da haste wohl was falsch gemacht.
    Bei mir geht das immer.

    Habe es jetzt nochmals in einem neuen Projekt probiert, da funktioniert das in der Tat!

    VB.NET-Quellcode

    1. progressbar1.update()

    ändert leider auch nichts an dem verhalten, dass der Fortschrittsbalken nicht ganz angezeigt wird.
    Schreibe jetzt mal den Code von @Facebamm für VB um

    Habe jetzt mal den Code berichtet, läuft.

    VB.NET-Quellcode

    1. Imports System
    2. Imports System.Drawing
    3. Imports System.Windows.Forms
    4. Namespace UI
    5. Public Class MeineProgressbar
    6. Inherits Control
    7. Private Event ValueChange As Action(Of MeineProgressbar, Double)
    8. Private _textloc As Point
    9. Private _deltaValue As Double
    10. Private _processRect As Rectangle
    11. Private _text As String
    12. Private _maxValue As Double = 100
    13. Public Property MaxValue As Double
    14. Get
    15. Return _maxValue
    16. End Get
    17. Set(ByVal value As Double)
    18. If MaxValue < value Then
    19. _maxValue = value
    20. Else
    21. _maxValue = value
    22. End If
    23. UpdateDeltaValue()
    24. Invalidate()
    25. End Set
    26. End Property
    27. Private _minValue As Double = 0
    28. Public Property MinValue As Double
    29. Get
    30. Return _minValue
    31. End Get
    32. Set(ByVal value As Double)
    33. If MinValue > value Then
    34. _minValue = value
    35. Else
    36. _minValue = value
    37. End If
    38. UpdateDeltaValue()
    39. Invalidate()
    40. End Set
    41. End Property
    42. Private _Value As Double
    43. Public Property Value As Double
    44. Get
    45. Return _Value
    46. End Get
    47. Set(ByVal value As Double)
    48. If value < MinValue Then Throw New IndexOutOfRangeException()
    49. If value > MaxValue Then Throw New IndexOutOfRangeException()
    50. _Value = value
    51. RaiseEvent ValueChange(Me, value)
    52. UpdateRect()
    53. Invalidate()
    54. End Set
    55. End Property
    56. Private _ProcessColor As Color
    57. Public Property ProcessColor As Color
    58. Get
    59. Return _ProcessColor
    60. End Get
    61. Set(ByVal value As Color)
    62. _ProcessColor = value
    63. BrushProcess = New SolidBrush(value)
    64. Invalidate()
    65. End Set
    66. End Property
    67. Private _ValueVisible As Boolean
    68. Public Property ValueVisible As Boolean
    69. Get
    70. Return _ValueVisible
    71. End Get
    72. Set(ByVal value As Boolean)
    73. _ValueVisible = value
    74. Invalidate()
    75. End Set
    76. End Property
    77. Private BrushProcess As SolidBrush
    78. Public Sub New()
    79. Dim styles As ControlStyles = ControlStyles.ResizeRedraw Or ControlStyles.SupportsTransparentBackColor Or ControlStyles.UserPaint Or ControlStyles.OptimizedDoubleBuffer
    80. SetStyle(styles, True)
    81. _maxValue = 100
    82. _minValue = 0
    83. _Value = 20
    84. ValueVisible = False
    85. End Sub
    86. Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
    87. Dim graphics As Graphics = e.Graphics
    88. If BrushProcess IsNot Nothing Then
    89. graphics.FillRectangle(BrushProcess, _processRect)
    90. If ValueVisible Then
    91. TextRenderer.DrawText(graphics, _text, Font, _textloc, ForeColor)
    92. End If
    93. End If
    94. End Sub
    95. Protected Overrides Sub OnSizeChanged(ByVal e As EventArgs)
    96. UpdateRect()
    97. End Sub
    98. Private Sub UpdateRect()
    99. Dim [step] As Double = Me.Width / _deltaValue
    100. Dim width As Double = (Value - MinValue) * [step]
    101. Dim topcorner As Point = Point.Empty
    102. Dim progressSize As Size = New Size(CInt(Width), Height)
    103. _processRect = New Rectangle(Point.Empty, progressSize)
    104. UpdateText()
    105. End Sub
    106. Private Sub UpdateDeltaValue()
    107. _deltaValue = MaxValue - MinValue
    108. UpdateText()
    109. End Sub
    110. Private Sub UpdateText()
    111. Dim textValue As Double = 100 * Value / _deltaValue
    112. _text = $"{Math.Round(textValue, 1)}%"
    113. Dim sizeText As Size = TextRenderer.MeasureText(_text, Font)
    114. Dim textX As Integer = cint((Width - sizeText.Width) / 2)
    115. Dim textY As Integer = cint((Height - sizeText.Height) / 2)
    116. _textloc = New Point(textX, textY)
    117. End Sub
    118. End Class
    119. End Namespace


    Ja die ist wirklich schneller als die Standard-PB. Und mit den Farben aussuchen deutlich bessere Features...
    Danke

    Habe ein paar Kleinigkeiten anpassen müssen, schätze jetzt hab ich alles richtig korrigiert. Evtl. stimmt die Zeile 100 nicht ganz. (Me.width), vorher ist width nicht deklariert...

    Dieser Beitrag wurde bereits 5 mal editiert, zuletzt von „Humax“ ()

    ja, nice, sieht gut aus :D
    es geht noch schnell, aber das wäre dann OverPower dafür :D Sehr schnell Grid zeichnen ins Control

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „Facebamm“ ()