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
Related
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
So today in my Computer Programming Class, we created a project called CaseStudy. I saw a way to make the program have more replay value. I decided to morph the code and interface to be like a Hangman game. I've got the limbs to appear, but only after clicking Ok on the messageBox.
I'm wondering if anyone has a way to make these limbs appear in real time.
Here is the important code:
Dim SECRET_WORD As String = newSecretWord
Const FLAG As Char = "!"
Const GUESS_PROMPT As String = "Enter a letter or " & FLAG & " to guess word:"
Dim numGuesses As Integer = 0
Dim letterGuess As Char
Dim wordGuess As String
Dim tempWord As String
Dim endGame As Boolean
Dim wordGuessedSoFar As String = ""
Dim lenght As Integer = SECRET_WORD.Length
wordGuessedSoFar = wordGuessedSoFar.PadLeft(lenght, "_")
Me.lblSecretWord.Text = wordGuessedSoFar
Dim tempLetterGuess = InputBox(GUESS_PROMPT, Me.Text)
If tempLetterGuess = Nothing Then
endGame = True
Else
letterGuess = tempLetterGuess
End If
Do While letterGuess <> FLAG And wordGuessedSoFar <> SECRET_WORD And Not endGame
numGuesses += 1
For letterPos As Integer = 0 To SECRET_WORD.Length - 1
If SECRET_WORD.Chars(letterPos) = Char.ToUpper(letterGuess) Then
tempWord = wordGuessedSoFar.Remove(letterPos, 1)
wordGuessedSoFar = tempWord.Insert(letterPos, Char.ToUpper(letterGuess))
Me.lblSecretWord.Text = wordGuessedSoFar
End If
Next letterPos
If wordGuessedSoFar <> SECRET_WORD Then
tempLetterGuess = InputBox(GUESS_PROMPT, Me.Text)
If tempLetterGuess = Nothing Then
endGame = True
Else
letterGuess = tempLetterGuess
End If
End If
Loop
If wordGuessedSoFar = SECRET_WORD Then
MessageBox.Show("You guessed it in " & numGuesses & " guesses!")
ElseIf letterGuess = FLAG Then
wordGuess = InputBox("Enter a word: ", Me.Text)
If wordGuess.ToUpper = SECRET_WORD Then
MessageBox.Show("You guessed it in " & numGuesses & " guesses!")
Me.lblSecretWord.Text = SECRET_WORD
Else
MessageBox.Show("Sorry, you lose.")
End If
Else
MessageBox.Show("Game over.")
lblSecretWord.Text = Nothing
End If
Dim place As Integer = SECRET_WORD.Length - 1
If tempLetterGuess <> SECRET_WORD.Chars(place) Then
numWrong += 1
End If
If numWrong = 1 Then
picHead.Visible = True
End If
If numWrong = 2 Then
picBody.Visible = True
End If
End Sub
End Class
I can take any other pictures if you'd like.
If I'm understanding you right, you want to show your "pictures" before the user sees the message. If so, you need to move the following code to an area just before your MessageBox and just after the InputBox:
Dim place As Integer = SECRET_WORD.Length - 1
If tempLetterGuess <> SECRET_WORD.Chars(place) Then
numWrong += 1
End If
If numWrong = 1 Then
picHead.Visible = True
End If
If numWrong = 2 Then
picBody.Visible = True
End If
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.
Given a string, how do you generate all partitions of it (shown as smaller strings separated by commas)?
Also, what is the total number of partitions for a string of length n?
The following will give the result, but is not good on long strings.
String: CODE
C,O,D,E
C,O,DE
C,OD,E
C,ODE
CO,D,E
CO,DE
COD,E
String: PEACE
P,E,A,C,E
P,E,A,CE
P,E,AC,E
P,E,ACE
P,EA,C,E
P,EA,CE
P,EAC,E
PE,A,C,E
PE,A,CE
PE,AC,E
PE,ACE
PEA,C,E
PEA,CE
Sub getAllComb()
oriStr = TextBox1.Text
Dim tmp = ""
Dim k = 0
For i = 0 To oriStr.Length
For j = 1 To 3
'tmp = Mid(oriStr, i, j)
Try
tmp1(k) = oriStr.Substring(i, j)
k = k + 1
'tmp = oriStr.Substring(i, j)
'Debug.Print(tmp)
Catch ex As Exception
'Debug.Print("Error>>>>" + ex.Message)
Exit For
End Try
Next
Next
tmp = ""
For i = 0 To k
Debug.Print(i.ToString + "<i " + tmp1(i))
tmp = tmp & tmp1(i) & vbCrLf
Next
'MessageBox.Show(tmp)
Dim tmpAll1 = ""
tmpAll1 = addFunclen4(k)
MessageBox.Show(tmpAll1)
Debug.Print(tmpAll1)
TextBox1.Text = oriStr & vbCrLf & vbCrLf & tmpAll1
End Sub
Function addFunclen4(k As Integer) As String
Dim retVal = ""
Dim tmp = ""
Dim tmpAll = ""
Dim tmpStr = ""
Dim tmpAll1 = ""
For i = 0 To k
For i1 = 0 To k
For i2 = 0 To k
For i3 = 0 To k
For i4 = 0 To k
tmp = Form1.tmp1(i) + Form1.tmp1(i1) + Form1.tmp1(i2) + Form1.tmp1(i3) + Form1.tmp1(i4)
If Form1.tmp1(i) <> "" Then
If tmp = Form1.oriStr Then
tmpStr = Form1.tmp1(i) + "," + Form1.tmp1(i1) + "," + Form1.tmp1(i2) + "," + Form1.tmp1(i3) + "," + Form1.tmp1(i4)
Do While tmpStr.Contains(",,") = True
tmpStr = Replace(tmpStr, ",,", ",")
Loop
If Mid(tmpStr, tmpStr.Length, 1) = "," Then
tmpStr = Mid(tmpStr, 1, tmpStr.Length - 1)
End If
If tmpAll1.Contains(tmpStr) = False Then
tmpAll1 = tmpAll1 + tmpStr + vbCrLf
End If
End If
End If
Next
Next
Next
Next
Next
retVal = tmpAll1
Return retVal
End Function
I reckon [2^(n-1) - 1] in total:
(n-1) positions to put a comma, 2 "states" (comma or not comma), -1 for the trivial case with no commas.
A simpler algorithm would be to iterate through the number of cases and use the binary representation to determine whether to put a comma in each position.
For example (simple form with TextBox, Button and ListBox):
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
ListBox1.Items.Clear()
Dim s As String = TextBox1.Text
If s.Length < 2 Then
MessageBox.Show("Enter a longer string")
Return
End If
For i = 1 To Math.Pow(2, s.Length - 1) - 1
Dim result As String = s(0)
For j = 1 To s.Length - 1
result = result & CommaOrNot(i, j) & s(j)
Next
ListBox1.Items.Add(result)
Next
End Sub
Private Function CommaOrNot(i As Integer, j As Integer) As String
If (i And Math.Pow(2, j - 1)) = Math.Pow(2, j - 1) Then
Return ","
Else
Return ""
End If
End Function
I really liked Fruitbat's approach. Here's an alternate version using a slightly different mechanism for the representation of the binary number and how to determine if the comma should be included or not:
Public Class Form1
Private combinations As List(Of String)
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim s As String = TextBox1.Text
If s.Length < 2 Then
MessageBox.Show("Enter a longer string")
Exit Sub
End If
Button1.Enabled = False
ListBox1.DataSource = Nothing
ListBox1.Items.Clear()
ListBox1.Items.Add("Generating combinations...")
BackgroundWorker1.RunWorkerAsync(s)
End Sub
Private Sub BackgroundWorker1_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
Dim s As String = e.Argument
Dim combinations As New List(Of String)
Dim binary() As Char
Dim values() As Char = s.ToCharArray
Dim max As Integer = Convert.ToInt32(New String("1", s.Length - 1), 2)
Dim sb As New System.Text.StringBuilder
For i As Integer = 0 To max
sb.Clear()
binary = Convert.ToString(i, 2).PadLeft(values.Length, "0").ToCharArray
For j As Integer = 0 To values.Length - 1
sb.Append(If(binary(j) = "0", "", ","))
sb.Append(values(j))
Next
combinations.Add(sb.ToString)
Next
e.Result = combinations
End Sub
Private Sub BackgroundWorker1_RunWorkerCompleted(sender As Object, e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles BackgroundWorker1.RunWorkerCompleted
combinations = e.Result
ListBox1.Items.Clear()
ListBox1.Items.Add("Generating combinations...Done!")
ListBox1.Items.Add("Adding Results...one moment please!")
Application.DoEvents()
ListBox1.DataSource = Nothing
ListBox1.DataSource = combinations
Button1.Enabled = True
MessageBox.Show("Done!")
End Sub
End Class
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