I am working on a program and one feature is to show a graph of accrued points by game. I have successfully created the graph but cannot work out how to get rid of the big gaps at either side. I have tried reducing padding and margins to 0 but to no avail. Any help would be greatly appreciated. :)
Image of graph:
Chart1.Series.Clear()
Chart1.Titles.Clear()
Chart1.ChartAreas.Clear()
Chart1.Show()
Chart1.AlignDataPointsByAxisLabel()
Chart1.Titles.Add(names(search))
Chart1.ChartAreas.Add("Default")
With Chart1.ChartAreas("Default")
.AxisX.Interval() = 5
.AxisY.Interval() = 1
.AxisY.Title = "Number of Wins"
.AxisX.Title = "Game"
.AxisX.CustomLabels.Add(0, 60, "low")
End With
Chart1.SetBounds(270, 200, 510, 250)
Dim ref As Integer = 0
For Each item As DictionaryEntry In gamespoints
If item.Value > 0 Then
ref = ref + 1
Chart1.Series.Add(item.Key)
If item.Value = max And ref Mod 2 = 0 Then
Chart1.Series(item.Key).Color = Color.Green
ElseIf item.Value = max Then
Chart1.Series(item.Key).Color = Color.LimeGreen
ElseIf ref Mod 2 = 0 Then
Chart1.Series(item.Key).Color = Color.Black
Else
Chart1.Series(item.Key).Color = Color.DarkGray
End If
Chart1.Series(item.Key).Points.AddXY(0, item.Value)
End If
Next
the code to generate no. of arrays from one is working..I'm try to make some change to it like below
Function myarray(ByVal arra1() As Integer, ByVal arran() As Integer, ByVal arrNumber As Integer) As Integer()
arran = arra1.Clone()
For i As Integer = 0 To arra1.Length - 1
If i = (arrNumber - 1) Then ' IF arrNumber is 1 then +1 to index 0, If it is 2 then +1 to index 1
arran(i) = arra1(i) + 1
'If there are two duplicate value make on of them zero at a time
For k = 0 To arran.Length - 1
For j = k + 1 To arran.Length - 1
If arran(k) = arran(j) Then
arran(k) = 0
End If
'make any value great than 11 zero
If arran(i) > 11 Then
arran(i) = 0
End If
Next
Next
Else
arran(i) = arra1(i)
End If
Next
'Print the array
For i = 0 To arran.Length - 1
Console.Write(arran(i) & " ")
Next
Console.WriteLine()
Return arran
End Function
what I really need is to decompose for example {1,4,5,5} to be {1,4,0,5} and then {1,4,5,0} the above code generate only {1,4,0,5}
I haven't tested this, but I believe the following code will do what you want. Based on your comments, I've changed the function to return all resulting arrays as an array of arrays, rather than requiring the index to change as an input and returning one array. I also ignored matches of 0, as the conditions you describe don't seem designed to handle them. Because of it's recursion, I think this approach will successfully handle input such as {3, 3, 3, 3}.
Public Function jaggedArray(ByVal inputArray() As Integer) As Integer()()
If inputArray Is Nothing Then
Return Nothing
Else
Dim resultArrays()(), i, j As Integer
Dim arrayMax As Integer = inputArray.GetUpperBound(0)
If arrayMax = 0 Then 'prevents errors later if only one number passed
ReDim resultArrays(0)
If inputArray(0) > 11 Then
resultArrays(0) = {1}
ElseIf inputArray(0) = 11 Then
resultArrays(0) = {0}
Else
resultArrays(0) = {inputArray(0) + 1}
End If
Return resultArrays
End If
For i = 0 To arrayMax
Dim tempArray() As Integer = inputArray.Clone
For j = 0 To arrayMax
If tempArray(j) > 11 Then
tempArray(j) = 0
End If
Next
If tempArray(i) = 11 Then
tempArray(i) = 0
Else
tempArray(i) += 1
End If
splitArray(resultArrays, tempArray)
Next
Return resultArrays
End If
End Function
Private Sub splitArray(ByRef arrayList()() As Integer, ByVal sourceArray() As Integer)
Dim x, y As Integer 'positions of matching numbers
If isValid(sourceArray, x, y) Then
If arrayList Is Nothing Then
ReDim arrayList(0)
Else
ReDim Preserve arrayList(arrayList.Length)
End If
arrayList(arrayList.GetUpperBound(0)) = sourceArray
Else
Dim xArray(), yArray() As Integer
xArray = sourceArray.Clone
xArray(x) = 0
splitArray(arrayList, xArray)
yArray = sourceArray.Clone
yArray(y) = 0
splitArray(arrayList, yArray)
End If
End Sub
Private Function isValid(ByRef testArray() As Integer, ByRef match1 As Integer, ByRef match2 As Integer) As Boolean
For i As Integer = 0 To testArray.GetUpperBound(0) - 1
If testArray(i) > 11 Then
testArray(i) = 0
End If
For j As Integer = i + 1 To testArray.GetUpperBound(0)
If testArray(j) > 11 Then
testArray(j) = 0
End If
If testArray(i) = testArray(j) AndAlso testArray(i) > 0 Then 'added second test to prevent infinite recursion
match1 = i
match2 = j
Return False
End If
Next
Next
match1 = -1
match2 = -1
Return True
End Function
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
In Shadowrun 5e there is a rule concerning explosives in confined spaces called the 'Chunky Salsa Effect'. I am trying to create a program that simulates the 'Chunky Salsa Effect'. I have most of the program working, however, as the size of the space [meters] increases, the number of blast reflections [bounces] increases. It should be the inverse, the blast falloff [minusMeters] should decrease the [bounces]. [walls] determines the number of surfaces the blast reflects off of. [damageDice] is equal to the base damage of the explosive [baseDamageDice] + (([damageDice]/2) per reflection). For some reason [damageDice] and [bounces] do not decrease when [meters] is increased.
Private Sub btnCalculate_Click(sender As Object, e As EventArgs) Handles btnCalculate.Click
Dim meters As Integer = 0
Dim dice As Integer = 0
Dim damageDice As Integer = 0
Dim baseDamageDice As Integer = 0
Dim bounces As Integer = 0
Dim hits As Integer = 0
Dim walls As Integer = 0
Dim minusMeters As Integer = 0
Dim explosiveType As Integer = 0
Dim ap As String = "-"
Dim diceRoll As Integer = 0
Randomize()
walls = CInt(txtWalls.Text)
explosiveType = cbExplosiveType.SelectedIndex
If explosiveType < 0 Then
explosiveType = 0
cbExplosiveType.SelectedIndex = 0
End If
Select Case explosiveType
Case 0
minusMeters = 1
baseDamageDice = 18
ap = "+5"
Case 1
minusMeters = 2
baseDamageDice = 16
ap = "-2"
Case 2
minusMeters = 4
baseDamageDice = 24
ap = "-4"
Case 3
minusMeters = 4
baseDamageDice = 24
ap = "-10"
Case 4
minusMeters = 1
baseDamageDice = 23
ap = "+5"
Case 5
minusMeters = 2
baseDamageDice = 21
ap = "-2"
End Select
diceRoll = CInt(Math.Floor((6 - 1 + 1) * Rnd())) + 1
If diceRoll >= 5 Then
hits = hits + 1
End If
dice = baseDamageDice
For x = 1 To walls
meters = CInt(txtMeters.Text)
damageDice = baseDamageDice
Do
damageDice = Math.Round(damageDice / 2)
dice = dice + damageDice
meters = meters - minusMeters
bounces = bounces + 1
Loop While meters >= 0
Next
For i As Integer = 1 To dice
diceRoll = CInt(Math.Floor((6 - 1 + 1) * Rnd())) + 1
If diceRoll >= 5 Then
hits = hits + 1
End If
Next
lblHitsPerBounce.Text = Math.Round(hits / bounces)
lblTimes.Text = bounces
lblResult.Text = dice
lblNumHits.Text = hits
lblAPOutput.Text = ap
End Sub
Here's basically what I have:
Public checkprogresstime_p1 As String = ""
Public checkprogresstime_p2 As String = ""
'P1 Progress bar updater
checkprogresstime_p1 = (time_total.Text - time_p1_hour.Value)
If checkprogresstime_p1 >= 60 Then
checkprogresstime_p1 = 60
time_p1_progress.ForeColor = Color.LimeGreen
ElseIf checkprogresstime_p1 <= 0 Then
checkprogresstime_p1 = 1
End If
If time_p1_progress.Value < 60 Then
time_p1_progress.ForeColor = Color.Red
End If
time_p1_progress.Value = checkprogresstime_p1
Here's basically what I need:
Dim cnt As Integer = 1
Do
'P1 Progress bar updater
checkprogresstime_p(cnt) = (time_total.Text - time_p(cnt)_hour.Value)
If checkprogresstime_p(cnt) >= 60 Then
checkprogresstime_p(cnt) = 60
time_p(cnt)_progress.ForeColor = Color.LimeGreen
ElseIf checkprogresstime_p(cnt) <= 0 Then
checkprogresstime_p(cnt) = 1
End If
If time_p(cnt)_progress.Value < 60 Then
time_p(cnt)_progress.ForeColor = Color.Red
End If
time_p(cnt)_progress.Value = checkprogresstime_p(cnt)
Loop While cnt <= 25
I have no idea how to do it... I need it to loop and add +1, 25 times. I basically have it written out 25 times at the moment...
This is the For/Loop with your current request. The cnt variable will increment itself in this type of Loop.
For cnt As Integer = 1 To 25
'P1 Progress bar updater
checkprogresstime_p(cnt) = (time_total.Text - time_p(cnt)_hour.Value)
If checkprogresstime_p(cnt) >= 60 Then
checkprogresstime_p(cnt) = 60
time_p(cnt)_progress.ForeColor = Color.LimeGreen
ElseIf checkprogresstime_p(cnt) <= 0 Then
checkprogresstime_p(cnt) = 1
End If
If time_p(cnt)_progress.Value < 60 Then
time_p(cnt)_progress.ForeColor = Color.Red
End If
time_p(cnt)_progress.Value = checkprogresstime_p(cnt)
Next
I believe what you're wanting to do has more to do with having 25 progress bars on your form where each one is named time_p#_progress where # is the number of the progress bar. That being said, there are two ways to acheive updating your progress bars without having to copy and paste your code 25 times...
1. Use Me.Controls to get a reference to the progress bar
For j = 1 To 25
Dim pbar As ProgressBar = Me.Controls("time_p" & j & "_progress")
Dim ph As NumericUpDown = Me.Controls("time_p" & j & "_hour")
Dim checkprogresstime As Long = (time_total.Text - ph.Value)
If checkprogresstime >= 60 Then
checkprogresstime = 60
pbar.ForeColor = Color.LimeGreen
ElseIf checkprogresstime <= 0 Then
checkprogresstime = 1
End If
If time_p1_progress.Value < 60 Then
pbar.Value = checkprogresstime
End If
pbar.Value = checkprogresstime
Application.DoEvents()
Next
Note: You didn't tell us what type of control time_p1_hour was. I assumed it was a NumericUpDown down control. So, if it's not, you need to replace it the type of control that time_p1_hour is.
2. Dynamically create your controls as a control array
Initizliaze your progress bars in the Form1_Load method (MyBase.Load)
Private pbars(24) As ProgressBar
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
For i = LBound(pbars) To UBound(pbars)
pbars(i) = New ProgressBar()
pbars(i).Parent = Me
pbars(i).Top = i * pbars(i).Height
pbars(i).Left = 0
pbars(i).Visible = True
Next
End Sub
Put your code inside of a loop like so
For cnt = 0 To 24
checkprogresstime_p(cnt) = (time_total.Text - time_hour(cnt).Value)
If checkprogresstime_p(cnt) >= 60 Then
checkprogresstime_p(cnt) = 60
time_p_progress(cnt).ForeColor = Color.LimeGreen
ElseIf checkprogresstime_p(cnt) <= 0 Then
checkprogresstime_p(cnt) = 1
End If
If time_p_progress(cnt).Value < 60 Then
time_p_progress(cnt).ForeColor = Color.Red
End If
time_p_progress(cnt).Value = checkprogresstime_p(cnt)
Next