I made a jeopardy game in VB.Net
I know I am missing some codes but I don't know what should I use.
I need to save in a txt file and load it to a listbox.
here is my code:
Private Sub SummaryMenu_Load (sender As Object, e As EventArgs) Handles MyBase.Load
highscoreFile = FreeFile()
FileOpen(highscoreFile,
"jeeperdeyData.txt",
OpenMode.Input)
FileClose()
If totalScore > highscoreFile Then
highscore = totalScore
FileOpen(highscoreFile,
"jeeperdeyData.txt",
OpenMode.Output)
WriteLine(highscoreFile, username & " " & highscore)
FileClose(highscoreFile)
End If
End Sub
i have the variables in modules
'files
Public highscoreFile As Integer
Thanks
This replicates the work from the existing method with APIs that are actually under active use, though it seems odd to do all of this in a method named "SummaryMenu_Load()":
Private Class ScoreData
Public Property Name As String
Public Property Score as Integer
Public Shared Function FromFileLine(line As String) As ScoreData
Dim data = line.Split(vbTab)
Return New ScoreData With {Name = data(0), Score = Integer.Parse(data(1))}
End Function
Public Overrides Function ToString()
Return $"{Name}{vbTab}{Score}"
End Function
Public Shared ReadOnly Property MaxScores As Integer = 10
End Class
Private Sub SummaryMenu_Load (sender As Object, e As EventArgs) Handles MyBase.Load
var scores = File.ReadLines("jeeperdeyData.txt").
Select(AddressOf ScoreData.FromFileLine).
OrderByDescending(Function(s) s.Score).
ToList()
If scores.Count < ScoreData.MaxScores Then
scores.Add(new ScoreData With {Name = username, Score = highscore})
Else
Dim i As Integer = 0
While i < scores.Count AndAlso highscore <= scores(i).Score
i++
End While
If i < scores.Count Then 'Greater than at least one existing entry
Dim current As ScoreData = scores(i)
scores(i) = New ScoreData With {Name = username, Score = highscore}
i+=1
While i < scores.Count
Dim temp As ScoreData = scores(i)
scores(i) = current
current = temp
i+=1
End While
End If
End IF
File.WriteAllLines("jeeperdeyData.txt", scores.Select(Function(s) s.ToString()))
End Sub
Related
If NUD_Pepperoni.Value > 0 Then
txtSummary.AppendText(vbNewLine + "Pepperoni" + vbTab & vbTab & NUD_Pepperoni.Text + vbTab & price.ToString("c1") + vbTab + vbTab & (NUD_Pepperoni.Value * price).ToString("c1") + vbNewLine)
End If
If NUD_Hawaiian.Value > 0 Then
txtSummary.AppendText(vbNewLine + "Hawaiian" + vbTab & vbTab & vbTab & NUD_Hawaiian.Text + vbTab & price.ToString("c1") + vbTab + vbTab & (NUD_Hawaiian.Value * price).ToString("c1") + vbNewLine)
End If
If NUD_Americano.Value > 0 Then
txtSummary.AppendText(vbNewLine + "Americano" + vbTab & vbTab & NUD_Americano.Text + vbTab & price.ToString("c1") + vbTab + vbTab & (NUD_Americano.Value * price).ToString("c1") + vbNewLine)
End If
there are 12 of them the same
And the code below is the value I store
Dim Pizzalist(11, 1) As Single
================================================================
For p = 0 To 5
Pizzalist(p, 0) = 8.5 'store the regular pizza Price
Next
For p = 6 To 11
Pizzalist(p, 0) = 13.5 'store the gourmet pizza price
Next
================================================================
Pizzalist(0, 1) = NUD_Pepperoni.Value
Pizzalist(1, 1) = NUD_Hawaiian.Value
Pizzalist(2, 1) = NUD_Americano.Value
Pizzalist(3, 1) = NUD_TacoFiesta.Value
Pizzalist(4, 1) = NUD_Margherita.Value
Pizzalist(5, 1) = NUD_BeefOnion.Value
Pizzalist(6, 1) = NUD_BNY.Value
Pizzalist(7, 1) = NUD_MML.Value
Pizzalist(8, 1) = NUD_IL.Value
Pizzalist(9, 1) = NUD_GSS.Value
Pizzalist(10, 1) = NUD_AC.Value
Pizzalist(11, 1) = NUD_TMC.Value'store the amount of specific pizza
I looked up so many examples to try to figure out how to do this, but I couldn't. Thank you!
If you had a class which contained the information related to a pizza, let's call it Pizza, you could create a List(Of Pizza). That list can be iterated over once its data has been entered, for example if the user clicked a button to calculate the price.
Public Class Form1
Dim pizzas As New List(Of Pizza)
Public Class Pizza
Public Property QuantitySelector As NumericUpDown
Public Property UnitPrice As Decimal
Public Property Name As String
Public ReadOnly Property Quantity As Integer
Get
Return Convert.ToInt32(QuantitySelector.Value)
End Get
End Property
Sub New()
' Empty constructor
End Sub
Sub New(name As String, quantitySelector As NumericUpDown, unitPrice As Decimal)
Me.QuantitySelector = quantitySelector
Me.UnitPrice = unitPrice
Me.Name = name
End Sub
End Class
Private Sub bnCalcPrice_Click(sender As Object, e As EventArgs) Handles bnCalcPrice.Click
Dim sb As New Text.StringBuilder
For Each pz In pizzas
If pz.Quantity > 0 Then
sb.Append(vbNewLine & pz.Name & vbTab & vbTab & pz.Quantity & vbTab & pz.UnitPrice.ToString("c1") & vbTab & vbTab & (pz.Quantity * pz.UnitPrice).ToString("c1") & vbNewLine)
End If
Next
txtSummary.Text = sb.ToString()
End Sub
Private Sub InitPizzas()
Dim regularPrice = 8.5D ' Use Decimal values for money.
Dim premiumPrice = 13.5D
pizzas.Add(New Pizza("Hawaiian", NUD_Hawaiian, premiumPrice))
pizzas.Add(New Pizza("Americano", NUD_Americano, premiumPrice))
' etc.
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
InitPizzas()
End Sub
End Class
You could add code to add up the individual prices for each type of pizza too.
I also created a solution for you. Andrew has replied in the meantime while I was busy but I don't want to withhold that from you.
Like Andrew said, I would change the whole concept. I wrote a class with the most important properties of a pizza. You can change the amount in your restaurant kitchen. The data is saved in a List(of ClassPizza). As Andrew said, you can then iterate over this list and take advantage of the properties. For example sort by property xy. Maybe by best-before dates?
You can save the data in a text file. (Of course, it can be done better / differently but we don't want to exaggerate today). These data are read in when the program starts. (The very first time there is of course no data, just click on ‘cancel’ in the OpenfileDialog).
When new goods arrive, you can click on the button "bring new pizzas in store" and enter everything. A second form opens for this. Care is taken to ensure that no input errors are made (for example, quantity 0 makes no sense – the text then turns red).
The current stock is displayed in the 12 text boxes.
This is Form1.vb:
Imports Microsoft.VisualBasic.ControlChars
Imports Microsoft.WindowsAPICodePack.Dialogs
Public NotInheritable Class FormMain
Private ReadOnly Deu As New System.Globalization.CultureInfo("de-DE") ' change this to your language, for example "en-GB"
Private ReadOnly All_my_pizzas_List As New List(Of ClassPizza)
Private Sub FormMain_Load(sender As Object, e As EventArgs) Handles MyBase.Load
For Each tb As TextBox In Me.Controls.OfType(Of TextBox)
tb.Text = "0"
Next
End Sub
Private Sub FormMain_Shown(sender As Object, e As EventArgs) Handles MyBase.Shown
Dim Path As String
Using OFD1 As New CommonOpenFileDialog
OFD1.Title = "pick file to open"
OFD1.Filters.Add(New CommonFileDialogFilter("Text file", ".txt"))
OFD1.InitialDirectory = Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments)
If OFD1.ShowDialog() = CommonFileDialogResult.Ok Then
Path = OFD1.FileName
Else
Return
End If
End Using
'read all Text
Dim RAT() As String = System.IO.File.ReadAllLines(Path, System.Text.Encoding.UTF8)
If RAT.Length = 0 Then Return
For i As Integer = 1 To RAT.Length - 3 Step 1
If RAT(i) = "#" Then
All_my_pizzas_List.Add(New ClassPizza(CType(RAT(i + 1), ClassPizza.Types_of_pizza), CUShort(RAT(i + 2)), CDec(RAT(i + 3))))
End If
Next
Update_Textboxes()
End Sub
Private Sub Update_Textboxes()
Dim NUD_Pepperoni, NUD_Hawaiian, NUD_Americano, NUD_TacoFiesta, NUD_Margherita, NUD_BeefOnion, NUD_BNY, NUD_MML, NUD_IL, NUD_GSS, NUD_AC, NUD_TMC As Integer
For Each piz As ClassPizza In All_my_pizzas_List
Select Case piz.Type_of_pizza
Case ClassPizza.Types_of_pizza.NUD_Pepperoni
NUD_Pepperoni += 1
Case ClassPizza.Types_of_pizza.NUD_Hawaiian
NUD_Hawaiian += 1
Case ClassPizza.Types_of_pizza.NUD_Americano
NUD_Americano += 1
Case ClassPizza.Types_of_pizza.NUD_TacoFiesta
NUD_TacoFiesta += 1
Case ClassPizza.Types_of_pizza.NUD_Margherita
NUD_Margherita += 1
Case ClassPizza.Types_of_pizza.NUD_BeefOnion
NUD_BeefOnion += 1
Case ClassPizza.Types_of_pizza.NUD_BNY
NUD_BNY += 1
Case ClassPizza.Types_of_pizza.NUD_MML
NUD_MML += 1
Case ClassPizza.Types_of_pizza.NUD_IL
NUD_IL += 1
Case ClassPizza.Types_of_pizza.NUD_GSS
NUD_GSS += 1
Case ClassPizza.Types_of_pizza.NUD_AC
NUD_AC += 1
Case ClassPizza.Types_of_pizza.NUD_TMC
NUD_TMC += 1
Case Else
Exit Select
End Select
Next
TextBox_Pepperoni.Text = NUD_Pepperoni.ToString(Deu)
TextBox_Hawaiian.Text = NUD_Hawaiian.ToString(Deu)
TextBox_Americano.Text = NUD_Americano.ToString(Deu)
TextBox_TacoFiesta.Text = NUD_TacoFiesta.ToString(Deu)
TextBox_Margherita.Text = NUD_Margherita.ToString(Deu)
TextBox_BeefOnion.Text = NUD_BeefOnion.ToString(Deu)
TextBox_BNY.Text = NUD_BNY.ToString(Deu)
TextBox_MML.Text = NUD_MML.ToString(Deu)
TextBox_IL.Text = NUD_IL.ToString(Deu)
TextBox_GSS.Text = NUD_GSS.ToString(Deu)
TextBox_AC.Text = NUD_AC.ToString(Deu)
TextBox_TMC.Text = NUD_TMC.ToString(Deu)
End Sub
Private Sub Button_toStore_Click(sender As Object, e As EventArgs) Handles Button_toStore.Click
Using FNP As New Form_new_pizza
FNP.GetData()
If FNP.ShowDialog = DialogResult.Yes Then
For i As UInt16 = 0US To FNP.Amount - 1US Step 1US
All_my_pizzas_List.Add(New ClassPizza(CType(FNP.SI, ClassPizza.Types_of_pizza), 1US, FNP.price))
Next
End If
End Using
Update_Textboxes()
End Sub
Private Sub Button_change_values_Click(sender As Object, e As EventArgs) Handles Button_change_values.Click
' this is still empty
End Sub
Private Sub Button_Save_Click(sender As Object, e As EventArgs) Handles Button_Save.Click
'-------------------------------------------------------------------------------------------------------------
' User can choose where to save the database text file and the program will save it.
'-------------------------------------------------------------------------------------------------------------
Dim Path As String
Using SFD1 As New CommonSaveFileDialog
SFD1.Title = "write data into text file"
SFD1.Filters.Add(New CommonFileDialogFilter("Text file", ".txt"))
SFD1.InitialDirectory = Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments)
If SFD1.ShowDialog() = CommonFileDialogResult.Ok Then
Path = SFD1.FileName & ".txt"
Else
Return
End If
End Using
Using textfile As System.IO.StreamWriter = My.Computer.FileSystem.OpenTextFileWriter(Path, True, System.Text.Encoding.UTF8)
textfile.WriteLine("Status of this file [dd.mm.yyyy hh:mm:ss]: " & Date.Now.ToString("G", Deu))
For Each pizza As ClassPizza In All_my_pizzas_List
textfile.WriteLine("#") ' Marker
textfile.WriteLine(pizza.Type_of_pizza)
textfile.WriteLine(pizza.stored_amount)
textfile.WriteLine(pizza.price)
Next
textfile.Close()
End Using
End Sub
End Class
This is the code of the ClassPizza.vb
Public NotInheritable Class ClassPizza
Public Enum Types_of_pizza
NUD_Pepperoni
NUD_Hawaiian
NUD_Americano
NUD_TacoFiesta
NUD_Margherita
NUD_BeefOnion
NUD_BNY
NUD_MML
NUD_IL
NUD_GSS
NUD_AC
NUD_TMC
End Enum
Public Type_of_pizza As Types_of_pizza
Public stored_amount As UInt16 = 0US
''' <summary>
''' in $
''' </summary>
Public price As Decimal
Public Sub New(ByVal type As Types_of_pizza, ByVal storedAmount As UInt16, price As Decimal)
Me.Type_of_pizza = type
Me.stored_amount = storedAmount
Me.price = price
End Sub
End Class
And this is the code of that second Form (Form_new_pizza.vb)
Public NotInheritable Class Form_new_pizza
Public Amount As UInt16
Public price As Decimal
Public SI As Integer
Public Sub GetData()
For Each _item As Object In [Enum].GetValues(GetType(ClassPizza.Types_of_pizza))
ListBox1.Items.Add(_item)
Next
End Sub
Private Sub Form_new_pizza_Load(sender As Object, e As EventArgs) Handles MyBase.Load
End Sub
Private Sub TextBox_Amount_TextChanged(sender As Object, e As EventArgs) Handles TextBox_Amount.TextChanged
Dim success As Boolean = UInt16.TryParse(TextBox_Amount.Text, Amount)
If success AndAlso Amount > 0US Then
TextBox_Amount.ForeColor = Color.FromArgb(0, 200, 0) 'Green
Else
TextBox_Amount.ForeColor = Color.Red
End If
End Sub
Private Sub TextBox_price_TextChanged(sender As Object, e As EventArgs) Handles TextBox_price.TextChanged
Dim success As Boolean = Decimal.TryParse(TextBox_price.Text, price)
If success Then
TextBox_price.ForeColor = Color.FromArgb(0, 200, 0) 'Green
Else
TextBox_price.ForeColor = Color.Red
End If
End Sub
Private Sub ListBox1_SelectedIndexChanged(sender As Object, e As EventArgs) Handles ListBox1.SelectedIndexChanged
If ListBox1.SelectedIndex <> (-1) Then
SI = ListBox1.SelectedIndex
End If
End Sub
Private Sub Button_OK_Click(sender As Object, e As EventArgs) Handles Button_OK.Click
If SI <> (-1) AndAlso Amount > 0US Then
Me.DialogResult = DialogResult.Yes
Else
Me.DialogResult = DialogResult.No
End If
End Sub
End Class
Of course, one can expand everything and do it better than me, but you can start, and understand the concept. 😉
By the way
You should set ‘Option Strict’ to On in the project properties so that you are advised to convert data types. Also set ‘Option Infer’ to Off so that you always have to write down the data type ("As Integer", "As Double", ...). The latter, however, is a matter of taste.
Also, you should remove the VB6 namespace as VB6 features are deprecated.
If you need control characters (such as NewLine), you can write Imports Microsoft.VisualBasic.ControlChars
.
====================================
Please note that I am using a FileDialog that I downloaded from Visual Studios' own Nuget Package Manager. See image. You don't have to do that, but I prefer this FileDialog because it offers more options than the one that is already included.
I'm trying to get data from a DGV grid onto specific tags, and so far it has been working great. But an update moved the tags positions in the DGV so Rows(x) does not equal the tags I'm moving data into anymore.
Is it possible to do a search like the one I'm doing in Cells("Val") but in the Rows("") instead?
Actually I want it to be something like this Rows("TagIndex = 5") etc.
A full line of code would then be:
HopperStatus = dgvDataFlt.Rows("TagIndex = 5").Cells("Val").Value
but is this possible.
Row 12 & 13 are switched when logging
dgvDataFLT = dgvDataFloating
If dgvDataFlt.Rows(0).Cells("TagIndex").Value = 12 Then
'DGVDataFlt.AutoResizeColumns()
'--------------------------------------Floating TAGS fra database------------------------------------------
ProdRecCnt = dgvDataFlt.Rows(10).Cells("Val").Value
ProdTotCnt = dgvDataFlt.Rows(9).Cells("Val").Value
FrontFree = dgvDataFlt.Rows(8).Cells("Val").Value
CurrAutoMode = dgvDataFlt.Rows(7).Cells("Val").Value
PalletStatus = dgvDataFlt.Rows(6).Cells("Val").Value
HopperStatus = dgvDataFlt.Rows(5).Cells("Val").Value
PowerStatus = dgvDataFlt.Rows(4).Cells("Val").Value
CurrRecNo = dgvDataFlt.Rows(3).Cells("Val").Value
NomCycTime = dgvDataFlt.Rows(2).Cells("Val").Value
AutoStart = dgvDataFlt.Rows(1).Cells("Val").Value
MachineNo = dgvDataFlt.Rows(0).Cells("Val").Value
LOGTimeStamp = dgvDataFlt.Rows(0).Cells("DateAndTime").Value 'for aktuelle lognings tidstempel
LOGDateStamp = Microsoft.VisualBasic.Left(LOGTimeStamp, 10)
LOGClockStamp = Microsoft.VisualBasic.Mid(LOGTimeStamp, 12, 5)
End If
I want the code to look/work something like this:
If dgvDataFlt.Rows(0).Cells("TagIndex").Value = 12 Then
'DGVDataFlt.AutoResizeColumns()
'--------------------------------------Floating TAGS fra database------------------------------------------
ProdRecCnt = dgvDataFlt.Rows("TagIndex = 10").Cells("Val").Value
ProdTotCnt = dgvDataFlt.Rows("TagIndex = 9").Cells("Val").Value
FrontFree = dgvDataFlt.Rows("TagIndex = 8").Cells("Val").Value
CurrAutoMode = dgvDataFlt.Rows("TagIndex = 7").Cells("Val").Value
PalletStatus = dgvDataFlt.Rows("TagIndex = 6").Cells("Val").Value
HopperStatus = dgvDataFlt.Rows("TagIndex = 5").Cells("Val").Value
PowerStatus = dgvDataFlt.Rows("TagIndex = 4").Cells("Val").Value
CurrRecNo = dgvDataFlt.Rows("TagIndex = 3").Cells("Val").Value
NomCycTime = dgvDataFlt.Rows("TagIndex = 2").Cells("Val").Value
AutoStart = dgvDataFlt.Rows("TagIndex = 1").Cells("Val").Value
MachineNo = dgvDataFlt.Rows("TagIndex = 0").Cells("Val").Value
LOGTimeStamp = dgvDataFlt.Rows(0).Cells("DateAndTime").Value 'for aktuelle lognings tidstempel
LOGDateStamp = Microsoft.VisualBasic.Left(LOGTimeStamp, 10)
LOGClockStamp = Microsoft.VisualBasic.Mid(LOGTimeStamp, 12, 5)
End If
I would suggest adding a class and then inheriting the DataGridView control into that class. I have made a quick little example of this and the code works, but to get it to work you will have to perform a few steps:
(1) If you don't already have a windows forms application to test this then,
make a new one.
(2) Create class named KeyedDataGridView
(3) Copy and Paste the following Code into KeyedDataGridView class
(4) Rebuild your Project
(5) Drag and Drop new component onto your windows Form.
NOTE: This class is limited, but should still be able to do what you require of it.
Finally, if you need any help then, please leave a comment and will try to get to it when I can.
Option Explicit On
Public Class KeyedDataGridView
Inherits Windows.Forms.DataGridView
Dim _Rows As KeyedDataRows
Public Shadows Property Rows As KeyedDataRows
Get
Return _Rows
End Get
Set(value As KeyedDataRows)
_Rows = value
End Set
End Property
Public Sub New()
Dim strName As String
strName = Me.Name
strName = MyBase.Name
_Rows = New KeyedDataRows(Me)
_Rows.Rows = MyBase.Rows
End Sub
Protected Overrides Sub Finalize()
_Rows = Nothing
MyBase.Finalize()
End Sub
End Class
Public Class KeyedDataRows
Inherits Windows.Forms.DataGridViewRowCollection
Dim _TagNames As Dictionary(Of String, Integer)
Dim _Rows As DataGridViewRowCollection
Dim _Cells As Dictionary(Of String, DataGridViewCellCollection)
Dim dgv As DataGridView
Default Public Overloads ReadOnly Property Item(strTagName As String) As DataGridViewRow
Get
Return _Rows.Item(Me.IndexFromName(strTagName))
End Get
End Property
Protected Friend Property Rows As DataGridViewRowCollection
Get
Return _Rows
End Get
Set(value As DataGridViewRowCollection)
_Rows = value
End Set
End Property
Public Property TagName(index As Integer) As String
Get
Return CStr(_TagNames.Item(index))
End Get
Set(value As String)
_TagNames.Item(index) = value
End Set
End Property
Public Sub New(tmp As DataGridView)
MyBase.New(tmp)
dgv = tmp
_TagNames = New Dictionary(Of String, Integer)
_Cells = New Dictionary(Of String, DataGridViewCellCollection)
End Sub
Public Shadows Sub Add(strTagName As String)
Dim intCurRow As Integer
If dgv.AllowUserToAddRows Then
intCurRow = _Rows.Count - 1
Else
intCurRow = _Rows.Count
End If
_TagNames.Add(strTagName, intCurRow)
_Rows.Add()
End Sub
Public Shadows Sub Add(strTagName As String, dataGridViewRow As DataGridViewRow)
Dim intCurRow As Integer
If dgv.AllowUserToAddRows Then
intCurRow = _Rows.Count - 1
Else
intCurRow = _Rows.Count
End If
_TagNames.Add(strTagName, intCurRow)
_Rows.Add(dataGridViewRow)
End Sub
Public Shadows Sub Add(count As Integer, strTagNames() As String)
Dim intI As Integer
Dim intCurRow As Integer
If dgv.AllowUserToAddRows Then
intCurRow = _Rows.Count - 1
Else
intCurRow = _Rows.Count
End If
For intI = 0 To (count - 1)
_TagNames.Add(strTagNames(intI), intCurRow)
_Rows.Add()
intCurRow = _Rows.Count - 1
Next intI
End Sub
Public Property IndexFromName(strTagName As String) As Integer
Get
If _TagNames.Count > 0 Then
If _TagNames.ContainsKey(strTagName) Then
Return _TagNames.Item(strTagName)
Else
Return -1
End If
Else
Return -1
End If
End Get
Set(value As Integer)
_TagNames.Add(strTagName, value)
End Set
End Property
Public Overloads Sub RemoveAt(strTagName As String)
_Cells.Remove(strTagName)
_Rows.RemoveAt(IndexFromName(strTagName))
_TagNames.Remove(strTagName)
End Sub
Protected Overrides Sub Finalize()
_TagNames.Clear()
_TagNames = Nothing
_Cells.Clear()
_Rows.Clear()
_Cells = Nothing
_Rows = Nothing
MyBase.Finalize()
End Sub
End Class
I also, added the following buttons to a windows form to test the code:
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
With KeyedDataGridView1
.Rows.Add("Tag Test 1")
.Rows.Add("Tag Test 2")
.Rows.Add("Tag Test 3")
.Rows.Add("Tag Test 4")
End With
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
MsgBox(KeyedDataGridView1.Rows("Tag Test 3").Cells(0).Value & vbCrLf &
KeyedDataGridView1.Rows("Tag Test 3").Cells(1).Value & vbCrLf &
KeyedDataGridView1.Rows("Tag Test 3").Cells(2).Value)
MsgBox(KeyedDataGridView1.Rows("Tag Test 2").Cells(0).Value & vbCrLf &
KeyedDataGridView1.Rows("Tag Test 2").Cells(1).Value & vbCrLf &
KeyedDataGridView1.Rows("Tag Test 2").Cells(2).Value)
MsgBox(KeyedDataGridView1.Rows("Tag Test 1").Cells(0).Value & vbCrLf &
KeyedDataGridView1.Rows("Tag Test 1").Cells(1).Value & vbCrLf &
KeyedDataGridView1.Rows("Tag Test 1").Cells(2).Value)
End Sub
I want to color every same word inside a RichTextBox. I can do it for one line but not on multiple lines.
E.g., Welcome "user" .....
I want the word user to be an exact color in every line it's found.
Here's with what i came up so far:
RichTextBox1.Text = "Welcome "
RichTextBox1.Select(RichTextBox1.TextLength, 0)
RichTextBox1.SelectionColor = My.Settings.color
RichTextBox1.AppendText(My.Settings.username)
RichTextBox1.SelectionColor = Color.Black
RichTextBox1.AppendText(" ........." + vbCrLf)
It's on form.Load; I tried to use the richtextbox.TextChange event, but it just colors the last user word and the others are remain the same.
This is a simple Class that enables multiple Selections and Highlights of text for RichTextBox and TextBox controls.
You can use multiple instances of this Class for different controls.
You can add the Words to Select/HighLight to a List and specify which color to use for selecting and/or highlighting the text.
Dim listOfWords As WordList = New WordList(RichTextBox1)
listOfWords.AddRange({"Word1", "Word2"})
listOfWords.SelectionColor = Color.LightBlue
listOfWords.HighLightColor = Color.Yellow
These are the visual results of the Class actions:
In the example, the List of words is filled using:
Dim patterns As String() = TextBox1.Text.Split()
listOfWords.AddRange(patterns)
In the visual example, the Class is configured this way:
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim patterns As String() = TextBox1.Text.Split()
Dim listOfWords As WordList = New WordList(RichTextBox1)
listOfWords.AddRange(patterns)
listOfWords.SelectionColor = Color.LightBlue
listOfWords.HighLightColor = Color.Yellow
If RadioButton1.Checked = True Then
listOfWords.WordsSelect()
ElseIf RadioButton2.Checked Then
listOfWords.WordsHighLight()
Else
listOfWords.DeselectAll()
End If
End Sub
This is the Class used to generate the Selections and HighLights:
Imports System.Drawing.Text
Imports System.Text.RegularExpressions
Public Class WordList
Private TextRendererFlags As TextFormatFlags =
TextFormatFlags.Top Or TextFormatFlags.Left Or TextFormatFlags.NoPadding Or
TextFormatFlags.WordBreak Or TextFormatFlags.TextBoxControl
Private textControl As RichTextBox = Nothing
Private wordsList As List(Of Word)
Public Sub New(rtb As RichTextBox)
textControl = rtb
wordsList = New List(Of Word)
ProtectSelection = False
End Sub
Public Property ProtectSelection As Boolean
Public Property HighLightColor As Color
Public Property SelectionColor As Color
Public Sub Add(word As String)
wordsList.Add(New Word() With {.Word = word, .Indexes = GetWordIndexes(word)})
End Sub
Public Sub AddRange(words As String())
For Each WordItem As String In words
wordsList.Add(New Word() With {.Word = WordItem, .Indexes = GetWordIndexes(WordItem)})
Next
End Sub
Private Function GetWordIndexes(word As String) As List(Of Integer)
Return Regex.Matches(textControl.Text, word).
OfType(Of Match)().
Select(Function(chr) chr.Index).ToList()
End Function
Public Sub DeselectAll()
If textControl IsNot Nothing Then
textControl.SelectAll()
textControl.SelectionBackColor = textControl.BackColor
textControl.Update()
End If
End Sub
Public Sub WordsHighLight()
If wordsList.Count > 0 Then
For Each WordItem As Word In wordsList
For Each Position As Integer In WordItem.Indexes
Dim p As Point = textControl.GetPositionFromCharIndex(Position)
TextRenderer.DrawText(textControl.CreateGraphics(), WordItem.Word,
textControl.Font, p, textControl.ForeColor,
HighLightColor, TextRendererFlags)
Next
Next
End If
End Sub
Public Sub WordsSelect()
DeselectAll()
If wordsList.Count > 0 Then
For Each WordItem As Word In wordsList
For Each Position As Integer In WordItem.Indexes
textControl.Select(Position, WordItem.Word.Length)
textControl.SelectionColor = textControl.ForeColor
textControl.SelectionBackColor = SelectionColor
textControl.SelectionProtected = ProtectSelection
Next
Next
End If
End Sub
Friend Class Word
Property Word As String
Property Indexes As List(Of Integer)
End Class
End Class
With a module,you can do it this way :
Imports System.Runtime.CompilerServices
Module Utility
<Extension()>
Sub HighlightText(ByVal myRtb As RichTextBox, ByVal word As String, ByVal color As Color)
If word = String.Empty Then Return
Dim index As Integer, s_start As Integer = myRtb.SelectionStart, startIndex As Integer = 0
While(__InlineAssignHelper(index, myRtb.Text.IndexOf(word, startIndex))) <> -1
myRtb.[Select](index, word.Length)
myRtb.SelectionColor = color
startIndex = index + word.Length
End While
myRtb.SelectionStart = s_start
myRtb.SelectionLength = 0
myRtb.SelectionColor = Color.Black
End Sub
<Obsolete("Please refactor code that uses this function, it is a simple work-around to simulate inline assignment in VB!")>
Private Shared Function __InlineAssignHelper(Of T)(ByRef target As T, value As T) As T
target = value
Return value
End Function
End Module
Or , you can also go with this one as it will allow you to highlight multiple words at the same time :
Private Sub HighlightWords(ByVal words() As String)
Private Sub HighlightWords(ByVal words() As String)
For Each word As String In words
Dim startIndex As Integer = 0
While (startIndex < rtb1.TextLength)
Dim wordStartIndex As Integer = rtb1.Find(word, startIndex, RichTextBoxFinds.None)
If (wordStartIndex <> -1) Then
rtb1.SelectionStart = wordStartIndex
rtb1.SelectionLength = word.Length
rtb1.SelectionBackColor = System.Drawing.Color.Black
Else
Exit While
End If
startIndex += wordStartIndex + word.Length
End While
Next
End Sub
Source Hope this helps :)
This works
Public Sub HighlightText(ByVal txt As String, ByVal obj As RichTextBox)
obj.SelectionStart = 0
obj.SelectAll()
obj.SelectionBackColor = Color.White
Dim len = txt.Length
Dim pos = obj.Find(txt, 0, RichTextBoxFinds.NoHighlight)
While (pos >= 0)
obj.Select(pos, len)
obj.SelectionBackColor = Color.Yellow
If pos + len >= obj.Text.Length Then
Exit While
End If
pos = obj.Find(txt, pos + len, RichTextBoxFinds.NoHighlight)
End While
End Sub
Public Sub HighlightText(ByVal txt As String, ByVal obj As RichTextBox)
obj.SelectionStart = 0
obj.SelectAll()
obj.SelectionBackColor = Color.White
Dim len = txt.Length
Dim pos = obj.Find(txt, 0, RichTextBoxFinds.NoHighlight)
While (pos >= 0)
obj.Select(pos, len)
obj.SelectionBackColor = Color.Yellow
If pos + len >= obj.Text.Length Then
Exit While
End If
pos = obj.Find(txt, pos + len, RichTextBoxFinds.NoHighlight)
End While
End Sub
I have delimited a text file and put it into a 2D array. Then, I have tried to find out if the array contains the product ID (entered in a textbox). However, the code I have used to try to search the array and show the name does not work.
The textfile says:
1, Frances
2, Emma
Here is my code:
Public Class Form1
Dim filename As String
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
filename = "names.txt"
End Sub
Private Sub btnsearch_Click(sender As Object, e As EventArgs) Handles btnsearch.Click
filename = "names.txt"
FileOpen(1, filename, OpenMode.Input,,,)
Dim lines() As String = IO.File.ReadAllLines("names.txt")
Dim values(lines.Length - 1, 1) As String
For i As Integer = 0 To lines.Length - 1
Dim parts() As String = lines(i).Split(","c)
values(i, 0) = parts(0)
values(i, 1) = parts(1)
Next
Dim ID As String
ID = txtidsearch.Text
Dim line As String
Do While Not EOF(1)
line = LineInput(1)
If values().Contains(ID) Then
lblid.Text = line
Application.DoEvents()
GoTo line1
ElseIf EOF(1) = True
MsgBox("Not Found")
End If
Loop
line1:
FileClose(1)
End Sub
End Class
Thanks in advance
What I would do is create a class to hold your people. It would make it easier in the long run.
First create a Person class:
Imports System.Collections.ObjectModel
Public Class Person
Public Key As String
Public Sub New(ByVal id As Integer,
ByVal name As String,
ByVal form as String)
_id = id
_name = name
_form = form
End Sub
Private _id As Integer
Public ReadOnly Property Id() As Integer
Get
Return _id
End Get
End Property
Private _name As String
Public ReadOnly Property Name() As String
Get
Return _name
End Get
End Property
Private _form As String
Public ReadOnly Property Form() As String
Get
Return _form
End Get
End Property
End Class
Now create a People class which will be a collection to hold each Person:
Public Class People
Inherits KeyedCollection(Of String, Person)
Protected Overrides Function GetKeyForItem(ByVal item As Person) As String
Return item.Key
End Function
End Class
I would then change this bit of code:
Dim values(lines.Length - 1, 1) As String
For i As Integer = 0 To lines.Length - 1
Dim parts() As String = lines(i).Split(","c)
values(i, 0) = parts(0)
values(i, 1) = parts(1)
Next
To this:
Dim myPeople As New People
For i As Integer = 0 To lines.Length - 1
Dim parts() As String = lines(i).Split(","c)
myPeople.Add(New Person(parts(0), parts(1), parts(2)))
Next
Note that I am adding a new Person class to the People collection class.
And I would replace this code:
Dim line As String
Do While Not EOF(1)
line = LineInput(1)
If values().Contains(ID) Then
lblid.Text = line
Application.DoEvents()
GoTo line1
ElseIf EOF(1) = True
MsgBox("Not Found")
End If
Loop
line1:
With this:
Dim filteredLines = From people In myPeople
Where people.Id = ID
Select people
If filteredLines IsNot Nothing AndAlso filteredLines.Count = 1 Then
Label1.Text = filteredLines(0).Name
End If
This last bit of code is LINQ:
General-purpose query facilities added to the .NET Framework apply to all sources of information, not just relational or XML data. This facility is called .NET Language-Integrated Query (LINQ).
Using LINQ we can query the People collection class like we would a table on a database using similar syntax. Here I am selecting all of the People where the ID matches. I then check to ensure that filteredLines actually has a Person before assigning the value.
I have a class that grabs data from a table on sql server and I assign the data to variables and I then output the data under columns in a listview, problem Is I am only getting the first row in my sql table I need a loop to fill some container full of the data values and pass all rows to listview. How would I accomplish this, my programing experience is very limited. how would I first get the data from sql into a usable container from the code below?
Public Class Inventory
Public mFirstName As String
Public mLastName As String
Public mComputerType As String
Public mAssetTag As String
Public mCheckOutDate As Date
Public mCheckInDate As Date
Public mExpectedReturnDate As Date
Public mUserEmailAddress As String
Public mLoanSubmitter As String
Public mDeployed As Integer
Public Sub New()
LoadData()
End Sub
Public Sub New(dr As DataRow)
End Sub
Private Sub LoadData()
Dim dbConn As HUG.Core.Database.SQLConnection
Dim sql As String = ""
Dim ds As New DataSet
sql = "SELECT * FROM HDData.dbo.TravelLaptopRecords "
dbConn = New HUG.Core.Database.SQLConnection("WorkFiles")
ds = dbConn.FillDataSet(sql)
If Not IsNothing(ds) Then
If ds.Tables(0).Rows.Count > 0 Then
With ds.Tables(0).Rows(0)
mFirstName = CStr(.Item("FirstName"))
mLastName = CStr(.Item("LastName"))
mComputerType = CStr(.Item("ComputerType"))
mAssetTag = CStr(.Item("AssetTag"))
mCheckOutDate = CDate(.Item("CheckOutDate"))
mCheckInDate = CDate(.Item("CheckInDate"))
mExpectedReturnDate = CDate(.Item("ExpectedReturnDate"))
mUserEmailAddress = CStr(.Item("UserEmailAddress"))
mLoanSubmitter = CStr(.Item("LoanSubmitter"))
mDeployed = CInt(.Item("Deployed"))
End With
End If
End If
End Sub
End Class
this is the form page
Public Class Form1
Private mLaptopInventory As Inventory
Private isLoad As Boolean
Private mFirstName As String
Private mLastName As String
Private mComputerType As String
Private mAssetTag As String
Private mCheckOutDate As Date
Private mCheckInDate As Date
Private mExpectedReturnDate As Date
Private mUserEmailAddress As String
Private mLoanSubmitter As String
Private mDeployed As Integer
Public Sub New()
' This call is required by the designer.
InitializeComponent()
' Add any initialization after the InitializeComponent() call.
HUG.Core.Globals.BootStrap("G:\Programs\somefile.ini")
isLoad = True
End Sub
Private Sub Form1_Shown(Sender As Object, e As EventArgs) Handles Me.Shown
mLaptopInventory = New Inventory()
LoadForm()
isLoad = False
End Sub
Private Sub LoadForm()
GroupBox1.Text = "Travel Laptop Inquiry"
InventoryList.View = View.Details
mFirstName = mLaptopInventory.mFirstName
mLastName = mLaptopInventory.mLastName
mComputerType = mLaptopInventory.mComputerType
mAssetTag = mLaptopInventory.mAssetTag
mCheckOutDate = mLaptopInventory.mCheckOutDate
mCheckInDate = mLaptopInventory.mCheckInDate
mExpectedReturnDate = mLaptopInventory.mExpectedReturnDate
mUserEmailAddress = mLaptopInventory.mUserEmailAddress
mLoanSubmitter = mLaptopInventory.mLoanSubmitter
mDeployed = mLaptopInventory.mDeployed
InventoryList.Items.Add(mFirstName)
InventoryList.Items(InventoryList.Items.Count - 1).SubItems.Add(mLastName)
InventoryList.Items(InventoryList.Items.Count - 1).SubItems.Add(mComputerType)
InventoryList.Items(InventoryList.Items.Count - 1).SubItems.Add(mAssetTag)
If mDeployed = -1 Then
InventoryList.Items(InventoryList.Items.Count - 1).SubItems.Add(mCheckOutDate)
InventoryList.Items(InventoryList.Items.Count - 1).SubItems.Add("Item Not Returned").ToString()
InventoryList.Items(InventoryList.Items.Count - 1).SubItems.Add(mExpectedReturnDate)
Else
InventoryList.Items(InventoryList.Items.Count - 1).SubItems.Add("Item is on Hand").ToString()
InventoryList.Items(InventoryList.Items.Count - 1).SubItems.Add(mCheckInDate)
InventoryList.Items(InventoryList.Items.Count - 1).SubItems.Add("").ToString()
End If
InventoryList.Items(InventoryList.Items.Count - 1).SubItems.Add(mUserEmailAddress)
InventoryList.Items(InventoryList.Items.Count - 1).SubItems.Add(mLoanSubmitter)
End Sub
End Class
You only check the first row with ds.Tables(0).Rows(0). You should loop through all the rows and add the data in a list.
Remove the loading from the New()
Public Sub New()
End Sub
Then change your LoadData to a Public Shared
Public Shared Function LoadData() As List(Of Inventory)
Dim dbConn As HUG.Core.Database.SQLConnection
Dim sql As String = ""
Dim ds As New DataSet
Dim result As New List(Of Inventory)
sql = "SELECT * FROM HDData.dbo.TravelLaptopRecords "
dbConn = New HUG.Core.Database.SQLConnection("WorkFiles")
ds = dbConn.FillDataSet(sql)
If Not IsNothing(ds) Then
For i As Integer = 0 To ds.Tables(0).Rows.Count-1
Dim newInventory As New Inventory
newInventory.mFirstName = CStr(ds.Tables(0).Rows(i).Item("FirstName"))
newInventory.mLastName = CStr(ds.Tables(0).Rows(i).Item("LastName"))
newInventory.mComputerType = CStr(ds.Tables(0).Rows(i).Item("ComputerType"))
newInventory.mAssetTag = CStr(ds.Tables(0).Rows(i).Item("AssetTag"))
newInventory.mCheckOutDate = CDate(ds.Tables(0).Rows(i).Item("CheckOutDate"))
newInventory.mCheckInDate = CDate(ds.Tables(0).Rows(i).Item("CheckInDate"))
newInventory.mExpectedReturnDate = CDate(ds.Tables(0).Rows(i).Item("ExpectedReturnDate"))
newInventory.mUserEmailAddress = CStr(ds.Tables(0).Rows(i).Item("UserEmailAddress"))
newInventory.mLoanSubmitter = CStr(ds.Tables(0).Rows(i).Item("LoanSubmitter"))
newInventory.mDeployed = CInt(ds.Tables(0).Rows(i).Item("Deployed"))
result.Add(newInventory)
Next
End If
Return result
End Function
At least now when you call Inventory.LoadData() you'll get all your data. This isn't the best way of doing things but it should start you on the right direction.
You are choosing Row zero (With ds.Tables(0).Rows(0)) and it needs to be in a loop like:
For i As Integer = 0 To ds.Tables(0).Rows.Count-1
' Get the strings here
' ...
mFirstName = ds.Tables(0).Rows(i).Item("FirstName").ToString
Next