最近，我一直在为我的大学做过这个课程，题目是＃34; SpellingBee项目＆＃34;。这是学生将从Access 2010数据库加载测试并将其输出到表单上的位置。
我有一个算法可以检查学生输入的拼写的准确性，并根据条件给出2分，1分或0分。 ＆lt; - 这可以在＆＃39; testword＆＃39;中找到。私人职能。
该算法将用于名为＆＃39; btnMarkIt＆＃39;的程序中，基本上它只需要所有答案并计算20分之外的总分。
以下是代码：
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
*注意：错误发生在＆＃39; btnMarkIt＆＃39;程序：
For i = 0 To 9
marks(i) = testWord(Controls("txtAns" & i + 1).Text, DtasetTest.Tables("tblTakeTest").Rows(0).Item("Ans" & i + 1))
Next i
答案 0 :(得分：0)
请尝试：
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