I'm trying to make a messagebox pop up when "Trade-in Value" >= "Price." If I enter Trade-in Value:2000 and Price:12,000. The messagebox comes up, when clearly that should not be happening. After testing a bunch of numbers, it seems like the form doesn't like the number "2" in either text box. The second block is where I have my code that does not work.
I am fairly new to coding and this is my first post, taker easy boy/girls.
Entered numbers/Form
Message Box error
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
GBTradeIn.Enabled = False
TxtTradeIn.Enabled = False
RBStandard.Checked = True
RBExcellent.Checked = True
End Sub
Private Sub CBTradeIn_CheckedChanged(sender As Object, e As EventArgs) Handles CBTradeIn.CheckedChanged
GBTradeIn.Enabled = True
TxtTradeIn.Enabled = True
If CBTradeIn.Checked = (False) Then
GBTradeIn.Enabled = False
TxtTradeIn.Enabled = False
RBExcellent.Checked = True
TxtTradeIn.Text = ""
End If
End Sub
Private Sub BtnCalculate_Click(sender As Object, e As EventArgs) Handles BtnCalculate.Click
Try
If CBTradeIn.Checked = (False) Then
TxtTradeIn.Text = 0
End If
If RBExcellent.Checked Then
TxtTradeInAllowance.Text = FormatCurrency(TxtTradeIn.Text * 1)
ElseIf RBGood.Checked Then
TxtTradeInAllowance.Text = FormatCurrency(TxtTradeIn.Text * 0.9)
ElseIf RBFair.Checked Then
TxtTradeInAllowance.Text = FormatCurrency(TxtTradeIn.Text * 0.8)
ElseIf RBPoor.Checked Then
TxtTradeInAllowance.Text = FormatCurrency(TxtTradeIn.Text * 0.7)
End If
Catch
MessageBox.Show("Enter valid Trade-In value")
End Try
Dim Exterior As Decimal
Dim Accessories As Decimal
If CBPremiumStereo.Checked And CBLeatherInterior.Checked And CBGPS.Checked Then
Accessories = 3154.4
ElseIf CBPremiumStereo.Checked And CBLeatherInterior.Checked Then
Accessories = 1413.17
ElseIf CBPremiumStereo.Checked And CBGPS.Checked Then
Accessories = 2166.99
ElseIf CBGPS.Checked And CBLeatherInterior.Checked Then
Accessories = 2728.64
ElseIf CBPremiumStereo.Checked Then
Accessories = 425.76
ElseIf CBLeatherInterior.Checked Then
Accessories = 987.41
ElseIf CBGPS.Checked Then
Accessories = 1741.23
End If
If RBStandard.Checked = True Then
Exterior = 0
ElseIf RBPearlized.Checked = True Then
Exterior = 345.72
ElseIf RBCustom.Checked = True Then
Exterior = 599.99
End If
TxtAccessoriesAndFinish.Text = FormatCurrency(Accessories + Exterior)
Try
Dim total As Decimal
Dim TradeIn As Decimal
Dim AccessoriesandExterior As Decimal
Dim Subtotal As Decimal
total = TxtPrice.Text
TradeIn = TxtTradeInAllowance.Text
AccessoriesandExterior = TxtAccessoriesAndFinish.Text
TxtSubtotal.Text = FormatCurrency(total + AccessoriesandExterior - TradeIn)
Subtotal = TxtSubtotal.Text
TxtSalesTax.Text = FormatCurrency((Subtotal + TradeIn) * 0.08)
TxtAmountDue.Text = FormatCurrency(Subtotal + TxtSalesTax.Text)
Catch
TxtAccessoriesAndFinish.Text = ""
TxtAmountDue.Text = ""
TxtTradeIn.Text = ""
TxtSubtotal.Text = ""
TxtSalesTax.Text = ""
TxtPrice.Text = ""
TxtTradeInAllowance.Text = ""
MessageBox.Show("Enter a valid price")
End Try
>
If TxtTradeIn.Text >= TxtPrice.Text Then
TxtAccessoriesAndFinish.Text = ""
TxtAmountDue.Text = ""
TxtTradeIn.Text = ""
TxtSubtotal.Text = ""
TxtSalesTax.Text = ""
TxtPrice.Text = ""
TxtTradeInAllowance.Text = ""
MessageBox.Show("Trade in value can't be higher than or equal to price")
End If
If CBTradeIn.Checked = (False) Then
TxtTradeIn.Text = ""
End If
End Sub
>
Private Sub BtnClear_Click(sender As Object, e As EventArgs) Handles BtnClear.Click
TxtAccessoriesAndFinish.Text = ""
TxtAmountDue.Text = ""
TxtTradeIn.Text = ""
TxtSubtotal.Text = ""
TxtSalesTax.Text = ""
TxtPrice.Text = ""
RBStandard.Checked = True
RBExcellent.Checked = True
CBPremiumStereo.Checked = False
CBLeatherInterior.Checked = False
CBGPS.Checked = False
CBTradeIn.Checked = False
TxtTradeInAllowance.Text = ""
End Sub
End Class
Instead of
If TxtTradeIn.Text >= TxtPrice.Text Then
use
If CDec(TxtTradeIn.Text) >= CDec(TxtPrice.Text) Then
CDec() converts the text inside the brackets to a decimal, allowing you to do numerical comparison rather than string comparison.
However, you must be careful: CDec() will return an error if you try to convert a non decimal to a decimal, such as a string, so you will have to check that the user has entered a valid decimal in the textboxes
Related
Public Class Form1
Dim area As Integer
Dim gauge As String
Dim cost As Decimal
Dim Length, Width, Depth, CostNo As Decimal
Dim CostNa, combo As String
Dim ErrorFlag As Boolean
Dim D1 As String
Private Sub Area2_Click(sender As Object, e As EventArgs) Handles Area2.Click
Length = txtLength.Text
Width = txtWidth.Text
Depth = txtDepth.Text
CostNo = CostumerNo.Text
CostNa = CostumerName.Text
ErrorFlag = ErrorLook(Width, Length, Depth)
If ErrorFlag = False Then
MsgBox("Invalid")
Reset()
txtDepth.Text = ""
txtLength.Text = ""
txtWidth.Text = ""
CostumerName.Text = ""
CostumerNo.Text = ""
Result.Text = ""
output.Text = ""
A2.Text = ""
G1.Text = ""
C1.Text = ""
ElseIf ErrorFlag = True Then
MsgBox("u Good")
End If
Length = L(Width)
Width = W(Length)
A2.Text = a(Width, Length)
G1.Text = g(gauge)
C1.Text = c(cost)
FileOpen(1, "Info1.txt", OpenMode.Append)
PrintLine(1, Result.Text & " " & CostumerName.Text & " " & CostumerNo.Text & " " & A2.Text & " " & G1.Text & " " & C1.Text)
FileClose(1)
FileOpen(1, "Info1.Text", OpenMode.Input)
While Not EOF(1)
Result.Text = LineInput(1)
End While
End Sub
Function combo1() As String
End Function
Const Cost1 As Decimal = 1.12
Const Cost2 As Decimal = 1.76
Public Function c(ByVal cost As Decimal) As String
If G1.Text = "Gauge1" Then
Return A2.Text * Cost1
Else
Return A2.Text * Cost2
End If
End Function
Public Function g(ByVal gauge As String) As String
If A2.Text <= 100 Then
Return "Gauge1"
Else
Return "Gauge2"
End If
End Function
'sets the boundaries for the input values
Public Function ErrorLook(ByVal w As Decimal, ByVal l As Decimal, ByVal d As Decimal) As Boolean
If l < 1 Or l > 10 Then
Return False
Else
Return True
End If
If w < 1 Or w > 10 Then
Return False
Else
Return True
End If
If d < 1 Or d > 10 Then
Return False
Else
Return True
End If
End Function
'calculates the width
Public Function L(ByVal W As Decimal) As Decimal
Width = txtWidth.Text + (2 * txtDepth.Text)
Return Width
End Function
'calculates the length
Public Function W(ByVal L As Decimal) As Decimal
Length = txtLength.Text + (2 * txtDepth.Text)
Return Length
End Function
'calculates the area
Public Function a(ByVal w As Decimal, ByVal l As Decimal) As Decimal
Dim area2 As Decimal
area2 = w * l
Return area2
End Function
'displays the date and time of the system it is eing run from
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
lbTime.Text = Now()
End Sub
'the clear button for clearing all of the fields
Private Sub CA_Click(sender As Object, e As EventArgs) Handles CA.Click
Reset()
txtDepth.Text = ""
txtLength.Text = ""
txtWidth.Text = ""
CostumerName.Text = ""
CostumerNo.Text = ""
Result.Text = ""
A2.Text = ""
G1.Text = ""
C1.Text = ""
End Sub
End Class
Look at the 'ErrorLook' function. The first thing it does is a boolean test where it will return true or false. Why have you got "If w < 1" e.t.c or "If d < 1" e.t.c, it will never get to them..... I could go on.....
You're obtaining strings into decimals without checking... You're doing calculations on strings without knowing if they are numbers...
Think what it is you are trying to do. First thing, stop using VB6 code and try and understand the logic, maybe you need to start from scratch.
Basically I generate a random word for example
"Tree" and when I press the T button it changes the label into a T but then when I choose R it doesnt show, can someone else see what i've done wrong?
here is my code
Sub GuessLetter(ByVal LetterGuess As String)
Dim strGuessedSoFar As String = Lbltempword.Text
Dim LengthOfSecretWord As Integer
LengthOfSecretWord = secret.Length - 1
tempWord = ""
Dim letterPosition As Integer
For letterPosition = 0 To LengthOfSecretWord
If secret.Substring(letterPosition, 1) = LetterGuess Then
tempWord = tempWord & LetterGuess
Else
tempWord = tempWord & Lbltempword.Text.Substring(letterPosition, 1)
End If
Next
Lbltempword.Text = tempWord
If Lbltempword.Text = secret Then 'YOU WIN
DisableButtons()
BtnStart.Enabled = True
MsgBox("YOU WIN")
End If
If Lbltempword.Text = strGuessedSoFar Then
NumWrong = NumWrong + 1
End If
DisplayHangman(NumWrong)
End Sub
Private Sub btnStart_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnStart.Click
randomword()
MsgBox(secret)
EnableButtons()
BtnStart.Enabled = False
'Load up the temp word label with dashes
Secret_Word = secret
LoadLabelDisplay()
NumWrong = 0
DisplayHangman(NumWrong)
End Sub
Sub LoadLabelDisplay()
Lbltempword.Text = ""
Dim LengthOfSecretWord As Integer
LengthOfSecretWord = secret.Length - 1
Dim LetterPosition As Integer
For LetterPosition = 0 To LengthOfSecretWord
Lbltempword.Text = Lbltempword.Text & "-"
Next
End Sub
I also generate the random words by doing this.
Sub randomword()
Dim RAND(16)
Dim rng As New System.Random()
For i = 0 To 16
RAND(0) = "Tree"
RAND(1) = "Star"
RAND(2) = "Jesus"
RAND(3) = "Present"
RAND(4) = "advent"
RAND(5) = "Calender"
RAND(6) = "Jinglebell"
RAND(7) = "skint"
RAND(8) = "lapland"
RAND(9) = "Santa"
RAND(10) = "raindeer"
RAND(11) = "Cookies"
RAND(12) = "Milk"
RAND(13) = "nothing"
RAND(14) = "play"
RAND(15) = "sack"
Next
secret = RAND(rng.Next(RAND.Count()))
End Sub
Hello I am currently making an hangman game where you guess a randomly selected word and you have three rounds. Each time you win a round you gain 10 points, however if you don't guess the word before you run out of the 10 generous attempts. You will lose the round not gain anything.
After you win you three games of hangman, you are shown a new input text box in a high score form to input your name to save your high score to be displayed on the high score form and it has validation in (Meaning the user is required have at least one character inside the text box). This is where my main problem is, my input box will save your name and your points if you pass validation first time. However if you didn't pass validation first time but pass it the second time, your name is saved however your high score will be saved but only with one point. Sorry for my bad English, but is there anyway to keep the amount of points the user scores even if they failed validation first time instead of changing it to 1 point? Here is my code (Sorry for the bad indention):
Hangman Game Code (This is where the user gets their points from)
Imports System.IO
Public Class Hangman
'Public Variables
Public AttemptsLeft As Integer = 0
Public Rounds As Integer = 1
Public LetterChosen As Char
Dim EndWord() As Char
Dim AppPath As String = Application.StartupPath()
Dim FileRead() As String
Public GameWinner As Boolean = True
Dim HangmanShapes As New List(Of PowerPacks.Shape)
Public ScoreForRound As Integer
Dim NewControls As New List(Of Button)
Dim GameWord As New List(Of Label)
'Form Load code
Private Sub Hangman_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'Load Word Game Code
If File.Exists(AppPath & "/wordlist.txt") Then
FileRead = IO.File.ReadAllLines(AppPath & "/wordlist.txt")
Dim RandomWord As New List(Of String)
For i = 0 To FileRead.Length - 1
RandomWord.Add(FileRead(i))
Next
Dim random As New Random() 'Using this to randomise each word
EndWord = RandomWord(random.Next(0, RandomWord.Count - 1)).ToUpper.ToCharArray 'Will put each character of the randomly chosen word into the labels.
Score.Text = UScore
Round.Text = Rounds
Letter1.Text = EndWord(0)
Letter1.Visible = False
Letter2.Text = EndWord(1)
Letter2.Visible = False
Letter3.Text = EndWord(2)
Letter3.Visible = False
Letter4.Text = EndWord(3)
Letter4.Visible = False
Letter5.Text = EndWord(4)
Letter5.Visible = False
Letter6.Text = EndWord(5)
Letter6.Visible = False
'Attempts left code
End If
With HangmanShapes
.Add(Attempt1)
.Add(Attempt2)
.Add(Attempt3)
.Add(Attempt4)
.Add(Attempt5)
.Add(Attempt6)
.Add(Attempt7)
.Add(Attempt8)
.Add(Attempt9)
.Add(Attempt10Part1)
.Add(Attempt10Part2)
End With
With NewControls
.Add(LetterA)
.Add(LetterB)
.Add(LetterC)
.Add(LetterD)
.Add(LetterE)
.Add(LetterF)
.Add(LetterG)
.Add(LetterH)
.Add(LetterI)
.Add(LetterJ)
.Add(LetterK)
.Add(LetterL)
.Add(LetterM)
.Add(LetterN)
.Add(LetterO)
.Add(LetterP)
.Add(LetterQ)
.Add(LetterR)
.Add(LetterS)
.Add(LetterT)
.Add(LetterU)
.Add(LetterV)
.Add(LetterW)
.Add(LetterX)
.Add(LetterY)
.Add(LetterZ)
End With
With GameWord
.Add(Me.Letter1)
.Add(Me.Letter2)
.Add(Me.Letter3)
.Add(Me.Letter4)
.Add(Me.Letter5)
.Add(Me.Letter6)
End With
End Sub
Private Sub AllBtnClicks(ByVal sender As System.Object, ByVal e As EventArgs) Handles LetterA.Click, LetterB.Click, LetterC.Click, LetterD.Click, LetterE.Click, LetterF.Click, LetterG.Click, LetterH.Click, LetterI.Click, LetterJ.Click, LetterK.Click, LetterL.Click, LetterM.Click, LetterN.Click, LetterO.Click, LetterP.Click, LetterQ.Click, LetterR.Click, LetterS.Click, LetterT.Click, LetterU.Click, LetterV.Click, LetterW.Click, LetterX.Click, LetterY.Click, LetterZ.Click
'Declartions
Dim LetterGuess As Button = sender
LetterGuess.Enabled = False
Dim LetterCorrect As Boolean = False
'Loop
For Each Letter In EndWord
If GetChar(LetterGuess.Name, 7) = Letter Then
Select Case Array.IndexOf(EndWord, Letter)
Case Is = 0
Letter1.Visible = True
Case Is = 1
Letter2.Visible = True
Case Is = 2
Letter3.Visible = True
Case Is = 3
Letter4.Visible = True
Case Is = 4
Letter5.Visible = True
Case Is = 5
Letter6.Visible = True
End Select
LetterCorrect = True
End If
Next
'Lives left code
If LetterCorrect = False Then
AttemptsLeft += 1
Select Case AttemptsLeft
Case 1
Attempt1.Visible = True
Attempts.Text = 1
Case 2
Attempt2.Visible = True
Attempts.Text = 2
Case 3
Attempt3.Visible = True
Attempts.Text = 3
Case 4
Attempt4.Visible = True
Attempts.Text = 4
Case 5
Attempt5.Visible = True
Attempts.Text = 5
Case 6
Attempt6.Visible = True
Attempts.Text = 6
Case 7
Attempt7.Visible = True
Attempts.Text = 7
Case 8
Attempt8.Visible = True
Attempts.Text = 8
Case 9
Attempt9.Visible = True
Attempts.Text = 9
Case 10
Attempt10Part1.Visible = True
Attempt10Part2.Visible = True
Attempts.Text = 10
LetterA.Enabled = False
LetterB.Enabled = False
LetterC.Enabled = False
LetterD.Enabled = False
LetterE.Enabled = False
LetterF.Enabled = False
LetterG.Enabled = False
LetterH.Enabled = False
LetterI.Enabled = False
LetterJ.Enabled = False
LetterK.Enabled = False
LetterL.Enabled = False
LetterM.Enabled = False
LetterN.Enabled = False
LetterO.Enabled = False
LetterP.Enabled = False
LetterQ.Enabled = False
LetterR.Enabled = False
LetterS.Enabled = False
LetterT.Enabled = False
LetterU.Enabled = False
LetterV.Enabled = False
LetterW.Enabled = False
LetterX.Enabled = False
LetterY.Enabled = False
LetterZ.Enabled = False
MsgBox("You have lost the round!")
ResetForm(0)
End Select
'Winning a round code
Else : Dim GameWinner As Boolean = True
Dim WordCheck As Label
For Each WordCheck In GameWord
If Not WordCheck.Visible Then
GameWinner = False
Exit For
End If
Next
If GameWinner Then
MsgBox("You have won the round!")
ResetForm(10)
'Losing a round code
End If
End If
End Sub
Private Sub ResetForm(ScoreForRound As Integer)
UScore += ScoreForRound
If Rounds = 3 Then
Me.Close()
HighScore.Show()
Else
Score.Text = +10
AttemptsLeft = 0
Attempts.Text = 0
Rounds += 1
Hangman_Load(Nothing, Nothing)
Dim HangmanReset As PowerPacks.Shape
For Each HangmanReset In HangmanShapes
HangmanReset.Visible = False
Next
Dim ControlReset As Control
For Each ControlReset In NewControls
ControlReset.Enabled = True
Next
End If
End Sub
End Class
High score form (This is where the user saves their points and also be able to view their high scores afterwards)
Imports System.IO
Public Class HighScore
Dim AppPath As String = Application.StartupPath()
Public Username As String
Private Sub HighScore_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim FileData() As String
Dim SizeArray As Integer
Try
FileData = File.ReadAllLines(AppPath & "/highscore.txt")
SizeArray = FileData.Length
Catch Break As Exception
MsgBox("The file is missing!", MsgBoxStyle.Critical)
End Try
For begin = 0 To SizeArray - 1 Step 1
Me.UserNameLabel.Text = UserNameLabel.Text & FileData(begin) & vbNewLine
Next
End Sub
Private Sub Backtomainmenu_Click(sender As Object, e As EventArgs) Handles Backtomainmenu.Click
MainMenu.Visible = True
Me.Visible = False
End Sub
Private Sub HelpButtonHighScore_Click(sender As Object, e As EventArgs) Handles HelpButtonHighScore.Click
MsgBox("This is the high score, this shows the top 10 players who achieved well in this game, this is ranked by the amount of points score. If you want to have your name in this high score, play the game well in order to achieve this.", MsgBoxStyle.Information)
End Sub
'This is where the user saves their high scores
Private Sub SaveName_Click(sender As Object, e As EventArgs) Handles SaveName.Click
Username = NameInput.Text
Try
File.WriteAllText(AppPath & "/highscore.txt", Username & " " & UScore)
Catch ex As Exception
MsgBox("The file is missing!", MsgBoxStyle.Critical)
End Try
UScore = vbNull
If NameInput.Text = "" Then
MsgBox("Enter a name please")
Else
File.WriteAllText(AppPath & "/highscore.txt", Username & " " & UScore)
Me.Close()
MainMenu.Show()
End If
End Sub
End Class
the user is required have at least one character inside the text box
Your code is currently saving to the file before any validation occurs:
Username = NameInput.Text
Try
File.WriteAllText(AppPath & "/highscore.txt", Username & " " & UScore)
Catch ex As Exception
MsgBox("The file is missing!", MsgBoxStyle.Critical)
End Try
UScore = vbNull
After that block of code (which has already written to the file), then you're attempting to validate:
If NameInput.Text = "" Then
MsgBox("Enter a name please")
Else
File.WriteAllText(AppPath & "/highscore.txt", Username & " " & UScore)
Me.Close()
MainMenu.Show()
End If
Consolidate the code, and only write to the file if your validation is successful:
Private Sub SaveName_Click(sender As Object, e As EventArgs) Handles SaveName.Click
Username = NameInput.Text.Trim
If Username = "" Then
MsgBox("Enter a name please!")
Else
Try
File.WriteAllText(AppPath & "/highscore.txt", Username & " " & UScore)
UScore = vbNull
Me.Close()
MainMenu.Show()
Catch ex As Exception
MsgBox("Error Saving High Score File!" & vbCrLf & vbCrLf & ex.ToString(), MsgBoxStyle.Critical)
End Try
End If
End Sub
With UScore = vbNull, you might be resetting the score even if NameInput.Text = "".
So, instead of
Try
File.WriteAllText(AppPath & "/highscore.txt", Username & " " & UScore)
Catch ex As Exception
MsgBox("The file is missing!", MsgBoxStyle.Critical)
End Try
UScore = vbNull
If NameInput.Text = "" Then
MsgBox("Enter a name please")
Else
File.WriteAllText(AppPath & "/highscore.txt", Username & " " & UScore)
Me.Close()
MainMenu.Show()
End If
Put UScore = vbNull inside the If statement so
Try
File.WriteAllText(AppPath & "/highscore.txt", Username & " " & UScore)
Catch ex As Exception
MsgBox("The file is missing!", MsgBoxStyle.Critical)
End Try
If NameInput.Text = "" Then
MsgBox("Enter a name please")
Else
File.WriteAllText(AppPath & "/highscore.txt", Username & " " & UScore)
Me.Close()
MainMenu.Show()
UScore = vbNull 'Put it here instead
End If
Recently, I've been doing this coursework for my college titled "SpellingBee project". This is where a student will take a test loaded from an Access 2010 database and output it on the form.
I have an algorithm which checks the accuracy of the spelling inputted by a student, and it will give either 2 points, 1 point or 0 points depending on the conditions. <-- This can be found in 'testword' private function.
The algorithm will be used in a procedure called 'btnMarkIt', and essentially it just takes all the answers and calculate the total score out of 20.
Here's the code:
Imports System.Data
Imports System.Data.OleDb
Public Class frmTakeTest
Dim TestConnection As New OleDbConnection
Dim DtasetTest As New DataSet
Dim DtaadpTest As New OleDbDataAdapter
Dim SqlCmdBldTest As New OleDbCommandBuilder(DtaadpTest)
Dim CurrentRowNo As Integer = -1
Dim MarkTest As Boolean = False
Dim TakeTestNow As Boolean = False
Dim ViewOnly As Boolean
Dim totalMarks As Integer
Private Sub frmTakeTest_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim DriveLetter As Char = Application.StartupPath.Substring(0, 1)
TestConnection.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DriveLetter & ":\Coursework - Computing\prj_computer-course\Jamie - Coursework\CourseworkDB.accdb"
DtaadpTest.SelectCommand = New OleDbCommand
DtaadpTest.SelectCommand.Connection = TestConnection
DtaadpTest.SelectCommand.CommandText = "SELECT * FROM tbl_test"
DtaadpTest.Fill(DtasetTest, "tblTakeTest")
ViewOnly = True
Protect()
End Sub
Private Sub DigitsOnly(ByRef Character As Char)
'Validate character input: digit keys only
If Char.IsDigit(Character) = False And Char.IsControl(Character) = False Then
MessageBox.Show("Digits only.", "Validation Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
'Stop invalid character appearing in field
Character = Nothing
End If
End Sub
Private Sub DisplayAccount()
'Purpose: Display a test when the user adds or edit a new record.
If DtasetTest.Tables("tblTakeTest").Rows.Count > 0 Then
txtDef1.Text = DtasetTest.Tables("tblTakeTest").Rows(CurrentRowNo).Item("Def1").ToString
txtDef2.Text = DtasetTest.Tables("tblTakeTest").Rows(CurrentRowNo).Item("Def2").ToString
txtDef3.Text = DtasetTest.Tables("tblTakeTest").Rows(CurrentRowNo).Item("Def3").ToString
txtDef4.Text = DtasetTest.Tables("tblTakeTest").Rows(CurrentRowNo).Item("Def4").ToString
txtDef5.Text = DtasetTest.Tables("tblTakeTest").Rows(CurrentRowNo).Item("Def5").ToString
txtDef6.Text = DtasetTest.Tables("tblTakeTest").Rows(CurrentRowNo).Item("Def6").ToString
txtDef7.Text = DtasetTest.Tables("tblTakeTest").Rows(CurrentRowNo).Item("Def7").ToString
txtDef8.Text = DtasetTest.Tables("tblTakeTest").Rows(CurrentRowNo).Item("Def8").ToString
txtDef9.Text = DtasetTest.Tables("tblTakeTest").Rows(CurrentRowNo).Item("Def9").ToString
txtDef10.Text = DtasetTest.Tables("tblTakeTest").Rows(CurrentRowNo).Item("Def10").ToString
End If
End Sub
Private Sub Protect()
'Purpose: To enable/disable screen objects depending on whether ViewOnly is true or false
If TakeTestNow = True Then
txtDef1.ReadOnly = True
txtDef2.ReadOnly = True
txtDef3.ReadOnly = True
txtDef4.ReadOnly = True
txtDef5.ReadOnly = True
txtDef6.ReadOnly = True
txtDef7.ReadOnly = True
txtDef8.ReadOnly = True
txtDef9.ReadOnly = True
txtDef10.ReadOnly = True
Else
txtDef1.ReadOnly = ViewOnly
txtDef2.ReadOnly = ViewOnly
txtDef3.ReadOnly = ViewOnly
txtDef4.ReadOnly = ViewOnly
txtDef5.ReadOnly = ViewOnly
txtDef6.ReadOnly = ViewOnly
txtDef7.ReadOnly = ViewOnly
txtDef8.ReadOnly = ViewOnly
txtDef9.ReadOnly = ViewOnly
txtDef10.ReadOnly = ViewOnly
End If
txtAns1.ReadOnly = ViewOnly
txtAns2.ReadOnly = ViewOnly
txtAns3.ReadOnly = ViewOnly
txtAns4.ReadOnly = ViewOnly
txtAns5.ReadOnly = ViewOnly
txtAns6.ReadOnly = ViewOnly
txtAns7.ReadOnly = ViewOnly
txtAns8.ReadOnly = ViewOnly
txtAns9.ReadOnly = ViewOnly
txtAns10.ReadOnly = ViewOnly
txtSearch.ReadOnly = Not ViewOnly
btnLoadTest.Enabled = ViewOnly
btnMarkIt.Enabled = Not ViewOnly
btnSubmit.Enabled = Not ViewOnly
btnPrintPreview.Enabled = Not ViewOnly
btnPrint.Enabled = Not ViewOnly
End Sub
Private Sub CloseToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CloseToolStripMenuItem.Click
Dim Result = MessageBox.Show("Are you sure you want to quite? Any information entered will not be saved.", "Warning", MessageBoxButtons.YesNo, MessageBoxIcon.Warning)
If Result = Windows.Forms.DialogResult.Yes Then
Me.Close()
Else
'Do Nothing
End If
End Sub
Private Sub btnLoadTest_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnLoadTest.Click
'Purpose: Load an existing test from the database and output it to the user
If txtSearch.Text = Nothing Then
MessageBox.Show("Please enter an ID number.", "Search Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
Else
If IsNumeric(txtSearch.Text) = True Then
DtaadpTest.SelectCommand.CommandText = "SELECT * FROM tbl_test WHERE TestID = " & txtSearch.Text
End If
DtasetTest.Tables("tblTakeTest").Clear()
DtaadpTest.Fill(DtasetTest, "tblTakeTest")
If DtasetTest.Tables("tblTakeTest").Rows.Count = 0 Then
MessageBox.Show("Test not found.", "Search Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
ViewOnly = True
Else
Dim Result = MessageBox.Show("Test found! Would you like to take it now?", "Question", MessageBoxButtons.YesNo, MessageBoxIcon.Question)
If Result = Windows.Forms.DialogResult.Yes Then
CurrentRowNo = 0
TakeTestNow = True
DisplayAccount()
ViewOnly = False
Protect()
Else
'Do Nothing
End If
End If
End If
End Sub
Private Sub txtSearch_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles txtSearch.KeyPress
DigitsOnly(e.KeyChar)
End Sub
Private Sub btnMarkIt_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnMarkIt.Click
Dim marks(9) As Integer
For i = 0 To 9
marks(i) = testWord(Controls("txtAns" & i + 1).Text, DtasetTest.Tables("tblTakeTest").Rows(0).Item("Ans" & i + 1))
Next i
Dim msgText As String = ""
For i = 0 To 9
msgText += DtasetTest.Tables("tblTakeTest").Rows(CurrentRowNo).Item("Ans" & i + 1) & " " & marks(i) & " points" & vbNewLine
Next
MsgBox(msgText)
totalMarks = CInt(marks(0) + marks(1) + marks(2) + marks(3) + marks(4) + marks(5) + marks(6) + marks(7) + marks(8) + marks(9))
txtTotalMark.Text = totalMarks
End Sub
Private Function testWord(ByVal inputWord As String, ByVal actualWord As String)
Dim lengthScore, accuracyScore, accuracyTally As Integer
inputWord = inputWord.ToLower
actualWord = actualWord.ToLower
'Length
If inputWord.Length = actualWord.Length Then
lengthScore = 2
ElseIf inputWord.Length = actualWord.Length + 1 Or inputWord.Length = actualWord.Length - 1 Then
lengthScore = 1
Else
lengthScore = 0
End If
'Accuracy
Dim inputArray() As Char = inputWord.ToCharArray
Dim actualArray() As Char = actualWord.ToCharArray
Dim found As Boolean
For i = 0 To inputArray.Length - 1
found = False
If actualArray.Length > i Then
If inputArray(i) = actualArray(i) Then
accuracyTally = accuracyTally + 2
found = True
End If
End If
If found = False And i > 0 And i <= (actualArray.Length) Then
If inputArray(i) = actualArray(i - 1) Then
accuracyTally = accuracyTally + 1
found = True
End If
End If
If found = False And i < (actualArray.Length - 1) Then
If inputArray(i) = actualArray(i + 1) Then
accuracyTally = accuracyTally + 1
found = True
End If
End If
Next i
'Add up
Dim accMax As Integer = inputWord.Length * 2
Dim accPerc As Integer
If accuracyTally > 0 Then
accPerc = CInt((accuracyTally / accMax) * 100)
Else
accPerc = 0
End If
If accPerc = 100 Then
accuracyScore = 2
ElseIf accPerc > 70 Then
accuracyScore = 1
Else
accuracyScore = 0
End If
If lengthScore = 2 And accuracyScore = 2 Then
Return 2
ElseIf lengthScore > 0 And accuracyScore > 0 Then
Return 1
Else
Return 0
End If
End Function
End Class
*Note: The error occurs in the 'btnMarkIt' procedure:
For i = 0 To 9
marks(i) = testWord(Controls("txtAns" & i + 1).Text, DtasetTest.Tables("tblTakeTest").Rows(0).Item("Ans" & i + 1))
Next i
Please try:
For i as Integer = 0 To 9
marks(i) = testWord(Controls("txtAns" & i + 1).Text, DtasetTest.Tables("tblTakeTest").Rows(0).Item("Ans" & i + 1))
Next i
I'm able to validate the cells if they are empty but I'm not able to check the length of the cell. I want the user to enter 5 digits and if it is less than 5, show up a message box.
I tried cellvalue.length method but its not working.
Private Sub dgvResults_CellValidating(ByVal sender As Object, ByVal e As System.Windows.Forms.DataGridViewCellValidatingEventArgs) Handles dgvResults.CellValidating
'variables
Dim columnName As String = dgvResults.Columns(e.ColumnIndex).Name
Dim cellVal As String = e.FormattedValue.ToString()
'Datagrid view validation
If ((e.ColumnIndex = 0) And (e.FormattedValue = "") And (Not (cellVal.Length = 5))) Then
e.Cancel = True
MessageBox.Show(columnName & " must be 5 Digits Long!")
ElseIf (e.ColumnIndex = 1 And e.FormattedValue = "") Then
e.Cancel = True
MessageBox.Show(columnName & " cannot be blank!")
ElseIf (e.ColumnIndex = 2 And e.FormattedValue = "") Then
e.Cancel = True
MessageBox.Show(columnName & " cannot be blank!")
ElseIf ((e.ColumnIndex = 3) And (e.FormattedValue = "") And (Not IsNumeric(e.FormattedValue))) Then
e.Cancel = True
MessageBox.Show(columnName & " cannot be blank!")
ElseIf ((e.ColumnIndex = 4) And (Not IsNumeric(e.FormattedValue))) Then
e.Cancel = True
MessageBox.Show(columnName & " cannot be blank!")
End If
End Sub
Following causes your code to not work:
(e.FormattedValue = "") And (Not (cellVal.Length = 5))
You are checking if the value is empty and also it's length is <> 5.
But you want to ensure that cellVal.Length is = 5:
If e.ColumnIndex = 0 AndAlso cellVal.Length <> 5 Then
e.Cancel = True
MessageBox.Show(columnName & " must be 5 Digits Long!")
End If
I think you will need:
cellval.text.length