How do I correct a message box error and code a numeric up down? - vb.net

I am working on a project in Visual Studio for school and can't figure a few things out. I am new to programming and have been working on this for weeks but keep running into errors.
1.Orders over $300 will display a message box with error stating manager approval needed. (I have this part). The manager will have to enter the word APPROVED in the txtName field to approve the order, this is the part that's not working.
I have to include a numeric up and down for massage minutes at $3/min up to 90 min this will be added to the total. I can't get this to work at all.
orders still going through after message box with error pops up.
My error messages are working but as soon as I hit OK to acknowledge the error the order displays anyway.
Dim strName As String = ""
Dim decTotalCost As Decimal = 0D
Dim decSkinCareCost As Decimal = 0D
Dim decNailCareCost As Decimal = 0D
Dim decWaxingCost As Decimal = 0D
Const FACIAL_PRICE As Decimal = 90D
Const MICRO_PRICE As Decimal = 120D
Const CHEM_PEEL_PRICE As Decimal = 130D
Const MANI_PRICE As Decimal = 25D
Const PEDI_PRICE As Decimal = 55D
Const MANI_PEDI_PRICE As Decimal = 75D
Const EYEBROW_WAX_PRICE As Decimal = 20D
Const LIP_WAX_PRICE As Decimal = 15D
Const CHIN_WAX_PRICE As Decimal = 15D
Const JAW_WAX_PRICE As Decimal = 20D
Const ARM_WAX_PRICE As Decimal = 45D
Const UNDER_ARM_WAX_PRICE As Decimal = 20D
Const FEET_HANDS_WAX_PRICE As Decimal = 15D
Const LEG_WAX_PRICE As Decimal = 65D
Const NONE_FACE As Decimal = 0D
Const NONE_NAILS As Decimal = 0D
Const strNO_SERVICES_SELECTED_ERROR As String = "ERROR: Please select a
service."
Const strORDER_OVER_300_ERROR As String = "ERROR: Order over $300, please
see manager for approval"
Const strNO_NAME_ERROR As String = "ERROR: Please enter a name."
Dim strNoNameMessage As String = strNO_NAME_ERROR
Dim strManagerApproval As String = strORDER_OVER_300_ERROR
Dim strNoServicesSelected As String = strNO_SERVICES_SELECTED_ERROR
Private Sub btnSubmit_Click(sender As Object, e As EventArgs) Handles
btnSubmit.Click
If txtName.Text <> "" Then
If radFacial.Checked = True Then
decTotalCost = decTotalCost + FACIAL_PRICE
ElseIf radMicro.Checked = True Then
decTotalCost = decTotalCost + MICRO_PRICE
ElseIf radChemPeel.Checked = True Then
decTotalCost = decTotalCost + CHEM_PEEL_PRICE
ElseIf radNoneFace.Checked = True Then
decTotalCost = NONE_FACE
End If
If radMani.Checked = True Then
decTotalCost = decTotalCost + MANI_PRICE
ElseIf radPedi.Checked = True Then
decTotalCost = decTotalCost + PEDI_PRICE
ElseIf radManiPedi.Checked = True Then
decTotalCost = decTotalCost + MANI_PEDI_PRICE
ElseIf radNoneNails.Checked = True Then
decTotalCost = NONE_NAILS
End If
If chkEyebrow.Checked = True Then
decTotalCost = decTotalCost + EYEBROW_WAX_PRICE
End If
If chkLip.Checked = True Then
decTotalCost = decTotalCost + LIP_WAX_PRICE
End If
If chkChin.Checked = True Then
decTotalCost = decTotalCost + CHIN_WAX_PRICE
End If
If chkJaw.Checked = True Then
decTotalCost = decTotalCost + JAW_WAX_PRICE
End If
If chkArm.Checked = True Then
decTotalCost = decTotalCost + ARM_WAX_PRICE
End If
If chkUnderArm.Checked = True Then
decTotalCost = decTotalCost + UNDER_ARM_WAX_PRICE
End If
If chkFeetHands.Checked = True Then
decTotalCost = decTotalCost + FEET_HANDS_WAX_PRICE
End If
If chkLeg.Checked = True Then
decTotalCost = decTotalCost + LEG_WAX_PRICE
End If
If decTotalCost > 300D Then
MsgBox(strORDER_OVER_300_ERROR)
txtName.Focus()
ElseIf decTotalCost = 0D Then
MsgBox(strNO_SERVICES_SELECTED_ERROR)
End If
MsgBox("Thank you, " & txtName.Text & " Your Spa total is: " &
decTotalCost.ToString("C"))
Else
txtName.Text = ""
MsgBox(strNO_NAME_ERROR)
End If
End Sub
Private Sub NumericUpDown1_ValueChanged(sender As Object, e As EventArgs)
Handles NumericUpDown1.ValueChanged

Related

How to make shortcut for each characters in vb.net?

There is a RichTextBox which if user enter any key it will show in there. I tried GetAsyncKeyState for "." and "-" and etc but it doesn't work however A-Z and 0-9 work correctly.
Private Sub tmrKeys_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tmrKeys.Tick
Dim result As Integer
Dim key As String = Nothing
Dim p As Boolean = CBool(GetAsyncKeyState(Keys.P))
Dim i As Integer
Dim dec As Boolean = CBool(GetAsyncKeyState(Keys.Decimal))
Dim subtract As Boolean = CBool(GetAsyncKeyState(Keys.Subtract))
Dim add As Boolean = CBool(GetAsyncKeyState(Keys.Add))
Try
For i = 2 To 90
result = 0
result = GetAsyncKeyState(i)
If result = -32767 Then
key = Chr(i)
If i = 13 Then key = vbNewLine
Exit For
End If
Next i
If key <> Nothing Then
If My.Computer.Keyboard.ShiftKeyDown OrElse My.Computer.Keyboard.CapsLock Then
txtlogs.Text &= key.ToUpper
ElseIf key = vbBack Then
If txtlogs.TextLength > 0 Then
txtlogs.Text = txtlogs.Text.Remove(txtlogs.TextLength - 1)
End If
ElseIf My.Computer.Keyboard.CtrlKeyDown Then
txtlogs.Text &= " -[CTRL+" & key & "]"
ElseIf subtract = True Then
txtlogs.Text &= "-"
ElseIf My.Computer.Keyboard.ShiftKeyDown AndAlso subtract = True Then
txtlogs.Text &= "_"
ElseIf dec = True Then
txtlogs.Text &= "."
Else
txtlogs.Text &= key.ToLower
End If
End If
I want when user press decimal in the keyboard RichTextBox shows add "." to the text and so on
Thanks for any help in advance
Here are the correct keycodes for the hyphen and the period, add these to your for loop:
If i = 189 Then key = "-"
If i = 190 Then key = "."
Also, to get the underscore and smaller-than sign, add these after your for loop:
If key = "-" AndAlso My.Computer.Keyboard.ShiftKeyDown Then key = "_"
If key = "." AndAlso My.Computer.Keyboard.ShiftKeyDown Then key = ">"

Conversion from string “” to type 'Double' is not valid. on below code ListBox4.Items.Add(TxUP.Text * TxBuyOrder.Text)

Private Sub Button1_Click_1(sender As Object, e As EventArgs) Handles BtnBuy.Click
If TxBuyOrder.Text = "" Then
MsgBox("How Much You Want " & TxBuyPName.Text, MsgBoxStyle.OkOnly)
Else
If TxCname.Text = "" Then
MsgBox("Please Enter Customer Name")
Else
ListBox1.Items.Add(TxBuyPName.Text)
ListBox2.Items.Add(TxUP.Text)
ListBox3.Items.Add(TxBuyOrder.Text)
ListBox4.Items.Add(TxUP.Text * TxBuyOrder.Text)
TxBuyOrder.Text = ""
TxBuyPName.Text = ""
TxBuyPPrice.Text = ""
CName.Text = TxCname.Text.ToUpper
CAddress.Text = TxCAddress.Text.ToUpper
Cphone.Text = TxCPhone.Text
LdATE.Text = Today.Date
End If
End If
ToolStripTextBox1.Focus()
ToolStripTextBox1.Text = ""
End Sub
If the text in your text boxes is not a number of is empty .TryParse will keep your program from crashing.
Dim num1, num2 As Double
If Double.TryParse(TextBox2.Text, num1) Then
If Double.TryParse(TextBox3.Text, num2) Then
ListBox1.Items.Add(num1 * num2)
End If
End If

RichTextBox flikers when syntax highlight

I am writing an IDE an while working on syntax highlighting, i've encountered a very annoying issue.
When I type something, the text flickers...
Here is my code:
Dim KeyWords As List(Of String) = New List(Of String)(New String() {"void", "int", "long", "char", "short", "unsigned", "signed", "#include", "#define", "return"})
Dim KeyWordsColors As List(Of Color) = New List(Of Color)(New Color() {Color.Purple, Color.Purple, Color.Purple, Color.Purple, Color.Purple, Color.Purple, Color.Purple, Color.Olive, Color.Olive, Color.Blue})
Private Sub RichTextBox1_TextChanged(sender As Object, e As EventArgs) Handles RichTextBox1.TextChanged
Dim words As IEnumerable(Of String) = RichTextBox1.Text.Split(New Char() {" "c, ".", ",", "?", "!", "(", Chr(13), Chr(10), " "})
Dim index As Integer = 0
Dim rtb As RichTextBox = sender 'to give normal color according to the base fore color
For Each word As String In words
'If the list contains the word, then color it specially. Else, color it normally
'Edit: Trim() is added such that it may guarantee the empty space after word does not cause error
coloringRTB(sender, index, word.Length, If(KeyWords.Contains(word.ToLower().Trim()) Or KeyWords.Contains("<"), KeyWordsColors(KeyWords.IndexOf(word.ToLower().Trim())), rtb.ForeColor))
index = index + word.Length + 1 '1 is for the whitespace, though Trimmed, original word.Length is still used to advance
Next
Dim strings() As String = RichTextBox1.Text.Split(Chr(34))
Dim count As Integer = 0
Dim cpart As Integer = 0
For Each part In strings
cpart = cpart + 1
If cpart Mod 2 = 0 Then
coloringRTB(RichTextBox1, count - 1, part.Length + 2, Color.Olive)
End If
count = count + part.Length + 1
Next
Dim strings2() As String = RichTextBox1.Text.Split(New Char() {"<", ">"})
count = 0
cpart = 0
For Each part In strings2
cpart = cpart + 1
If cpart Mod 2 = 0 Then
coloringRTB(RichTextBox1, count - 1, part.Length + 2, Color.Olive)
End If
count = count + part.Length + 1
Next
End Sub
Private Sub coloringRTB(rtb As RichTextBox, index As Integer, length As Integer, color As Color)
Dim selectionStartSave As Integer = rtb.SelectionStart 'to return this back to its original position
rtb.SelectionStart = index
rtb.SelectionLength = length
rtb.SelectionColor = color
rtb.SelectionLength = 0
rtb.SelectionStart = selectionStartSave
rtb.SelectionColor = rtb.ForeColor 'return back to the original color
End Sub
Private Sub RichTextBox1_KeyUp(sender As Object, e As KeyPressEventArgs) Handles RichTextBox1.KeyPress
If e.KeyChar = "{"c Then
RichTextBox1.SelectedText = "{}"
RichTextBox1.SelectionStart = RichTextBox1.Text.Substring(0, RichTextBox1.SelectionStart).LastIndexOf("{") + 1
e.Handled = True
End If
If e.KeyChar = "("c Then
RichTextBox1.SelectedText = "()"
RichTextBox1.SelectionStart = RichTextBox1.Text.Substring(0, RichTextBox1.SelectionStart).LastIndexOf("(") + 1
e.Handled = True
End If
If e.KeyChar = "["c Then
RichTextBox1.SelectedText = "[]"
RichTextBox1.SelectionStart = RichTextBox1.Text.Substring(0, RichTextBox1.SelectionStart).LastIndexOf("[") + 1
e.Handled = True
End If
If e.KeyChar = "'"c Then
RichTextBox1.SelectedText = "''"
RichTextBox1.SelectionStart = RichTextBox1.Text.Substring(0, RichTextBox1.SelectionStart).LastIndexOf("'")
e.Handled = True
End If
Dim currentLength = RichTextBox1.Text.Length
End Sub
hope someone can help Thanks ^_^
RichTextBox1 is the richtextbox

Subtract from textbox (hexadecimal)

Here is my code.
It reads bytes from *.bin file and show it in textbox1
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim OFD As New OpenFileDialog
Dim fullFile() As Byte
If OFD.ShowDialog = Windows.Forms.DialogResult.OK Then
fullFile = File.ReadAllBytes(OFD.FileName)
TextBox1.AppendText(fullFile(&H2E).ToString("X2") & " ")
TextBox1.AppendText(fullFile(&H2F).ToString("X2"))
End If
End Sub
Now I want to add subtraction in textbox2.
example:
H2E - BC
H2F - CD
BCCD - 2222 = 9AABB
Textbox2. = result
I tried with this, but it gives result in decimal
TextBox2.Text = Val(TextBox1.Text) - Val("2222")
Try something like this out:
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim hex As String = String.Join("", TextBox1.Text.Trim.Split(" ")) ' Assuming "BC CD" is in the box
If hex.Length = 4 Then
Try
Dim intA As Integer = Convert.ToInt32(hex, 16)
Dim intB As Integer = Convert.ToInt32("2222", 16)
Dim intC As Integer = intA - intB
TextBox2.Text = intC.ToString("X2")
Catch ex As Exception
MessageBox.Show("Invalid Hexadecimal Value")
End Try
Else
MessageBox.Show("Invalid Hexadecimal Value")
End If
End Sub
call function like this
Call SumEtcHexToOther("p", Textfirst, Textother)
'Used function
Sub SumEtcHexToOther(ByVal operacion As String, ByVal firstno As TextBox, ByVal other As TextBox)
Dim n1 As String, n2 As String, b1 As Long, b2 As Long, sundec As Long
If TestHex(firstno.Text) = True Then Exit Sub
If TestHex(other.Text) = True Then Exit Sub
n1 = firstno.Text 'hex sum
n2 = other.Text
b1 = HextoDec(n1)
b2 = HextoDec(n2)
Select Case operacion
Case "p"
sundec = b1 + b2
Case "s"
sundec = b1 - b2
' Messageboxmy(sundec)
If (b1 - b2) = 0 Then
sundec = 0
End If
Case "m"
sundec = b1 * b2
Case "d"
sundec = b1 / b2
End Select
' Messageboxmy(AnyBasePrintNumber(Str(sundec), 16))
LResult.Text = "In dec n1,n2=" & b1 & "," & b2 & ",Dec res=" & sundec
If sundec = 0 Then
Dim ans As Integer = 0
LResult.Text &= ",Hex n1,n2 =" & n1 & "," & n2 & " Hex res=" & 0
'LResult.Text &= ",Hex n1,n2 =" & n1 & "," & n2 & " Hex res=" & DecimalToHex(Str(sundec))
Else
LResult.Text &= ",Hex n1,n2 =" & n1 & "," & n2 & " Hex res=" & DecimalToHex(Str(sundec))
End If
End Sub
'also used
Function DecimalToHex(ByVal intNumber As Integer) As String
Dim thisnum As Integer
On Error Resume Next
' If testBlank(intNumber) = True Then Exit Function
thisnum = Val(intNumber)
Dim intRemainder As Integer
Dim strRemainder As String
Dim strHexaNumber As String
'intNumber = CInt(InputBox("Enter number in decimal:", "DECIMAL TO HEXADECIMAL CONVERSION"))
Do While thisnum >= 1
intRemainder = thisnum Mod 16
strRemainder = CStr(intRemainder)
thisnum = thisnum \ 16
Select Case strRemainder
Case "10" : strRemainder = "A"
Case "11" : strRemainder = "B"
Case "12" : strRemainder = "C"
Case "13" : strRemainder = "D"
Case "14" : strRemainder = "E"
Case "15" : strRemainder = "F"
End Select
strHexaNumber = strRemainder & strHexaNumber
If strHexaNumber = String.Empty Then
strHexaNumber = "0"
End If
Loop
' Messageboxmy(strHexaNumber)
DecimalToHex = strHexaNumber
'MsgBox "The Number in Hexadecimal is : " & strHexaNumber, , "DECIMAL TO HEXADECIMAL CONVERSION"
End Function
'still any doubt see me

NullReferenceException - Having the classic “Object reference not set to an instance of an object.” when marking a spelling test

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

Resources