how to populate array of controls (labels) using database vb.net - database

I am doing my homework but stuck on a part. Problem is, How can i populate seat number in array of controls(labels) using database. I already created labels and a class to retrieve all rows from database but how can i apply it in main form and populate labels.
--------------------------Class---------------------------------------
Public Shared Function getOneRow(PK As Integer) As datMovieTimes
Dim returnRow As New datMovieTimes(0)
Dim connDB As New SqlConnection
connDB.ConnectionString = Conn.getConnectionString
Dim command As New SqlCommand
command.Connection = connDB
command.CommandType = CommandType.Text
command.CommandText = SQLStatements.SELECT_1_BY_ID
command.Parameters.AddWithValue("#Key", PK)
Try
connDB.Open()
Dim dR As IDataReader = command.ExecuteReader
If dR.Read() Then
returnRow.showingID = PK
If Not IsDBNull(dR(Fields.movieID)) Then returnRow.movieID = dR(Fields.movieID)
If Not IsDBNull(dR(Fields.dateTime)) Then returnRow.dateTime = dR(Fields.dateTime)
If Not IsDBNull(dR(Fields.isActive)) Then returnRow.isActive = dR(Fields.isActive)
End If
Catch ex As Exception
Console.WriteLine(Err.Description)
End Try
Return returnRow
End Function
Public Shared Function getAllRows() As Generic.List(Of datMovieTimes)
Dim returnRows As New Generic.List(Of datMovieTimes)
Dim connDB As New SqlConnection
connDB.ConnectionString = Conn.getConnectionString
Dim command As New SqlCommand
command.Connection = connDB
command.CommandType = CommandType.Text
command.CommandText = SQLStatements.SELECT_ALL
Try
connDB.Open()
Dim dR As IDataReader = command.ExecuteReader
Do While dR.Read()
Dim Row As New datMovieTimes(0)
If Not IsDBNull(dR(Fields.showingID)) Then Row.showingID = dR(Fields.showingID)
If Not IsDBNull(dR(Fields.movieID)) Then Row.movieID = dR(Fields.movieID)
If Not IsDBNull(dR(Fields.dateTime)) Then Row.dateTime = dR(Fields.dateTime)
If Not IsDBNull(dR(Fields.isActive)) Then Row.isActive = dR(Fields.isActive)
returnRows.Add(Row)
Loop
Catch ex As Exception
Console.WriteLine(Err.Description)
End Try
Return returnRows
End Function
-----------------------------main form-----------------------------------------
Public Sub createSeat()
Dim S1 As Label
For X As Integer = 1 To _MAX_X
For Y As Integer = 1 To _MAX_Y
S1 = New Label
S1.Height = 25
S1.Width = 25
S1.BackColor = Color.LightGreen
S1.Top = 100 + (X - 1) * (S1.Height + 5)
S1.Left = 200 + (Y - 1) * (S1.Width + 5)
S1.TextAlign = ContentAlignment.MiddleCenter
S1.Text = Y.ToString
AddHandler S1.Click, AddressOf GenericLabel_Click
Me.Controls.Add(S1)
_SeatArray(X, Y) = S1
Next
Next
For X As Integer = 0 To 9
_AlphaLabel(X) = New Label
_AlphaLabel(X).Height = 25
_AlphaLabel(X).Width = 25
_AlphaLabel(X).BackColor = Color.Transparent
_AlphaLabel(X).Top = 130 + (X - 1) * (_AlphaLabel(X).Height + 6)
_AlphaLabel(X).Left = 170
_AlphaLabel(X).Text = _AlphaName(X)
Me.Controls.Add(_AlphaLabel(X))
Next
End Sub
Private Sub GenericLabel_Click(sender As Object, e As EventArgs)
Dim L As New Label
L = DirectCast(sender, Label)
If L.BackColor = Color.LightGreen Then
L.BackColor = Color.Orange
clickLess -= 1
ElseIf L.BackColor = Color.Orange Then
L.BackColor = Color.LightGreen
clickLess += 1
End If
clickCount += 1
Me.lblRemainingCount.Text = clickLess.ToString
Me.nudTicketsCount.Value = clickCount
If clickLess <= 0 Then
MsgBox("No more seats left.", MsgBoxStyle.OkOnly, "House Full")
End If
End Sub
Database pic

When creating labels, insert one more line:
S1.Name = "MyLabel" & X & Y
When accessing the label:
Dim MyCurrentLabel as Label
MyCurrentLabel = CType("MyLabel" & X & Y, Label)
Then you can do things with the current label:
MyCurrentLabel.Text = "Hello World"

current image
Now it is something like this, so it want to change the colour to red if it is paid according to database.
Thanks

I found the answer, sorry i forgot to mention it because i was busy in completing the project
----------------------Seat creation----------------------------------------
Public Sub createSeat()
Dim S1 As Label
Dim numValue As Integer = 1
For X As Integer = 1 To _MAX_X
For Y As Integer = 1 To _MAX_Y
S1 = New Label
S1.Height = 25
S1.Width = 25
S1.BackColor = Color.LightGreen
S1.Top = 180 + (X - 1) * (S1.Height + 5)
S1.Left = 200 + (Y - 1) * (S1.Width + 5)
S1.TextAlign = ContentAlignment.MiddleCenter
S1.Text = Y.ToString
' S1.Text = numValue
S1.Name = "Label" & numValue
AddHandler S1.Click, AddressOf GenericLabel_Click
Me.Controls.Add(S1)
_SeatArray(X, Y) = S1
numValue += 1
Next
Next
For X As Integer = 0 To 9
_AlphaLabel(X) = New Label
_AlphaLabel(X).Height = 25
_AlphaLabel(X).Width = 25
_AlphaLabel(X).BackColor = Color.Transparent
_AlphaLabel(X).Top = 210 + (X - 1) * (_AlphaLabel(X).Height + 6)
_AlphaLabel(X).Left = 170
_AlphaLabel(X).Text = _AlphaName(X)
Me.Controls.Add(_AlphaLabel(X))
Next
End Sub
-------------------------------populate seat number----------------------------------
Public Sub populateSeatNumber()
Dim connectionString As String = DBL.Conn.getConnectionString
Dim connection As New SqlConnection(connectionString)
connection.Open()
Dim selectStatement As String = "SELECT * FROM datTicketsSold"
Dim selectCommand As New SqlCommand(selectStatement, connection)
Dim daSoldTickets As New SqlDataAdapter(selectCommand)
Dim dsSoldTickets As DataSet = New DataSet
daSoldTickets.Fill(dsSoldTickets, "datTicketsSold")
connection.Close()
Dim dtTickets As DataTable = dsSoldTickets.Tables("datTicketsSold")
Dim row As DataRow
For Each row In dtTickets.Rows
If row(3) = True Then
CType(Controls("Label" & row(2)), Label).BackColor = Color.Red
redCounter += 1
Else
CType(Controls("Label" & row(2)), Label).BackColor = Color.Yellow
yellowCounter += 1
End If
Next
Me.lblReservedCount.Text = yellowCounter.ToString
Me.lblSoldCount.Text = redCounter.ToString
End Sub
Thanks everyone

Related

Problem retrieving data: System.IndexOutOfRangeException: There is no row at position 0

Dim command As New SqlCommand("SELECT * From tblUserInfo WHERE Username='" & Trim(frmdashboard.ToolStripLabel4.Text) & "'", con)
Dim table As New DataTable()
Dim sqlAdapter As New SqlDataAdapter(command)
sqlAdapter.Fill(table)
Me.UserTypeTextBox.Text = table.Rows(0)(10).ToString()
Me.UsernameTextBox.Text = table.Rows(0)(9).ToString()
Me.Email_AddressTextBox.Text = table.Rows(0)(12).ToString()
Me.PositionTextBox.Text = table.Rows(0)(1).ToString()
Me.NameTextBox.Text = table.Rows(0)(2).ToString()
Me.AddressTextBox.Text = table.Rows(0)(3).ToString()
Me.Date_of_BirthDateTimePicker.Value = table.Rows(0)(4).ToString()
Me.AgeTextBox.Text = table.Rows(0)(5).ToString()
Me.SexComboBox.Text = table.Rows(0)(6).ToString()
Me.Telephone_NumberTextBox.Text = table.Rows(0)(7).ToString()
Me.Mobile_NumberTextBox.Text = table.Rows(0)(8).ToString()
Me.Security_Question_1TextBox.Text = table.Rows(0)(13).ToString()
Me.Security_Question_2TextBox.Text = table.Rows(0)(15).ToString()
Dim img() As Byte
img = table.Rows(0)(17)
Dim ms As New MemoryStream(img)
Me.PicturePictureBox.Image = Image.FromStream(ms)
This should retrieve the data of a specific person. The error I get is
System.IndexOutOfRangeException: There is no row at position 0
You are assuming that your query will return at least one record which might/might not be true all times. You should first check if your tables has at least one row as below:
if ( table.Rows != null && tables.Rows.Count > 0)
{
Dim img() As Byte;
img = table.Rows(0)(17)
Dim ms As New MemoryStream(img)
Me.PicturePictureBox.Image = Image.FromStream(ms)
}

Why can not Grid cloned with childrens?

Why can not grid cloned with childrens? The following error occurs on the line Grid1 = Markup.XamlReader.Load(xmlReader):
System.Windows.Markup.XamlParseException: no matching constructor
found on type System.Windows.Media.Imaging.WriteableBitmap.
What needs to be changed?
Private Sub pelespausti(sender As Object, e As MouseButtonEventArgs) Handles Grid1.MouseDown
If e.LeftButton = MouseButtonState.Pressed Then
If im IsNot Nothing Then
If e.GetPosition(im).X >= im.Margin.Left AndAlso e.GetPosition(im).X < im.ActualWidth AndAlso
e.GetPosition(im).Y >= im.Margin.Top AndAlso e.GetPosition(im).Y < im.ActualHeight Then
'CType(bi.PixelWidth / 8, Integer)
Dim pix As PixelFormat = PixelFormats.Rgba64
Array.Resize(Of Byte)(pixels2, bi.PixelWidth * bi.PixelHeight * Math.Ceiling(pix.BitsPerPixel / 8))
colors = New List(Of System.Windows.Media.Color) From {System.Windows.Media.Colors.Transparent}
palete = New BitmapPalette(colors)
bi2 = BitmapSource.Create(bi.PixelWidth, bi.PixelHeight, 96, 96, pix, palete, pixels2, Math.Ceiling(bi.PixelWidth * pix.BitsPerPixel / 8))
o = New FormatConvertedBitmap(bi2, pix, palete, 100)
o2 = New FormatConvertedBitmap(bi, o.Format, palete, 100)
Dim pixelsp(Math.Ceiling(o2.Format.BitsPerPixel / 8)) As Byte
Dim pixelsp2(Math.Ceiling(o2.Format.BitsPerPixel / 8)) As Byte
o2.CopyPixels(New Int32Rect(e.GetPosition(im).X, e.GetPosition(im).Y, 1, 1), pixelsp, Math.Ceiling(o2.Format.BitsPerPixel / 8), 0) 'klaida
ras = New WriteableBitmap(o)
'Me.Title = Color.FromArgb(pixelsp(0), pixelsp(1), pixelsp(2), pixelsp(3)).R
Dim m As Boolean = True
For x = 0 To o2.PixelWidth - 1
For y = 0 To o2.PixelHeight - 1
o2.CopyPixels(New Int32Rect(x, y, 1, 1), pixelsp2, Math.Ceiling(o2.Format.BitsPerPixel / 8), 0)
For k = 0 To pixelsp.GetUpperBound(0)
If Not pixelsp(k) = pixelsp2(k) Then
m = False : Exit For
End If
Next
If m = True Then
ras.WritePixels(New Int32Rect(x, y, 1, 1), pixelsp2, Math.Ceiling(o.Format.BitsPerPixel / 8), 0)
Else
m = True
End If
Next
Next
im.Source = ras
Me.Title = "komp"
End If
End If
Dim objXaml As String = Markup.XamlWriter.Save(Grid1)
Dim StringReader As StringReader = New StringReader(objXaml)
Dim xmlReader As Xml.XmlReader = Xml.XmlReader.Create(StringReader)
Grid1 = Markup.XamlReader.Load(xmlReader)'here exception
End If
End Sub

WPF ListBox values from another selected ListBox item then move up and down

We have a series of ListBoxes - when an item in the main ListBox is selected the relevant values are displayed in the sub ListBox. This works as intended...
We also have the ability to move items up or down, and this works as intended...
When the main ListBox has the SelectionChanged event wired up the ability to move items up and down in the sub list box stops working. Comment that out and up/down works again in the sub ListBox... I must have overlooked something glaringly obvious but after numerous changes still can't get it to work
Main ListBox SelectionChanged
Private Sub Reports_CashFlow_ListBox_IndexChanged(ByVal MainLB As String, ByVal NominalLB As String, ByVal NomDT As DataTable)
Try
Dim LB As LBx = ReportCashFlow_Grid.FindName(MainLB)
If LB.SelectedIndex = -1 Then
Exit Sub
End If
Dim NomLB As LBx = ReportCashFlow_Grid.FindName(NominalLB)
If NomLB Is Nothing Then
Exit Sub
End If
If LB.SelectedValue Is Nothing Then
Exit Sub
End If
If LB.SelectedValue.GetType.Name Is Nothing Then
Exit Sub
End If
If LB.SelectedValue.GetType.Name <> "DataRowView" Then
Dim CatID As Integer = LB.SelectedValue
Dim DV As New DataView(NomDT)
DV.RowFilter = "CatID = " & CatID & " AND FormID = " & Form_ID
DV.Sort = "Position"
With NomLB
.ItemsSource = DV
.Items.Refresh()
End With
LB.ScrollIntoView(LB.SelectedItem)
End If
Catch ex As Exception
EmailError(ex)
End Try
End Sub
Move items up
Private Sub Reports_BalanceSheet_ListBoxMoveUp(LB As ListBox, DT As DataTable, DisplayName As String, Optional MasterListBox As ListBox = Nothing)
Try
Dim StartIndex As Integer = LB.SelectedIndex
If StartIndex = -1 Then
AppBoxValidation("You have not selected an item to move up!")
Exit Sub
End If
If Not StartIndex = 0 Then
Dim CatID As Integer = 0
If DisplayName = "NomName" Then
CatID = MasterListBox.SelectedValue
End If
Dim vSelected As DataRow = DT.Rows(StartIndex)
Dim vNew As DataRow = DT.NewRow()
vNew.ItemArray = vSelected.ItemArray
DT.Rows.Remove(vSelected)
DT.Rows.InsertAt(vNew, StartIndex - 1)
DT.AcceptChanges()
LB.SelectedIndex = StartIndex - 1
Dim vPos As Integer = 0
For Each Row As DataRow In DT.Rows
If Not CatID = 0 Then
If Row("CatID") = CatID Then
Row("Position") = vPos
vPos += 1
End If
Else
Row("Position") = vPos
vPos += 1
End If
Next
LB.Items.Refresh()
End If
Catch ex As Exception
EmailError(ex)
End Try
End Sub
Turns out the issue related to subsets of data in the DataView - so needed to find the correct index for the selected item and the replacement index in the entire back-end table
Private Sub Reports_BalanceSheet_ListBoxMoveUp(LB As ListBox, DT As DataTable, DisplayName As String, Optional MasterListBox As ListBox = Nothing)
Try
Dim StartIndex As Integer = LB.SelectedIndex
If StartIndex = -1 Then
AppBoxValidation("You have not selected an item to move up!")
Exit Sub
End If
If Not StartIndex = 0 Then
Dim CatID As Integer = 0
If DisplayName = "NomName" Then
CatID = MasterListBox.SelectedValue
'As the view could be a subset of data we need to find the actual back end DB index
Dim SelectedID As Integer = LB.SelectedValue
Dim DR() As DataRow = DT.Select("ID = " & SelectedID, Nothing)
Dim vIndex As Integer = DT.Rows.IndexOf(DR(0))
Dim vCurrentPos As Integer = DR(0)("Position")
'Find the index of the one above in the grid
Dim DR2() As DataRow = DT.Select("CatID = " & CatID & " AND Position = " & vCurrentPos - 1, Nothing)
Dim vIndex2 As Integer = DT.Rows.IndexOf(DR2(0))
Dim vSelected As DataRow = DT.Rows(vIndex)
Dim vNew As DataRow = DT.NewRow()
vNew.ItemArray = vSelected.ItemArray
DT.Rows.Remove(vSelected)
DT.Rows.InsertAt(vNew, vIndex2)
DT.AcceptChanges()
Else
Dim vSelected As DataRow = DT.Rows(StartIndex)
Dim vNew As DataRow = DT.NewRow()
vNew.ItemArray = vSelected.ItemArray
DT.Rows.Remove(vSelected)
DT.Rows.InsertAt(vNew, StartIndex - 1)
DT.AcceptChanges()
End If
Dim vPos As Integer = 0
For Each Row As DataRow In DT.Rows
If Not CatID = 0 Then
If Row("CatID") = CatID Then
Row("Position") = vPos
vPos += 1
End If
Else
Row("Position") = vPos
vPos += 1
End If
Next
LB.SelectedIndex = StartIndex - 1
End If
Catch ex As Exception
EmailError(ex)
End Try
End Sub

WPF ListBox - moving items up and down

In an older WinForms app this worked, but in WPF it will move the item only once, the only current workaround is the save it to the back end DB, open again and move one more space. The list items are supplied by a DataTable
Private Sub Reports_BalanceSheet_ListBoxMoveUp(LB As ListBox, DT As DataTable, DisplayName As String, Optional MasterListBox As ListBox = Nothing)
Try
Dim StartIndex As Integer = LB.SelectedIndex
Dim CatID As Integer = 0
'Update the datasource
Dim SR() As DataRow
If DisplayName = "Name" Then
SR = DT.Select("ID > 0 AND FormID = " & Form_ID, Nothing)
Else
CatID = MasterListBox.SelectedValue
'Check that the positions are correct
If DataChanged = False Then
Dim vRowID As Integer = 0
For Each Row As DataRow In DT.Rows
If Row("FormID") = Form_ID And Row("CatID") = CatID Then
Row("Position") = vRowID
vRowID += 1
End If
Next
End If
SR = DT.Select("ID > 0 AND FormID = " & Form_ID & " AND CatID = " & CatID, "Position")
End If
Dim vString As String = ""
Dim vUpperID As Integer = 0
Dim vCurrentID As Integer = 0
For Each Row As DataRow In SR
Dim vPos As Integer = Row("Position")
If vPos = StartIndex - 1 Then
vUpperID = Row("ID")
End If
If vPos = StartIndex Then
vCurrentID = Row("ID")
End If
Next
If Not vUpperID = 0 And Not vCurrentID = 0 Then
DT.Select("ID = " & vUpperID)(0)("Position") = StartIndex
DT.Select("ID = " & vCurrentID)(0)("Position") = StartIndex - 1
If DisplayName = "Name" Then
DT.DefaultView.RowFilter = "FormID = " & Form_ID
Else
DT.DefaultView.RowFilter = "FormID = " & Form_ID & " AND CatID = " & CatID
End If
DT.DefaultView.Sort = "Position"
DT = DT.DefaultView.ToTable
DT.AcceptChanges()
With LB
.SelectedValuePath = "ID"
.DisplayMemberPath = DisplayName
.ItemsSource = DT.DefaultView
.SelectedValue = vCurrentID
.UpdateLayout()
End With
End If
Catch ex As Exception
EmailError(ex)
End Try
End Sub
Got it working this way (and with less code) :-)
Dim StartIndex As Integer = LB.SelectedIndex
Dim vTotalRows As Integer = DT.Rows.Count - 1
If Not StartIndex = vTotalRows Then
Dim vSelected As DataRow = DT.Rows(StartIndex)
Dim vNew As DataRow = DT.NewRow()
vNew.ItemArray = vSelected.ItemArray
DT.Rows.Remove(vSelected)
DT.Rows.InsertAt(vNew, StartIndex + 1)
LB.SelectedIndex = StartIndex + 1
Dim vPos As Integer = 0
For Each Row As DataRow In DT.Rows
Row("Position") = vPos
vPos += 1
Next
End If

Background Worker and ODBC Query

I want to run the fetching of a Database into a background worker but it seems to be crashing without Visual Studio returning me an error in my code.
Here's the code in the DoWork:
Private Sub ITSM_Fetch_BW_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles ITSM_Fetch_BW.DoWork
Dim sql As String = "xxxx"
Dim ConnString As String = "DRIVER={AR System ODBC Driver};ARServer=xxxx;ARServerPort=xxxx;ARPrivateRpcSocket=xxxx;UID=xxxx;PWD=xxxx;ARAuthentication=;ARUseUnderscores=1;SERVER=NotTheServer"
Dim connection As New Odbc.OdbcConnection(ConnString)
connection.Open()
Dim ODBC_Command As New Odbc.OdbcCommand(sql, connection)
Dim ODBC_reader As Odbc.OdbcDataReader
'Load the Data into the local Memory
ODBC_reader = ODBC_Command.ExecuteReader
e.Result = ODBC_reader
ODBC_reader.Close()
End Sub
Private Sub ITSM_Fetch_BW_RunWorkerCompleted(sender As Object, e As RunWorkerCompletedEventArgs) Handles ITSM_Fetch_BW.RunWorkerCompleted
Data = New DataTable
Data.Load(e.Result)
Dim Count_ToDo(5) As String
Count_ToDo(0) = "Product_Name"
Count_ToDo(1) = "Status"
Count_ToDo(2) = "Language"
Count_ToDo(3) = "Assigned_Group"
Count_ToDo(4) = "Priority"
Count_ToDo(5) = "Company"
For Each Item As String In Count_ToDo
Dim i As Integer = 0
Dim ITEM_Count(0, 1) As String
For Each Ticket As DataRow In Data.Rows
'PART FOR THE CI
If IsDBNull(Ticket.Item(Item)) = False Then
Dim IsInIndex As Integer = -1
If i = 0 Then
ITEM_Count(0, 0) = Ticket.Item(Item)
ITEM_Count(0, 1) = 1
Else
For x As Integer = 0 To ITEM_Count.GetLength(0) - 1
If ITEM_Count(x, 0) = Ticket.Item(Item) Then
IsInIndex = x
End If
Next
If IsInIndex = -1 Then
Dim ITEM_Count_Temp(ITEM_Count.GetLength(0), ITEM_Count.GetLength(0)) As String
ITEM_Count_Temp = ITEM_Count
ReDim ITEM_Count(ITEM_Count.GetLength(0), 1)
For x As Integer = 0 To ITEM_Count_Temp.GetLength(0) - 1
For y As Integer = 0 To ITEM_Count_Temp.GetLength(1) - 1
ITEM_Count(x, y) = ITEM_Count_Temp(x, y)
Next
Next
ITEM_Count(ITEM_Count.GetLength(0) - 1, 0) = Ticket.Item(Item)
ITEM_Count(ITEM_Count.GetLength(0) - 1, 1) = 1
Else
ITEM_Count(IsInIndex, 1) = ITEM_Count(IsInIndex, 1) + 1
End If
End If
Else
'IF NULL
End If
i = i + 1
Next
'CI_COUNT FILLING
'ORDERING BY COUNT
Dim ITEM_obj = New List(Of obj)
Dim ITEM_ToObj As String = ""
Dim ITEMCount_ToObj As String = ""
For x As Integer = 0 To ITEM_Count.GetLength(0) - 1
ITEM_ToObj = ITEM_Count(x, 0)
ITEMCount_ToObj = ITEM_Count(x, 1)
ITEM_obj.Add(New obj(ITEM_ToObj, ITEMCount_ToObj))
Next
ITEM_obj = OrderItem(ITEM_obj)
Dim Item_Count_listview As ListViewItem
For Each Itemobj As obj In ITEM_obj
Dim Transfer_Array(2) As String
Transfer_Array(0) = Itemobj.Item
Transfer_Array(1) = Itemobj.Item_Count
Item_Count_listview = New ListViewItem(Transfer_Array)
Select Case Item
Case "Product_Name"
CI_Count_Table.Items.Add(Item_Count_listview)
Case "Status"
Status_Count_Table.Items.Add(Item_Count_listview)
Case "Language"
Language_Count_Table.Items.Add(Item_Count_listview)
Case "Assigned_Group"
AssignedGroup_Count_Table.Items.Add(Item_Count_listview)
Case "Priority"
Priority_Count_Table.Items.Add(Item_Count_listview)
Case "Company"
LOB_Count_Table.Items.Add(Item_Count_listview)
Case Else
MsgBox("No Category Of this type exist. Programming Issue. Item is: " & Item)
End Select
Next
Next
End Sub
What is not possible to run into a background worker like this?
regards,

Resources