Snakes and ladders Vb.net [closed] - vb.net

Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 7 years ago.
Improve this question
Form 2 is to enter ladder base and its off set value and for snakes where the snake head is and skakes off set value.
Not able to figure out why its not working . When the values are entered to show simulation it show's up error sandl is private and the other one is the validation one .
Public Class Form2
Dim sandl(99) As Integer
Dim snakeshead As TextBox()
Dim snakesoffset As TextBox()
Dim ladderfoot As TextBox()
Dim ladderoffset As TextBox()
Dim rnd As Random = New Random
Sub initialise()
For i = 0 To 99
sandl(i) = 0 ' reset data
Next
End Sub
Sub snake()
snakeshead = {txthead1, txthead2, txthead3, txthead4, txthead5, txthead6, txthead7, txthead8, txthead9, txthead10}
snakesoffset = {txtoffset1, txtoffset2, txtoffset3, txtoffset4, txtoffset5, txtoffset6, txtoffset7, txtoffset8, txtoffset9, txtoffset10}
' SnakeHead(i).Text = (i + 81).ToString
' SnakeOffset(i).Text = "10" '(i + 10).ToString
For i As Integer = 0 To 9
While True
Dim base = rnd.Next(90) + 11
If sandl(base - 1) <> 0 Then
Continue While
End If
Dim offset = rnd.Next(20) + 10
If base - offset < 1 Then
Continue While
End If
snakeshead(i).Text = base.ToString
snakesoffset(i).Text = offset.ToString
sandl(base - 1) = -offset
Exit While
End While
Next
End Sub
Sub ladders()
ladderfoot = {txtladder1, txtladder2, txtladder3, txtladder4, txtladder5, txtladder6, txtladder7, txtladder8, txtladder9, txtladder10}
ladderoffset = {txtladderoffset1, txtladderoffset2, txtladderoffset3, txtladderoffset4, txtladderoffset5, txtladderoffset6, txtladderoffset7, txtladderoffset8, txtladderoffset9, txtladderoffset10}
'For i As Integer = 0 To 9
' LadderFoot(i).Text = (i + 11).ToString
' LadderOffset(i).Text = "10"
For i As Integer = 0 To 99
sandl(i) = 0 'reset data
Next
For i As Integer = 0 To 9
While True
Dim base = rnd.Next(90) + 1
If sandl(base - 1) <> 0 Then
Continue While
End If
Dim offset = rnd.Next(20) + 10
If base + offset > 100 Then
Continue While
End If
ladderfoot(i).Text = base.ToString
ladderoffset(i).Text = offset.ToString
sandl(base - 1) = offset
Exit While
End While
Next
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
For i As Integer = 0 To 99
sandl(i) = 0 'reset data
Next
Dim valid = Validate(ladderfoot, ladderoffset, +1, "Ladder")
If (valid) Then
valid = Validate(snakeshead, snakesoffset, -1, "Snake")
End If
If (valid) Then
'Form3 = New Form3
Form3.ShowDialog()
End If
End Sub
Private Function Validate(tbBase() As TextBox, tbOffset() As TextBox, delta As Integer, s As String) As Boolean
For i As Integer = 0 To 9
Dim base As Integer
If ((Not Integer.TryParse(tbBase(i).Text.Trim(), base)) OrElse (base < 1) OrElse (base > 100) OrElse (sandl(base - 1) <> 0)) Then
MessageBox.Show(s & (i + 1).ToString() & " base is invalid.")
tbBase(i).Select()
tbBase(i).SelectAll()
Return False
End If
base -= 1 'zero based
Dim offset As Integer
If ((Not Integer.TryParse(tbOffset(i).Text.Trim(), offset)) OrElse (offset < 10) OrElse (offset > 30) OrElse (base + offset * delta < 0) OrElse (base + offset * delta >= 100)) Then
MessageBox.Show(s & (i + 1).ToString() & " offset is invalid.")
tbOffset(i).Select()
tbOffset(i).SelectAll()
Return False
End If
sandl(base) = offset * delta 'write offset
Next
Return True
End Function
End Class
Public Class Form3
Enum EState
Dice
Move
Slide
Wait
Win
End Enum
Dim Fnt = New Font("Arial", 16)
Dim FntBig = New Font("Arial", 256)
Dim Frame As Integer = -1 'counter
Dim State = EState.Dice
Dim Rnd As Random = New Random
Dim Dice As Integer
Dim Pos As Point = New Point(32, 640 + 32)
Dim CurrentIndex As Integer = -1
Dim NextIndex As Integer
Dim TargetIndex As Integer
Private Sub Form3_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dice = 0
Frame = -1
State = EState.Dice
Pos = New Point(32, 640 + 32)
CurrentIndex = -1
End Sub
Private Sub PictureBox1_Paint(sender As Object, e As PaintEventArgs) Handles PictureBox1.Paint
DrawBackground(e.Graphics)
Frame += 1
Dim oldState = State
Select Case State
Case EState.Dice
If Frame = 0 Then
Dice = Rnd.Next(6) + 1 'roll dice
TargetIndex = CurrentIndex + Dice
NextIndex = CurrentIndex
ElseIf Frame >= 63 Then
If CurrentIndex + Dice < 100 Then
State = EState.Move 'valid dice
Else
State = EState.Wait 'invalid dice
End If
Dice = 0
End If
Case EState.Move
If Frame Mod 64 = 0 Then
CurrentIndex = NextIndex
If CurrentIndex = TargetIndex Then
If CurrentIndex < 99 Then 'not win
If Form2.sandl(CurrentIndex) <> 0 Then
State = EState.Slide 'snake or ladder
Else
State = EState.Dice 'empty tile
End If
TargetIndex = CurrentIndex + Form2.sandl(CurrentIndex)
Else
State = EState.Win 'win
End If
Else
NextIndex = CurrentIndex + 1 'move
End If
Else
Dim c = GetCoordinate(CurrentIndex)
Dim n = GetCoordinate(NextIndex)
Dim dx = (n.X - c.X)
Dim dy = (n.Y - c.Y)
Pos.X = c.X * 64 + (dx * (Frame Mod 64)) + 32
Pos.Y = c.Y * 64 + (dy * (Frame Mod 64)) + 32
End If
Case EState.Slide
If Frame >= 63 Then
CurrentIndex = TargetIndex
If CurrentIndex < 99 Then
State = EState.Dice 'not win
Else
State = EState.Win 'win
End If
Else
Dim c = GetCoordinate(CurrentIndex)
Dim n = GetCoordinate(TargetIndex)
Dim dx = (n.X - c.X)
Dim dy = (n.Y - c.Y)
Pos.X = c.X * 64 + (dx * (Frame Mod 64)) + 32
Pos.Y = c.Y * 64 + (dy * (Frame Mod 64)) + 32
End If
Case EState.Wait
If Frame >= 63 Then
State = EState.Dice
End If
End Select
e.Graphics.FillEllipse(Brushes.Blue, Pos.X - 16, Pos.Y - 16, 32, 32) 'draw player
If Dice > 0 Then
Dim size = e.Graphics.MeasureString(Dice.ToString, FntBig)
e.Graphics.DrawString(Dice.ToString, FntBig, Brushes.Black, 320 - size.Width / 2, 320 - size.Height / 2) 'print dice
End If
If State <> oldState Then
Frame = -1 'reset counter
End If
If State <> EState.Win Then
PictureBox1.Invalidate() 'schedule next paint
End If
End Sub
Private Sub DrawBackground(g As Graphics)
For y As Integer = 0 To 9
For x As Integer = 0 To 9
If (((x + y) Mod 2) = 0) Then
g.FillRectangle(Brushes.LightGray, x * 64, y * 64, 64, 64) 'dark rectangle
End If
Dim z = (9 - y) * 10 + x + 1
If y Mod 2 = 0 Then
z = (9 - y) * 10 + (9 - x) + 1
End If
g.DrawString(z.ToString, Fnt, Brushes.Black, x * 64, y * 64) 'number
Next
Next
For i As Integer = 0 To 99
If Form2.sandl(i) <> 0 Then
Dim base = GetCoordinate(i)
Dim offset = GetCoordinate(i + Form2.sandl(i))
If Form2.sandl(i) > 0 Then 'ladder
Dim delta = Math.Abs(base.X - offset.X) + 4
g.DrawLine(Pens.Green, base.X * 64 + 32 - delta, base.Y * 64 + 32, offset.X * 64 + 32 - delta, offset.Y * 64 + 32) 'left part
g.DrawLine(Pens.Green, base.X * 64 + 32 + delta, base.Y * 64 + 32, offset.X * 64 + 32 + delta, offset.Y * 64 + 32) 'right part
Else 'snake
g.DrawLine(Pens.Red, base.X * 64 + 32, base.Y * 64 + 32, offset.X * 64 + 32, offset.Y * 64 + 32) 'red line
End If
End If
Next
End Sub
Private Function GetCoordinate(i As Integer) As Point
Dim result As Point
result.Y = 9 - (i \ 10)
result.X = i Mod 10
If result.Y Mod 2 = 0 Then
result.X = 9 - result.X
End If
Return result
End Function
End Class

In Form2, change your declaration from
Dim sandl(99) As Integer
to
Public sandl(99) As Integer
This would allow Form3 to access your integer array
Rename your Validate method to something else, like ValidateTextBoxes, or if you intend to overload the base.Validate, then declare as
Private Overloads Function Validate

Related

Graphing from a table VB

I am trying to graph from a table called totals(). The program itself is working okay, but i am having some issues. First, for each button press, it is adding the values and regraphing them. I do not want them to add to the previous values, i want them to overwrite the values.
Dim d1, d2, d3 As Single
Dim dieSumInt As Integer
Dim totals(17) as integer
For ptr = 1 To 10000
d1 = (Int((Rnd() * 6) + 1))
d2 = (Int((Rnd() * 6) + 1))
d3 = (Int((Rnd() * 6) + 1))
dieSumInt = CInt((d1 + d2 + d3))
totals(dieSumInt) += 1
Next
The whole code i have here, is supposed to take the sum of 3 dice and graph the totals into a picture box. I have all the graphing down, but each time i hit the "roll" button it keeps adding to the previous values. Im not sure how to clear out the values, to get a consistent value being graphed.
Dim totals(18) As Integer
Dim dashPen As New Pen(Color.Black, 1)
Public Function Max(ByVal arry() As Integer) As Integer
Max = arry(0)
For ptr As Integer = 0 To UBound(arry)
If arry(ptr) > Max Then Max = arry(ptr)
Next
End Function
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Randomize(DateAndTime.Timer)
End Sub
Private Sub rollButton_Click(sender As Object, e As EventArgs) Handles RollButton.Click
Dim d1, d2, d3 As Single
Dim dieSumInt As Integer
For ptr = 1 To 10000
d1 = (Int((Rnd() * 6) + 1))
d2 = (Int((Rnd() * 6) + 1))
d3 = (Int((Rnd() * 6) + 1))
dieSumInt = CInt((d1 + d2 + d3))
totals(dieSumInt) += 1
Next
Call Plot(totals)
Call LabelGraph(totals)
End Sub
Private Sub Plot(ByVal arry() As Integer)
Dim plotColor As Color
plotColor = Color.SkyBlue
Dim plotPen As New Pen(plotColor, 5)
Dim graph As Graphics = displayBox.CreateGraphics
Dim ymax, ptr As Integer
Dim xscale, yscale, x1, y1, Dwidth, Dheight As Single
Dim myfont As New Font("courier new", 5 + (displayBox.Width \ 100))
Dim percentArry(4) As Integer
Dwidth = displayBox.Width - 50
Dheight = displayBox.Height - 100
ymax = Max(arry)
displayBox.Refresh()
yscale = CSng(Dheight / ymax)
xscale = CSng(Dwidth / 17)
Dwidth = displayBox.Width - 50
Dheight = displayBox.Height - 70
For ptr = 0 To 4
percentArry(ptr) = CInt(arry.Max * (ptr + 1) * 0.2)
y1 = Dheight - CInt((arry.Max * (ptr + 1) / 5) * yscale)
graph.DrawLine(dashPen, displayBox.Left - 25, y1 + 4, displayBox.Right - 25, y1 + 4)
dashPen.DashStyle = Drawing2D.DashStyle.DashDotDot
graph.DrawString(CStr(percentArry(ptr)), myfont, Brushes.LightSlateGray, 'marking the sides
CSng(displayBox.Left - 10),
y1 + 3)
Next
For ptr = 3 To 18
x1 = (ptr - 2) * xscale
y1 = Dheight - (arry(ptr) * yscale)
graph.DrawRectangle(plotPen, x1 + 30, y1 + 4, xscale - 10, Dheight - y1) 'adjusting the size of the graph rectangles
Next
End Sub
Private Sub LabelGraph(ByVal arry() As Integer)
Dim graph As Graphics = displayBox.CreateGraphics
Dim myfont As New Font("courier new", 5 + (displayBox.Width \ 100))
For ptr As Integer = 1 To 16
graph.DrawString(CStr(ptr + 2), myfont, Brushes.LightSlateGray,
CSng(((displayBox.Width / 17) * ptr + 5) - (ptr * 3) + displayBox.Width / 35),
displayBox.Height - 60)
graph.DrawString(CStr(arry(ptr + 2)), myfont, Brushes.LightSlateGray,
CSng(((displayBox.Width / 17) * ptr) - (ptr * 3) + displayBox.Width / 28),
displayBox.Height - 30)
Next
End Sub
Private Sub exitButton_Click(sender As Object, e As EventArgs) Handles exitButton.Click
Me.Close()
End Sub
Private Sub Form1_ResizeEnd(sender As Object, e As EventArgs) Handles Me.ResizeEnd
Plot(totals)
LabelGraph(totals)
End Sub

bounding data to mschart so i can return non-data point-values

I'm trying to build a chart composed of up-to-100% stacked columns, each with 4 series and, once built, upon hovering upon the series, return all bound data (in this case, user names)
I'm very close to what i want, but the tooltip is showing only the sums, which is expected, but i dont know how to proceed. If there's another way that passes over the hover, like clicking and, in the click, I recognize the series and all those that are there, that would help immensely too
What I Have right now
What I Want
After looking it up, i built the chart this way:
(right now its a code nightmare, but i will methodify everything properly later)
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim sql As New SqlCommand(my query, my connector)
connect()
Dim rs = sql.ExecuteReader
Dim dtTest1 As DataTable = New DataTable
If rs.Read Then
dtTest1.Load(rs)
End If
disconnect()
Dim arrayTempoCallback(dtTest1.Rows.Count) As Double
Dim arrayTempoInaptidao(dtTest1.Rows.Count) As Double
Dim arrayTempoParabens(dtTest1.Rows.Count) As Double
Dim arrayTempoRecusa(dtTest1.Rows.Count) As Double
Dim arrayTempoSemDados(dtTest1.Rows.Count) As Double
For Each item In dtTest1.Rows
arrayTempoCallback(dtTest1.Rows.IndexOf(item)) = item("TEMPO_CALLBACK")
arrayTempoInaptidao(dtTest1.Rows.IndexOf(item)) = item("TEMPO_INAPTIDAO")
arrayTempoParabens(dtTest1.Rows.IndexOf(item)) = item("TEMPO_PARABENS")
arrayTempoRecusa(dtTest1.Rows.IndexOf(item)) = item("TEMPO_RECUSA")
arrayTempoSemDados(dtTest1.Rows.IndexOf(item)) = item("TEMPO_SEMDADOS")
Next
Dim QuartisCallBack = Quartiles(arrayTempoCallback)
Dim QuartisTempoInaptidao = Quartiles(arrayTempoInaptidao)
Dim QuartisTempoParabens = Quartiles(arrayTempoParabens)
Dim QuartisTempoRecusa = Quartiles(arrayTempoRecusa)
Dim QuartisTempoSemDados = Quartiles(arrayTempoSemDados)
Dim tabelafinal As New DataTable
tabelafinal.Columns.Add("VALORES", GetType(String))
tabelafinal.Columns.Add("COLUNA", GetType(String))
tabelafinal.Columns.Add("COR", GetType(String))
Dim somaS As Integer = 0
Dim somaH As Integer = 0
Dim somaC As Integer = 0
Dim somaD As Integer = 0
For Each linha In dtTest1.Rows
If linha("TEMPO_INAPTIDAO") < QuartisTempoInaptidao.Item1 Then
somaS += 1
ElseIf linha("TEMPO_INAPTIDAO") >= QuartisTempoInaptidao.Item1 AndAlso linha("TEMPO_INAPTIDAO") < QuartisTempoInaptidao.Item2 Then
somaH += 1
ElseIf linha("TEMPO_INAPTIDAO") >= QuartisTempoInaptidao.Item2 AndAlso linha("TEMPO_INAPTIDAO") < QuartisTempoInaptidao.Item3 Then
somaC += 1
ElseIf linha("TEMPO_INAPTIDAO") >= QuartisTempoInaptidao.Item3 Then
somaD += 1
End If
Next
tabelafinal.Rows.Add(somaS, "TM_INAP", "D")
tabelafinal.Rows.Add(somaH, "TM_INAP", "C")
tabelafinal.Rows.Add(somaC, "TM_INAP", "H")
tabelafinal.Rows.Add(somaD, "TM_INAP", "S")
somaC = somaD = somaH = somaS = 0
For Each linha In dtTest1.Rows
If linha("TEMPO_PARABENS") < QuartisTempoParabens.Item1 Then
somaS += 1
ElseIf linha("TEMPO_PARABENS") >= QuartisTempoParabens.Item1 AndAlso linha("TEMPO_PARABENS") < QuartisTempoParabens.Item2 Then
somaH += 1
ElseIf linha("TEMPO_PARABENS") >= QuartisTempoParabens.Item2 AndAlso linha("TEMPO_PARABENS") < QuartisTempoParabens.Item3 Then
somaC += 1
ElseIf linha("TEMPO_PARABENS") >= QuartisTempoParabens.Item3 Then
somaD += 1
End If
Next
tabelafinal.Rows.Add(somaS, "TM_PARABENS", "S")
tabelafinal.Rows.Add(somaH, "TM_PARABENS", "H")
tabelafinal.Rows.Add(somaC, "TM_PARABENS", "C")
tabelafinal.Rows.Add(somaD, "TM_PARABENS", "D")
somaC = somaD = somaH = somaS = 0
For Each linha In dtTest1.Rows
If linha("TEMPO_RECUSA") < QuartisTempoRecusa.Item1 Then
somaS += 1
ElseIf linha("TEMPO_RECUSA") >= QuartisTempoRecusa.Item1 AndAlso linha("TEMPO_PARABENS") < QuartisTempoRecusa.Item2 Then
somaH += 1
ElseIf linha("TEMPO_RECUSA") >= QuartisTempoRecusa.Item2 AndAlso linha("TEMPO_PARABENS") < QuartisTempoRecusa.Item3 Then
somaC += 1
ElseIf linha("TEMPO_RECUSA") >= QuartisTempoRecusa.Item3 Then
somaD += 1
End If
Next
tabelafinal.Rows.Add(somaS, "TM_RECUSA", "S")
tabelafinal.Rows.Add(somaH, "TM_RECUSA", "H")
tabelafinal.Rows.Add(somaC, "TM_RECUSA", "C")
tabelafinal.Rows.Add(somaD, "TM_RECUSA", "D")
somaC = somaD = somaH = somaS = 0
For Each linha In dtTest1.Rows
If linha("TEMPO_SEMDADOS") < QuartisTempoSemDados.Item1 Then
somaS += 1
ElseIf linha("TEMPO_SEMDADOS") >= QuartisTempoSemDados.Item1 AndAlso linha("TEMPO_PARABENS") < QuartisTempoSemDados.Item2 Then
somaH += 1
ElseIf linha("TEMPO_SEMDADOS") >= QuartisTempoSemDados.Item2 AndAlso linha("TEMPO_PARABENS") < QuartisTempoSemDados.Item3 Then
somaC += 1
ElseIf linha("TEMPO_SEMDADOS") >= QuartisTempoSemDados.Item3 Then
somaD += 1
End If
Next
Dim somaFinalSemDadosS As Integer = If(somaS < 0, 0, somaS)
Dim somaFinalSemDadosH As Integer = If(somaH < 0, 0, somaH)
Dim somaFinalSemDadosC As Integer = If(somaC < 0, 0, somaC)
Dim somaFinalSemDadosD As Integer = If(somaD < 0, 0, somaD)
tabelafinal.Rows.Add(somaFinalSemDadosS, "TM_SEMDADOS", "S")
tabelafinal.Rows.Add(somaFinalSemDadosH, "TM_SEMDADOS", "H")
tabelafinal.Rows.Add(somaFinalSemDadosC, "TM_SEMDADOS", "C")
tabelafinal.Rows.Add(somaFinalSemDadosD, "TM_SEMDADOS", "D")
somaC = somaD = somaH = somaS = 0
For Each linha In dtTest1.Rows
If linha("TEMPO_CALLBACK") < QuartisCallBack.Item1 Then
somaS += 1
ElseIf linha("TEMPO_CALLBACK") >= QuartisCallBack.Item1 AndAlso linha("TEMPO_PARABENS") < QuartisCallBack.Item2 Then
somaH += 1
ElseIf linha("TEMPO_CALLBACK") >= QuartisCallBack.Item2 AndAlso linha("TEMPO_PARABENS") < QuartisCallBack.Item3 Then
somaC += 1
ElseIf linha("TEMPO_CALLBACK") >= QuartisCallBack.Item3 Then
somaD += 1
End If
Next
Dim somaFinalCallBackS As Integer = If(somaS < 0, 0, somaS)
Dim somaFinalCallBackH As Integer = If(somaH < 0, 0, somaH)
Dim somaFinalCallBackC As Integer = If(somaC < 0, 0, somaC)
Dim somaFinalCallBackD As Integer = If(somaD < 0, 0, somaD)
tabelafinal.Rows.Add(somaFinalCallBackS, "TEMPO_CALLBACK", "S")
tabelafinal.Rows.Add(somaFinalCallBackH, "TEMPO_CALLBACK", "H")
tabelafinal.Rows.Add(somaFinalCallBackC, "TEMPO_CALLBACK", "C")
tabelafinal.Rows.Add(somaFinalCallBackD, "TEMPO_CALLBACK", "D")
Dim dv As DataView = New DataView(tabelafinal)
Chart1.AlignDataPointsByAxisLabel()
Chart1.DataBindCrossTable(dv, "COR", "COLUNA", "VALORES", "")
For Each cs As Series In Chart1.Series
cs.ChartType = SeriesChartType.StackedColumn100
cs.ToolTip = "Pessoas = #VALY"
Next
End Sub
Friend Function Quartiles(ByVal afVal As Double()) As Tuple(Of Double, Double, Double)
Dim iSize As Integer = afVal.Length
System.Array.Sort(afVal)
Dim iMid As Integer = iSize / 2
Dim fQ1 As Double = 0
Dim fQ2 As Double = 0
Dim fQ3 As Double = 0
If iSize Mod 2 = 0 Then
fQ2 = (afVal(iMid - 1) + afVal(iMid)) / 2
Dim iMidMid As Integer = iMid / 2
If iMid Mod 2 = 0 Then
fQ1 = (afVal(iMidMid - 1) + afVal(iMidMid)) / 2
fQ3 = (afVal(iMid + iMidMid - 1) + afVal(iMid + iMidMid)) / 2
Else
fQ1 = afVal(iMidMid)
fQ3 = afVal(iMidMid + iMid)
End If
ElseIf iSize = 1 Then
fQ1 = afVal(0)
fQ2 = afVal(0)
fQ3 = afVal(0)
Else
fQ2 = afVal(iMid)
If (iSize - 1) Mod 4 = 0 Then
Dim n As Integer = (iSize - 1) / 4
fQ1 = (afVal(n - 1) * 0.25) + (afVal(n) * 0.75)
fQ3 = (afVal(3 * n) * 0.75) + (afVal(3 * n + 1) * 0.25)
ElseIf (iSize - 3) Mod 4 = 0 Then
Dim n As Integer = (iSize - 3) / 4
fQ1 = (afVal(n) * 0.75) + (afVal(n + 1) * 0.25)
fQ3 = (afVal(3 * n + 1) * 0.25) + (afVal(3 * n + 2) * 0.75)
End If
End If
Return New Tuple(Of Double, Double, Double)(fQ1, fQ2, fQ3)
End Function
End Class
If I understand correctly, you are trying to show a tooltip (when hovering the cursor over one colored 'block' in the chart) that shows information about the data that makes up the point.
The problem is that each 'block' is only a single X and Y value. For example: The DataPoint behind the tooltip that shows 'Pessoas = 392' is actually just a simple DataPoint (Series-S X=5 Y=392) with no additional information.
To show a tooltip the way you want each one will have to be pre-set, like this:
point.ToolTip = "User1 in the series\nUser2 in the series\n..."

vb Image grid detection

Im looking for a way to detect the center of grid squares when VB.net is feed an image
I want to start with an image of a grid with blue squares like this:
Grid
and i want the program to make an array of points in the center of each square like this (points aren't centered in picture)
Grid with Red points
i dont want to modify the image, i just want to get the points. I've tried getpixel for x and y but that just returns the same point
Dim search_color As Color = Color.FromArgb(255, 64, 128, 192)
Dim background_color As Color = Color.FromArgb(255, 240, 240, 240)
Dim grid_color As Color = Color.FromArgb(255, 144, 144, 144)
Dim pix As Color
Dim liney = 0, linex = 0
Dim loc, sloc, gloc As Point
For ch As Integer = 1 To 64
For y As Integer = liney To Bmp.Height - 1
For x As Integer = linex To Bmp.Width - 1
If Bmp.GetPixel(x, y) = search_color Then
sloc = New Point(x, y)
linex = x
liney = y
x = Bmp.Width - 1
y = Bmp.Height - 1
End If
Next
Next
Dim xloc = 0
For x As Integer = sloc.X To Bmp.Width - 1
If Bmp.GetPixel(x, sloc.Y) = grid_color Then
xloc = x - 1
End If
If Bmp.GetPixel(x, sloc.Y) = background_color Then
xloc = x - 1
End If
Next
For y As Integer = sloc.Y To Bmp.Height - 1
If Bmp.GetPixel(xloc, y) = grid_color Or Bmp.GetPixel(xloc, y) = background_color Then
gloc = New Point(xloc, y - 1)
End If
Next
loc = New Point((gloc.X + sloc.X) / 2, (gloc.Y + sloc.Y) / 2)
liney = gloc.Y
linex = gloc.X + 20
ListBox1.Items.Add(loc.ToString)
Next
Try this:
I added the following controls to a form to test the code:
pbImageToScan (PictureBox) - btnAnalyzeIMG (Button) - lbResult (ListBox)
Public Class Form1
Dim arrCenters() As Point
Dim bmpToAnalyze As Bitmap
Dim search_color As Color = Color.FromArgb(255, 64, 128, 192)
Dim background_color As Color = Color.FromArgb(255, 240, 240, 240)
Dim grid_color As Color = Color.FromArgb(255, 144, 144, 144)
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
bmpToAnalyze = New Bitmap(Application.StartupPath & "\Image.bmp")
pbImageToScan.Image = Image.FromFile(Application.StartupPath & "\Image.bmp")
End Sub
Private Sub btnAnalyzeIMG_Click(sender As Object, e As EventArgs) Handles btnAnalyzeIMG.Click
FindCenters()
End Sub
Private Sub FindCenters()
bmpToAnalyze = New Bitmap(Application.StartupPath & "\Image.bmp")
pbImageToScan.Image = Image.FromFile(Application.StartupPath & "\Image.bmp")
'arrCenters is the array who will contains all centers data
ReDim arrCenters(0)
'arrCenters already starts with an element; this boolean is used to handle the first point insertion
Dim bFirstElementAddedToArray As Boolean
lbResult.Items.Clear()
Dim iIMGWidth As Integer = bmpToAnalyze.Width
Dim iIMGHeight As Integer = bmpToAnalyze.Height
'X, Y coordinates used for iterations
Dim iX As Integer = 0
Dim iY As Integer = 0
'Bitmap limits reached
Dim bExit As Boolean
'Used to skip a great part of Ys, if a match has been found along the current examinated line
Dim iDeltaYMax As Integer = 0
'Main cycle
Do While Not bExit
Dim colCurrentColor As Color = bmpToAnalyze.GetPixel(iX, iY)
If colCurrentColor = search_color Then
Dim iXStart As Integer = iX
Dim iYStart As Integer = iY
Dim iXEnd As Integer
Dim iYEnd As Integer
'Width of the Blue square
For iXEnd = iX + 1 To iIMGWidth - 1
Dim colColorSearchX As Color = bmpToAnalyze.GetPixel(iXEnd, iY)
If (colColorSearchX = background_color) Or (colColorSearchX = grid_color) Then
iXEnd -= 1
Exit For
End If
Next
'Height of the Blue square
For iYEnd = iY + 1 To iIMGHeight - 1
Dim colColorSearchY As Color = bmpToAnalyze.GetPixel(iXEnd, iYEnd)
If (colColorSearchY = background_color) Or (colColorSearchY = grid_color) Then
iYEnd -= 1
Exit For
End If
Next
iDeltaYMax = iYEnd - iYStart
'Blue square center coordinates
Dim pCenter As New Point((iXStart + iXEnd) / 2, (iYStart + iYEnd) / 2)
Dim iArrLenght As Integer = 0
If Not bFirstElementAddedToArray Then
bFirstElementAddedToArray = True
Else
iArrLenght = arrCenters.GetLength(0)
ReDim Preserve arrCenters(iArrLenght)
End If
arrCenters(iArrLenght) = pCenter
lbResult.Items.Add(pCenter.ToString)
iX = iXEnd
'Checks if the Width limit of the bitmap has been reached
If iX = (iIMGWidth - 1) Then
iX = 0
iY += iDeltaYMax + 1
iDeltaYMax = 0
Else
iX += 1
End If
Else
'Checks if the Width limit of the bitmap has been reached
If iX = (iIMGWidth - 1) Then
iX = 0
iY += iDeltaYMax + 1
iDeltaYMax = 0
Else
iX += 1
End If
End If
'Width and Height limit of the bitmap have been reached
If (iX = iIMGWidth - 1) And (iY = iIMGHeight - 1) Then
bExit = True
End If
Loop
'Draws a Red point on every center found
For Each P As Point In arrCenters
bmpToAnalyze.SetPixel(P.X, P.Y, Color.Red)
Next
pbImageToScan.Image = bmpToAnalyze
End Sub
End Class

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.

How to make a "key generator" knowing the formula

I have the formula to check 9 integers,
First digit(d1) must be: 1, 2, 5, 6, 8 or 9
Last digit(d9) must be: 0 or 9
9xd1+8xd2+7xd3+6xd4+5xd5+4xd6+3xd7+2xd8+d9 mod 11 = 0
I can "validate" the key, but how can I generate more of this, knowing the conditions for it to be right?
How can I generate 9 different integers from 0 to 9 and check them under this formula?
Thanks for helping!
Generate the first 7 digits randomly, calculating the formula for those digits.
Set the 9th digit's value to 9, and add it to the formula.
Calculate a value for the 8th digit based on the mod of the result of the formula that causes the result of the formula to be mod 11 = 0.
For the exception case where attempting to do this causes mod 11 = 9, set the 9th digit to 0.
Implementation:
Private randGen As New Random()
Function GenNum() As Integer
Dim digits(0 To 8) As Integer
GenNum = 0
Dim checkSum As Integer
digits(0) = randGen.Next(6) + 1
If digits(0) >= 3 Then digits(0) += 2
If digits(0) >= 7 Then digits(0) += 1
checkSum += digits(0) * 9
For d As Integer = 1 To 6
digits(d) = randGen.Next(10)
checkSum += digits(d) * (9 - d)
Next
digits(8) = 9
checkSum += digits(8)
If (checkSum Mod 11) Mod 2 = 1 Then
digits(7) = (11 - (checkSum Mod 11)) \ 2
Else
digits(7) = ((12 - (checkSum Mod 11)) \ 2 + 4) Mod 10
End If
checkSum += digits(7) * 2
If checkSum Mod 11 = 9 Then digits(8) = 0
Dim pow10 As Integer = 1
For d As Integer = 8 To 0 Step -1
GenNum += pow10 * digits(d)
pow10 *= 10
Next
End Function
I can help you to generate integers from 0 to 9.
here is how your form should look like:
and here is the code:
Public Class Form1
Dim NumRandom As Random = New Random
Dim X, Y, Z As Integer
Private Sub GenerateBUT_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles GenerateBUT.Click
Dim a(9), i, j, RN As Integer
Dim flag As Boolean
flag = False
i = 1
a(j) = 1
Do While i <= 9
Randomize()
RN = CInt(Int(9 * Rnd()) + 1)
For j = 1 To i
If (a(j)) = RN Then
flag = True
Exit For
End If
Next
If flag = True Then
flag = False
Else
a(i) = RN
i = i + 1S
End If
Loop
Label1.Text = a(1)
Label2.Text = a(2)
Label3.Text = a(3)
Label4.Text = a(4)
Label5.Text = a(5)
Label6.Text = a(6)
Label7.Text = a(7)
Label8.Text = a(8)
Label9.Text = a(9)
Z = Label4.Text
Y = Label5.Text
X = Z + Y
X = X - Label3.Text
If X > 1 And X < 10 Then
X = NumRandom.Next(1, 7)
If X = 1 Then
Label1.Text = "0"
ElseIf X = 2 Then
Label2.Text = "0"
ElseIf X = 3 Then
Label3.Text = "0"
ElseIf X = 4 Then
Label4.Text = "0"
ElseIf X = 5 Then
Label5.Text = "0"
ElseIf X = 6 Then
Label6.Text = "0"
ElseIf X = 7 Then
Label7.Text = "0"
End If
End If
End Sub
End Class