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

它有点不稳定，因为填充的第一个HALF总是红色，黄色或绿色约为25％（但我只留下你的缩放）。

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

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％，而不是33％的时间。如果你愿意，可以轻松扩展。

VB.NET中的态度进度条

1 个答案: