In my simulation, the planet's colour is randomly chosen when it is created. The trail left behind is supposed to be the same colour as its planet. This works fine if there is just one planet, but when a new planet is added the trail for every planet is the same colour as that of the new planet. Here are some screenshots to demonstrate what I mean:https://imgur.com/a/EVh5o
I each planet to have a trail the same colour as itself, if that makes sense. Here are the relevant parts of my code:
Public Sub Form1_Paint(sender As Object, e As PaintEventArgs) Handles picSpace.Paint
For Each sun In sunsList
e.Graphics.FillEllipse(Brushes.Yellow, CInt(sun.positionX - 10), CInt(sun.positionY - 30), 20, 20)
Next
For Each planet In planetsList
Dim planetFill As Brush = New SolidBrush(planet.colour)
Dim trailColour As Pen = New Pen(planet.colour)
e.Graphics.FillEllipse(planetFill, planet.displayX - 5, planet.displayY - 5, 10, 10)
For count As Integer = 0 To counter
e.Graphics.DrawEllipse(trailColour, trail(0, count), trail(1, count), 1, 1)
Next
Next
End Sub
Sub Position()
planet.displayX = Math.Round(planet.positionX)
planet.displayY = Math.Round(planet.positionY)
trail(0, counter) = planet.displayX
trail(1, counter) = planet.displayY
counter += 1
ReDim Preserve trail(1, counter)
End Sub
Private Sub space_Click(sender As Object, e As EventArgs) Handles picSpace.Click
If hsbSimulationSpeed.Value > 0 Then
Timer1.Enabled = True
End If
If chkAddPlanets.Checked = True Then
planet = New Body
numberOfPlanets += 1
planet.colour = GetRandomColour()
planet.positionX = MousePosition.X
planet.positionY = MousePosition.Y - 25
planet.velocityX = txtVelocityX.Text * 1000
planet.velocityY = txtVelocityY.Text * 1000
planetsList.Add(planet)
ElseIf chkAddSuns.Checked = True Then
sun = New Body
numberOfSuns += 1
sun.positionX = MousePosition.X
sun.positionY = MousePosition.Y
sun.mass = hsbSunMass.Value * 5 * (10 ^ 29)
sunsList.Add(sun)
End If
End Sub
Function GetRandomColour() As Color
Dim rand As New Random
Return Color.FromArgb(rand.Next(0, 256), rand.Next(0, 256), rand.Next(0,
256))
End Function
Is there an easy way to fix this, or will I need to completely change the way trails are generated?
The problem is that you only have 1 trail() list, which is used for all planets. So in your painting loop, although the planet loop selects a different pen for each planet, they are all drawing in the same coordinates. The last planet will overwrite the first ones. Presumably trail() contains the coordinates from all planets - ie all trails listed together.
You need to have one trail list per planet, as part of the planet object to make it work.
Related
I am trying to add multiple labels to a userform at runtime
It's for the player names of a board game; and until the game starts the number of players are not known. I have managed to figure out for myself how to use the dynamic array function to create the list of players. I used a For.....Next loop to add the player names. I thought I could do that to add the labels to the form, but it only adds one. Depending on where the new control type is declared, it either adds the first player only, or the last player
This code produces one label only within the groupbox, the last player
Public Class Form1
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim Players_Num As Integer = InputBox("Enter the number of players")
Dim Players(Players_Num) As String
Dim newText As New Label
For i = 0 To Players_Num - 1
Players(i) = InputBox("Enter player name")
Next
'This piece of code was jsut for me to test that I was successfully using a For...Loop
'to add the players names, and will be deleted later on
For x = 0 To Players_Num - 1
MessageBox.Show(Players(x))
Next
For z = 0 To Players_Num - 1
newText.Name = "txt" & Players(z)
newText.Text = Players(z)
newText.Size = New Size(170, 20)
newText.Location = New Point(12 + 5, 12 + 5)
GroupBox1.Controls.Add(newText)
Next
End Sub
End Class
This one places only the first player
Public Class Form1
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim Players_Num As Integer = InputBox("Enter the number of players")
Dim Players(Players_Num) As String
For i = 0 To Players_Num - 1
Players(i) = InputBox("Enter player name")
Next
'This piece of code was jsut for me to test that I was successfully using a For...Loop
'to add the players names, and will be deleted later on
For x = 0 To Players_Num - 1
MessageBox.Show(Players(x))
Next
For z = 0 To Players_Num - 1
Dim newText As New Label
newText.Name = "txt" & Players(z)
newText.Text = Players(z)
newText.Size = New Size(170, 20)
newText.Location = New Point(12 + 5, 12 + 5)
GroupBox1.Controls.Add(newText)
Next
End Sub
End Class
I've tried this in vs 2015 and 2019 Community
Where is it going wrong?
From the looks of the code, you are correctly creating the controls but their location is the same for all of them, essentially, they are being place one of top of the other, the first is hidden with the second, which is hidden with the third.
The line
newText.Location = New Point(12 + 5, 12 + 5)
needs to be modified to place the labels at different locations.
Perhaps, something like:
newText.Location = New Point(12 + 5, 12 + (z * 25))
This will vertically align the labels with a gap of 25 between them
You are placing them all in the same location
newText.Location = New Point(12 + 5, 12 + 5)
Use your 'z' index to place them at different locations in order to be able to see them
For me it is easier to contain controls in a TableLayoutPanel then add the TLP to what ever control collection, such as a GroupBox This way you can couple a Label with TextBox, for example. Here's an example how you can create controls from a DataTable. In your case you would only need 1 ColumnStyle for labels, I just thought I would show you a good practice for future shortcuts. (I rarely use the designer to place controls)
'Start test data
Dim DtTable As New DataTable
With DtTable
Dim NewDtRow As DataRow = .NewRow
For i As Integer = 0 To 25
Dim DtCol As New DataColumn With {.ColumnName = "Col" & i, .DataType = GetType(String)}
.Columns.Add(DtCol)
NewDtRow(DtCol.ColumnName) = "Test" & i
Next
.Rows.Add(NewDtRow)
End With
'End test data
Dim TLP1 As New TableLayoutPanel With {.Name = "TlpFields"}
With TLP1
.BorderStyle = BorderStyle.Fixed3D
.CellBorderStyle = TableLayoutPanelCellBorderStyle.Inset
.AutoScroll = True
.AutoSize = True
.RowStyles.Clear()
.ColumnStyles.Clear()
.Dock = DockStyle.Fill
.ColumnCount = 2
.ColumnStyles.Add(New ColumnStyle With {.SizeType = SizeType.AutoSize})
End With
For Each DtCol As DataColumn In DtTable.Columns
With TLP1
.RowCount += 1
.RowStyles.Add(New RowStyle With {.SizeType = SizeType.AutoSize})
'create labels
.Controls.Add(New Label With {
.Text = DtCol.ColumnName,
.Anchor = AnchorStyles.Right}, 0, .RowCount)
'create textboxs
Dim TxtBox As New TextBox With {
.Name = "TextBox" & DtCol.ColumnName,
.Size = New Size(170, 20),
.Anchor = AnchorStyles.Left}
'add binding
TxtBox.DataBindings.Add("Text", DtTable, DtCol.ColumnName)
.Controls.Add(TxtBox, 1, .RowCount)
End With
Next
Controls.Add(TLP1)
I cannot figure out how to move an image from one picturebox to another inside a grid of pictureboxes (all of the pictureboxes are created in an 2 dimensional array, for x and y ) with WASD/arrow keys. Is there a way I can assign each picturebox with co ordinates where I can manipulate it to change in the image in the pictureboxes to give the illusion of movement?
For example: program starts with picturebox (3,3) to have the player image set and a variable called "CurrentPicBox = picturebox(Xpos,Ypos)" ; User presses W/Up arrow; this makes the picturebox (that has the player image set) to clear the image and makes "CurrentPicBox = picturebox(Xpos, Ypos + 1). Which then makes the picturebox(3,4) have the image set.
Would this work or is this logic incorrect?
Your logic should work just fine! Although I think it would be easier to manage if you'd use (0, 0) as the top-left corner and (4, 4) as the bottom-right one.
Moving the player would then be:
Up: (Xpos, Ypos - 1)
Down: (Xpos, Ypos + 1)
Left: (Xpos - 1, Ypos)
Right: (Xpos + 1, Ypos)
Here's an example class for creating and using a game grid:
Public NotInheritable Class GameBoard
'The size of each picture box.
Public Shared ReadOnly GameTileSize As New Size(16, 16)
'The 2D array holding our grid.
Private Grid As PictureBox(,)
Private PosX As Integer = 0
Private PosY As Integer = 0
Public Sub MovePlayer(ByVal Direction As MovementDirection)
Select Case Direction
Case MovementDirection.Left
If PosX - 1 < 0 Then Return 'Error checking. Cannot move outside grid.
Grid(PosX - 1, PosY).Image = Grid(PosX, PosY).Image 'Move image to the left.
Grid(PosX, PosY).Image = Nothing 'Clear the current picture box.
PosX -= 1
Case MovementDirection.Right
If PosX + 1 >= Grid.GetLength(0) Then Return
Grid(PosX + 1, PosY).Image = Grid(PosX, PosY).Image
Grid(PosX, PosY).Image = Nothing
PosX += 1
Case MovementDirection.Up
If PosY - 1 < 0 Then Return
Grid(PosX, PosY - 1).Image = Grid(PosX, PosY).Image
Grid(PosX, PosY).Image = Nothing
PosY -= 1
Case MovementDirection.Down
If PosY + 1 >= Grid.GetLength(1) Then Return
Grid(PosX, PosY + 1).Image = Grid(PosX, PosY).Image
Grid(PosX, PosY).Image = Nothing
PosY += 1
End Select
End Sub
Public Sub New(ByVal Container As Container, ByVal PlayerSprite As Image, ByVal TilesX As Integer, ByVal TilesY As Integer) As PictureBox(,)
'Initialize our array.
Grid = New PictureBox(TilesX - 1, TilesY - 1) {}
'Iterate every "coordinate" and add a game tile to it.
For x = 0 To TilesX - 1
For y = 0 To TilesY - 1
'Create a tile of the appropriate size and place it at a location that is a multiple of its size.
Dim Tile As New PictureBox() With {
.Size = GameBoard.GameTileSize,
.Location = New Point(x * GameBoard.GameTileSize.X, y * GameBoard.GameTileSize.Y),
.BorderStyle = BorderStyle.FixedSingle 'Add a border to the tile.
}
'Add the tile to our array.
Grid(x, y) = Tile
'Add the tile to the specified container.
Container.Controls.Add(Tile)
Next
Next
'Place the player at the initial coordinates.
Grid(PosX, PosY).Image = PlayerSprite
End Sub
Public Enum MovementDirection As Integer
Left = 0
Right
Up
Down
End Enum
End Class
Then you can use it like so:
'The variable holding our game board.
Dim Board As GameBoard
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'Create the grid inside the form (Me), 4 tiles tall and wide.
Board = New GameBoard(Me, My.Resources.Player, 4, 4)
End Sub
Private Sub Form1_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
'Handle movement.
Select Case e.KeyCode
Case Keys.Left, Keys.A : Board.MovePlayer(MovementDirection.Left)
Case Keys.Right, Keys.D : Board.MovePlayer(MovementDirection.Right)
Case Keys.Up, Keys.W : Board.MovePlayer(MovementDirection.Up)
Case Keys.Down, Keys.S : Board.MovePlayer(MovementDirection.Down)
End Select
End Sub
Replace My.Resources.Player with your actual player sprite.
I am writing a snake game in visual studio in visual basic.
The playing field is a 2D Array of PictureBoxes. My Snake is a 1D array as type Point. The snake array is called 'Snake'.
When the form loads, Snake(0) is set as New Point(1, 1). I have created a sub routine that moves the snake depending on the arrow key the user presses. This is under a timer. Snake(0) (The snake head) is set to equal Snake(0) + direction (direction is a variable altered by the arrow key that the user presses, eg. when up is pressed direction is set to x: 0 and y: -1)
When snake(0) hits a piece of food, the amount of elements in the snake array is set to the length of the array. EG(If snake(0) = foodPosition Then ReDim Preserve snake(snake.Length) End If)
I have created a loop, also under the timer, to make the body of the snake follow the head (eg. snake(2) = snake(1) and snake(1) = snake(0) but can't get it to work)
Code:
Public Class frmPlayfield
'Food Creating and Grow Snake Variables
Dim randF As New Random
Dim foodPointX As Integer = randF.Next(0, 32)
Dim foodPointY As Integer = randF.Next(0, 32)
'Play Field Variables
Dim playMaxWidth As Integer = 32
Dim playMaxHeight As Integer = 32
Dim boxSize As Integer = 16 'Size of PictureBox
Dim boxArray(,) As PictureBox 'PictureBox Array
'Snake Stuff Variable
Dim snake(1) As Point 'Snake array
Dim direction As New Point(1, 0) 'Direction for snake movement
Private Sub frmPlayfield_Load(sender As Object, e As EventArgs) Handles MyBase.Load
ReDim boxArray(playMaxWidth, playMaxHeight)
For x As Integer = 0 To playMaxWidth
For y As Integer = 0 To playMaxHeight
boxArray(x, y) = New PictureBox
boxArray(x, y).Width = boxSize
boxArray(x, y).Height = boxSize
boxArray(x, y).Top = y * boxSize
boxArray(x, y).Left = x * boxSize
boxArray(x, y).Visible = True
boxArray(x, y).BackColor = Color.White
boxArray(x, y).BorderStyle = BorderStyle.FixedSingle
Me.Controls.Add(boxArray(x, y))
Next
Next
Me.ClientSize = New Size((playMaxWidth + 1) * boxSize, (playMaxHeight + 1) * boxSize)
snake(0) = New Point(1, 1) 'Creates snake head
boxArray(foodPointX, foodPointY).BackColor = Color.Red
End Sub
Private Function createBox(x As Integer, y As Integer, bSize As Integer) As PictureBox
Dim tempBox As New PictureBox
tempBox.Width = bSize
tempBox.Height = bSize
tempBox.Top = y * bSize
tempBox.Left = x * bSize
tempBox.Visible = True
tempBox.BackColor = Color.White
tempBox.BorderStyle = BorderStyle.FixedSingle
Me.Controls.Add(tempBox)
Return tempBox
End Function
Private Sub Food()
If snake(0).X = foodPointX And snake(0).Y = foodPointY Then
ReDim Preserve snake(snake.Length) 'Increases the amount of elements in the snake array.
For j As Integer = 0 To 0
foodPointX = randF.Next(0, 32)
foodPointY = randF.Next(0, 32)
boxArray(foodPointX, foodPointY).BackColor = Color.Red
Next
End If
For h As Integer = snake.Length - 1 To snake.GetUpperBound(0)
snake(h) = snake(snake.Length - 2)
Next
End Sub
Private Sub CheckBoundsAndMovement()
For i As Integer = 0 To snake.GetUpperBound(0)
boxArray(snake(i).X, snake(i).Y).BackColor = Color.White 'Loop to change the whole snake black
Next
snake(1) = snake(0)
snake(0) = snake(0) + direction
If snake(0).X > playMaxWidth Then
snake(0).X -= (playMaxWidth + 1)
End If
If snake(0).X < 0 Then
snake(0).X += (playMaxWidth + 1)
End If 'Four If statements to check if the snake has gone outside the play area.
If snake(0).Y > playMaxWidth Then
snake(0).Y -= (playMaxWidth + 1)
End If
If snake(0).Y < 0 Then
snake(0).Y += (playMaxWidth + 1)
End If
For k As Integer = 0 To snake.GetUpperBound(0)
boxArray(snake(k).X, snake(k).Y).BackColor = Color.Black 'Loop to make the whole snake black
Next
End Sub
Private Sub timGameTick_Tick(sender As Object, e As EventArgs) Handles timGameTick.Tick
Food()
CheckBoundsAndMovement()
End Sub
Private Sub frmPlayfield_KeyDown(sender As Object, e As KeyEventArgs) Handles MyBase.KeyDown 'Subroutine for direction
Select Case (e.KeyCode)
Case Keys.Up
direction = New Point(0, -1)
Case Keys.Down
direction = New Point(0, 1)
Case Keys.Left
direction = New Point(-1, 0)
Case Keys.Right
direction = New Point(1, 0)
End Select
End Sub
End Class
This works fine after I eat the first piece of food. The snake of length 2 is increased to length 3. But when I eat another piece of food the end of the snake is left behind at the spot where the food was eaten.
Ok - It looks like I found the problems -
First off - you defined the snake array as Dim snake (1) As Point this created the array with two elements instead of 1
Next, in your Food sub, the loop to roll the pixels back along the snake should be done every time the snake moves, not just when food is eaten. So I moved it into the CheckBoundsAndMovement sub to replace line 4 of that sub which only copied the location of the head to the next point back rather than the whole snake. But of course trying to execute the loop when the length of the snake was only one pixel would result in an out of range exception on the array, so added an If statement to only execute the loop if the length of snake is more than 1.
Also the direction of the loop in your code was in increasing order. To do it properly it should be in decreasing order. This way, the loop overwrites the point representing the end of the tail with the next point forward and so on. Finally, the new location for the head is entered into snake(0)
So - here it is -
Public Class frmPlayfield
'Food Creating and Grow Snake Variables
Dim randF As New Random
Dim foodPointX As Integer = randF.Next(0, 32)
Dim foodPointY As Integer = randF.Next(0, 32)
'Play Field Variables
Dim playMaxWidth As Integer = 32
Dim playMaxHeight As Integer = 32
Dim boxSize As Integer = 16 'Size of PictureBox
Dim boxArray(,) As PictureBox 'PictureBox Array
'Snake Stuff Variable
Dim snake(0) As Point 'Snake array
Dim direction As New Point(1, 0) 'Direction for snake movement
Private Sub frmPlayfield_Load(sender As Object, e As EventArgs) Handles MyBase.Load
ReDim boxArray(playMaxWidth, playMaxHeight)
For x As Integer = 0 To playMaxWidth
For y As Integer = 0 To playMaxHeight
boxArray(x, y) = New PictureBox
boxArray(x, y).Width = boxSize
boxArray(x, y).Height = boxSize
boxArray(x, y).Top = y * boxSize
boxArray(x, y).Left = x * boxSize
boxArray(x, y).Visible = True
boxArray(x, y).BackColor = Color.White
boxArray(x, y).BorderStyle = BorderStyle.FixedSingle
Me.Controls.Add(boxArray(x, y))
Next
Next
Me.ClientSize = New Size((playMaxWidth + 1) * boxSize, (playMaxHeight + 1) * boxSize)
snake(0) = New Point(1, 1) 'Creates snake head
boxArray(foodPointX, foodPointY).BackColor = Color.Red
End Sub
Private Function createBox(x As Integer, y As Integer, bSize As Integer) As PictureBox
Dim tempBox As New PictureBox
tempBox.Width = bSize
tempBox.Height = bSize
tempBox.Top = y * bSize
tempBox.Left = x * bSize
tempBox.Visible = True
tempBox.BackColor = Color.White
tempBox.BorderStyle = BorderStyle.FixedSingle
Me.Controls.Add(tempBox)
Return tempBox
End Function
Private Sub Food()
If snake(0).X = foodPointX And snake(0).Y = foodPointY Then
ReDim Preserve snake(snake.Length)
foodPointX = randF.Next(0, 32)
foodPointY = randF.Next(0, 32)
boxArray(foodPointX, foodPointY).BackColor = Color.Red
End If
End Sub
Private Sub CheckBoundsAndMovement()
For i As Integer = 0 To snake.GetUpperBound(0)
boxArray(snake(i).X, snake(i).Y).BackColor = Color.White 'Loop to change the whole snake white
boxArray(snake(i).X, snake(i).Y).Update()
Next
If snake.Length > 1 Then
For i As Integer = snake.GetUpperBound(0) To 1 Step -1
snake(i) = snake(i - 1)
Next
End If
snake(0) = snake(0) + direction
If snake(0).X > playMaxWidth Then
snake(0).X -= (playMaxWidth + 1)
End If
If snake(0).X < 0 Then
snake(0).X += (playMaxWidth + 1)
End If 'Four If statements to check if the snake has gone outside the play area.
If snake(0).Y > playMaxWidth Then
snake(0).Y -= (playMaxWidth + 1)
End If
If snake(0).Y < 0 Then
snake(0).Y += (playMaxWidth + 1)
End If
For k As Integer = 0 To snake.GetUpperBound(0)
boxArray(snake(k).X, snake(k).Y).BackColor = Color.Black 'Loop to make the whole snake black
Next
End Sub
Private Sub timGameTick_Tick(sender As Object, e As EventArgs) Handles timGameTick.Tick
Food()
CheckBoundsAndMovement()
End Sub
Private Sub frmPlayfield_KeyDown(sender As Object, e As KeyEventArgs) Handles MyBase.KeyDown 'Subroutine for direction
Select Case (e.KeyCode)
Case Keys.Up
direction = New Point(0, -1)
Case Keys.Down
direction = New Point(0, 1)
Case Keys.Left
direction = New Point(-1, 0)
Case Keys.Right
direction = New Point(1, 0)
End Select
End Sub
End Class
The Problem: I'm programmatically generating labels but am having trouble referencing them in code because they don't exist at runtime.
The Context: For a game, I've generated a 10x10 grid of labels with the following:
Public lbl As Label()
Dim tilefont As New Font("Sans Serif", 8, FontStyle.Regular)
Private Sub Lucror_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim i As Integer = 0
Dim a As Integer = 0
Dim height As Integer
Dim width As Integer
height = 30
width = 30
ReDim lbl(99)
For i = 0 To 99
lbl(i) = New Label
lbl(i).Name = i
lbl(i).Size = New System.Drawing.Size(30, 30)
lbl(i).Location = New System.Drawing.Point((width), height)
lbl(i).Text = i
lbl(i).Font = tilefont
Me.Controls.Add(lbl(i))
width = width + 30
a = a + 1 'starting new line if required
If (a = 10) Then
height = height + 30
width = 30
a = 0
End If
Next
End Subenter code here
This worked fine but the labels function as tiles in the game and game tiles need to store 2-3 integers each as well as be able to be referenced through event handlers. I figured a possible way to store integers would be to generate 100 arrays, each named after a label and each holding the 2-3 integers, but that seems very redundant.
What I need:
On click and on hover event handlers for every label
An array (or dictionary?) to store 2-3 integers for every label
Labels have to reference each others names ie. do something to label with name (your name + 1).
The Question: Is there a simple way to achieve these three things with the current way I generate labels (and if so, how?) and if not, how else can I generate the 100 labels to make achieving these things possible?
Any help is much appreciated.
Your labels do exist at runtime, but not at compile time. Attaching events is a little different at runtime, you must use AddHandler.
Below is some sample code that should illustrate everything you're asking for. I've introduced inheritance as a way of saving data that is pertinent to each tile. The GameTile type behaves exactly as a label, and we've added some functionality for storing integers and naming the control.
Public Class Form1
Dim tilefont As New Font("Sans Serif", 8, FontStyle.Regular)
Public Property GameTiles As List(Of GameTile)
Private Sub Lucror_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim a As Integer = 0
Dim xPosition As Integer = 30
Dim yPosition As Integer = 30
GameTiles = New List(Of GameTile)
For i = 0 To 99
Dim gt As New GameTile(i.ToString)
gt.Size = New System.Drawing.Size(30, 30)
gt.Location = New System.Drawing.Point((yPosition), xPosition)
gt.Font = tilefont
gt.Integer1 = i + 1000
gt.Integer2 = i + 2000
gt.Integer3 = i + 3000
Me.Controls.Add(gt)
AddHandler gt.Click, AddressOf TileClickHandler
GameTiles.Add(gt)
yPosition = yPosition + 30
a = a + 1 'starting new line if required
If (a = 10) Then
xPosition = xPosition + 30
yPosition = 30
a = 0
End If
Next
End Sub
Private Sub TileClickHandler(sender As Object, e As EventArgs)
Dim gt = CType(sender, GameTile)
MsgBox("This tile was clicked: " & gt.Text &
Environment.NewLine & gt.Integer1 &
Environment.NewLine & gt.Integer2 &
Environment.NewLine & gt.Integer3)
End Sub
End Class
Public Class GameTile
Inherits Label
'this class should be in a separate file, but it's all together for the sake of clarity
Public Property Integer1 As Integer
Public Property Integer2 As Integer
Public Property Integer3 As Integer
Public Sub New(NameText As String)
MyBase.New()
Name = NameText
Text = NameText
End Sub
End Class
Public Sub Form1_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint
For Each planet In planetsList
Dim planetFill As Brush = New SolidBrush(planet.colour)
e.Graphics.FillEllipse(planetFill, planet.displayX - 5, planet.displayY - 5, 10, 10)
Dim trailcolour As Pen = New Pen(planet.colour)
For count As Integer = 0 To trailDots
e.Graphics.DrawEllipse(trailcolour, planet.trailX(count), planet.trailY(count), 1, 1)
Next
Next
End Sub
Public Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
If numberOfPlanets > 0 Or numberOfSuns > 0 Then
For Each planet In planetsList
For Each sun In sunsList
...
trailDots += 1
ReDim Preserve planet.trailX(trailDots)
ReDim Preserve planet.trailY(trailDots)
planet.trailX(trailDots) = planet.displayX
planet.trailY(trailDots) = planet.displayY
Next
Next
Me.Refresh()
End If
End Sub
The purpose of this part of the code is to draw a trail behind a planet while it moves (My project is a gravity physics simulation). This works fine for one planet, but once a second planet is added it throws an error at the DrawEllipse line, saying 'IndexOutOfRangeException was unhandled.'
I moved a few lines from the paint event to the timer tick event, so that it reads roughly like this:
trailDots += 1
ReDim Preserve planet.trailX(trailDots)
ReDim Preserve planet.trailY(trailDots)
planet.trailX(trailDots) = planet.displayX
planet.trailY(trailDots) = planet.displayY
Dim mygraphics As Graphics = Me.CreateGraphics
Dim trailColour As Pen = New Pen(planet.colour)
For count As Integer = 0 To trailDots
mygraphics.DrawEllipse(trailColour, planet.trailX(count), planet.trailY(count), 1, 1)
Next
This no longer gives an error message and the code works as expected aside from performance. Instead of drawing the trail as the planet moves, the trail is completely redrawn each time, from the starting location to the current location. So as time goes on the performance gets worse and worse, so each time the trail is drawn it takes longer than before. What can I do to fix this?
It was a quick fix. The problem was that the trailX array size was not matching the trailDots indexer I was using. Changing the loop to work off the actual array size fixed it:
For count As Integer = 0 To trailDots
e.Graphics.DrawEllipse(trailcolour, planet.trailX(count), planet.trailY(count), 1, 1)
Next