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