Speed up my function - Dynamic button creation vb.net - vb.net

I have a function that creates button dynamically based on a database table, there are about 250 records inside. Everything is working properly but I'd like to make it faster but I don't know how.
Maybe it's due to the language I don't know.
Actually, on my development machine, it takes about 56 seconds to load. I'm not an experienced developper so maybe I'm missing something.
The problem is that on the client machine, that has only 4Go of RAM, the loading time is much bigger, 2.5 to 3.5 minutes.
Thans you for your help.
This is my code :
Public Sub LoadProducts()
Me.ProgressBar1.Value = 0
Me.ProgressBar1.Visible = True
Dim oSim As New SimFonction
Dim str As String = "SELECT * FROM produits ORDER BY ref;"
Dim oCmd As New MySqlCommand(str, oSim.ConnectDb)
Dim oData As New DataSet
Dim oAdapt As New MySqlDataAdapter With {
.SelectCommand = oCmd
}
oAdapt.Fill(oData)
oSim.conn.Close()
recCount = oData.Tables(0).Rows.Count
Dim btn(recCount) As Button
Dim x, y, j As Integer
oAdapt = Nothing
oCmd = Nothing
str = Nothing
Dim ref As String
x = 0
y = 0
Dim valeurIncr As Integer = 100 / recCount
valeurBar = 0
i = 0
For i = 0 To oData.Tables(0).Rows.Count - 1
If Me.ProgressBar1.Value >= 90 Then
Me.ProgressBar1.Value = 0
End If
If j = 5 Then
y += 90
j = 0
x = 0
End If
x += 90
btn(i) = New Button With {
.Parent = productPanel,
.Location = New Point(x, y),
.Height = 90,
.Width = 90,
.Font = New Font("Microsoft Sans Serif", 14, FontStyle.Bold),
.ForeColor = Color.Orange,
.UseVisualStyleBackColor = True,
.TextAlign = ContentAlignment.BottomCenter
}
ref = oData.Tables(0).Rows(i).Item("ref").ToString
If IsDBNull(oData.Tables(0).Rows(i).Item("photo")) Then
btn(i).Text = oData.Tables(0).Rows(i).Item("ref").ToString
btn(i).Tag = oData.Tables(0).Rows(i).Item("ref").ToString
btn(i).Name = "bt" & ref
Else
Dim photoP As New IO.MemoryStream(CType(oData.Tables(0).Rows(i).Item("photo"), Byte()))
btn(i).BackgroundImage = Image.FromStream(photoP)
btn(i).BackgroundImageLayout = ImageLayout.Stretch
btn(i).Tag = oData.Tables(0).Rows(i).Item("ref").ToString
btn(i).Text = oData.Tables(0).Rows(i).Item("ref").ToString
btn(i).Name = "bt" & ref
photoP = Nothing
End If
If oSim.CheckProduiEnStock(ref) = False Then
btn(i).Enabled = False
End If
AddHandler btn(i).Click, AddressOf ButtonClicked
j += 1
Me.ProgressBar1.Value += 1
btn(i) = Nothing
Next
Me.ProgressBar1.Visible = False
End Sub

You may use the following command:
At the beginning: Me.SuspendLayout() ,and
at the end: Me.ResumeLayout()

Related

As population increases the SIR model graph should shift left. And the recovery & transmission rate trackbars don't work at all

I'm trying to simulate the spread of a virus using the SIR model in VB.net but my code doesn't work.
increase initial infections: should shift graph left (but mine doesn't)
increase Population: shifts graph left (but mine doesn't)
increase Susceptible: shifts graph left (but mine doesn't)
increase transmission rate (b): increases peak of 'infectives' curve (but my trackbar doesn't work at all - produces an overflow error)
increase recovery rate (a): 'infectives' peak decreases, while the other two lines go up
This is what the graph should do: https://faradars.org/ev/sir-simulator/?lang=en
These images demonstrate the errors in my code that I don't know how to fix:
Here's my code:
Imports System.Windows.Forms.DataVisualization.Charting
Public Class Form1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'initail values
Dim N As Double = 10000
Dim S As Double = 8000
Dim R = 0.0
Dim I As Double = N - S - R
Dim t As Double = 0
Dim b As Double = 2 'contact rate
Dim a As Double = 0.5 'removal rate
Dim scale As Double = 0.1
setupForm(N, S, I, R, t, b, a, scale)
ProccessGraph()
End Sub
Sub setupForm(N, S, I, R, t, b, a, scale)
'Trackbars
Dim tbData(7) As Decimal
tbData(1) = N 'population N
tbData(2) = S 'Susceptibles S
tbData(3) = I 'infectives I
tbData(4) = R 'Recoveries R
tbData(5) = t 'time t
tbData(6) = b 'infection rate b
tbData(7) = a 'removal rate a
Dim y As Integer = 10
For I = 1 To 7
Dim Tbar As New TrackBar
With Tbar
.Location = New Point(20, y)
.Size = New Size(140, 30)
.BackColor = Color.White
.Minimum = 0
.Maximum = 10000
.SmallChange = 1
.Name = "Trackbar" & I
.Value = tbData(I)
End With
Me.Controls.Add(Tbar)
'labels (display value) ✓
Dim labvalue As New Label
With labvalue
.Location = New Point(180, y)
.Name = "label" & I
.Size = New Size(50, 15)
End With
Me.Controls.Add(labvalue)
'labels (tbar title) ✓
Dim labtitle_data(7) As String
labtitle_data(1) = "Population N"
labtitle_data(2) = "Susceptibles S"
labtitle_data(3) = "Infectives I"
labtitle_data(4) = "Recoveries R"
labtitle_data(5) = "time"
labtitle_data(6) = "infection rate"
labtitle_data(7) = "removal rate"
Dim labtitle As New Label
With labtitle
.Location = New Point(240, y)
.Name = "label" & I
.Size = New Size(60, 60)
.Text = labtitle_data(I)
End With
y += 60
Me.Controls.Add(labtitle)
'ComboBox (to list countries) ✓
Dim cb1 As New ComboBox
cb1.Items.Add("China")
cb1.Location = New Point(990, 50)
Me.Controls.Add(cb1)
'Form properties ✓
Me.Size = New Size(1200, 500)
Me.BackColor = Color.White
AddHandler Tbar.ValueChanged, AddressOf ProccessGraph 'every time the value changes, recreate the graph to match it
Next
End Sub
Sub ProccessGraph()
Dim tblist(7) As TrackBar 'array of trackbars
For tbar = 1 To 7
tblist(tbar) = Me.Controls("TrackBar" & tbar)
Me.Controls("label" & tbar).Text = tblist(tbar).Value 'adds value to label
Next
'reset NSIR values to match trackbar values
Dim N = tblist(1).Value
Dim S = tblist(2).Value
Dim I = tblist(3).Value
Dim R = tblist(4).Value
Dim t = tblist(5).Value
Dim b = tblist(6).Value
'Dim a = tblist(7).Value
Dim a As Double = 0.5
Dim scale As Double = 0.1
'b = tblist(6).Value
'a = tblist(7).Value
'chart lines ✓
Chart1.Series.Clear()
Chart1.Titles.Clear()
Dim serS As New Series
Dim serI As New Series
Dim serR As New Series
serS.Name = "S"
serS.ChartType = SeriesChartType.Line
serS.BorderWidth = 2
serI.Name = "I"
serI.ChartType = SeriesChartType.Line
serI.BorderWidth = 2
serR.Name = "R"
serR.ChartType = SeriesChartType.Line
serR.BorderWidth = 2
'chart calculations ✓
For ind = 0 To 99
serS.Points.AddXY(t, S)
serI.Points.AddXY(t, I)
serR.Points.AddXY(t, R)
Dim ds = (-b * S * I) / N
Dim Di = ((b * S * I) / N) - a * I
Dim Dr = a * I
Dim dt = 1
S = S + ds * scale
I = I + Di * scale
R = R + Dr * scale
t = t + dt * scale
Next
'chart properties ✓
Chart1.Series.Add(serS)
Chart1.Series.Add(serI)
Chart1.Series.Add(serR)
Chart1.ChartAreas("ChartArea1").AxisX.Title = "Days"
Chart1.ChartAreas("ChartArea1").AxisY.Title = "Population"
Chart1.ChartAreas("ChartArea1").AxisX.Interval = 10
Chart1.ChartAreas("ChartArea1").AxisY.Interval = 500
Chart1.Titles.Add("SIR Graph")
Chart1.Location = New Point(280, 30)
Chart1.Size = New Size(700, 400)
''trackbar colors which, remember, are only accessible via the array tbs
'tblist(1).BackColor = Color.LightGray
'tblist(2).BackColor = Color.Blue
'tblist(3).BackColor = Color.Yellow
'tblist(4).BackColor = Color.LightCoral
End Sub
End Class`
Existing SIR models:
https://faradars.org/ev/sir-simulator/?lang=en
Existing SIR models code:
https://www.google.com/amp/s/jamesmccaffrey.wordpress.com/2020/02/11/the-kermack-mckendrick-sir-disease-model-using-c/amp/
https://github.com/henrifroese/infectious_disease_modelling/blob/master/part_two.ipynb

How to print loop result in next blank page if Current Page is Full

I have have the following codes to print the voucher, but I face problem in loop section while printing the SQL query result if the page is full it reprints using same page.
enter image description here
Private Sub ATATprint_PrintPage(sender As Object, e As PrintPageEventArgs) Handles ATATprint.PrintPage
Dim Brush1 As New SolidBrush(Color.Black)
Dim ValueBrush As New SolidBrush(Color.DarkGreen)
Dim lblFont As Font = New Font("B Yekan", 10, FontStyle.Regular)
Dim ValueFont As Font = New Font("Agency FB", 10, FontStyle.Bold)
Dim ypos As Integer = 300
Dim pn As Integer = 1
Dim str(6) As String
str(0) = TrnAccountType
str(1) = TrnAccountNo
str(2) = TrnAccountName
str(3) = TrnCurrecy
str(4) = TrnExRate
str(5) = TrnAmount
str(6) = TrnNarration
Try
Dim adapter As New SqlDataAdapter("select case when trd_DrCr = 'Dr' then 'Debit' else 'Credit' end,
isnull(acc_Ccy, '')+'-'+Convert(nvarchar,trd_Account), acc_Name, trd_ccy, format(trd_ExRate,'#,###,###.0000'), format(trd_Amount, '#,###,###.00'), trd_Narration
from TransactionDetails join Accounts on Accounts.acc_Number = TransactionDetails.trd_Account where trd_TrnRef = '" & fncTrnReference.Text & "'", connection)
Dim table As New DataTable
adapter.Fill(table)
For row As Integer = 0 To table.Rows.Count - 1
For col As Integer = 0 To table.Columns.Count - 1
e.Graphics.DrawString(str(col), lblFont, Brush1, 100, ypos)
e.Graphics.DrawString(table.Rows(row)(col).ToString, ValueFont, ValueBrush, 200, ypos)
ypos += 15
Next
ypos += 30
If ypos > 900 Then
ypos = 200
e.HasMorePages = True
End If
Next
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
e.HasMorePages = False
End Sub
You need to fill the adapter outside of the PrintPage method and also keep track of the value of the row variable from your for loop. When the PrintPage method is called again, start your For loop from that point.
Also, you don't need to create new SolidColorBrushes if you are using the standard colors.
Finally, be sure to dispose your Fonts when finished. I did this in the Finally block of the code below.
This code is not tested so it may require some changes to meet your needs, but it should give you some ideas.
'These variables are declared outside the PrintPage method so they retain their values between calls.
Private adapter As SqlDataAdapter = Nothing
Private savedRowValue As Integer = 0
Private table As DataTable = Nothing
Private Sub ATATprint_PrintPage(sender As Object, e As PrintPageEventArgs) Handles ATATprint.PrintPage
Dim Brush1 As Brushes.Black 'Use the standard brushes here.
Dim ValueBrush Brushes.DarkGreen
Dim lblFont As Font = New Font("B Yekan", 10, FontStyle.Regular)
Dim ValueFont As Font = New Font("Agency FB", 10, FontStyle.Bold)
Dim ypos As Integer = 300
Dim pn As Integer = 1
Dim str(6) As String
str(0) = TrnAccountType
str(1) = TrnAccountNo
str(2) = TrnAccountName
str(3) = TrnCurrecy
str(4) = TrnExRate
str(5) = TrnAmount
str(6) = TrnNarration
Try
'Create the data adapter and fill the DataTable only on the first time the PrintPage method is called
If adapter Is Nothing Then
adapter As New SqlDataAdapter("select case when trd_DrCr = 'Dr' then 'Debit' else 'Credit' end,
isnull(acc_Ccy, '')+'-'+Convert(nvarchar,trd_Account), acc_Name, trd_ccy, format(trd_ExRate,'#,###,###.0000'), format(trd_Amount, '#,###,###.00'), trd_Narration
from TransactionDetails join Accounts on Accounts.acc_Number = TransactionDetails.trd_Account where trd_TrnRef = '" & fncTrnReference.Text & "'", connection)
table = New DataTable
adapter.Fill(table)
End If
'Start the For loop at the saved value instead of at 0
For row As Integer = savedRowValue To table.Rows.Count - 1
For col As Integer = 0 To table.Columns.Count - 1
e.Graphics.DrawString(str(col), lblFont, Brush1, 100, ypos)
e.Graphics.DrawString(table.Rows(row)(col).ToString, ValueFont, ValueBrush, 200, ypos)
ypos += 15
Next
ypos += 30
If ypos > 900 Then
ypos = 200
e.HasMorePages = True
savedRowValue = row + 1 'Save the value of the current row
Exit Sub
End If
Next
Catch ex As Exception
MessageBox.Show(ex.Message)
Finally
lblFont.Dispose() 'Dispose of your fonts here
ValueFont.Dispose()
End Try
e.HasMorePages = False
End Sub

VB Net What is the fastest way to generate object created programmatically

I have create an application that need to generate about 100 to 1000 object programmatically. This object will be generated with the same amount in the database. In order to accomplish objective above, of course i need to call the data from database, then i looping through each data to generate each object. But it takes such a very long time before it done. I hoping that you have an alternative way beside how i do this.
Below is my code to call the data from database
Dim tbls As New DataTable
Using cons As New SqlConnection(stringconnection)
Dim sqls = "select * from tbsectiondetail where IDSection = '" & txtIDSection.Text &
"' AND KodeLocation like '%" & txtCari.Text &
"%' AND Status like '%" & cbStatus.Text &
"%' ORDER BY Status DESC"
Dim adps As New SqlDataAdapter(sqls, cons)
adps.Fill(tbls)
adps.Dispose()
cons.Dispose()
End Using
If i just generate the data only, its just take only 1 to 2 second. So i don't think there is problem about how i call the data from database
And below is how i generate the object through looping the data
Dim resultsx As DataRow() = tbls.Select("")
If resultsx.Count > 0 Then
For iX = 0 To resultsx.Count - 1
'CREATE A VARIABLE
Dim IDSectionDetail = resultsx(iX)("IDSectionDetail").ToString
Dim NamaLocation = resultsx(iX)("NamaLocation").ToString
Dim SectionKode = resultsx(iX)("KodeLocation").ToString
Dim StatusSection = resultsx(iX)("Status").ToString
Dim StatusSectionAt = resultsx(iX)("StatusAt").ToString
Dim StatusC1 = resultsx(iX)("StatusC1").ToString
Dim StatusC2 = resultsx(iX)("StatusC2").ToString
'GENERATE A PANEL
Dim pnlContainer As New Panel
pnlContainer.Size = New Size(290, 200)
Tablex.Controls.Add(pnlContainer, curColumn, rowNo)
pnlContainer.Dock = DockStyle.Fill
Dim pnlHeader As New Panel
pnlContainer.Controls.Add(pnlHeader)
pnlHeader.Dock = DockStyle.Top
pnlHeader.Size = New Size(pnlContainer.Width, 35)
If StatusSection = "Open" Then
pnlHeader.BackColor = Color.DarkSlateGray
Else
pnlHeader.BackColor = Color.FromArgb(185, 58, 50)
End If
pnlContainer.Controls.SetChildIndex(pnlHeader, 2)
'GENERATE LABEL HEADER
Dim lblHeader As New Label
lblHeader.Text = NamaLocation & " - " & SectionKode
pnlHeader.Controls.Add(lblHeader)
lblHeader.Font = New Font("Century Gothic", 9, FontStyle.Bold Or FontStyle.Italic)
lblHeader.ForeColor = Color.White
lblHeader.Location = New Point(8, 7)
lblHeader.AutoSize = True
'GENERATE LABEL STATUS
Dim lblStatus As New Label
lblStatus.Text = "Status : " & StatusSection
pnlHeader.Controls.Add(lblStatus)
lblStatus.Font = New Font("Century Gothic", 8, FontStyle.Bold Or FontStyle.Italic)
lblStatus.ForeColor = Color.White
lblStatus.TextAlign = ContentAlignment.MiddleRight
lblStatus.Height = pnlHeader.Height
lblStatus.Dock = DockStyle.Right
lblStatus.AutoSize = True
'GENERATE PANEL FOOTER
Dim pnlFooter As New Panel
pnlContainer.Controls.Add(pnlFooter)
pnlFooter.Dock = DockStyle.Fill
pnlFooter.Size = New Size(pnlFooter.Width, 35)
pnlFooter.BackColor = Color.White
pnlContainer.Controls.SetChildIndex(pnlFooter, 0)
'GENERATE BUTTON DETAIL
Dim btnDetail As New Button
pnlFooter.Controls.Add(btnDetail)
btnDetail.Name = "btn" & SectionKode
btnDetail.FlatStyle = FlatStyle.Flat
btnDetail.FlatAppearance.BorderColor = Color.FromArgb(46, 74, 98)
btnDetail.FlatAppearance.BorderSize = 1
btnDetail.FlatAppearance.MouseDownBackColor = Color.Gold
btnDetail.FlatAppearance.MouseOverBackColor = Color.Gold
btnDetail.BackColor = Color.DarkSlateGray
btnDetail.Text = "Detail"
btnDetail.Image = My.Resources.search2_icon
btnDetail.Font = New Font("Century Gothic", 8, FontStyle.Bold)
btnDetail.TextImageRelation = TextImageRelation.TextBeforeImage
btnDetail.Location = New Point(181, 84)
btnDetail.Anchor = AnchorStyles.Right And AnchorStyles.Top
btnDetail.Size = New Size(75, 28)
btnDetail.ForeColor = Color.White
AddHandler btnDetail.Click, Sub() DetailSection(IDSectionDetail, SectionKode)
curColumn += 1
If curColumn >= 5 Then
curColumn = 0
RowCount += 1
Tablex.RowCount = RowCount
rowNo += 1
End If
Next
End If
pnlFill.Controls.Add(Tablex)
Actually there is still more object to generate through that looping. But from my analysis, the looping already take such a long time already just from code above.
The result of the generated object
I just wonder if there is another and faster alternative to generate such object. Or do i need to give up to design and just make it simple black and white ?

Vb.net export data to excel

I have a problem with the following code to export the data to excel with following button click Event:
Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click
ExportToExcel()
End Sub
here is the code
Private Sub ExportToExcel()
Dim ExcelApp As Object, ExcelBook As Object
Dim ExcelSheet As Object
Dim i As Integer
Dim j As Integer
Try
Me.DgView.DefaultCellStyle.ForeColor = Color.Navy
Me.DgView.RowsDefaultCellStyle.BackColor = Color.AliceBlue
Me.DgView.GridColor = Color.Blue
Me.DgView.BorderStyle = BorderStyle.Fixed3D
Me.DgView.RowHeadersBorderStyle = BorderStyle.Fixed3D
DgView.AutoGenerateColumns = False
Dim ReferColumn As New DataGridViewTextBoxColumn()
ReferColumn.DataPropertyName = "Refer_no"
ReferColumn.HeaderText = "ካሴት መ/ቁ"
ReferColumn.Width = 80
Dim TitleColumn As New DataGridViewTextBoxColumn()
TitleColumn.DataPropertyName = "Title"
TitleColumn.HeaderText = "ካሴት ርእስ"
TitleColumn.Width = 150
Dim GnrNmColumn As New DataGridViewTextBoxColumn()
GnrNmColumn.DataPropertyName = "Genre_Name"
GnrNmColumn.HeaderText = "የካሴት ዓይነት"
GnrNmColumn.Width = 100
Dim GrpNmColumn As New DataGridViewTextBoxColumn()
GrpNmColumn.DataPropertyName = "Group_Name"
GrpNmColumn.HeaderText = "የምድብ ስም"
GrpNmColumn.Width = 100
Dim ActColumn As New DataGridViewTextBoxColumn()
ActColumn.DataPropertyName = "Actors"
ActColumn.HeaderText = "ሪፖርተር"
ActColumn.Width = 150
Dim DirecColumn As New DataGridViewTextBoxColumn()
DirecColumn.DataPropertyName = "Director"
DirecColumn.HeaderText = "ኃላፊ"
DirecColumn.Width = 150
Dim LangColumn As New DataGridViewTextBoxColumn()
LangColumn.DataPropertyName = "Language"
LangColumn.HeaderText = "ቋንቋ"
LangColumn.Width = 150
Dim releasedateColumn As New DataGridViewTextBoxColumn()
LangColumn.DataPropertyName = "release_date"
LangColumn.HeaderText = "የተቀረፀበተት ቀነን"
LangColumn.Width = 150
Dim StatusColumn As New DataGridViewTextBoxColumn()
StatusColumn.DataPropertyName = "status"
StatusColumn.HeaderText = "ሁኔታ"
StatusColumn.Width = 80
Dim synopsisColumn As New DataGridViewTextBoxColumn()
synopsisColumn.DataPropertyName = "synopsis"
synopsisColumn.HeaderText = "የተቀረፀበተት ጉዳይ"
synopsisColumn.Width = 180
DgView.Columns.Add(ReferColumn)
DgView.Columns.Add(TitleColumn)
DgView.Columns.Add(GnrNmColumn)
DgView.Columns.Add(GrpNmColumn)
DgView.Columns.Add(ActColumn)
DgView.Columns.Add(DirecColumn)
DgView.Columns.Add(LangColumn)
DgView.Columns.Add(releasedateColumn)
DgView.Columns.Add(StatusColumn)
DgView.Columns.Add(synopsisColumn)
Dim columns As String() = {"Refer_No", "Title", "genre_name", "group_name", "Actors", "Director", "Language", "release_date", "Status", "synopsis"}
DVDModule.FillListWithoutParam(DVDList, columns, "usp_SelectDVDList", _
GetType(Entity.DVD))
FormatGridWithBothTableAndColumnStyles()
DgView.DataSource = DVDList
'create object of excel
ExcelApp = CreateObject("Excel.Application")
ExcelBook = ExcelApp.WorkBooks.Add
ExcelSheet = ExcelBook.WorkSheets(1)
With ExcelSheet
For Each column As DataGridViewColumn In DgView.Columns
.cells(1, column.Index + 1) = column.HeaderText
Next
For i = 1 To Me.DgView.RowCount
.cells(i + 1, 1) = Me.DgView.Rows(i - 1).Cells("Refer_no").Value
For j = 1 To DgView.Columns.Count - 1
.cells(i + 1, j + 1) = DgView.Rows(i - 1).Cells(j).Value
Next
Next
End With
ExcelApp.Visible = True
'
ExcelSheet = Nothing
ExcelBook = Nothing
ExcelApp = Nothing
I admit I didn't read all of your code. It's a mess and there's too much code for your question. It gives you some kind of error or what?
Anyway, if you just want to export a table showing some data, I suggest you to create a .csv file instead of using MS Excel. It's much more easier to code, faster during execution, and the output file is portable

Telerik winforms radgridview hierarchical data not showing correctly

Good day,
I am using telerik radgridview hierarchical data in vb.net winforms vs2013.
I am getting this problem, I see correctly the first list in the radgridview and in the first gridviewtemplate, but I do not see a thing in the second gridviewtemplate. I am out of ideas, I post the code here to see if anyone can help me.
Private Function loaddt0() As Data.DataSet
Dim dt As New Data.DataSet
dt.Tables.Add("person")
dt.Tables("person").Columns.Add("personID")
dt.Tables("person").Columns.Add("personName")
For i As Integer = 1 To 3
Dim rw As Data.DataRow
rw = dt.Tables("person").NewRow
rw.Item("personID") = i
rw.Item("personName") = "person" & " - " & i.ToString
dt.Tables("person").Rows.Add(rw)
Next
Return dt
End Function
Private Function loaddt1() As Data.DataSet
Dim dt As New Data.DataSet
dt.Tables.Add("project")
dt.Tables("project").Columns.Add("projectID")
dt.Tables("project").Columns.Add("projectName")
dt.Tables("project").Columns.Add("personID")
dt.Tables("project").Columns.Add("personprojectID")
Dim rw As Data.DataRow
rw = dt.Tables("project").NewRow
rw.Item("projectID") = 1
rw.Item("projectName") = "Proyect 1"
rw.Item("personID") = 1
rw.Item("personprojectID") = "1-1"
dt.Tables("project").Rows.Add(rw)
Dim rw1 As Data.DataRow
rw1 = dt.Tables("project").NewRow
rw1.Item("projectID") = 2
rw1.Item("projectName") = "Proyect 2"
rw1.Item("personID") = 1
rw1.Item("personprojectID") = "1-2"
dt.Tables("project").Rows.Add(rw1)
Dim rw2 As Data.DataRow
rw2 = dt.Tables("project").NewRow
rw2.Item("projectID") = 1
rw2.Item("projectName") = "Proyect 1"
rw2.Item("personID") = 2
rw2.Item("personprojectID") = "2-1"
dt.Tables("project").Rows.Add(rw2)
Dim rw3 As Data.DataRow
rw3 = dt.Tables("project").NewRow
rw3.Item("projectID") = 1
rw3.Item("projectName") = "Proyect 1"
rw3.Item("personID") = 3
rw3.Item("personprojectID") = "3-1"
dt.Tables("project").Rows.Add(rw3)
Return dt
End Function
Private Function loaddt2() As Data.DataSet
Dim dt As New Data.DataSet
dt.Tables.Add("task")
dt.Tables("task").Columns.Add("personprojectID")
dt.Tables("task").Columns.Add("taskID")
dt.Tables("task").Columns.Add("taskName")
dt.Tables("task").Columns.Add("personID")
dt.Tables("task").Columns.Add("personprojecttaskID")
Dim rw As Data.DataRow
rw = dt.Tables("task").NewRow
rw.Item("personprojectID") = "1-1"
rw.Item("taskID") = 3
rw.Item("taskName") = "Task 3"
rw.Item("personID") = 1
rw.Item("personprojecttaskID") = "1-1-3"
dt.Tables("task").Rows.Add(rw)
Dim rw1 As Data.DataRow
rw1 = dt.Tables("task").NewRow
rw1.Item("personprojectID") = "1-1"
rw1.Item("taskID") = 5
rw1.Item("taskName") = "Task 5"
rw1.Item("personID") = 1
rw1.Item("personprojecttaskID") = "1-1-5"
dt.Tables("task").Rows.Add(rw1)
Dim rw2 As Data.DataRow
rw2 = dt.Tables("task").NewRow
rw2.Item("personprojectID") = "1-1"
rw2.Item("taskID") = 8
rw2.Item("taskName") = "Task 8"
rw2.Item("personID") = 1
rw2.Item("personprojecttaskID") = "1-1-8"
dt.Tables("task").Rows.Add(rw2)
Dim rw3 As Data.DataRow
rw3 = dt.Tables("task").NewRow
rw3.Item("personprojectID") = "1-2"
rw3.Item("taskID") = 6
rw3.Item("taskName") = "Task 6"
rw3.Item("personID") = 1
rw3.Item("personprojecttaskID") = "1-2-6"
dt.Tables("task").Rows.Add(rw3)
Dim rw4 As Data.DataRow
rw4 = dt.Tables("task").NewRow
rw4.Item("personprojectID") = "2-1"
rw4.Item("taskID") = 1
rw4.Item("taskName") = "Task 1"
rw4.Item("personID") = 1
rw4.Item("personprojecttaskID") = "2-1-1"
dt.Tables("task").Rows.Add(rw4)
Dim rw5 As Data.DataRow
rw5 = dt.Tables("task").NewRow
rw5.Item("personprojectID") = "3-1"
rw5.Item("taskID") = 8
rw5.Item("taskName") = "Task 8"
rw5.Item("personID") = 3
rw5.Item("personprojecttaskID") = "3-1-8"
dt.Tables("task").Rows.Add(rw5)
Return dt
End Function
Private Sub load2()
Dim ldt As Data.DataSet
ldt = loaddt0()
rgvtareas.DataSource = ldt.Tables("person").DefaultView
ldt.Dispose()
Dim gridviewtemple As New Telerik.WinControls.UI.GridViewTemplate
Dim ldt2 As Data.DataSet
ldt2 = loaddt1()
gridviewtemple.DataSource = ldt2.Tables("project").DefaultView
ldt2.Dispose()
Dim ldt3 As Data.DataSet
ldt3 = loaddt2()
Dim gridviewtemple2 As New Telerik.WinControls.UI.GridViewTemplate
gridviewtemple2.DataSource = ldt3.Tables("task").DefaultView
ldt3.Dispose()
rgvtareas.MasterTemplate.Templates.Add(gridviewtemple)
Dim relation As New Telerik.WinControls.UI.GridViewRelation(rgvtareas.MasterTemplate)
relation.ChildTemplate = gridviewtemple
relation.RelationName = "PERSONS - PROJECTS"
relation.ParentColumnNames.Add("personID")
relation.ChildColumnNames.Add("personID")
rgvtareas.Relations.Add(relation)
gridviewtemple.AllowAddNewRow = False
gridviewtemple.AllowDragToGroup = False
gridviewtemple.AllowDeleteRow = False
gridviewtemple.AllowEditRow = False
gridviewtemple.AutoSizeColumnsMode = Telerik.WinControls.UI.GridViewAutoSizeColumnsMode.Fill
'Me.cargaridiomagrv3(gridviewtemple2)
'Me.dgdarformatogvt(gridviewtemple)
gridviewtemple.Templates.Add(gridviewtemple2)
Dim relation2 As New Telerik.WinControls.UI.GridViewRelation(gridviewtemple)
relation2.ChildTemplate = gridviewtemple2
relation2.RelationName = "PERSONPROJECTS - TASKS"
relation2.ParentColumnNames.Add("personprojectID")
relation2.ChildColumnNames.Add("personprojectID")
gridviewtemple2.AllowAddNewRow = False
gridviewtemple2.AllowDragToGroup = False
gridviewtemple2.AllowDeleteRow = False
gridviewtemple2.AllowEditRow = False
gridviewtemple2.AutoSizeColumnsMode = Telerik.WinControls.UI.GridViewAutoSizeColumnsMode.Fill
rgvtareas.Refresh()
End Sub
The image of what I get is:
You've missed adding the second GridViewRelation to the Relations collection of the control. Just add this line at the bottom:
rgvtareas.Relations.Add(relation2)