VB.NET 中的气质进度条

Question

如果有人有任何其他解决方案来实现此目的，我将非常有兴趣听取他们的意见。

我正在尝试为学校项目创建密码检查程序，但我的进度条出现问题。基本上，当密码强度高（因此意味着分数更高）时，进度条工作得很好，但当密码强度不强时，进度条不会更改为所需的颜色或显示值。

这是我的代码：

Public Class PassCheck

Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer,
                                                                ByVal wMsg As Integer, ByVal wParam As Integer,
                                                                ByVal IParam As Integer) As Integer

Dim Checked As Boolean
Dim Password As String
Dim PasswordLength As Integer
Dim PasswordStrength As String
Dim Score As Integer
Dim ProgBarVal As Double
Dim LengthScore As Integer
Dim NumberScore As Integer
Dim CapsScore As Integer
Dim LowerScore As Integer
Dim SymbolScore As Integer

Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
    hidepasswordOption.Checked = True
    textboxPassword.PasswordChar = "*"
End Sub

Private Sub hidepasswordOption_Click(sender As Object, e As EventArgs) Handles hidepasswordOption.Click
    hidepasswordOption.Checked = Not hidepasswordOption.Checked
    If textboxPassword.PasswordChar = "*" Then
        textboxPassword.PasswordChar = ""
    Else
        textboxPassword.PasswordChar = "*"
    End If
End Sub

Private Sub buttonCheck_Click(sender As Object, e As EventArgs) Handles buttonCheck.Click
    Score = 0
    NumberScore = 0
    SymbolScore = 0
    LowerScore = 0
    CapsScore = 0

    Password = textboxPassword.Text

    If String.IsNullOrEmpty(Password) Then
        MsgBox("You must enter a password!", 16, "Error!")
        Exit Sub
    End If

    Checked = True

    Check_Password()

    progressbarStrength.Value = 0
    progressbarStrength.Maximum = 20
    progressbarStrength.Minimum = 0
    labelScoreText.Text = Score & "/20"
    progressbarStrength.Value = Score

    Progbar_calc()

    labelStrengthText.Text = PasswordStrength

End Sub


Public Sub Progbar_calc()

    If Score <= 10 Then
        PasswordStrength = "Weak"
        SendMessage(progressbarStrength.Handle, 1040, 2, 0)
    ElseIf Score <= 15 Then
        PasswordStrength = "Medium"
        SendMessage(progressbarStrength.Handle, 1040, 3, 0)
    ElseIf Score <= 20 Then
        PasswordStrength = "Strong"
        SendMessage(progressbarStrength.Handle, 1040, 1, 0)
    End If
End Sub

Public Sub Check_Password()
    Password = textboxPassword.Text
    PasswordLength = Len(Password)
    ImprovePass.Password = textboxPassword.Text

    Dim array() As Char = Password.ToCharArray()
    For i = 0 To array.Length - 1
        If Char.IsUpper(array(i)) Then
            If CapsScore >= 3 Then
            Else
                CapsScore = CapsScore + 1
            End If
        ElseIf Char.IsLower(array(i)) Then
            If LowerScore >= 3 Then
            Else
                LowerScore = LowerScore + 1
            End If
        ElseIf Char.IsNumber(array(i)) Then
            If NumberScore >= 3 Then
            Else
                NumberScore += 1
            End If
        ElseIf Char.IsSymbol(array(i)) Then
            If SymbolScore >= 3 Then
            Else
                SymbolScore += 1
            End If
        End If
    Next

    Score += CapsScore
    Score += LowerScore
    Score += NumberScore
    Score += SymbolScore

    If PasswordLength >= 8 Then
        Score += 8
    Else
        Score += PasswordLength
    End If

    If CapsScore = 0 Then
        ImprovePass.listboxImprove.Items.Add("You should include some capital letters.")
        ImprovePass.listboxImprove.Items.Add("-------------------------------------")
    ElseIf CapsScore = 1 Then
        ImprovePass.listboxImprove.Items.Add("You have included 1 capital letter,")
        ImprovePass.listboxImprove.Items.Add("You should include some more capital letters.")
        ImprovePass.listboxImprove.Items.Add("-------------------------------------")
    ElseIf CapsScore >= 2 Then
        ImprovePass.listboxImprove.Items.Add("You have included 2 or more capital letters!")
        ImprovePass.listboxImprove.Items.Add("-------------------------------------")
    End If
    If LowerScore = 0 Then
        ImprovePass.listboxImprove.Items.Add("You should include some lower case letters.")
        ImprovePass.listboxImprove.Items.Add("-------------------------------------")
    ElseIf LowerScore = 1
        ImprovePass.listboxImprove.Items.Add("You have included 1 lower case letter,")
        ImprovePass.listboxImprove.Items.Add("You should include some more lowercase letters.")
        ImprovePass.listboxImprove.Items.Add("-------------------------------------")
    ElseIf LowerScore >= 2 Then
        ImprovePass.listboxImprove.Items.Add("You have included 2 or more lower case letters!")
        ImprovePass.listboxImprove.Items.Add("-------------------------------------")
    End If
    If NumberScore = 0 Then
        ImprovePass.listboxImprove.Items.Add("You should include some numbers.")
        ImprovePass.listboxImprove.Items.Add("-------------------------------------")
    ElseIf NumberScore = 1 Then
        ImprovePass.listboxImprove.Items.Add("You have included 1 number,")
        ImprovePass.listboxImprove.Items.Add("You should include some more numbers.")
        ImprovePass.listboxImprove.Items.Add("-------------------------------------")
    ElseIf NumberScore >= 2 Then
        ImprovePass.listboxImprove.Items.Add("You have included 2 or more numbers!")
        ImprovePass.listboxImprove.Items.Add("-------------------------------------")
    End If
    If SymbolScore = 0 Then
        ImprovePass.listboxImprove.Items.Add("You should include some symbols.")
        ImprovePass.listboxImprove.Items.Add("-------------------------------------")
    ElseIf SymbolScore = 1 Then
        ImprovePass.listboxImprove.Items.Add("You have included 1 symbol,")
        ImprovePass.listboxImprove.Items.Add("You should include some more symbols.")
        ImprovePass.listboxImprove.Items.Add("-------------------------------------")
    ElseIf SymbolScore >= 2 Then
        ImprovePass.listboxImprove.Items.Add("You have included 2 or more symbols!")
        ImprovePass.listboxImprove.Items.Add("-------------------------------------")
    End If
    If PasswordLength <= 6 Then
        ImprovePass.listboxImprove.Items.Add("You have only included" & Space(1) & PasswordLength & Space(1) & "characters,")
        ImprovePass.listboxImprove.Items.Add("You should include at least 3 more to make your password more secure!")
        ImprovePass.listboxImprove.Items.Add("-------------------------------------")
    ElseIf PasswordLength <= 8 Then
        ImprovePass.listboxImprove.Items.Add("You have only included" & Space(1) & PasswordLength & Space(1) & "characters,")
        ImprovePass.listboxImprove.Items.Add("You should include at least 4 more to make your password more secure!")
        ImprovePass.listboxImprove.Items.Add("-------------------------------------")
    ElseIf PasswordLength >= 11 Then
        ImprovePass.listboxImprove.Items.Add("You have included 11 or more characters!")
        ImprovePass.listboxImprove.Items.Add("-------------------------------------")
    End If

    'MsgBox("Upper: " & CapsScore & "Lower: " & LowerScore & "Number: " & NumberScore & "Symbol: " & SymbolScore)

End Sub


Private Sub improvePassMenu_Click(sender As Object, e As EventArgs) Handles improvePassMenu.Click
    ImprovePass.Show()
    If textboxPassword.PasswordChar = "*" Then
        ImprovePass.labelPassText.Text = "(Hidden)"
    Else
        ImprovePass.labelPassText.Text = Password
    End If
End Sub

Private Sub textboxPassword_TextChanged(sender As Object, e As EventArgs) Handles textboxPassword.TextChanged
    Score = 0
    NumberScore = 0
    SymbolScore = 0
    LowerScore = 0
    CapsScore = 0
    Password = textboxPassword.Text
    PasswordLength = Len(Password)

    Select Case PasswordLength
        Case < 6
            buttonCheck.Enabled = False
            labelScoreText.Text = "Too Short"
            labelStrengthText.Text = "Too Short"
        Case > 12
            buttonCheck.Enabled = False
            labelScoreText.Text = "Too Long"
            labelStrengthText.Text = "Too Long"
        Case Else
            buttonCheck.Enabled = True
            labelScoreText.Text = ""
            labelStrengthText.Text = ""
    End Select

End Sub
End Class

强度大时进度条有效：

进度条仅在程序打开后第一次（或可能第二次）检查时在介质上起作用：

当它不是第一个（或可能是第二个）时检查它不起作用：

进度条仅在程序打开后第一次（或可能第二次）检查时才有效：

当它不是第一个（或可能是第二个）时检查它不起作用：

无论您输入多少密码，我都需要它每次都能正常工作。

知道为什么它可能不起作用吗？谢谢，

Answer 1

If anyone has any other solutions...

该控件不应该以这种方式使用。它对我来说似乎工作正常，但我不知道你在失败之前使用的是什么值。

使用 PictureBox 的简单矩形仪表：

'form level variables:
Private pValue As Double
Private pColor1 As Color

然后你评价分数的时候（我用的是轨迹条）：

    pValue = track1.Value / 20

    Select Case track1.Value
        Case Is <= 10
            pColor1 = Color.Red           
        Case Is <= 15
            pColor1 = Color.Yellow     
        Case Else
            pColor1 = Color.LimeGreen 
    End Select
    ' pb2 is the picturebox
    pb2.Invalidate()

然后在绘画事件中：

If pValue = 0 Then Exit Sub

Dim rect = New Rectangle(0, 0,
                        Convert.ToInt32(pb2.Width * pValue),
                        pb2.Height)
' single color version
Using br As New SolidBrush(pColor1)
    e.Graphics.FillRectangle(br, rect)
End Using

它有点不稳定，因为填充的前半部分总是红色，大约 25% 是黄色或绿色（但我没有单独调整缩放比例）。

对于渐变 - 你的老师不会认为你想出了这个 - 你需要做一些小的改变。变量：

Private pColor1 As Color
Private pColor2 As Color
Private pValue As Double

评价：

pValue = track1.Value / 20
Select Case track1.Value
    Case Is <= 10
        pColor1 = Color.Red
        pColor2 = Color.MistyRose

    Case Is <= 15
        pColor1 = Color.Red
        pColor2 = Color.Yellow

    Case Else
        pColor1 = Color.Yellow
        pColor2 = Color.LimeGreen

End Select
pb2.Invalidate()

pColor1为渐变起始颜色，pcolor2为结束颜色。和他们一起玩，看看什么看起来最好。绘画事件：

If pValue = 0 Then Exit Sub

Dim rect = New Rectangle(0, 0,
                        Convert.ToInt32(pb2.Width * pValue),
                        pb2.Height)

Using br As New LinearGradientBrush(rect, pColor1, pColor2, LinearGradientMode.Horizontal)
    e.Graphics.FillRectangle(br, rect)
End Using

结果：

在我的上，我还有一个结果的文本指示器。 50% 的时间仍然是 Red/WEAK，而不是 33%。如果您愿意，可以轻松扩展。

VB.NET 中的气质进度条

Temperamental progressbar in VB.NET

vb.net

progress-bar