Code Efficiency: Iterations and Queries - sql

The code below does a few things:
Iterates through a colleciton of labels I have on my Windows form, used as a placeholder
While iterating through the collection, the code is connecting to an SQL database to return a result from a query for each label (about 104 labels)
Finally some charts are populates.
I have timed this whole process and it takes about 4 or 5 seconds. My goal is to have this process performed instantly or 1 seconds or less.
Could an expert out there explain to me what I'm doing wrong and why this process takes so long?
here is the query:
Dim RESULT1 As Decimal 'declare this as global
Dim RESULT2 As Decimal 'declare this as global
Private Sub Week(ByVal week As Integer)
Dim queryString As String = "SELECT " & _
" (SELECT CAST(SUM(TARGET_SECONDS) AS DECIMAL)/ CAST(SUM(ROUTE_SECONDS) AS DECIMAL) FROM dbo.APE_BUSDRIVER_MAIN WITH(NOLOCK) WHERE ACTIVE = 1 AND EMPLOYEE_NAME = '" & cbEmployeeName.Text & "') AS RESULT1," & _
" (SELECT (SELECT CAST(COUNT(APE_BUSDRIVER_STATUS_OBJID) AS DECIMAL) FROM dbo.APE_BUSDRIVER_MAIN AS RESULT2 WHERE ACTIVE = 1 AND APE_BUSDRIVER_STATUS_OBJID= 1 AND EMPLOYEE_NAME = '" & cbEmployeeName.Text & "' )/(SELECT CAST(COUNT(APE_BUSDRIVER_STATUS_OBJID) AS DECIMAL) FROM dbo.APE_BUSDRIVER_MAIN AS RESULT2 WHERE ACTIVE = 1 AND EMPLOYEE_NAME = '" & cbEmployeeName.Text & "' )) AS RESULT2" & _
" FROM dbo.APE_BUSDRIVER_MAIN WHERE WEEK_TIME = " & week & " AND APE_AREA_OBJID = " & lblAreaOBJID.Text & " AND EMPLOYEE_NAME = '" & cbEmployeeName.Text & "' AND YEAR_TIME = '" & cbYear.Text & "' AND ACTIVE = 1"
Using connection As New SqlConnection(SQLConnectionStr)
Dim command As New SqlCommand(queryString, connection)
connection.Open()
Dim reader As SqlDataReader = command.ExecuteReader()
' Call Read before accessing data.
If reader.HasRows Then
While reader.Read()
RESULT1 = reader("RESULT1")
RESULT2 = reader("RESULT2")
End While
Else
RESULT1 = 0
RESULT2 = 0
End If
' Call Close when done reading.
reader.Close()
End Using
End Sub
Here is the code:
Private Sub LoadWeeklyStats()
For i As Integer = 0 To 51
Dim LabelWkEff As String = "LblWkEff" + (i + 1).ToString
Dim myArray1 As Array = Controls.Find(LabelWkEff, False)
Dim myControl1 As Label = myArray1(0)
myControl1.Text = RESULT1
'AND
Dim LabelDeliveryStat As String = "lblDeliveryStat" + (i + 1).ToString
Dim myArray2 As Array = Controls.Find(LabelDeliveryStat, False)
Dim myControl2 As Label = myArray2(0)
myControl2.Text = RESULT2
'COUNTER
Week(i + 1)
Next
'TO CLEAR CHART AND RELOAD IT
Chart1.Titles.Clear()
Chart1.Series.Clear()
Chart1.ChartAreas.Clear()
Chart1.ChartAreas.Add("AREA")
Chart1.Series.Add("WeeklyEfficiency")
Chart1.Series.Add("TARGET")
Chart1.Titles.Add("ROUTE EFFICIENCY")
Chart1.Series("TARGET").ChartType = SeriesChartType.Line
With Chart1.Titles(0)
.Font = New Font("TAHOMA", 12, FontStyle.Bold)
End With
With Chart1.ChartAreas(0)
'.AxisY.MajorGrid.Enabled = False
.AxisX.MajorGrid.Enabled = False
.AxisX.Title = "WEEKS"
.AxisY.Title = "EFFICIENCY"
.AxisX.Minimum = 0
.AxisX.Maximum = 53
.AxisY.Minimum = 0
.AxisX.Interval = 1
.AxisY.LabelStyle.Format = Format(0, "0%")
End With
With Chart1.Series(0)
.Font = New Font(Me.Font.Name, 7, FontStyle.Regular)
.SmartLabelStyle.Enabled = False
.LabelAngle = -90
.Label = "#VAL{P}"
.IsValueShownAsLabel = True
.Name = "WeeklyEfficiency"
.ChartType = SeriesChartType.Column
.LabelToolTip = Enabled
.ToolTip = "WEEK #VALX" & vbNewLine & "#VAL{P}"
.BorderColor = Color.Black
.LabelForeColor = Color.Transparent
Dim area As String = cbArea.Text
Select Case area
Case "BC_PICKUP"
.Color = Color.Blue
Case "BC_DELIVERY"
.Color = Color.Blue
Case "RAW"
.Color = Color.LimeGreen
Case "RTV"
.Color = Color.Yellow
Case Else
.Color = Color.Black
End Select
'LOAD DATA POINTS
With .Points
.AddXY(0, 0)
.AddXY(1, LblWkEff1.Text)
.AddXY(2, LblWkEff2.Text)
.AddXY(3, LblWkEff3.Text)
.AddXY(4, LblWkEff4.Text)
.AddXY(5, LblWkEff5.Text)
.AddXY(6, LblWkEff6.Text)
.AddXY(7, LblWkEff7.Text)
.AddXY(8, LblWkEff8.Text)
.AddXY(9, LblWkEff9.Text)
.AddXY(10, LblWkEff10.Text)
.AddXY(11, LblWkEff11.Text)
.AddXY(12, LblWkEff12.Text)
.AddXY(13, LblWkEff13.Text)
.AddXY(14, LblWkEff14.Text)
.AddXY(15, LblWkEff15.Text)
.AddXY(16, LblWkEff16.Text)
.AddXY(17, LblWkEff17.Text)
.AddXY(18, LblWkEff18.Text)
.AddXY(19, LblWkEff19.Text)
.AddXY(20, LblWkEff20.Text)
.AddXY(21, LblWkEff21.Text)
.AddXY(22, LblWkEff22.Text)
.AddXY(23, LblWkEff23.Text)
.AddXY(24, LblWkEff24.Text)
.AddXY(25, LblWkEff25.Text)
.AddXY(26, LblWkEff26.Text)
.AddXY(27, LblWkEff27.Text)
.AddXY(28, LblWkEff28.Text)
.AddXY(29, LblWkEff29.Text)
.AddXY(30, LblWkEff30.Text)
.AddXY(31, LblWkEff33.Text)
.AddXY(32, LblWkEff32.Text)
.AddXY(33, LblWkEff33.Text)
.AddXY(34, LblWkEff34.Text)
.AddXY(35, LblWkEff35.Text)
.AddXY(36, LblWkEff36.Text)
.AddXY(37, LblWkEff37.Text)
.AddXY(38, LblWkEff38.Text)
.AddXY(39, LblWkEff39.Text)
.AddXY(40, LblWkEff40.Text)
.AddXY(41, LblWkEff41.Text)
.AddXY(42, LblWkEff42.Text)
.AddXY(43, LblWkEff43.Text)
.AddXY(44, LblWkEff44.Text)
.AddXY(45, LblWkEff45.Text)
.AddXY(46, LblWkEff46.Text)
.AddXY(47, LblWkEff47.Text)
.AddXY(48, LblWkEff48.Text)
.AddXY(49, LblWkEff49.Text)
.AddXY(50, LblWkEff50.Text)
.AddXY(51, LblWkEff51.Text)
.AddXY(52, LblWkEff52.Text)
.AddXY(53, 0)
End With
End With
With Chart1.Series("TARGET")
.Name = "TARGET"
.ChartType = SeriesChartType.Line
.Color = Color.Red
.BorderWidth = 3
With .Points
.AddXY(0, 1)
.AddXY(1, 1)
.AddXY(2, 1)
.AddXY(3, 1)
.AddXY(4, 1)
.AddXY(5, 1)
.AddXY(6, 1)
.AddXY(7, 1)
.AddXY(8, 1)
.AddXY(9, 1)
.AddXY(10, 1)
.AddXY(11, 1)
.AddXY(12, 1)
.AddXY(13, 1)
.AddXY(14, 1)
.AddXY(15, 1)
.AddXY(16, 1)
.AddXY(17, 1)
.AddXY(18, 1)
.AddXY(19, 1)
.AddXY(20, 1)
.AddXY(21, 1)
.AddXY(22, 1)
.AddXY(23, 1)
.AddXY(24, 1)
.AddXY(25, 1)
.AddXY(26, 1)
.AddXY(27, 1)
.AddXY(28, 1)
.AddXY(29, 1)
.AddXY(30, 1)
.AddXY(31, 1)
.AddXY(32, 1)
.AddXY(33, 1)
.AddXY(34, 1)
.AddXY(35, 1)
.AddXY(36, 1)
.AddXY(37, 1)
.AddXY(38, 1)
.AddXY(39, 1)
.AddXY(40, 1)
.AddXY(41, 1)
.AddXY(42, 1)
.AddXY(43, 1)
.AddXY(44, 1)
.AddXY(45, 1)
.AddXY(46, 1)
.AddXY(47, 1)
.AddXY(48, 1)
.AddXY(49, 1)
.AddXY(50, 1)
.AddXY(51, 1)
.AddXY(52, 1)
.AddXY(53, 1)
End With
End With
'MAKE ONTIME CHART
'______________________________________________________________________________()
'TO CLEAR CHART AND RELOAD IT
Chart2.Titles.Clear()
Chart2.Series.Clear()
Chart2.ChartAreas.Clear()
Chart2.ChartAreas.Add("AREA")
Chart2.Series.Add("WeeklyEfficiency")
Chart2.Series.Add("TARGET")
Chart2.Titles.Add("ON TIME EFFICIENCY")
With Chart2.Titles(0)
.Font = New Font("TAHOMA", 12, FontStyle.Bold)
End With
With Chart2.ChartAreas(0)
'.AxisY.MajorGrid.Enabled = False
.AxisX.MajorGrid.Enabled = False
.AxisX.Title = "WEEKS"
.AxisY.Title = "EFFICIENCY"
.AxisX.Minimum = 0
.AxisX.Maximum = 53
.AxisY.Minimum = 0
.AxisX.Interval = 1
.AxisY.LabelStyle.Format = Format(0, "0%")
End With
With Chart2.Series(0)
.Font = New Font(Me.Font.Name, 7, FontStyle.Regular)
.SmartLabelStyle.Enabled = False
.LabelAngle = -90
.Label = "#VAL{P}"
.IsValueShownAsLabel = True
.Name = "WeeklyEfficiency"
.ChartType = SeriesChartType.Column
.LabelToolTip = Enabled
.ToolTip = "WEEK #VALX" & vbNewLine & "#VAL{P}"
.BorderColor = Color.Black
.LabelForeColor = Color.Transparent
Dim area As String = cbArea.Text
Select Case area
Case "BC_PICKUP"
.Color = Color.Blue
Case "BC_DELIVERY"
.Color = Color.Blue
Case "RAW"
.Color = Color.LimeGreen
Case "RTV"
.Color = Color.Yellow
Case Else
.Color = Color.Black
End Select
'LOAD DATA POINTS
.Points.AddXY(0, 0)
.Points.AddXY(1, lblDeliveryStat1.Text)
.Points.AddXY(2, lblDeliveryStat2.Text)
.Points.AddXY(3, lblDeliveryStat3.Text)
.Points.AddXY(4, lblDeliveryStat4.Text)
.Points.AddXY(5, lblDeliveryStat5.Text)
.Points.AddXY(6, lblDeliveryStat6.Text)
.Points.AddXY(7, lblDeliveryStat7.Text)
.Points.AddXY(8, lblDeliveryStat8.Text)
.Points.AddXY(9, lblDeliveryStat9.Text)
.Points.AddXY(10, lblDeliveryStat10.Text)
.Points.AddXY(11, lblDeliveryStat11.Text)
.Points.AddXY(12, lblDeliveryStat12.Text)
.Points.AddXY(13, lblDeliveryStat13.Text)
.Points.AddXY(14, lblDeliveryStat14.Text)
.Points.AddXY(15, lblDeliveryStat15.Text)
.Points.AddXY(16, lblDeliveryStat16.Text)
.Points.AddXY(17, lblDeliveryStat17.Text)
.Points.AddXY(18, lblDeliveryStat18.Text)
.Points.AddXY(19, lblDeliveryStat19.Text)
.Points.AddXY(20, lblDeliveryStat20.Text)
.Points.AddXY(21, lblDeliveryStat21.Text)
.Points.AddXY(22, lblDeliveryStat22.Text)
.Points.AddXY(23, lblDeliveryStat23.Text)
.Points.AddXY(24, lblDeliveryStat24.Text)
.Points.AddXY(25, lblDeliveryStat25.Text)
.Points.AddXY(26, lblDeliveryStat26.Text)
.Points.AddXY(27, lblDeliveryStat27.Text)
.Points.AddXY(28, lblDeliveryStat28.Text)
.Points.AddXY(29, lblDeliveryStat29.Text)
.Points.AddXY(30, lblDeliveryStat30.Text)
.Points.AddXY(31, lblDeliveryStat33.Text)
.Points.AddXY(32, lblDeliveryStat32.Text)
.Points.AddXY(33, lblDeliveryStat33.Text)
.Points.AddXY(34, lblDeliveryStat34.Text)
.Points.AddXY(35, lblDeliveryStat35.Text)
.Points.AddXY(36, lblDeliveryStat36.Text)
.Points.AddXY(37, lblDeliveryStat37.Text)
.Points.AddXY(38, lblDeliveryStat38.Text)
.Points.AddXY(39, lblDeliveryStat39.Text)
.Points.AddXY(40, lblDeliveryStat40.Text)
.Points.AddXY(41, lblDeliveryStat41.Text)
.Points.AddXY(42, lblDeliveryStat42.Text)
.Points.AddXY(43, lblDeliveryStat43.Text)
.Points.AddXY(44, lblDeliveryStat44.Text)
.Points.AddXY(45, lblDeliveryStat45.Text)
.Points.AddXY(46, lblDeliveryStat46.Text)
.Points.AddXY(47, lblDeliveryStat47.Text)
.Points.AddXY(48, lblDeliveryStat48.Text)
.Points.AddXY(49, lblDeliveryStat49.Text)
.Points.AddXY(50, lblDeliveryStat50.Text)
.Points.AddXY(51, lblDeliveryStat51.Text)
.Points.AddXY(52, lblDeliveryStat52.Text)
.Points.AddXY(53, 0)
End With
With Chart2.Series("TARGET")
.Name = "TARGET"
.ChartType = SeriesChartType.Line
.Color = Color.Red
.BorderWidth = 3
With .Points
.AddXY(0, 1)
.AddXY(1, 1)
.AddXY(2, 1)
.AddXY(3, 1)
.AddXY(4, 1)
.AddXY(5, 1)
.AddXY(6, 1)
.AddXY(7, 1)
.AddXY(8, 1)
.AddXY(9, 1)
.AddXY(10, 1)
.AddXY(11, 1)
.AddXY(12, 1)
.AddXY(13, 1)
.AddXY(14, 1)
.AddXY(15, 1)
.AddXY(16, 1)
.AddXY(17, 1)
.AddXY(18, 1)
.AddXY(19, 1)
.AddXY(20, 1)
.AddXY(21, 1)
.AddXY(22, 1)
.AddXY(23, 1)
.AddXY(24, 1)
.AddXY(25, 1)
.AddXY(26, 1)
.AddXY(27, 1)
.AddXY(28, 1)
.AddXY(29, 1)
.AddXY(30, 1)
.AddXY(31, 1)
.AddXY(32, 1)
.AddXY(33, 1)
.AddXY(34, 1)
.AddXY(35, 1)
.AddXY(36, 1)
.AddXY(37, 1)
.AddXY(38, 1)
.AddXY(39, 1)
.AddXY(40, 1)
.AddXY(41, 1)
.AddXY(42, 1)
.AddXY(43, 1)
.AddXY(44, 1)
.AddXY(45, 1)
.AddXY(46, 1)
.AddXY(47, 1)
.AddXY(48, 1)
.AddXY(49, 1)
.AddXY(50, 1)
.AddXY(51, 1)
.AddXY(52, 1)
.AddXY(53, 1)
End With
End With
End Sub

I had a similar issue with a Caller Id Program I'm developing When the user was bringing back more than a couple of hundred call records it was taking forever
My approach was to only query the DB once at the beginning, Then Use linq on the data Set to bring back in the individual pieces of data
Ian
Private Sub LoadWeeklyStats()
'Get Global DataSource Here
For i As Integer = 0 To 51
Dim LabelWkEff As String = "LblWkEff" + (i + 1).ToString
Dim myArray1 As Array = Controls.Find(LabelWkEff, False)
Dim myControl1 As Label = myArray1(0)
myControl1.Text = RESULT1
'AND
Dim LabelDeliveryStat As String = "lblDeliveryStat" + (i + 1).ToString
Dim myArray2 As Array = Controls.Find(LabelDeliveryStat, False)
Dim myControl2 As Label = myArray2(0)
myControl2.Text = RESULT2
'COUNTER
Week(i + 1)
Next

Related

How to determine what is causing catastrophic error

I am getting catastrophic error at certain sequence on listbox form selection...
how can I determine what exactly is causing catastrophic error? The error is repeatable from my file.
On bellow code I put msgbox "a" and error doesn't appear any more... If I remove that it will apear again. Also it appears only right after I run the excel file and open forms and select item on that listbox.
Also the code is around 4000 lines and 150000 characters for this specific form. With other classes it's over 10000 lines and over 300000 characters.
Private Sub ListBox3_Change()
Dim partf As Variant, ctype As String
ReDim fncleft(4)
ReDim fncright(4)
Dim i As Integer, h As Integer
For i = 0 To Me.ListBox3.ListCount - 1
If Me.ListBox3.Selected(i) = True Then
With bomfix.ExcelTables(Me.ComboBox_Tables2.Value).settings
If Me.ListBox3.List(i, 1) <> vbNullString Then
Me.CheckBox_SQLltrim.Enabled = True
Me.CheckBox_SQLrtrim.Enabled = True
Me.CheckBox_SQLtrim.Enabled = True
Me.CheckBox_SQLlower.Enabled = True
Me.CheckBox_SQLupper.Enabled = True
Me.CommandButtonSQLreplace.Enabled = True
Me.Frame9.Visible = True
Me.TextBox_ConstraintType.Visible = True
Me.CommandButton8.Visible = True
Me.Label99.Visible = True
Me.Label100.Visible = True
Me.TextBox_ConstrTableName.Visible = True
Me.TextBox_ConstrColumnName.Visible = True
If .TableExists(Me.ListBox3.List(i, 0)) = True Then
If .Table(Me.ListBox3.List(i, 0)).ColumnExists(Me.ListBox3.List(i, 1)) = True Then
Me.ComboBox_PartTable.List = .Tables
Me.ComboBox_PartTable.AddItem vbNullString, 0
With .Table(Me.ListBox3.List(i, 0))
Me.CheckBox_FullJoinTable.Enabled = True
Me.CheckBox_FullJoinTable.Value = .FullJoin
With .column(Me.ListBox3.List(i, 1))
Me.TextBox_ExportName.Value = .Value
Me.CheckBox_ColumnHidden.Value = .Hidden
Me.CheckBox_ColumnEnabled.Value = .Active
Me.TextBox_ConstraintType.Value = .ConstraintType
Me.TextBox_ConstrTableName.Value = .ConstraintTable
Me.TextBox_ConstrColumnName.Value = .ConstraintColumn
Me.CheckBox_SQLltrim.Value = .SQLltrim
Me.CheckBox_SQLrtrim.Value = .SQLrtrim
Me.CheckBox_SQLtrim.Value = .SQLtrim
Me.CheckBox_SQLlower.Value = .SQLlower
Me.CheckBox_SQLupper.Value = .SQLupper
MsgBox "b"
partf = .PartitionFilter
If Not UBound(partf) < 0 Then
Me.TextBox_PartResults.Value = partf(0)
If bomfix.ExcelTables(Me.ComboBox_Tables2.Value).settings.TableExists(partf(1)) = True Then
Me.ComboBox_PartTable.Value = partf(1)
Me.ComboBox_PartColumn.List = bomfix.ExcelTables(Me.ComboBox_Tables2.Value).settings.Table(Me.ComboBox_PartTable.Value).Columns
Me.ComboBox_PartColumn.AddItem vbNullString, 0
If bomfix.ExcelTables(Me.ComboBox_Tables2.Value).settings.Table(partf(1)).ColumnExists(partf(2)) = True Then
Me.ComboBox_PartColumn.Value = partf(2)
Me.ComboBox_PartOrderBy.Value = partf(3)
End If
End If
Else
Me.TextBox_PartResults.Value = vbNullString
Me.ComboBox_PartTable.Value = vbNullString
Me.ComboBox_PartColumn.Value = vbNullString
Me.ComboBox_PartOrderBy.Value = vbNullString
End If
Me.TextBox_FuncLeftCol.Value = Me.ListBox3.List(i, 0) & "." & Me.ListBox3.List(i, 1)
Me.ComboBox_FuncRightVal.Value = Me.ComboBox_FuncRightVal.List(0)
' add filters Array(and_or, Comparator, tableright, columnright, FunctionRight, FunctionLeft)
Me.ListBox4.Clear
For h = 1 To .FilterSet.Count
Me.ListBox4.AddItem
Me.ListBox4.List(Me.ListBox4.ListCount - 1, 0) = .FilterSet(h)(0) ' and_or
Me.ListBox4.List(Me.ListBox4.ListCount - 1, 1) = Join(.FilterSet(h)(5), "|") ' function left
Me.ListBox4.List(Me.ListBox4.ListCount - 1, 2) = .FilterSet(h)(1) ' comparator
Me.ListBox4.List(Me.ListBox4.ListCount - 1, 3) = .FilterSet(h)(2) ' table right
Me.ListBox4.List(Me.ListBox4.ListCount - 1, 4) = .FilterSet(h)(3) ' column right
Me.ListBox4.List(Me.ListBox4.ListCount - 1, 5) = Join(.FilterSet(h)(4), "|") ' function right
Next
End With
End With
End If
End If
ElseIf Me.ListBox3.List(i, 2) <> vbNullString Then
If .Aggregates.Exists(Me.ListBox3.List(i, 0)) = True Then
With .Aggregates(Me.ListBox3.List(i, 0))(1)
Me.CheckBox_SQLltrim.Enabled = False
Me.CheckBox_SQLrtrim.Enabled = False
Me.CheckBox_SQLtrim.Enabled = False
Me.CheckBox_SQLlower.Enabled = False
Me.CheckBox_SQLupper.Enabled = False
Me.CommandButtonSQLreplace.Enabled = False
Me.CheckBox_FullJoinTable.Enabled = False
Me.Frame9.Visible = False
Me.TextBox_ConstraintType.Visible = False
Me.CommandButton8.Visible = False
Me.Label99.Visible = False
Me.Label100.Visible = False
Me.TextBox_ConstrTableName.Visible = False
Me.TextBox_ConstrColumnName.Visible = False
Me.TextBox_ExportName.Value = .Value
Me.CheckBox_ColumnHidden.Value = .Hidden
Me.CheckBox_ColumnEnabled.Value = .Active
Me.TextBox_ConstraintType.Value = .ConstraintType
Me.TextBox_ConstrTableName.Value = .ConstraintTable
Me.TextBox_ConstrColumnName.Value = .ConstraintColumn
Me.TextBox_FuncLeftCol.Value = "aggregate"
Me.ComboBox_FuncRightVal.Value = Me.ComboBox_FuncRightVal.List(0)
' add filters Array(and_or, Comparator, tableright, columnright, FunctionRight, FunctionLeft)
Me.ListBox4.Clear
For h = 1 To .FilterSet.Count
Me.ListBox4.AddItem
Me.ListBox4.List(Me.ListBox4.ListCount - 1, 0) = .FilterSet(h)(0)
Me.ListBox4.List(Me.ListBox4.ListCount - 1, 1) = Join(.FilterSet(h)(5), "|")
Me.ListBox4.List(Me.ListBox4.ListCount - 1, 2) = .FilterSet(h)(1)
Me.ListBox4.List(Me.ListBox4.ListCount - 1, 3) = .FilterSet(h)(2)
Me.ListBox4.List(Me.ListBox4.ListCount - 1, 4) = .FilterSet(h)(3)
Me.ListBox4.List(Me.ListBox4.ListCount - 1, 5) = Join(.FilterSet(h)(4), "|")
Next
End With
End If
End If
End With
Exit For
End If
Next
Me.ComboBox_FuncTypeRight.Value = Me.ComboBox_FuncTypeRight.List(0)
Me.ComboBox_FuncTypeLeft.Value = Me.ComboBox_FuncTypeLeft.List(0)
Call ComboBox_FuncComp_Change
End Sub

How to speed up pie charts creation in VB Web?

I have a web page that can create multiple pie charts based on an SQL query that executes when the page is loading. However I have noticed that the page loading takes too long (around 30 seconds). I checked the SQL formula and can confirm that it is working fine (results given almost instantly).
There are 40 different pie charts the page needs to create, and the page also have the option to generate a single pie chart and that works fast enough.
So I can deduce that it's the pie chart generation that is slow when it needs to create 40 of them. Is there a way to help speed up the pie chart creation process?
Here is my code for reference.
Sub draw_chart1() 'All Machines
Dim check1, check2, fi, cnt
Dim sql
Dim myConnectionString As String = "Provider=SQLOLEDB;" & SQLDB_pp.ConnectionString
fi = 0
cnt = 0
PlaceHolder1.Dispose()
PlaceHolder2.Dispose()
'Get all model
Dim query1 As String = String.Format("SELECT DISTINCT A.MacID FROM dbo.tblMachine A LEFT JOIN dbo.tblDataHdr b on a.MacID = b.MacID where DayID between '" & TextBox1.Text & "' AND '" & TextBox3.Text & "' ORDER BY A.MACID")
Dim dt1 As DataTable = GetData(query1)
For Q As Integer = 0 To dt1.Rows.Count - 1
'For Q As Integer = 0 To 1
check1 = dt1.Rows(Q)(0).ToString()
'This is the slow query
Dim query As String = String.Format("SELECT Z.MacID, Z.EventName, ISNULL(DIFF,0) AS DIFF FROM (select distinct MacID, EventName from dbo.tblMachine a join (SELECT DISTINCT EVENTNAME FROM dbo.tblEvtDur where EventName <> 'ON' ) b on b.EventName <> '' and MacID in ('" & check1 & "') ) Z LEFT JOIN (SELECT A.MacID, A.EventName, SUM(DATEDIFF(SECOND, A.STARTdt, A.eNDdt)) as diff,round(SUM(DATEDIFF(SECOND, A.STARTdt, A.eNDdt)) / cast(aVG(Tdiff) as decimal(30,8)),4) * 100 AS PER FROM dbo.tblEvtDur A LEFT JOIN ( SELECT MacID, SUM(DATEDIFF(SECOND, STARTdt, eNDdt)) as Tdiff FROM dbo.tblEvtDur WHERE DayID between '" & TextBox1.Text & "' and '" & TextBox3.Text & "' GROUP BY MacID ) B ON A.MacID = B.MacID WHERE DayID between '" & TextBox1.Text & "' and '" & TextBox3.Text & "' AND A.MacID in ('" & check1 & "') group by A.MacID, A.EventName) a ON A.EVENTNAME = Z.EVENTNAME and Z.MacID = a.MacID order by Z.MacID, Z.EventName")
Dim mychart As Chart = New Chart
' Dim myplace As PlaceHolder = New PlaceHolder
Dim ChartArea1 As ChartArea = New ChartArea
Dim Legend1 As Legend = New Legend
Dim dt As DataTable = GetData(query)
Dim x As String() = New String(dt.Rows.Count - 1) {}
Dim y As Integer() = New Integer(dt.Rows.Count - 1) {}
For i As Integer = 0 To dt.Rows.Count - 1
x(i) = dt.Rows(i)(1).ToString()
' y(i) = dt.Rows(i)(2).ToString()
y(i) = Convert.ToInt32(dt.Rows(i)(2))
Next
'Dim myConnection As New OleDbConnection(myConnectionString)
'Dim myCommand As New OleDbCommand(sql, myConnection)
'mychart.Width = Unit.Pixel(Session("sw") - 100)
'mychart.Height = Unit.Pixel((Session("sh") / 2) - 88)
mychart.Width = 600
mychart.Height = 400
mychart.ChartAreas.Clear()
mychart.ChartAreas.Add("ChartArea1")
mychart.Series.Clear()
mychart.Series.Add(0)
mychart.Series(0).Points.DataBindXY(x, y)
mychart.Titles.Clear()
mychart.Titles.Add("[" & Q + 1 & "] " & check1.ToString.ToUpper)
mychart.Titles(0).Font = New System.Drawing.Font("Tahoma", 12, System.Drawing.FontStyle.Bold)
mychart.Titles(0).BackColor = Color.PaleTurquoise
mychart.Titles(0).ForeColor = Color.Black
mychart.Series(0).ChartType = SeriesChartType.Pie
' mychart.Series(0).Points.DataBindXY(x, y)
mychart.Series(0).LegendText = "#VALX"
mychart.Series(0)("BarLabelStyle") = "Center"
mychart.Series(0)("pointWidth") = "1"
mychart.Series(0).BorderDashStyle = ChartDashStyle.Solid
mychart.Series(0).BorderWidth = 2
mychart.Series(0).Label = "#PERCENT"
mychart.Series(0).ShadowColor = Color.Gray
mychart.Series(0).ShadowOffset = 10
mychart.Series(0).LabelBackColor = Drawing.Color.Cornsilk
mychart.Series(0).Font = New Font("Tahoma", 9, FontStyle.Bold)
'Chart1.Series(0).LabelToolTip = "#LABEL Percent: #PERCENT"
mychart.Series(0).LegendToolTip = "#VALX - #PERCENT"
mychart.Series(0).ToolTip = "#VALX - #PERCENT"
mychart.ChartAreas("ChartArea1").Area3DStyle.Enable3D = True
mychart.Series(0).CustomProperties = "DrawingStyle=LightToDark"
'new
Chart1.Series(0).CustomProperties = "PieLabelStyle=Outside"
mychart.ChartAreas("ChartArea1").BorderDashStyle = BorderStyle.Solid
mychart.Palette = ChartColorPalette.None
mychart.Series(0).BorderDashStyle = ChartDashStyle.Solid
mychart.Series(0).BorderWidth = 2
mychart.Series(0).BorderColor = Color.Black
mychart.PaletteCustomColors = {Drawing.Color.Black, Drawing.Color.LightGray, Drawing.Color.Blue, Drawing.Color.Yellow, Drawing.Color.Red, Drawing.Color.Orange, Drawing.Color.Green}
mychart.Legends.Clear()
mychart.Legends.Add(0)
'Chart1.Legends(0).Enabled = True
''Chart1.Legends(0).BackColor = Drawing.Color.LightGreenplace
mychart.Legends(0).Font = New Font("Tahoma", 10, FontStyle.Bold)
mychart.Legends(0).Docking = System.Web.UI.DataVisualization.Charting.Docking.Bottom
'Chart1.Legends(0).Alignment = Drawing.StringAlignment.Center
'Chart1.Legends(0).BackColor = System.Drawing.Color.Transparent
mychart.DataBind()
'myplace.Visible = True
If (Q + 1) Mod 2 <> 0 Then
PlaceHolder1.Controls.Add(mychart)
' Dim spacer As LiteralControl = New LiteralControl("<p />")
' PlaceHolder1.Controls.Add(spacer)
End If
'Exit For
If (Q + 1) Mod 2 = 0 Then
PlaceHolder2.Controls.Add(mychart)
'Dim spacer As LiteralControl = New LiteralControl("<p />")
' PlaceHolder2.Controls.Add(spacer)
End If
Next
End Sub

Program not responding fast enough

To get started I created a program at work to read our network tools and store the retrieved data to our database. No problem but the way I set it up originally was every tool had its own instance and was hard coded for each tool.
Now I was tasked with making the program more user friendly so I can send it to other places. So now I database the IP address of tool and location on assembly line so I can cross reference while the code is executing.
On the new program I created an array of my Tool Reader class:
Dim TB(50) As ReadAtlascopco
Then I run through this loop on form load:
Private dict As New Dictionary(Of Timer, Label)()
Private Sub CreateTimers()
For i = 0 To IPCount
TB(i) = New ReadAtlascopco
' timer(i) = New Timerarray
Next
For i As Integer = 1 To IPCount
C = i - 1
timer = New Timer() With {.Interval = 250, .Enabled = True, .Tag = i.ToString}
AddHandler timer.Tick, (AddressOf timer_Tick)
' timer.Interval = (100 * i)
label = New Label()
label.Name = "label" & i
label.Location = New Point(10, 10 + i * 25)
label.Font = New Font("Sans Serif", 9, FontStyle.Bold)
label.AutoSize = True
'label.Width = 100
'label.AutoEllipsis = False
label.TabIndex = i
label.Visible = True
Me.Controls.Add(label)
dict(timer) = label
TB(C).ipaddress = TBData(C)
TB(C).StartConnection()
timer.Enabled = True
timer.Start()
Next
Then I go through the timer tick event. Everything works great up until this point. Once I go through the tick event it starts lagging and I miss data.
Is there a way to speed this process up?
Here is the tick event:
Private Sub timer_Tick(ByVal sender As Object, ByVal e As EventArgs)
Dim Stop_Num(50) As String
Dim Line_Name(50) As String
Dim t As Timer = DirectCast(sender, Timer)
Dim s As Integer = Val(t.Tag) - 1
Param1 = TBData(s)
CWE(s) = False
If Activestat(s) = True Then
Dim SQL1 As String = "SELECT Stop_Num FROM TBL_Added_Boxes Where(IP_Address = N'" + Param1 + "')"
Dim output1 As String
Using cn = New SqlConnection(My.Settings.Torque_InfoConnectionString)
Using cmd = New SqlCommand(SQL1, cn)
cn.Open()
Try
Dim dr1 = cmd.ExecuteReader()
While dr1.Read()
output1 = dr1("Stop_Num").ToString()
End While
Catch ex As SqlException
WriteToErrorLog("Error pulling data from the database in reguards to torque box info (Stop Number).", ex.ToString(), "Failed to retreive Torque controler Info .")
End Try
cn.Close()
End Using
End Using
Stop_Num(0) = output1
Dim SQL2 As String = "SELECT Line_On FROM TBL_Added_Boxes Where(IP_Address = N'" + Param1 + "')"
Dim output2 As String
Using cn = New SqlConnection(My.Settings.Torque_InfoConnectionString)
Using cmd = New SqlCommand(SQL2, cn)
cn.Open()
Try
Dim dr2 = cmd.ExecuteReader()
While dr2.Read()
output2 = dr2("Line_On").ToString()
End While
Catch ex As SqlException
WriteToErrorLog("Error pulling data from the database in reguards to torque box info (Line On).", ex.ToString(), "Failed to retreive Torque controler Info .")
End Try
cn.Close()
End Using
End Using
Line_Name(0) = output2
If Line_Name(0) = "Line 1" Then
Newlinename(s) = "Line1Serial"
ElseIf Line_Name(0) = "Line 2" Then
Newlinename(s) = "Line2Serial"
ElseIf Line_Name(0) = "Line 3" Then
Newlinename(s) = "Line3Serial"
End If
Param3 = Stop_Num(0)
Param2 = Newlinename(s)
Dim SQL As String = "SELECT " + Newlinename(s) + " FROM TBL_RunningLineStatus Where(Stop_Number = N'" + Stop_Num(0) + "')"
Dim output As String
Using cn = New SqlConnection(My.Settings.ScanBypassConnectionString)
Using cmd = New SqlCommand(SQL, cn)
cn.Open()
Try
Dim dr = cmd.ExecuteReader()
While dr.Read()
output = dr(Param2).ToString()
End While
Catch ex As SqlException
WriteToErrorLog("Error Pulling Data From The Database In reguards to Seat Data.", ex.ToString(), "Failed to retreive buildline data.")
End Try
cn.Close()
End Using
End Using
TBSData(s) = output
If Killall = "True" Then
t.Stop()
Else
Try
TB(s).GetData()
If TB(s).Colorselect = 0 Then
dict(t).BackColor = System.Drawing.Color.GreenYellow
dict(t).ForeColor = Color.Black
ElseIf TB(s).Colorselect = 1 Then
TB(s).ipaddress = TBData(s)
TB(s).StartConnection()
dict(t).BackColor = System.Drawing.Color.Red
dict(t).ForeColor = Color.White
ElseIf TB(s).Colorselect = 2 Then
dict(t).BackColor = System.Drawing.Color.Purple
dict(t).ForeColor = Color.White
End If
If Olddata(s) <> TB(s).TorboxData(20) Then
Cname(s) = TB(s).TorboxData(2)
Tstatus(s) = TB(s).TorboxData(7)
TValue(s) = TB(s).TorboxData(19)
Sdata(s) = TBSData(s)
Tfinal(s) = TB(s).TorboxData(18)
TPset(s) = TB(s).TorboxData(30)
TFinalAngle(s) = TB(s).TorboxData(24)
RDAmin(s) = TB(s).TorboxData(25)
RDAmax(s) = TB(s).TorboxData(26)
RDAactual(s) = TB(s).TorboxData(27)
RDAStat(s) = TB(s).TorboxData(15)
Anglemin(s) = TB(s).TorboxData(21)
Anglemax(s) = TB(s).TorboxData(22)
AngleFT(s) = TB(s).TorboxData(23)
Anglestat(s) = TB(s).TorboxData(13)
Tormin(s) = TB(s).TorboxData(16)
Tormax(s) = TB(s).TorboxData(17)
TTTights(s) = TB(s).TorboxData(28)
TTSerial(s) = TB(s).TorboxData(29)
Olddata(s) = TB(s).TorboxData(20)
CWE(s) = True
dict(t).Text = t.Tag + " ) " + "Controler Name : " + TB(s).TorboxData(2) + ": Status : " + TB(s).Connectiontext + " : Date : " + Now() + " :: SERIAL # : " + Sdata(s) + " : From : " + Newlinename(s) + " :: Stop : " + Param3 + ""
' .Text = t.Tag + " ) " + "Controler Name : " + TB(s).TorboxData(2) + ": Status : " + TB(s).Connectiontext + " : Date : " + Now() + " :: SERIAL # : " + Sdata(s) + " : From : " + Newlinename(s) + " :: Stop : " + Param3 + "")
dict(t).BackColor = System.Drawing.Color.Yellow
Else
If TB(s).networkconnected = True Then
dict(t).AutoSize = True
'dict(t).Text = "Controler Name : " + TB(s).TorboxData(2) + ": Status : " + TB(s).Connectiontext + " : Date : " + Now()
dict(t).BackColor = System.Drawing.Color.Yellow
dict(t).ForeColor = Color.Black
Else
dict(t).Text = TB(s).Connectiontext + " :::: " + Now() + " :: " + TBData(s)
dict(t).BackColor = System.Drawing.Color.Red
dict(t).ForeColor = Color.White
End If
End If
Catch ex As Exception
WriteToErrorLog("Error Reading the torque box .", ex.Message, "Failed read torque data.")
Finally
'If CWE(s) = True Then
' Call Data_Entry()
'End If
If TValue(s) <> "" And CWE(s) = True Then
Try
con.ConnectionString = My.Settings.ScanBypassConnectionString
con.Open()
cmd.Connection = con
cmd.CommandText = "INSERT INTO TBL_Torque_Value1 (Serial_Num, Controler_Name, Torque_Status, Torque_Value, Date_Time,Extra_1, Extra_2, Extra_3,RundownMin,RundownMax,RundownAct,RundownStat,AngleMin,AngleMax,AngleFT,AngleStat,TorqueMin,TorqueMax,ToolTightens,Toolserialnum) VALUES(#p1,#p2, #p3, #p4, #p5, #p6, #p7, #p8,#p9, #p10, #p11, #p12, #p13, #p14, #p15, #p16, #p17, #p18, #p19, #p20)"
cmd.Parameters.Add("#p1", SqlDbType.NVarChar, 50)
cmd.Parameters.Add("#p2", SqlDbType.NVarChar, 250)
cmd.Parameters.Add("#p3", SqlDbType.NVarChar, 50)
cmd.Parameters.Add("#p4", SqlDbType.NVarChar, 50)
cmd.Parameters.Add("#p5", SqlDbType.DateTime2, 7)
cmd.Parameters.Add("#p6", SqlDbType.NVarChar, 250)
cmd.Parameters.Add("#p7", SqlDbType.NVarChar, 250)
cmd.Parameters.Add("#p8", SqlDbType.NVarChar, 250)
cmd.Parameters.Add("#p9", SqlDbType.NVarChar, 250)
cmd.Parameters.Add("#p10", SqlDbType.NVarChar, 250)
cmd.Parameters.Add("#p11", SqlDbType.NVarChar, 250)
cmd.Parameters.Add("#p12", SqlDbType.NVarChar, 250)
cmd.Parameters.Add("#p13", SqlDbType.NVarChar, 250)
cmd.Parameters.Add("#p14", SqlDbType.NVarChar, 250)
cmd.Parameters.Add("#p15", SqlDbType.NVarChar, 250)
cmd.Parameters.Add("#p16", SqlDbType.NVarChar, 250)
cmd.Parameters.Add("#p17", SqlDbType.NVarChar, 250)
cmd.Parameters.Add("#p18", SqlDbType.NVarChar, 250)
cmd.Parameters.Add("#p19", SqlDbType.NVarChar, 250)
cmd.Parameters.Add("#p20", SqlDbType.NVarChar, 250)
cmd.Parameters("#p1").Value = Sdata(s)
cmd.Parameters("#p2").Value = Cname(s)
cmd.Parameters("#p3").Value = Tstatus(s)
cmd.Parameters("#p4").Value = TValue(s)
cmd.Parameters("#p5").Value = Now()
cmd.Parameters("#p6").Value = Tfinal(s)
cmd.Parameters("#p7").Value = TFinalAngle(s) + " Deg"
cmd.Parameters("#p8").Value = "P:" + TPset(s)
cmd.Parameters("#p9").Value = RDAmin(s)
cmd.Parameters("#p10").Value = RDAmax(s)
cmd.Parameters("#p11").Value = RDAactual(s)
cmd.Parameters("#p12").Value = RDAStat(s)
cmd.Parameters("#p13").Value = Anglemin(s)
cmd.Parameters("#p14").Value = Anglemax(s)
cmd.Parameters("#p15").Value = AngleFT(s)
cmd.Parameters("#p16").Value = Anglestat(s)
cmd.Parameters("#p17").Value = Tormin(s)
cmd.Parameters("#p18").Value = Tormax(s)
cmd.Parameters("#p19").Value = TTTights(s)
cmd.Parameters("#p20").Value = TTSerial(s)
cmd.ExecuteNonQuery()
Catch ex As Exception
WriteToErrorLog("Error Inserting Data into The Database In reguards to Torque Data.", ex.Message, "Failed to Insert Torque Data.")
con.Close()
cmd.Parameters.Clear()
Cname(s) = ""
Tstatus(s) = ""
TValue(s) = ""
Sdata(s) = ""
Tfinal(s) = ""
TFinalAngle(s) = ""
TPset(s) = ""
RDAmin(s) = ""
RDAmax(s) = ""
RDAactual(s) = ""
RDAStat(s) = ""
Anglemin(s) = ""
Anglemax(s) = ""
AngleFT(s) = ""
Anglestat(s) = ""
Tormin(s) = ""
Tormax(s) = ""
TTTights(s) = ""
TTSerial(s) = ""
Finally
con.Close()
cmd.Parameters.Clear()
Cname(s) = ""
Tstatus(s) = ""
TValue(s) = ""
Sdata(s) = ""
Tfinal(s) = ""
TFinalAngle(s) = ""
TPset(s) = ""
RDAmin(s) = ""
RDAmax(s) = ""
RDAactual(s) = ""
RDAStat(s) = ""
Anglemin(s) = ""
Anglemax(s) = ""
AngleFT(s) = ""
Anglestat(s) = ""
Tormin(s) = ""
Tormax(s) = ""
TTTights(s) = ""
TTSerial(s) = ""
End Try
End If
End Try
End If
Else
dict(t).AutoSize = True
dict(t).Text = "Torque Box is not active :: " + TBData(s) + " ::"
dict(t).BackColor = System.Drawing.Color.Black
dict(t).ForeColor = Color.White
End If
End Sub
The class that is being referenced is one that I created and is working but like I said everything is slow. It seems to hang for 3 to 5 seconds in a single tick event.
As of now I only have 21 tools setup and it will take about 15 to 30 seconds to cycle through all.

VB.Net Drawing Binary Trees

Essentially, the purpose of this program is for revision. The program will generate a random mathematical expression, convert this into a visual representation of a binary tree and the user will have to traverse the binary tree. However, when I run this code, the initial node is far off centre. How would I go about re-positioning the binary tree to be in the middle of the PictureBox? Here is my code:
Public Class BTT
'VARAIBLES DECLARED CANNOT BE A FAULT
Dim nodes(7) As Object
'maybe try to alter the form so that the user can only get two incorrect answers'
Dim operators(6) As String
Dim actualAnswer As String = ""
Dim ogEquation(11) As String
Dim newLabel As String = "" 'used to store the equation to be stored in the label'
Dim userAnswer As String
Dim myTime As Double
Dim traversal(3) As String
Dim selectedTraversal As String
Dim treeCounter As Integer = 0
Dim draw As Boolean = False
Structure tree
Dim name As String
Dim left As Integer
Dim right As Integer
End Structure
Dim TreeNode(7) As tree
Dim scoreValue As Integer = 0 'stores the user's score for the game just completed'
Dim updating As Boolean = False 'if there are already 10 scores, the first one will need to be removed, so updating = true'
Class node
Public lineColour As Color
Public lineWidth As Integer
Public posX As Integer
Public posY As Integer
Public radius As Integer
Public Sub draw(e As PaintEventArgs)
Dim myPen As New Pen(Me.lineColour, Me.lineWidth)
e.Graphics.DrawEllipse(myPen, Me.posX, Me.posY, Me.radius, Me.radius)
End Sub
End Class
Sub DrawTree()
'these are the coordinates of the top left of the PictureBox
Dim leftX As Integer = 171
Dim rightX As Integer = 171 + PictureBox1.Width 'will be set to the edge of the picturebox
Dim topY As Integer = 138
Dim bottomY As Integer = 138 + PictureBox1.Height 'will be that number of pixels down, WILL NEVER CHANGE
Dim currentNode As Integer = 1 'will initially be the root node
For i = 1 To treeCounter 'loops based on the number of nodes in the array'
'assigns the basic information common to all of the nodes
nodes(i) = New node
nodes(i).radius = 70
nodes(i).lineWidth = 2
nodes(i).lineColour = Color.Black
Next
'need to go through the binary tree and determine x & y positions, with labels inside the ellipses
ConstructTree(currentNode, leftX, rightX, topY, bottomY)
draw = True
PictureBox1.Refresh()
End Sub
Sub ConstructTree(ByRef currentNode As Integer, ByRef leftX As Integer, ByRef rightX As Integer, ByRef topY As Integer, ByRef bottomY As Integer)
'ASK ISABEL ABOUT DYNAMICALLY GENERATING A LABEL'
'e.g. Dim test As New Label
nodes(currentNode).posX = (leftX + rightX) / 2 'gets average of x coordinates'
nodes(currentNode).posY = topY + ((bottomY - topY) * (1 / 3)) 'gets number of pixels down between bottom of form & last node, goes a third of the way down
If TreeNode(currentNode).left <> 0 Then 'if there is a node to the left
ConstructTree(TreeNode(currentNode).left, leftX, (leftX + rightX) / 2, nodes(currentNode).posY, bottomY)
End If
If TreeNode(currentNode).right <> 0 Then 'if there is a node to the right
ConstructTree(TreeNode(currentNode).right, (leftX + rightX) / 2, rightX, nodes(currentNode).posY, bottomY) 'swaps the left and right x-coords which have been changed
End If
End Sub
Private Sub PictureBox1_Paint(sender As Object, e As PaintEventArgs) Handles PictureBox1.Paint
If draw = True Then
For i = 1 To treeCounter
nodes(i).draw(e)
Next
'ALSO need to draw lines between the nodes, but IGNORE FOR NOW
End If
End Sub
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
TextBox1.Text = myTime - (0.1)
myTime = TextBox1.Text
If myTime = 0 Then
Timer1.Enabled = False
MsgBox("Time is up!")
checkupdate()
resetForm()
End If
'add another if statement checking for two wrong answers, will stop the timer and tell the user that they have got too man questions wrong'
End Sub
Sub resetForm()
Score.Text = "Score:"
Label1.Text = ""
scoreValue = 0
End Sub
Sub writefile()
FileOpen(1, "BTTscores.txt", OpenMode.Output)
Select Case updating
Case True
For i = 2 To 11
WriteLine(1, scores(i))
Next
Case False
For i = 1 To numberOfScores + 1
WriteLine(1, scores(i))
Next
End Select
FileClose()
End Sub
Sub checkupdate()
'need to check whether there are already ten elements in the array. If so, then delete the first score, move all the indices of the other scores 1 to the left and add the new scores on the end'
numberOfScores = 0 'will need to be reset if the user carries on using the program'
FileOpen(1, "BTTscores.txt", OpenMode.Input) 'need to bubble sort values'
Dim line As String
Do Until EOF(1)
line = LineInput(1)
If line <> "" Then
numberOfScores = numberOfScores + 1
scores(numberOfScores) = line 'copies the line to the array'
End If
Loop
If numberOfScores = 10 Then 'if one needs to be updated, need to read all but the first line into the array'
updating = True
scores(11) = scoreValue
Else 'if there are less than 10 scores, the user's current score just needs to be added on the end'
updating = False
scores(numberOfScores + 1) = scoreValue
End If
FileClose(1)
writefile()
End Sub
Private Sub EnterButton_Click(sender As Object, e As EventArgs) Handles EnterButton.Click
userAnswer = Answer.Text
If actualAnswer.Replace(" ", "") = userAnswer.Replace(" ", "") Then
UpdateScore()
End If
Score.Text = ("Score: " & scoreValue)
Answer.Text = ""
InitialSetup()
End Sub
Sub UpdateScore()
Select Case difficulty
Case "Easy"
scoreValue = scoreValue + 10
Case "Medium"
scoreValue = scoreValue + 15
Case "Hard"
scoreValue = scoreValue + 20
End Select
End Sub
Private Sub StartButton_Click(sender As Object, e As EventArgs) Handles StartButton.Click
scoreValue = 0
Initialisation()
InitialSetup()
myTime = 60
Timer1.Enabled = True
End Sub
Sub InitialSetup()
Dim currentNode As Integer = 1 'will be root node'
actualAnswer = ""
GetEquation()
newLabel = ""
selectedTraversal = traversal(CInt(Math.Floor((3 - 1 + 1) * Rnd())) + 1) 'will choose a random traversal'
newLabel = "Traversal: " + selectedTraversal
Label1.Text = newLabel
If selectedTraversal = "Prefix" Then
PrefixConversion(currentNode)
ElseIf selectedTraversal = "Infix" Then
InfixConversion()
Else
RPConversion()
End If
DrawTree()
End Sub
Sub Initialisation()
operators(1) = "("
operators(2) = "-"
operators(3) = "+"
operators(4) = "*"
operators(5) = "/"
operators(6) = ")"
traversal(1) = "Prefix"
traversal(2) = "Infix"
traversal(3) = "Postfix"
End Sub
Sub GetEquation()
Select Case difficulty
'RANDOM NUMBER FORMAT: CInt(Math.Floor((upperbound - lowerbound + 1) * Rnd())) + lowerbound'
Case "Easy"
'FORMAT: 17 * 4'
treeCounter = 3
ogEquation(1) = CInt(Math.Floor((20 - 1 + 1) * Rnd())) + 1
ogEquation(2) = operators(CInt(Math.Floor((5 - 2 + 1) * Rnd())) + 2)
ogEquation(3) = CInt(Math.Floor((20 - 1 + 1) * Rnd())) + 1
'initialising the binary tree iteration'
TreeNode(1).name = ogEquation(2) 'operator is the root'
TreeNode(1).left = 2
TreeNode(1).right = 3
TreeNode(2).name = ogEquation(1)
TreeNode(3).name = ogEquation(3)
'EG: * 17 4
Case "Medium"
treeCounter = 5
'FORMAT: 15 * (17 + 4)'
ogEquation(1) = CInt(Math.Floor((50 - 1 + 1) * Rnd())) + 1
ogEquation(2) = operators(CInt(Math.Floor((5 - 2 + 1) * Rnd())) + 2)
ogEquation(3) = operators(1)
ogEquation(4) = CInt(Math.Floor((50 - 1 + 1) * Rnd())) + 1
ogEquation(5) = operators(CInt(Math.Floor((5 - 2 + 1) * Rnd())) + 2)
ogEquation(6) = CInt(Math.Floor((50 - 1 + 1) * Rnd())) + 1
ogEquation(7) = operators(6)
'initialising the binary tree iteration'
TreeNode(1).name = ogEquation(2) 'root node'
TreeNode(1).left = 2
TreeNode(1).right = 3
TreeNode(2).name = ogEquation(1)
TreeNode(3).name = ogEquation(5)
TreeNode(3).left = 4
TreeNode(3).right = 5
TreeNode(4).name = ogEquation(4)
TreeNode(5).name = ogEquation(6)
'EG: * 15 + 17 4
Case "Hard"
'FORMAT: (17 + 4) * (20 / 10), random numbers are 1-150'
treeCounter = 7
ogEquation(1) = operators(1)
ogEquation(2) = CInt(Math.Floor((150 - 1 + 1) * Rnd())) + 1
ogEquation(3) = operators(CInt(Math.Floor((5 - 2 + 1) * Rnd())) + 2)
ogEquation(4) = CInt(Math.Floor((150 - 1 + 1) * Rnd())) + 1
ogEquation(5) = operators(6)
ogEquation(6) = operators(CInt(Math.Floor((5 - 2 + 1) * Rnd())) + 2)
ogEquation(7) = operators(1)
ogEquation(8) = CInt(Math.Floor((150 - 1 + 1) * Rnd())) + 1
ogEquation(9) = operators(CInt(Math.Floor((5 - 2 + 1) * Rnd())) + 2)
ogEquation(10) = CInt(Math.Floor((150 - 1 + 1) * Rnd())) + 1
ogEquation(11) = operators(6)
'initialising the binary tree iteration'
TreeNode(1).name = ogEquation(6) 'root node'
TreeNode(1).left = 2
TreeNode(1).right = 5
TreeNode(2).name = ogEquation(3)
TreeNode(2).left = 3
TreeNode(2).right = 4
TreeNode(3).name = ogEquation(2)
TreeNode(4).name = ogEquation(4)
TreeNode(5).name = ogEquation(9)
TreeNode(5).left = 6
TreeNode(5).right = 7
TreeNode(6).name = ogEquation(8)
TreeNode(7).name = ogEquation(10)
'EG: * + 17 4 / 20 10
End Select
End Sub
'Traversal Solutions'
'Postfix Conversion'
Sub RPConversion()
Dim myStack As New Stack(15)
Dim empty As Boolean = True
Dim temp As String 'used to store the current part of the original equation'
Dim operatorNum As Integer
Dim peekNum As Integer
Dim stoploop As Boolean = True
For i = 1 To ogEquation.Count - 1 'will iterate through the total number of elements in the array ogEquation'
If myStack.Count = 0 Then empty = True
temp = ogEquation(i)
MatchTempOperation(myStack, temp, operatorNum)
If operatorNum > 1 And operatorNum < 6 Then 'if the value is an operator'
If myStack.Count <> 0 Then 'if the stack contains a value'
CheckPeek(myStack, peekNum)
If operatorNum > peekNum Then
myStack.Push(temp)
ElseIf operatorNum = peekNum Then
actualAnswer = actualAnswer + myStack.Pop()
myStack.Push(temp)
Else 'operatorNum < peekNum'
actualAnswer = actualAnswer + myStack.Pop()
Do
stoploop = True
CheckPeek(myStack, peekNum)
If operatorNum > peekNum Then
myStack.Push(temp)
ElseIf operatorNum = peekNum Then
actualAnswer = actualAnswer + myStack.Pop()
myStack.Push(temp)
Else
actualAnswer = actualAnswer + myStack.Pop()
stoploop = False
End If
Loop Until stoploop Or myStack.Count = 0
End If
Else
myStack.Push(temp)
End If
ElseIf temp = "(" Then
myStack.Push(temp)
ElseIf temp = ")" Then
Do
actualAnswer = actualAnswer + myStack.Pop()
Loop Until myStack.Peek() = "("
myStack.Pop()
Else
actualAnswer = actualAnswer + temp
End If
operatorNum = 0
Next
If myStack.Count > 0 Then
For i = 1 To myStack.Count
actualAnswer = actualAnswer + myStack.Pop()
Next
End If
End Sub
Sub CheckPeek(ByVal myStack As Stack, ByRef peekNum As Integer) 'does the same as MatchTempOperation but for the top of the stack'
For i = 2 To 5 'skip one and six because we know it isn't a left or right bracket'
If myStack.Peek() = operators(i) Then
peekNum = i
End If
Next
End Sub
Sub MatchTempOperation(ByVal myStack As Stack, ByVal temp As String, ByRef operatorNum As Integer) 'wants to look at the stack but not be able to change it'
For i = 1 To 6
If temp = operators(i) Then
operatorNum = i
End If
Next
End Sub
'Infix'
Sub InfixConversion()
For i = 1 To 11
'check each element for empty spaces / brackets'
If ogEquation(i) <> "" And ogEquation(i) <> "(" And ogEquation(i) <> ")" Then
actualAnswer = actualAnswer + ogEquation(i)
End If
Next
End Sub
'Prefix'
Sub PrefixConversion(ByRef currentNode As Integer)
actualAnswer = actualAnswer + TreeNode(currentNode).name
If TreeNode(currentNode).left <> 0 Then
PrefixConversion(TreeNode(currentNode).left)
End If
If TreeNode(currentNode).right <> 0 Then
PrefixConversion(TreeNode(currentNode).right)
End If
End Sub
Private Sub ExitButton_Click(sender As Object, e As EventArgs) Handles ExitButton.Click
Me.Hide()
End Sub
End Class
Apologies for it's inefficiency, please also note that the "difficulty" variable is Public and stored outside of this form. Thanks :)
OUTPUT:
enter image description here
As you can see, the root node is far off centre in the bottom left.

Strange issue with Datagridview-Rows not displayed

I have a Datagridview connected to a dataset.The problem is that occasionally,when the data is refreshed,it is not displayed in the DGV.The code is:
Private Sub DisplayInDGV()
Dim SQLSet As String
Dim DASet As New OleDb.OleDbDataAdapter
Dim DSSet As New DataSet
SQLSet = "Select * From SetDisplayTable"
DASet = New OleDb.OleDbDataAdapter(SQLSet, Con)
DSSet.Clear()
DASet.Fill(DSSet, "DSSetHere")
With DGVSetView
.Refresh()
.AutoGenerateColumns = False
.DataSource = Nothing
.DataSource = DSSet.Tables(0)
.Update()
DGVSetView.Columns(i).DataPropertyName = DSSet.Tables(0).Columns(i).ToString
.Columns(0).DataPropertyName = DSSet.Tables(0).Columns(0).ToString
.Columns(2).DataPropertyName = DSSet.Tables(0).Columns(1).ToString
.Columns(3).DataPropertyName = DSSet.Tables(0).Columns(2).ToString
.Columns(4).DataPropertyName = DSSet.Tables(0).Columns(3).ToString
.Columns(5).DataPropertyName = DSSet.Tables(0).Columns(4).ToString
.Columns(6).DataPropertyName = DSSet.Tables(0).Columns(5).ToString
.Columns(7).DataPropertyName = DSSet.Tables(0).Columns(6).ToString
.Columns(8).DataPropertyName = DSSet.Tables(0).Columns(7).ToString
.Columns(9).DataPropertyName = DSSet.Tables(0).Columns(8).ToString
.Columns(10).DataPropertyName = DSSet.Tables(0).Columns(9).ToString
.Columns(11).DataPropertyName = DSSet.Tables(0).Columns(10).ToString 'Item Unique Code for Hot Edit
.Columns(14).DataPropertyName = DSSet.Tables(0).Columns(12).ToString
End With
'Updating Totals/::
For ItemRow As Integer = 0 To DGVSetView.Rows.Count - 1
If DGVSetView.Rows(ItemRow).Cells(14).Value = True Then
DGVSetView.Rows(ItemRow).Cells(12).Value = DGVSetView.Rows(ItemRow).Cells(10).Value
ElseIf DGVSetView.Rows(ItemRow).Cells(14).Value = False Then
DGVSetView.Rows(ItemRow).Cells(13).Value = DGVSetView.Rows(ItemRow).Cells(10).Value
End If
Next
'Updating School and general totals in DGV//:
Dim SchoolTotal, GeneralTotal As Decimal
For ColumnTotal As Integer = 0 To DGVSetView.Rows.Count - 1
SchoolTotal += DGVSetView.Rows(ColumnTotal).Cells(12).Value
GeneralTotal += DGVSetView.Rows(ColumnTotal).Cells(13).Value
Next
txtSchoolAmtFinal.Text = SchoolTotal
txtGeneralAmtFinal.Text = GeneralTotal
DGVSetView.Update()
'Get gross total of the DGV amount column//:
If DGVSetView.RowCount <> 0 Then
Dim GrossAmt As Decimal = 0
For Index As Integer = 0 To DGVSetView.RowCount - 1
' GrossAmt += Convert.ToDecimal(DataGridView1.Rows(Index).Cells(11).Value)
If Str(DGVSetView.Rows(Index).Cells(10).Value) = "Null" Or (DGVSetView.Rows(Index).Cells(10).Value) <= 0 Then
MsgBox("Item Number " & (DGVSetView.Rows(Index).Cells(10).Value) & " is either blank or 0", MsgBoxStyle.Exclamation, "Item Error")
Else
GrossAmt += Convert.ToDecimal(DGVSetView.Rows(Index).Cells(10).Value)
End If
Next
txtInsertGrossAmt.Text = GrossAmt ' - Val(DGVSetView.Text)
Call SetNetAmount()
End If
'Generate Serial//:
Dim X As Integer
Do While X < DGVSetView.Rows.Count
DGVSetView.Item(0, X).Value = X + 1
X = X + 1
Loop
'Disbaling editing in all columns except pending//:
With DGVSetView
.Columns(0).ReadOnly = True
.Columns(2).ReadOnly = True
.Columns(3).ReadOnly = True
.Columns(4).ReadOnly = True
.Columns(5).ReadOnly = True
.Columns(6).ReadOnly = True
.Columns(7).ReadOnly = True
.Columns(8).ReadOnly = True
.Columns(9).ReadOnly = True
.Columns(10).ReadOnly = True
End With
txtTotalItems.Text = DGVSetView.Rows.Count
For Each r As DataGridViewRow In DGVSetView.Rows
r.Cells(1).Value = True
Next r
End Sub
The problem is that occasionally,the DGV will not show any rows and displays a blank frame.At such instances.if I check in DGV.Rows.count
the result is 0 despite there being underlying data in the table.
Note that this happens randomly.At other times the DGV refreshed properly and also displays data correctly.
Also note that this DGV resides within a TabControl.
Further,when the DGV fails to display the data,the totals which I have calculated in the above sub procedure return zero value.As such the problem appears to lie somewhere in the rows not being inserted in the DGV.
Thank you.
Khalid.
//Edit;Code Updated:
#jmcilhinney I have updated my code as follows.However,the earlier problem of the DGV going blank occasionally persists.Also the update process has slowed down slightly.It seems I may be making a mistake in the location of placing the Suspend and ResumeBinding statements:
Private Sub SetPreview()
Dim SQLSet As String
Dim DASet As New OleDb.OleDbDataAdapter
Dim DSSet As New DataSet
SQLSet = "Select * From SetDisplayTable"
Dim DTDGV As New DataTable
Dim DGVBindingSource As New BindingSource
DASet = New OleDb.OleDbDataAdapter(SQLSet, Con)
DASet.Fill(DTDGV)
DGVBindingSource.DataSource = DTDGV
DGVBindingSource.ResumeBinding()
With DGVSetView
.AutoGenerateColumns = False
.DataSource = DGVBindingSource
.Columns(0).DataPropertyName = DTDGV.Columns(0).ToString
.Columns(2).DataPropertyName = DTDGV.Columns(1).ToString
.Columns(3).DataPropertyName = DTDGV.Columns(2).ToString
.Columns(4).DataPropertyName = DTDGV.Columns(3).ToString
.Columns(5).DataPropertyName = DTDGV.Columns(4).ToString
.Columns(6).DataPropertyName = DTDGV.Columns(5).ToString
.Columns(7).DataPropertyName = DTDGV.Columns(6).ToString
.Columns(8).DataPropertyName = DTDGV.Columns(7).ToString
.Columns(9).DataPropertyName = DTDGV.Columns(8).ToString
.Columns(10).DataPropertyName = DTDGV.Columns(9).ToString
.Columns(11).DataPropertyName = DTDGV.Columns(10).ToString 'Item Unique Code for Hot Edit
.Columns(14).DataPropertyName = DTDGV.Columns(12).ToString
End With
DGVBindingSource.SuspendBinding()
'Updating Totals/::
For ItemRow As Integer = 0 To DGVSetView.Rows.Count - 1
If DGVSetView.Rows(ItemRow).Cells(14).Value = True Then
DGVSetView.Rows(ItemRow).Cells(12).Value = DGVSetView.Rows(ItemRow).Cells(10).Value
ElseIf DGVSetView.Rows(ItemRow).Cells(14).Value = False Then
DGVSetView.Rows(ItemRow).Cells(13).Value = DGVSetView.Rows(ItemRow).Cells(10).Value
End If
Next
'Updating School and general totals in DGV//:
Dim SchoolTotal, GeneralTotal As Decimal
For ColumnTotal As Integer = 0 To DGVSetView.Rows.Count - 1
SchoolTotal += DGVSetView.Rows(ColumnTotal).Cells(12).Value
GeneralTotal += DGVSetView.Rows(ColumnTotal).Cells(13).Value
Next
txtSchoolAmtFinal.Text = SchoolTotal
txtGeneralAmtFinal.Text = GeneralTotal
DGVSetView.Update()
'Get gross total of the DGV amount column//:
If DGVSetView.RowCount <> 0 Then
Dim GrossAmt As Decimal = 0
For Index As Integer = 0 To DGVSetView.RowCount - 1
' GrossAmt += Convert.ToDecimal(DataGridView1.Rows(Index).Cells(11).Value)
If Str(DGVSetView.Rows(Index).Cells(10).Value) = "Null" Or (DGVSetView.Rows(Index).Cells(10).Value) <= 0 Then
MsgBox("Item Number " & (DGVSetView.Rows(Index).Cells(10).Value) & " is either blank or 0", MsgBoxStyle.Exclamation, "Item Error")
Else
GrossAmt += Convert.ToDecimal(DGVSetView.Rows(Index).Cells(10).Value)
End If
Next
txtInsertGrossAmt.Text = GrossAmt ' - Val(DGVSetView.Text)
Call SetNetAmount()
End If
'Disabling editing in all columns except pending//:
With DGVSetView
.Columns(0).ReadOnly = True
.Columns(2).ReadOnly = True
.Columns(3).ReadOnly = True
.Columns(4).ReadOnly = True
.Columns(5).ReadOnly = True
.Columns(6).ReadOnly = True
.Columns(7).ReadOnly = True
.Columns(8).ReadOnly = True
.Columns(9).ReadOnly = True
.Columns(10).ReadOnly = True
End With
txtTotalItems.Text = DGVSetView.Rows.Count
For Each r As DataGridViewRow In DGVSetView.Rows
r.Cells(1).Value = True
Next r
End Sub