Listbox formatting VB - vb.net

I would like to format my listbox so that the output becomes something like this.
This is method, not in the main form tho:
Public Function GetSeatInfoStrings(ByVal choice As DisplayOptions,
ByRef strSeatInfoStrings As String()) As Integer
Dim count As Integer = GetNumOfSeats(choice)
If (count <= 0) Then
Return 0
End If
strSeatInfoStrings = New String(count - 1) {}
Dim StrReservation As String = ""
strSeatInfoStrings = New String(count - 1) {}
Dim i As Integer = 0 'counter for return array
'is the element corresponding with the index empty
For index As Integer = 0 To m_totNumOfSeats - 1
Dim strName As String = ""
Dim reserved As Boolean = Not String.IsNullOrEmpty(m_nameList(index))
'if the criteria below are not met, skip to add info in the array
If (choice = DisplayOptions.AllSeats) Or
(reserved And choice = DisplayOptions.ReservedSeats) Or
((Not reserved) And (choice = DisplayOptions.VacantSeats)) Then
If (reserved) Then
StrReservation = "Reserved"
strName = m_nameList(index)
Else
StrReservation = "Vacant"
strName = "..........."
End If
strSeatInfoStrings(i) = String.Format("{0,4} {1,-8} {2, -20} {3,10:f2}",
index + 1, StrReservation, strName, m_priceList(index))
i += 1
End If
Next
Return count
End Function
I don't know how to format the listbox as the strSeatInfoStrings(i) in the main form.
My listbox
This is what I've done
Private Sub UpdateGUI()
'Clear the listbox and make it ready for new data.
ReservationList.Items.Clear()
'size of array is determined in the callee method
Dim seatInfoStrings As String() = Nothing
Dim calcOption As DisplayOptions = DirectCast(cmbDisplayOptions.SelectedIndex, DisplayOptions)
Dim count As Integer = m_seatMngr.GetSeatInfoStrings(calcOption, seatInfoStrings)
If count > 0 Then
ReservationList.Items.AddRange(seatInfoStrings)
Else
ReservationList.Items.Add("Nothing to display!")
End If

Found the error! I forgot to call the UpdateGUI() in the IntializeGUI().

Related

DataTable.Rows.Count always returns 0 - VB.NET

I'm trying to populate DataGridView cells with information from two (parent, child tables). Everything works just fine, except for this part table.Rows.Count. It always returns 0, no matter that I have one record in the table.
This is the code:
Private Sub Query__tbl_purchase_order_articlesDataGridView_CellEndEdit(sender As Object, e As DataGridViewCellEventArgs) Handles Query__tbl_purchase_order_articlesDataGridView.CellEndEdit
Dim table As DataTable = Orders_DBDataSet.Tables("tbl_list_of_articles")
Dim selectedRowCount As Integer = Query__tbl_purchase_order_articlesDataGridView.CurrentCell.RowIndex
Dim art_ID As Integer = CInt(Query__tbl_purchase_order_articlesDataGridView.Rows(selectedRowCount).Cells(0).Value)
Dim art_ttl As String
Dim art_ttl_tr As String
Dim mu As String
Dim art_ttl_i As Integer
Dim art_ttl_tr_i As Integer
Dim mu_i As Integer
Dim art_ID_t_i As Integer
Dim art_ttl_t_i As Integer
Dim art_ttl_tr_t_i As Integer
Dim mu_t_i As Integer
Dim i As Integer
'search for column index in DataGridView
For i = 0 To Query__tbl_purchase_order_articlesDataGridView.Columns.Count - 1
If Query__tbl_purchase_order_articlesDataGridView.Columns(i).HeaderText.ToString = "article_name" Then
art_ttl_i = i
End If
If Query__tbl_purchase_order_articlesDataGridView.Columns(i).HeaderText.ToString = "article_name_tr" Then
art_ttl_tr_i = i
End If
If Query__tbl_purchase_order_articlesDataGridView.Columns(i).HeaderText.ToString = "masurement_unit" Then
mu_i = i
End If
Next
'search for column index in "table"
For i = 0 To table.Columns.Count - 1
If table.Columns(i).ColumnName.ToString = "article_ID" Then
art_ID_t_i = i
End If
If table.Columns(i).ColumnName.ToString = "article_name" Then
art_ttl_t_i = i
End If
If table.Columns(i).ColumnName.ToString = "article_name_tr" Then
art_ttl_tr_t_i = i
End If
If table.Columns(i).ColumnName.ToString = "masurement_unit" Then
mu_t_i = i
End If
Next
For i = 0 To table.Rows.Count
If art_ID = CInt(table.Rows(i).Item(art_ID_t_i).ToString()) Then
art_ttl = table.Rows(i).Item(art_ttl_t_i).ToString()
art_ttl_tr = table.Rows(i).Item(art_ttl_tr_t_i).ToString()
mu = table.Rows(i).Item(mu_t_i).ToString()
Query__tbl_purchase_order_articlesDataGridView.Rows(selectedRowCount).Cells(art_ttl_i).Value = art_ttl
Query__tbl_purchase_order_articlesDataGridView.Rows(selectedRowCount).Cells(art_ttl_tr_i).Value = art_ttl_tr
Query__tbl_purchase_order_articlesDataGridView.Rows(selectedRowCount).Cells(mu_i).Value = mu
Exit For
End If
Next
End Sub
Also, I tied to test it like this, but the result is the same. It can find a table index, but always return 0 as a table row count.
'test ========================================
Dim x, y As Integer
For x = 0 To Orders_DBDataSet.Tables.Count - 1
If Orders_DBDataSet.Tables(x).TableName.ToString = "tbl_list_of_articles" Then
y = x
End If
Next
x = 0
For Each row As DataRow In table.Rows
x = x + 1
Next
'============================================
x = Orders_DBDataSet.Tables(y).Rows.Count
Most of the times this happened to me because I was not actually using the instance of the dataset "connected" to the form. What does this mean? You either don't populate the dataset instance tied to the form in the Load event, or you are populating it but you are somehow using other instance of it. This has a higher chance of happening if you are sending data between forms as well.

Removing duplicates in Text Box and adding the corresponding values

I have a VB form with three TextBoxes. Here's an example of what I'd like the program to achieve:
So, that's the form ... the program sorts a text file and gets names, goals, and positions. E.g.
Jordan 26 Center
James 10 Mid
Jordan 4 Center
Jack 6 Forward
James 10 Mid
When the update button is clicked, the program should realize that James and Jordan are written twice, remove one of them and add their goals, so it should output:
Jordan 30 Center
James 20 Mid
Jack 6 Forward
To do this I've had the data transferred into ListBoxes which makes it easier to remove duplicates, the data is then transferred back into a multi-line TextBox so it is editable. Here's my code so far. It either gives the wrong results or an index out of range error.
Dim Count1 As Integer
Dim Count2 As Integer
Dim Count3 As Integer
Dim NewInt As Integer
Dim ValOne As Integer
Dim ValTwo As Integer
ListBox1.Items.Clear()
ListBox2.Items.Clear()
ListBox3.Items.Clear()
NewInt = 0
ValOne = 0
ValTwo = 0
ListBox1.Items.AddRange(Players.Text.Split(vbNewLine))
ListBox2.Items.AddRange(Goals.Text.Split(vbNewLine))
ListBox3.Items.AddRange(Positions.Text.Split(vbNewLine))
Count1 = ListBox1.Items.Count
Count2 = ListBox2.Items.Count
Count3 = ListBox3.Items.Count
If Count1 = Count2 And Count1 = Count3 And Count2 = Count3 Then
'Set two counters to compare all words with each other
For iFirstCounter As Integer = 0 To ListBox1.Items.Count - 1
For iSecondCounter As Integer = 0 To ListBox1.Items.Count - 1
'Make sure there will not be an 'out of range' error,
'because you are removing items from the listbox.
iSecondCounter = Convert.ToInt64(iSecondCounter)
iFirstCounter = Convert.ToInt64(iFirstCounter)
ListBox2.Items.RemoveAt(iSecondCounter)
ListBox2.Items.RemoveAt(iFirstCounter)
If iFirstCounter < iSecondCounter Then
ListBox2.Items.Insert(iFirstCounter, NewInt.ToString)
Else
ListBox2.Items.Insert(iSecondCounter, NewInt.ToString)
End If
Next
Next
Players.Text = ""
Goals.Text = ""
Positions.Text = ""
Dim i As Integer
For i = 0 To ListBox1.Items.Count - 1
If Players.Text = "" Then
Players.Text = ListBox1.Items(i)
Else
Players.Text = Players.Text & vbNewLine & ListBox1.Items(i)
End If
Next
Dim a As Integer
For a = 0 To ListBox2.Items.Count - 1
If Goals.Text = "" Then
Goals.Text = ListBox2.Items(a)
Else
Goals.Text = Goals.Text & vbNewLine & ListBox2.Items(a)
End If
Next
Dim b As Integer
For b = 0 To ListBox3.Items.Count - 1
If Positions.Text = "" Then
Positions.Text = ListBox3.Items(b)
Else
Positions.Text = Positions.Text & vbNewLine & ListBox3.Items(b)
End If
Next
Else
MessageBox.Show("The Text Boxes don't contain an equal number of values ... please add more/remove some values")
End If
Could be done in multiple ways, for example:
If TextBox2.Lines.Count > 1 Then
Dim LineList As List(Of String) = TextBox2.Lines.ToList 'textbox lines
Dim NewLines As List(Of String) = TextBox2.Lines.ToList 'can't edit list we're looping over, a copy of lines
Dim NamesList As New List(Of String)
For x = 0 To LineList.Count - 1
Dim linesplit As String() = LineList(x).Split({" "}, StringSplitOptions.RemoveEmptyEntries)
If NamesList.Contains(linesplit(0)) Then
NewLines.Remove(LineList(x))
Else
NamesList.Add(linesplit(0))
End If
Next
TextBox2.Lines = NewLines.ToArray
End If
Here's an example of code that does this via LINQ and Lambdas.
Module Module1
Sub Main()
Dim ungroupedPlayers(1) As String
ungroupedPlayers(0) = "Jordan 26 Center"
ungroupedPlayers(1) = "Jordan 4 Center"
Dim players = ungroupedPlayers.ToList().ConvertAll(Of Player)(Function(x As String) As Player
Dim split() As String = x.Split(" "c)
Dim p As New Player
p.PlayerName = split(0)
p.Count = split(1)
p.Position = split(2)
Return p
End Function)
Dim playersGrouped = From p In players
Group By PlayerName = p.PlayerName Into g = Group
Select PlayerName, Count = g.Sum(Function(ip As Player) ip.Count), Position = g.Min(Function(ip As Player) ip.Position.ToString())
Dim groupedPlayers() As String = playersGrouped.ToList().ConvertAll(Of String)(Function(ip)
Return ip.PlayerName.ToString() & " " & ip.Count.ToString() & " " & ip.Position.ToString()
End Function).ToArray()
For Each groupedPlayer as String in groupedPlayers
Console.WriteLine(groupedPlayer)
Next
Console.Read()
End Sub
Public Class Player
Public PlayerName As String
Public Count As Integer
Public Position As String
End Class
End Module
You don't need heavy ListBox control for working with players data.
Use List(Of T) and create class Player for better readability.
You can remove duplicates before you will display values in your form.
And instead of multiline textbox you can use DataGridView as "right tool for the editing data".
Public Class Player
Public Property Name As String
Public Property Position As String
Public Property Goals As Integer
End
Public Class PlayersForm : Form
Private Sub Form_Load(sender As Object, e As System.EventArgs) Handles MyBase.Load
Dim data As List(Of Player) = LoadPlayersData()
Dim players As List(Of Player) = NormalizeData(data)
' Use DataGridView
Me.DataGridView1.DataSource = players
End Sub
Private Function LoadPlayersData() As List(Of Player)
Dim rawData As String() = File.ReadAllLines("pathToTextFile")
Return rawData.Select(Function(line) LineToPlayer(line)).ToList()
End Function
Private Function NormalizeData(players As List(Of Player)) As List(Of Player)
Return players.Group(Function(player) player.Name)
.Select(Function(group)
Return New Player With
{
.Name = group.Key,
.Position = group.First().Position,
.Goals = group.Sum(Function(player) player.Goals)
}
End Function)
.ToList()
End Function
Private Function LineToPlayer(line As String) As Player
Dim values = line.Split(" "c)
Return New Player With
{
.Name = values(0),
.Position = values(2),
.Goals = Integer.Parse(values(1))
}
End Function
End Class
DataGridView control will automatically update your List(Of Players) when you make any change. which give you possibility to have some other controls which automatically display best scorers for example, without extra converting data from string to integer and back.

How can I seperate the values in the textbox to show in different labels using button?

i want to be able to separate the values in a textbox and display the separated values in different labels using a button
this is what i want to happen:
input "Ac2O3" on textbox
Be able to separate "Ac", "2", "O", and "3".
Show the separated values in different textboxes using a button
im using visual basic 2012
im sorry im still new to this
thanks in advance!!
You can access different character of the string with the index.
Dim input As String = "Ac2O3"
Dim part1 As String = input(0) & input(1)
Dim part2 As String = input(2)
Dim part3 As String = input(3)
Dim part4 As String = input(4)
If you don't know how to handle the button event or how to display text in a textbox, that would be different questions.
This code creates a structure called Element to make the results from the function clearer - add this to your main class that the function is going to be placed in. The main function takes a string as it's input and produced a list of structures of Element as it's output. There probably are shorter ways to do this, but I'm a fairly basic programmer who likes a puzzle - hope this helps - Dont forget to accept the answer by clicking on the tick. If you have any queries please dont hesitate to ask
Structure Element
Dim symbol As String
Dim elementCount As Int16
End Structure
Function ParseFormula(ByVal compoundString As String) As List(Of Element)
Dim tempParseFormula = New List(Of Element)
Dim firstLetter As String = "[A-Z]"
Dim secondLetter As String = "[a-z]"
Dim number As String = "[0-9]"
Dim tempElementCount As String = ""
Dim maxIndex As String = compoundString.Length - 1
Dim i As Integer = 0
Dim parsedElement As New Element
While i <= maxIndex
Dim tempChar As String = compoundString(i)
Select Case True
Case tempChar Like firstLetter
parsedElement.symbol = parsedElement.symbol & tempChar
Case tempChar Like secondLetter
parsedElement.symbol = parsedElement.symbol & tempChar
Case tempChar Like number
tempElementCount = tempElementCount & tempChar
End Select
If i = maxIndex Then
If Val(tempElementCount) = 0 Then
tempElementCount = 1
End If
parsedElement.elementCount = Val(tempElementCount)
tempParseFormula.Add(parsedElement)
parsedElement.symbol = ""
parsedElement.elementCount = 0
tempElementCount = ""
Exit While
End If
i += 1
If compoundString(i) Like firstLetter Then
If Val(tempElementCount) = 0 Then
tempElementCount = 1
End If
parsedElement.elementCount = Val(tempElementCount)
tempParseFormula.Add(parsedElement)
parsedElement.symbol = ""
parsedElement.elementCount = 0
tempElementCount = ""
End If
End While
Return tempParseFormula
End Function

changing a value to next value in an array

I am developing a routine to calculate the proper futures contract front month
If i have a array of integers denoting month numbers ie, "1,4,7,10,12"
and I have a variable integer that is 2.
How do i test the variable against the array and change the variable to the next highest available in the array if the variable itself wasn't in the array? ie in this case the variable's value of 2 would become 4.
I've tried various ways but am stuck now
If datenum >= (targetdayofmonth + adjdays) Then
currentmonth = currentmonth + 1
Dim currmonthname As String = MonthName(currentmonth, True)
For x As Integer = 0 To contractmonths.Count - 1
If GetMonthNumberfromShortMonthName(contractmonths(x)) = currentmonth Then
currmonthname = currmonthname
Else
End If
Next
Else
Dim currmonthname As String = MonthName(currentmonth, True)
End If
So based on Tim's comments I've updated the code to;
Dim contractmonthNos As New List(Of Int32)
For Each childnode As XmlNode In From childnode1 As XmlNode In root Where childnode1.SelectSingleNode("futures/symbol/Code").InnerText = commodcode
'get the available contract months for this contract
Dim contractmonthnodes As XmlNode = childnode.SelectSingleNode("ContractMonths")
contractmonthNos.AddRange(From subnode As XmlNode In contractmonthnodes Select GetMonthNumberfromShortMonthName(subnode.Name))
Next
If datenum >= (targetdayofmonth + adjdays) Then
currentmonth = currentmonth + 1
Dim currmonthname As String = MonthName(currentmonth, True)
Else
Dim nextmonth = From month As Integer In contractmonthNos Where month > currentmonth
If nextmonth.Any() Then
currentmonth = nextmonth.First()
End If
Dim currmonthname As String = MonthName(currentmonth, True)
End If
but I am getting a VS2012 squiggly under nextmonth in the If Then Else warning of "Possible multiple enumeration of IEnumerable"
I think this is what you want:
Dim intVar = 2
Dim months = { 1,4,7,10,12 }
Dim higherMonths = months.Where(Function(month) month > intVar).ToArray()
If higherMonths.Any() Then
intVar = higherMonths.First()
End If
If you don't want the next available month in the array but the nearest you have to sort before:
Dim higherMonths = months.Where(Function(m) m> intVar).
OrderBy(Function(m) m).
ToArray()
If higherMonths.Any() Then
intVar = higherMonths.First()
End If
Something like
Module Module1
Sub Main()
' N.B. this needs to the array to be sorted.
Dim a() As Integer = {1, 4, 7, 10, 12}
Dim toFind As Integer = 2
Dim foundAt As Integer = -1
For i = 0 To a.Length() - 1
If a(i) >= toFind Then
foundAt = i
Exit For
End If
Next
If foundAt >= 0 Then
Console.WriteLine(String.Format("Looked for {0}, found {1}.", toFind, a(foundAt)))
Else
Console.WriteLine(String.Format("Did not find {0} or higher.", toFind))
End If
Console.ReadLine()
End Sub
End Module
Or you might want to look at using the Array.BinarySearch Method.

VBA. How to find position of first digit in string

I have string "ololo123".
I need get position of first digit - 1.
How to set mask of search ?
Here is a lightweight and fast method that avoids regex/reference additions, thus helping with overhead and transportability should that be an advantage.
Public Function GetNumLoc(xValue As String) As Integer
For GetNumLoc = 1 To Len(xValue)
If Mid(xValue, GetNumLoc, 1) Like "#" Then Exit Function
Next
GetNumLoc = 0
End Function
Something like this should do the trick for you:
Public Function GetPositionOfFirstNumericCharacter(ByVal s As String) As Integer
For i = 1 To Len(s)
Dim currentCharacter As String
currentCharacter = Mid(s, i, 1)
If IsNumeric(currentCharacter) = True Then
GetPositionOfFirstNumericCharacter = i
Exit Function
End If
Next i
End Function
You can then call it like this:
Dim iPosition as Integer
iPosition = GetPositionOfFirstNumericCharacter("ololo123")
Not sure on your environment, but this worked in Excel 2010
'Added reference for Microsoft VBScript Regular Expressions 5.5
Const myString As String = "ololo123"
Dim regex As New RegExp
Dim regmatch As MatchCollection
regex.Pattern = "\d"
Set regmatch = regex.Execute(myString)
MsgBox (regmatch.Item(0).FirstIndex) ' Outputs 5
I actually have that function:
Public Function GetNumericPosition(ByVal s As String) As Integer
Dim result As Integer
Dim i As Integer
Dim ii As Integer
result = -1
ii = Len(s)
For i = 1 To ii
If IsNumeric(Mid$(s, i, 1)) Then
result = i
Exit For
End If
Next
GetNumericPosition = result
End Function
You could try regex, and then you'd have two problems. My VBAfu is not up to snuff, but I'll give it a go:
Function FirstDigit(strData As String) As Integer
Dim RE As Object REMatches As Object
Set RE = CreateObject("vbscript.regexp")
With RE
.Pattern = "[0-9]"
End With
Set REMatches = RE.Execute(strData)
FirstDigit = REMatches(0).FirstIndex
End Function
Then you just call it with FirstDigit("ololo123").
If speed is an issue, this will run a bit faster than Robs (noi Rob):
Public Sub Example()
Const myString As String = "ololo123"
Dim position As Long
position = GetFirstNumeric(myString)
If position > 0 Then
MsgBox "Found numeric at postion " & position & "."
Else
MsgBox "Numeric not found."
End If
End Sub
Public Function GetFirstNumeric(ByVal value As String) As Long
Dim i As Long
Dim bytValue() As Byte
Dim lngRtnVal As Long
bytValue = value
For i = 0 To UBound(bytValue) Step 2
Select Case bytValue(i)
Case vbKey0 To vbKey9
If bytValue(i + 1) = 0 Then
lngRtnVal = (i \ 2) + 1
Exit For
End If
End Select
Next
GetFirstNumeric = lngRtnVal
End Function
An improved version of spere's answer (can't edit his answer), which works for any pattern
Private Function GetNumLoc(textValue As String, pattern As String) As Integer
For GetNumLoc = 1 To (Len(textValue) - Len(pattern) + 1)
If Mid(textValue, GetNumLoc, Len(pattern)) Like pattern Then Exit Function
Next
GetNumLoc = 0
End Function
To get the pattern value you can use this:
Private Function GetTextByPattern(textValue As String, pattern As String) As String
Dim NumLoc As Integer
For NumLoc = 1 To (Len(textValue) - Len(pattern) + 1)
If Mid(textValue, NumLoc, Len(pattern)) Like pattern Then
GetTextByPattern = Mid(textValue, NumLoc, Len(pattern))
Exit Function
End If
Next
GetTextByPattern = ""
End Function
Example use:
dim bill as String
bill = "BILLNUMBER 2202/1132/1 PT2200136"
Debug.Print GetNumLoc(bill , "PT#######")
'Printed result:
'24
Debug.Print GetTextByPattern(bill , "PT#######")
'Printed result:
'PT2200136