I want to align Dynamic pictureboxs with Dynamic Labels - vb.net

Here is my function that allows me to get from a webpage the image link for my PictureBoxs and the title for my labels
Public Shared Function getPics(website As String, pattern As String)
Dim tempTitles As New List(Of String)()
Dim tempTitles2 As New List(Of String)()
Dim lestitres As New List(Of titlesclass)
Dim webClient As New WebClient()
webClient.Headers.Add("user-agent", "null")
Dim counter As Integer = 0
Dim counter2 As Integer = 0
Dim counter3 As Integer = 0
Dim counter4 As Integer = 1
Dim counter5 As Integer = 0
Dim counter6 As Integer = 0
'If the website happens to go offline, at least your application wont crash.
Dim content As String = webClient.DownloadString(website)
Dim query = From title In Regex.Matches(content, pattern).Cast(Of Match)
Select New With {Key .Link = String.Concat("http://www.gamestop.com", title.Groups("Data").Value),
Key .Title = title.Groups("Dataa").Value}
For Each letitre In query.Distinct
'MsgBox(letitre.Link & " ======= " & letitre.Title)
Next
'For Each title As Match In (New Regex(pattern).Matches(content)) 'Since you are only pulling a few strings, I thought a regex would be better.
' Dim letitre As New titlesclass
' letitre.Link = title.Groups("Data").Value
' letitre.Title = title.Groups("Dataa").Value
' lestitres.Add(letitre)
' 'tempTitles2.Add(title.Groups("Dataa").Value)
'Next
Dim titles = tempTitles.Distinct().ToArray() 'remove duplicate titles
'Dim titles2 = tempTitles2.Distinct().ToArray()
Dim titles2 = lestitres.Distinct().ToArray()
lestitres.Clear()
'For Each title As titlesclass In titles2
For Each letitre In query.Distinct
'ListBox.Items.Add(title) 'what you do with the values from here is up to you.
Dim ImageInBytes() As Byte = webClient.DownloadData(letitre.Link)
Dim ImageStream As New IO.MemoryStream(ImageInBytes)
Dim MyPic As New PictureBox
Dim MyLab As New Label
If (counter2 > 0 AndAlso ((counter2 Mod 4 = 0) OrElse counter3 = 1)) Then
counter3 = 1
counter4 += 1
If (counter2 Mod 4 = 0) Then
counter5 = 0
counter6 += 170
End If
MyPic.Location = New Point(counter5, MyPic.Location.Y + counter6)
MyLab.Location = New Point(counter5, MyPic.Location.Y + counter6)
If counter4 = 4 Then
counter3 = 0
End If
counter5 += 200
Else
MyPic.Location = New Point(counter, MyPic.Location.Y)
MyLab.Location = New Point(counter, MyPic.Location.Y)
End If
counter += 200
counter2 += 1
MyPic.SizeMode = PictureBoxSizeMode.AutoSize
MyLab.Text = letitre.Title
MyPic.Image = New System.Drawing.Bitmap(ImageStream)
Form2.Controls.Add(MyPic)
Form2.Controls.Add(MyLab)
Next
End Function
The class named titlesclass contain two elements which i will store my Link and Title in :
Public Class titlesclass
Public Property Link As String
Public Property Title As String
End Class
And My little button does all the work
Dim websiteURL1 As String = "http://www.gamestop.com/collection/upcoming-video-games"
Class1.getPics(websiteURL1, "<img src=""(?<Data>[^>]*)""><p>(?<Dataa>[^>]*)<br>")
What i'm trying to do is to show 4 pictureboxs per row with the lables right bellow each picture , for now some labels doesn't show , some shows just in the right place and some shows very far bellow ! I tested the values i'm getting with a Message Box and it shows me the informations in the order i need , i'm not sure if i screw up in the x,y values or if it's something else ...
Edit : I can already show the 4 pictureboxes per row , the labels also , but the Y of some labels isn't well adjusted it can go far far bellow !
Here is some pictures that will help you to understand my situation Don't mind the buttons and listboxs , it's just for the test :
My list containt a lot of pictures , so i just showed you some when the thing work kind of well , when it shows couple of rows far from the designed picture
http://img110.xooimage.com/files/f/a/d/picture1-5239f7c.png
http://img110.xooimage.com/files/8/f/8/picture-2-5239f7e.png
http://img110.xooimage.com/files/4/7/b/picture-3-5239f80.png
http://img110.xooimage.com/files/f/0/f/picture4-5239f82.png

So I cleaned the way you where generating the position of the PictureBox by using a row principle and increment:
Note:
If you need space at the top to add information start the row count at 1 instead of 0
Note 2:
Here the image dimensions are harcoded but you could use dynamic ones which would be more fluid. I just cleaned the positioning code not the rest.
Replace your function by this one:
Public Shared Sub getPics(website As String, pattern As String)
Dim tempTitles As New List(Of String)()
Dim tempTitles2 As New List(Of String)()
Dim lestitres As New List(Of titlesclass)
Dim webClient As New WebClient()
webClient.Headers.Add("user-agent", "null")
Dim counter As Integer = 0
Dim counter2 As Integer = 0
Dim counter3 As Integer = 0
Dim counter4 As Integer = 1
Dim counter5 As Integer = 0
Dim counter6 As Integer = 0
'If the website happens to go offline, at least your application wont crash.
'Handle default proxy
Dim proxy As IWebProxy = WebRequest.GetSystemWebProxy()
proxy.Credentials = CredentialCache.DefaultCredentials
webClient.Proxy = proxy
Dim content As String = webClient.DownloadString(website)
Dim query = From title In Regex.Matches(content, pattern).Cast(Of Match)
Select New With {Key .Link = String.Concat("http://www.gamestop.com", title.Groups("Data").Value),
Key .Title = title.Groups("Dataa").Value}
Dim titles = tempTitles.Distinct().ToArray() 'remove duplicate titles
Dim titles2 = lestitres.Distinct().ToArray()
lestitres.Clear()
'Count Items
Dim item As Integer = 0
'Count Row
Dim row As Integer = 0
'image: 222*122
For Each letitre In query.Distinct
Dim ImageInBytes() As Byte = webClient.DownloadData(letitre.Link)
Dim ImageStream As New IO.MemoryStream(ImageInBytes)
Dim MyPic As New PictureBox
Dim MyLab As New Label
'x = numéro item fois largeur image
'y = numéro de ligne fois hauteur image
MyPic.Location = New Point(item * 222, row * 122)
MyLab.Location = New Point(item * 222, row * 122)
MyPic.SizeMode = PictureBoxSizeMode.AutoSize
MyLab.Text = letitre.Title
MyPic.Image = New System.Drawing.Bitmap(ImageStream)
Form1.Controls.Add(MyPic)
Form1.Controls.Add(MyLab)
'Bring Labels to front
For Each ctrl As Control In Form1.Controls
'If the control is of type label
If TypeOf ctrl Is Label Then
'Then bring to front
ctrl.BringToFront()
End If
Next
'Increment the item count
item = item + 1
'If item is multiple of 4 or could check 4 then
If item Mod 4 = 0 Then
'Reset counter
item = 0
'Increment Row
row = row + 1
End If
Next
End Sub
Example return:

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 to remove vb.net Richtextbox lines that not contains specific words

Hi there im trying to get specific words from a html web page and im trying to do this by loading the html sourcecode into a textbox and then filter it out.
Im now using this wich is stupid i know but how can i fuse both together that it will check both words in 1 loop?
Dim Filter1 = "filterword1"
Dim Filter2 = "filterword2"
TextBox1.Text = WebBrowser1.DocumentText
TextBox2.Text = WebBrowser1.DocumentText
Dim lines As New List(Of String)
lines = TextBox1.Lines.ToList
For i As Integer = lines.Count - 1 To 0 Step -1
If Not Regex.IsMatch(lines(i), Filter1) Then
lines.RemoveAt(i)
End If
Next
TextBox1.Lines = lines.ToArray
Dim lines1 As New List(Of String)
lines1 = TextBox3.Lines.ToList
For i As Integer = lines1.Count - 1 To 0 Step -1
If Not Regex.IsMatch(lines1(i), Filter2) Then
lines1.RemoveAt(i)
End If
Next
TextBox1.Lines = lines1.ToArray
I got it working :
Const filter = "(Filterword1)|(Filterword2)|(Filterword3)|(Filterword4)"
Dim lines As New List(Of String)
lines = TextBox2.Lines.ToList
For i As Integer = lines.Count - 1 To 0 Step -1
If Not Regex.IsMatch(lines(i), filter) Then
lines.RemoveAt(i)
End If
Next

Listbox formatting VB

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().

multiple DatagridView Rendering Vb.net

I'm able to add multiple datagridview 1 after another on panel.
by adding code of SysDragon from the same forum
Dim AllDataGrids As List(Of My_custom_DGV)
Dim lastCtrl As Control
AllDataGrids = New List(Of My_custom_DGV)
For j As Int32 = 0 To 3
Dim aDataGridView As New My_custom_DGV()
aDataGridView.for_date = ""
aDataGridView._count = week_count
aDataGridView.Dock = DockStyle.Top
aDataGridView.Dock = DockStyle.Right
aDataGridView.Dock = DockStyle.Left
aDataGridView.Dock = DockStyle.Bottom
AllDataGrids.Add(aDataGridView)
Next j
For i As Integer = 1 To 3
Dim dgv As My_custom_DGV = AllDataGrids(i)
' Dim dgv As DataGridView = AllDataGrids(i)
If dataGrid_Panel.Controls.Count.Equals(0) Then
dgv.Top = DataGridView1.Height + 20
Else
lastCtrl = dataGrid_Panel.Controls(dataGrid_Panel.Controls.Count - 1)
dgv.Top = lastCtrl.Top + lastCtrl.Height + 5
End If
dataGrid_Panel.Controls.Add(dgv)
Next
the problem is that when i scroll in between them then it is looking very bad(i.e. as i scroll,it is repeating the the image on panel again and again). does it render the view again when i Scroll,and may be calling the paint method of datagridview repeatedly. if yes then what is the solution?
Thanks.