Here is my code
Public Class FrmGameBoard
Const NumValues As Integer = 26
Dim Values(NumValues) As Decimal
Dim ValueCollection = New Collection
Dim i As Integer = 0
Dim Briefcases = New Collection
Dim RemainingBriefcases = New Collection
Dim GlobalAction As Integer = 0
Dim turn As Integer = 0
Dim name As String
Dim numberofremainingvalues, sumofremainingvalues As Integer
Dim MyValue, EVBig, EVSmall As Double
Dim n As Integer = 0
Function longif()
If MyValue = 0.01 Then
Lbl1p.Visible = False
RemainingBriefcases.Remove(0)
ElseIf MyValue = 0.02 Then
Lbl2p.Visible = False
RemainingBriefcases.Remove(1)
ElseIf MyValue = 0.05 Then
Lbl5p.Visible = False
RemainingBriefcases.Remove(2)
ElseIf MyValue = 0.1 Then
Lbl10p.Visible = False
RemainingBriefcases.Remove(3)
ElseIf MyValue = 0.25 Then
Lbl25p.Visible = False
RemainingBriefcases.Remove(4)
ElseIf MyValue = 0.5 Then
Lbl50p.Visible = False
RemainingBriefcases.Remove(5)
ElseIf MyValue = 0.75 Then
Lbl75p.Visible = False
RemainingBriefcases.Remove(6)
ElseIf MyValue = 1.0 Then
Lbl1d.Visible = False
RemainingBriefcases.Remove(7)
ElseIf MyValue = 2.5 Then
Lbl2d50p.Visible = False
RemainingBriefcases.Remove(8)
ElseIf MyValue = 5.0 Then
Lbl5d.Visible = False
RemainingBriefcases.Remove(9)
ElseIf MyValue = 10.0 Then
Lbl10d.Visible = False
RemainingBriefcases.Remove(10)
ElseIf MyValue = 25.0 Then
Lbl25d.Visible = False
RemainingBriefcases.Remove(11)
ElseIf MyValue = 50.0 Then
Lbl50d.Visible = False
RemainingBriefcases.Remove(12)
ElseIf MyValue = 100.0 Then
Lbl100d.Visible = False
RemainingBriefcases.Remove(13)
ElseIf MyValue = 500.0 Then
Lbl500d.Visible = False
RemainingBriefcases.Remove(14)
ElseIf MyValue = 1000.0 Then
Lbl1000d.Visible = False
RemainingBriefcases.Remove(15)
ElseIf MyValue = 5000.0 Then
Lbl5000d.Visible = False
RemainingBriefcases.Remove(16)
ElseIf MyValue = 10000.0 Then
Lbl10000d.Visible = False
RemainingBriefcases.Remove(17)
ElseIf MyValue = 50000.0 Then
Lbl50000d.Visible = False
RemainingBriefcases.Remove(18)
ElseIf MyValue = 100000.0 Then
Lbl100000d.Visible = False
RemainingBriefcases.Remove(19)
ElseIf MyValue = 250000.0 Then
Lbl250000d.Visible = False
RemainingBriefcases.Remove(20)
ElseIf MyValue = 500000.0 Then
Lbl500000d.Visible = False
RemainingBriefcases.Remove(21)
ElseIf MyValue = 750000.0 Then
Lbl750000d.Visible = False
RemainingBriefcases.Remove(22)
ElseIf MyValue = 1000000 Then
Lbl1000000d.Visible = False
RemainingBriefcases.Remove(23)
ElseIf MyValue = 1250000.0 Then
Lbl1250000d.Visible = False
RemainingBriefcases.Remove(24)
ElseIf MyValue = 1500000.0 Then
Lbl1500000.Visible = False
RemainingBriefcases.Remove(25)
End If
turn = turn + 1
LblTurnNumber.Text = CStr(turn)
End Function
Private Sub FrmGameBoard_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim X As Integer
Dim n As Integer = 1
Dim MyRandom As New Random()
Values(0) = 0.01
Values(1) = 0.02
Values(2) = 0.05
Values(3) = 0.1
Values(4) = 0.25
Values(5) = 0.5
Values(6) = 0.75
Values(7) = 1.0
Values(8) = 2.5
Values(9) = 5.0
Values(10) = 10.0
Values(11) = 25.0
Values(12) = 50.0
Values(13) = 100.0
Values(14) = 500.0
Values(15) = 1000.0
Values(16) = 5000.0
Values(17) = 10000.0
Values(18) = 50000.0
Values(19) = 100000.0
Values(20) = 250000.0
Values(21) = 500000.0
Values(22) = 750000.0
Values(23) = 1000000.0
Values(24) = 1250000.0
Values(25) = 1500000.0
name = InputBox("Please enter your name below.")
LblWelcome.Text = "Welcome " & name
Do While i <= NumValues
ValueCollection.Add(Values(i))
RemainingBriefcases.Add(Values(i))
i = i + 1
Loop
i = 1
For n = 1 To NumValues
X = MyRandom.Next(1, ValueCollection.Count)
Briefcases.Add(ValueCollection(X))
ValueCollection.Remove(X)
Next
n = 1
i = 1
End Sub
Private Sub Lbl1_Click(sender As Object, e As EventArgs) Handles Lbl1.Click
Const MyNumber As Integer = 1
Lbl1.Visible = False
Pic1.Visible = False
MyValue = Briefcases(MyNumber)
Dim action As Integer = 0
If GlobalAction = 0 Then
LblMyBriefcase.Text = CStr(MyNumber)
action = 1
GlobalAction = 1
End If
If action = 0 Then
longif()
End If
End Sub
Private Sub Pic1_Click(sender As Object, e As EventArgs) Handles Pic1.Click
Const MyNumber As Integer = 1
Lbl1.Visible = False
Pic1.Visible = False
MyValue = Briefcases(MyNumber)
Dim action As Integer = 0
If GlobalAction = 0 Then
LblMyBriefcase.Text = CStr(MyNumber)
action = 1
GlobalAction = 1
End If
If action = 0 Then
longif()
End If
End Sub
Private Sub Lbl2_Click(sender As Object, e As EventArgs) Handles Lbl2.Click
Const MyNumber As Integer = 2
Lbl2.Visible = False
Pic2.Visible = False
MyValue = Briefcases(MyNumber)
Dim action As Integer = 0
If GlobalAction = 0 Then
LblMyBriefcase.Text = CStr(MyNumber)
action = 1
GlobalAction = 1
End If
If action = 0 Then
longif()
End If
End Sub
Private Sub Pic2_Click(sender As Object, e As EventArgs) Handles Pic2.Click
Const MyNumber As Integer = 2
Lbl2.Visible = False
Pic2.Visible = False
Dim action As Integer = 0
MyValue = Briefcases(MyNumber)
If GlobalAction = 0 Then
LblMyBriefcase.Text = CStr(MyNumber)
action = 1
GlobalAction = 1
End If
If action = 0 Then
longif()
End If
End Sub
Private Sub Lbl3_Click(sender As Object, e As EventArgs) Handles Lbl3.Click
Const MyNumber As Integer = 3
Lbl3.Visible = False
Pic3.Visible = False
Dim action As Integer = 0
MyValue = Briefcases(MyNumber)
If GlobalAction = 0 Then
LblMyBriefcase.Text = CStr(MyNumber)
action = 1
GlobalAction = 1
End If
If action = 0 Then
longif()
End If
End Sub
Private Sub Pic3_Click(sender As Object, e As EventArgs) Handles Pic3.Click
Const MyNumber As Integer = 3
Lbl3.Visible = False
Pic3.Visible = False
Dim action As Integer = 0
MyValue = Briefcases(MyNumber)
If GlobalAction = 0 Then
LblMyBriefcase.Text = CStr(MyNumber)
action = 1
GlobalAction = 1
End If
If action = 0 Then
longif()
End If
End Sub
Private Sub Lbl4_Click(sender As Object, e As EventArgs) Handles Lbl4.Click
Const MyNumber As Integer = 4
Lbl4.Visible = False
Pic4.Visible = False
Dim action As Integer = 0
MyValue = Briefcases(MyNumber)
If GlobalAction = 0 Then
LblMyBriefcase.Text = CStr(MyNumber)
action = 1
GlobalAction = 1
End If
If action = 0 Then
longif()
End If
End Sub
Private Sub Pic4_Click(sender As Object, e As EventArgs) Handles Pic4.Click
Const MyNumber As Integer = 4
Lbl4.Visible = False
Pic4.Visible = False
Dim action As Integer = 0
MyValue = Briefcases(MyNumber)
If GlobalAction = 0 Then
LblMyBriefcase.Text = CStr(MyNumber)
action = 1
GlobalAction = 1
End If
If action = 0 Then
longif()
End If
End Sub
............... (the same code just continues for the different picboxes and labels up to 26)
End Class
I want to have the values of the remaining briefcases in the RemainingBriefcases Collection so I remove the selected value in the longif() function. However, it works for the first few clicks, but after a few it highlights one of the RemainingBriefcases.Remove statements and says Collection index must be in the range 1 to the size of the collection.
What should I change?
Thanks
Expanding on my earlier comment, I created a new Windows Forms project. I added a label for "LblTurnNumber", a panel "pnlBriefcases" to show the briefcases, and a panel "valuesLabels" to show the values which have not been selected.
Option Infer On
Option Strict On
Public Class FrmGameBoard
Dim briefcases As List(Of Briefcase)
Dim valuesLabels As List(Of Label)
Dim clicksProcessed As Integer = 0
Class Briefcase
Property Value As Decimal
Property AssociatedLabel As Label
Property AssociatedPictureBox As PictureBox
Property IsAvailable As Boolean = True
End Class
Private Sub Briefcase_Click(sender As Object, e As EventArgs)
' get the control which raised the event
Dim ctrl = DirectCast(sender, Control)
' get the briefcase for that control
Dim bc = DirectCast(ctrl.Tag, Briefcase)
bc.AssociatedLabel.Visible = False
bc.AssociatedPictureBox.Visible = False
' I don't know the purpose of the following line: I carried it over from the example oode
' referring to Briefcases vs. RemainingBriefcases
bc.IsAvailable = False
' Find the value in the available values corresponding to the item clicked on...
Dim valueToRemove = bc.Value.ToString()
Dim valueToHide = valuesLabels.First(Function(vl) vl.Text = valueToRemove)
valueToHide.Visible = False
clicksProcessed += 1
LblTurnNumber.Text = clicksProcessed.ToString()
End Sub
Sub Init()
Dim rand As New Random()
Dim values() As Decimal = {0.01D, 0.02D, 0.05D, 0.1D, 0.25D, 0.5D, 0.75D, 1D, 2.5D, 5D, 10D, 25D, 50D, 100D, 500D, 1000D, 5000D, 10000D, 50000D, 100000D, 250000D, 500000D, 750000D, 1000000D, 1250000D, 1500000D}
' Create a set of labels showing the available values
' and show them in a panel named "valuesPanel".
valuesLabels = New List(Of Label)
For i = 0 To values.Length - 1
Dim valueLabel As New Label With {.Text = values(i).ToString()}
valueLabel.TextAlign = ContentAlignment.MiddleRight
Dim yPos = valuesPanel.Height - 24 * (i + 1)
valueLabel.Location = New Point(6, yPos)
valuesPanel.Controls.Add(valueLabel)
valuesLabels.Add(valueLabel)
Next
' Get a shuffled list of the values
Dim shuffledValues As New List(Of Decimal)
For i = 0 To values.Length - 1
shuffledValues.Insert(rand.Next(0, i), values(i))
Next
' Create briefcases with imaages and labels
' and associate those to UI elements.
briefcases = New List(Of Briefcase)
For i = 0 To values.Count - 1
Dim lbl As New Label
Dim pb As New PictureBox
' N.B. The following is a crude and unsatisfactory way to display the briefcases and
' requires improvement.
'TODO: set the text of lbl and the image of pb properly
'TODO: set the position of lbl and the position of pb properly
pb.Image = Bitmap.FromFile("C:\temp\briefcase.png")
Dim xSize = pb.Image.Width
Dim ySize = pb.Image.Height
Dim xLoc = (i Mod 13) * xSize ' magic number 13 to make two rows of briefcases because there are 26 of them
Dim yLoc = (i \ 13) * ySize + 40 ' magic number 40 to crudely account for label size
pb.Size = pb.Image.Size
pb.Location = New Point(xLoc, yLoc)
lbl.Location = New Point(xLoc, yLoc + ySize)
lbl.Text = "???" & i.ToString()
' Tell it what to do when the Label or PictureBox is clicked...
AddHandler lbl.Click, AddressOf Briefcase_Click
AddHandler pb.Click, AddressOf Briefcase_Click
' Show the controls we have created...
pnlBriefcases.Controls.Add(lbl)
pnlBriefcases.Controls.Add(pb)
' Create a Briefcase which has a value and is connected to the label and picturebox:
Dim thisBriefcase = New Briefcase With {.Value = shuffledValues(i), .AssociatedLabel = lbl, .AssociatedPictureBox = pb}
' Connect the label and picturebox to the Briefcase
' - the .Tag holds an Object, i.e. anything we want as long as we know what to convert it back to when we use it.
lbl.Tag = thisBriefcase
pb.Tag = thisBriefcase
briefcases.Add(thisBriefcase)
Next
LblTurnNumber.Text = clicksProcessed.ToString()
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Init()
End Sub
End Class
The image "C:\temp\briefcase.png" is
Starting the program shows:
(I did say it needed improvements for the UI...)
and after clicking a few pictureboxes/labels...
If you need to process the briefcases which are still displayed, you can get a list of them with something like
Dim stillShown = briefcases.Where(Function(bc) bc.IsAvailable).ToList()
Dim briefcases As List(Of Double) = New List(Of Double)
briefcases.Add( 1.0 )
briefcases.Add( 2.0 )
briefcases.Add( 3.0 )
briefcases.Remove( 2.0 )
This will let you remove items by number.
Related
i am using vb.net to create a linked list, and am finding an issue with storage. the second to last value entered is always deleted. i believe this issue is in the Add() subroutine, but i cant figure out how this is caused, or how to fix it. attached is the code and ss of the console. console output
Module Program
Structure linkedList
Dim item As String
Dim position As Integer
Dim pointer As Decimal
Dim isEmpty As Boolean
End Structure
Dim tail As Integer
Dim input As String
Dim list(30) As linkedList
Dim index As Integer
Const head As Integer = 0
Dim menuChoice As Integer
Sub Main()
For i = 0 To list.Length - 1 : list(i).isEmpty = True : Next
menu()
End Sub
Sub menu()
Do
Try
Console.WriteLine("Press 1 to add values, 2 to remove them.")
menuChoice = Console.ReadLine
Catch ex As Exception
Console.WriteLine(ex.Message)
End Try
Loop Until menuChoice = 1 Or menuChoice = 2
Select Case menuChoice
Case 1
add()
Case 2
remove()
End Select
End Sub
Sub add()
list(0).position = -1
list(0).item = "Head"
index = 1
Do
Console.WriteLine("Enter a value to enter into the linked list, or press X to stop: ")
input = Console.ReadLine
If input <> "X" And input <> vbNullString Then
For i = 0 To list.Length - 1
If list(i).isEmpty = True Then
list(i + 1).item = input
list(i + 1).position = index
list(i + 1).pointer = index + 1
list(i).isEmpty = False
Exit For
End If
Next
End If
list(0).pointer = findNextAvailable(0)
If input <> "X" Then : index += 1 : End If
If input = "X" Then
tail = index
End If
Loop Until input = "X" Or index = 30
showList()
End Sub
Sub remove()
Dim checked As Boolean = False
Dim removString As String
Dim removPos As Integer
Dim removPoint As Integer
Dim num1 As Integer
Do
Try
Console.WriteLine("Enter a string to remove from the Linked List:")
removString = Console.ReadLine.Trim
For i = 0 To list.Length - 1
If list(i).item = removString Then
checked = True
removPos = i
num1 = i - 1
list(i).isEmpty = True
Exit For
Else
checked = False
list(i).isEmpty = False
End If
Next
Catch ex As Exception
Console.WriteLine(ex.Message)
End Try
Loop Until checked = True
list(removPos).item = vbNullString
list(removPos).pointer = fixPointer(num1)
list(num1).pointer = findPos(removPos)
showList()
End Sub
Function findPos(start As Integer) As Integer
Dim check As Boolean
Dim num1 As Integer
For i = start To list.Length - 1
If list(i).item <> vbNullString Then
check = True
num1 = i - 1
Exit For
End If
Next
If check = True Then
Return num1
Else
Return vbNullString
End If
End Function
Function findNextAvailable(startPoint As Integer) As Integer
Dim nextAvailableTrue As Boolean
Dim num1 As Integer
For i = startPoint To 0 Step -1
If list(i).item <> vbNullString Then
nextAvailableTrue = True
num1 = i
Exit For
End If
Next
If nextAvailableTrue Then
Return num1 + 1
Else
Return startPoint + 1
End If
End Function
Function fixPointer(r As Integer) As Integer
Dim i As Integer = 0
Dim check As Boolean = False
Do
If list(i).item <> vbNullString Then
check = True
End If
i += 1
Loop Until check = True
For x = 0 To list.Length - 1
If list(x).pointer <> vbNull And list(x).item = vbNullString Then
list(x).pointer = vbNull
End If
Next
list(r).pointer = list(i).position
Return list(r).pointer
End Function
Sub showList()
Dim lastPosition As Integer = 0
For x = 0 To list.Length - 1
If list(x).isEmpty Then
list(x).pointer = 0
list(x).position = x
End If
If list(x).isEmpty = False Then
lastPosition = list(x).position
End If
Next
list(lastPosition).item = vbNullString
list(lastPosition).pointer = 0.0
For i = 0 To list.Length - 1
Console.WriteLine($"{list(i).position} ¦ {list(i).item} ¦ {list(i).pointer}")
Next
Console.ReadLine()
menu()
End Sub
End Module
I have a function that creates button dynamically based on a database table, there are about 250 records inside. Everything is working properly but I'd like to make it faster but I don't know how.
Maybe it's due to the language I don't know.
Actually, on my development machine, it takes about 56 seconds to load. I'm not an experienced developper so maybe I'm missing something.
The problem is that on the client machine, that has only 4Go of RAM, the loading time is much bigger, 2.5 to 3.5 minutes.
Thans you for your help.
This is my code :
Public Sub LoadProducts()
Me.ProgressBar1.Value = 0
Me.ProgressBar1.Visible = True
Dim oSim As New SimFonction
Dim str As String = "SELECT * FROM produits ORDER BY ref;"
Dim oCmd As New MySqlCommand(str, oSim.ConnectDb)
Dim oData As New DataSet
Dim oAdapt As New MySqlDataAdapter With {
.SelectCommand = oCmd
}
oAdapt.Fill(oData)
oSim.conn.Close()
recCount = oData.Tables(0).Rows.Count
Dim btn(recCount) As Button
Dim x, y, j As Integer
oAdapt = Nothing
oCmd = Nothing
str = Nothing
Dim ref As String
x = 0
y = 0
Dim valeurIncr As Integer = 100 / recCount
valeurBar = 0
i = 0
For i = 0 To oData.Tables(0).Rows.Count - 1
If Me.ProgressBar1.Value >= 90 Then
Me.ProgressBar1.Value = 0
End If
If j = 5 Then
y += 90
j = 0
x = 0
End If
x += 90
btn(i) = New Button With {
.Parent = productPanel,
.Location = New Point(x, y),
.Height = 90,
.Width = 90,
.Font = New Font("Microsoft Sans Serif", 14, FontStyle.Bold),
.ForeColor = Color.Orange,
.UseVisualStyleBackColor = True,
.TextAlign = ContentAlignment.BottomCenter
}
ref = oData.Tables(0).Rows(i).Item("ref").ToString
If IsDBNull(oData.Tables(0).Rows(i).Item("photo")) Then
btn(i).Text = oData.Tables(0).Rows(i).Item("ref").ToString
btn(i).Tag = oData.Tables(0).Rows(i).Item("ref").ToString
btn(i).Name = "bt" & ref
Else
Dim photoP As New IO.MemoryStream(CType(oData.Tables(0).Rows(i).Item("photo"), Byte()))
btn(i).BackgroundImage = Image.FromStream(photoP)
btn(i).BackgroundImageLayout = ImageLayout.Stretch
btn(i).Tag = oData.Tables(0).Rows(i).Item("ref").ToString
btn(i).Text = oData.Tables(0).Rows(i).Item("ref").ToString
btn(i).Name = "bt" & ref
photoP = Nothing
End If
If oSim.CheckProduiEnStock(ref) = False Then
btn(i).Enabled = False
End If
AddHandler btn(i).Click, AddressOf ButtonClicked
j += 1
Me.ProgressBar1.Value += 1
btn(i) = Nothing
Next
Me.ProgressBar1.Visible = False
End Sub
You may use the following command:
At the beginning: Me.SuspendLayout() ,and
at the end: Me.ResumeLayout()
So this morning I ran into a wall:
Using this Code I randomly get another row to show up when i paste my data.
It is meant to receive values ranging from 1 to 99999
So when i copy this:
And paste it into the Program this happens:
Private Sub DataGridView101_KeyDown(sender As Object, e As KeyEventArgs) Handles DataGridView101.KeyDown
If e.Control And
e.KeyCode = Keys.V Then
IsCopyPaste = True
Dim _ClipboardRows As String() = System.Windows.Forms.Clipboard.GetText().Split({System.Environment.NewLine}, StringSplitOptions.None)
Me.DataGridView101.BeginEdit(True)
For Each _ClipboardRow As String In _ClipboardRows
If _ClipboardRow <> "" Then
Dim _CellL As String = ""
Dim _CellR As String = ""
For Each _ClipboardColumn As String In _ClipboardRow.Split(System.Convert.ToChar(vbTab))
If _CellL = "" Then
_CellL = _ClipboardColumn
Else
If _CellR = "" Then
_CellR = _ClipboardColumn
End If
End If
Next
Dim _DataRow As System.Data.DataRow = (CType(Me.DataGridView101.DataSource, System.Data.DataTable)).NewRow()
_DataRow("1") = _CellL
_DataRow("2") = _CellR
CType(Me.DataGridView101.DataSource, System.Data.DataTable).Rows.Add(_DataRow)
End If
Next
Me.DataGridView101.EndEdit()
CType(Me.DataGridView101.DataSource, System.Data.DataTable).AcceptChanges()
IsCopyPaste = False
End If
End Sub
Below is my solution for that. You must call the functions from your event. In my application I need to decide allow pasting or not in the PasteUnboundRecords sub, which is controlled by the Allowed boolen
Public Sub CopyRows(MyDataGridView As DataGridView)
Dim d As DataObject = MyDataGridview.GetClipboardContent()
Try
Clipboard.SetDataObject(d)
Catch
MessageBox.Show("Text not copied, null value")
End Try
End Sub
Sub PasteUnboundRecords(MyDataGridView As DataGridView)
Dim Allowed As Boolean
Dim OriginLines As String() = Clipboard.GetText(TextDataFormat.Text).Split(New String(0) {vbCr & vbLf}, StringSplitOptions.None)
Dim Xo As Integer = SelectedAreaMinColumn(MyDataGridview)
Dim Yo As Integer = SelectedAreaMinRow(MyDataGridview)
Dim X As Integer
Dim Y As Integer
Dim i As Integer
Dim j As Integer
Dim ii As Integer
Dim jj As Integer = 0
Dim m1 As Integer
Dim n1 As Integer = OriginLines.Length
Dim m2 As Integer = SelectedAreaColumns(MyDataGridView)
Dim n2 As Integer = SelectedAreaRows(MyDataGridview)
Dim m2Max As Integer = MyDataGridview.Columns.Count
Dim n2Max As Integer = MyDataGridview.Rows.Count
For j = 0 To Math.Max(n1-1, n2-1)
Y = Yo + j
If Y = n2Max Then Exit For
If j-jj*n1 = n1 Then jj = jj+1
Dim OriginValue As String() = OriginLines(j-jj*n1).Split(New String(0) {vbTab}, StringSplitOptions.None)
m1 = OriginValue.Length
ii = 0
For i = 0 To Math.Max(m1-1, m2-1)
X = Xo + i
If X = m2Max Then Exit For
If i-ii*m1 = m1 Then ii = ii+1
If X > 0 Then 'Avoid pasting in first column containing codes
If Y = 0 Then 'Avoid first line
Allowed = True
Else 'Check DataValidatios
If DataValidations(OriginValue(i-ii*m1), X) = "OK" Then
Allowed = True
Else
Allowed = False
End If
End If
'Avoid pasting in Readonly columns
If MyDataGridview.Rows(Y).Cells(X).ReadOnly Then
Allowed = False
End If
If Allowed Then
MyDataGridview.Rows(Y).Cells(X).Value = OriginValue(i-ii*m1)
End If
End If
End If
Next i
Next j
End Sub
Private Function SelectedAreaMinRow(MyDataGridView As DataGridView) As Integer
Dim minRowIndex As Integer
For i As Integer = 0 To MyDataGridView.SelectedCells.Count - 1
If i = 0 Then
minRowIndex = MyDataGridView.SelectedCells.Item(i).RowIndex
End If
minRowIndex = Math.Min(MyDataGridView.SelectedCells.Item(i).RowIndex, minRowIndex)
Next i
Return minRowIndex
End Function
Private Function SelectedAreaMinColumn(MyDataGridView As DataGridView) As Integer
Dim minColumnIndex As Integer
For i As Integer = 0 To MyDataGridView.SelectedCells.Count - 1
If i = 0 Then
minColumnIndex = MyDataGridView.SelectedCells.Item(i).ColumnIndex
End If
minColumnIndex = Math.Min(MyDataGridView.SelectedCells.Item(i).ColumnIndex, minColumnIndex)
Next i
Return minColumnIndex
End Function
Private Function SelectedAreaRows(MyDataGridView As DataGridView) As Integer
Dim minRowIndex As Integer
Dim MaxRowIndex As Integer
For i As Integer = 0 To MyDataGridView.SelectedCells.Count - 1
If i = 0 Then
minRowIndex = MyDataGridView.SelectedCells.Item(i).RowIndex
MaxRowIndex = MyDataGridView.SelectedCells.Item(i).RowIndex
End If
minRowIndex = Math.Min(MyDataGridView.SelectedCells.Item(i).RowIndex, minRowIndex)
MaxRowIndex = Math.Max(MyDataGridView.SelectedCells.Item(i).RowIndex, MaxRowIndex)
Next i
Return MaxRowIndex-minRowIndex+1
End Function
Private Function SelectedAreaColumns(MyDataGridView As DataGridView) As Integer
Dim minColumnIndex As Integer
Dim MaxColumnIndex As Integer
For i As Integer = 0 To MyDataGridView.SelectedCells.Count - 1
If i = 0 Then
minColumnIndex = MyDataGridView.SelectedCells.Item(i).ColumnIndex
MaxColumnIndex = MyDataGridView.SelectedCells.Item(i).ColumnIndex
End If
minColumnIndex = Math.Min(MyDataGridView.SelectedCells.Item(i).ColumnIndex, minColumnIndex)
MaxColumnIndex = Math.Max(MyDataGridView.SelectedCells.Item(i).ColumnIndex, MaxColumnIndex)
Next i
Return MaxColumnIndex-minColumnIndex+1
End Function
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
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