Drawing an array of PictureBoxes in vb.net - vb.net

I'm trying to draw an array of PictureBoxes, for testing I use the same picture for each picturebox.
But instead of showing the picture, it shows the color blue.
I would show you a picture, but I dont have 10 reputation..
Dim teren(120) As PictureBox
Dim x_locatie As Integer = 1, y_locatie As Integer = 0
For i = 0 To 10
x_locatie = 210
For j = 0 To 12
teren(i * j) = New PictureBox()
teren(i * j).Size = New Size(61, 61)
teren(i * j).Name = "x" + i.ToString + "y" + j.ToString
teren(i * j).Location = New Point(x_locatie, y_locatie)
Dim locatie As String = folder + "\harta\test.png"
teren(i * j).ImageLocation = locatie
teren(i * j).Show()
Next
y_locatie += 61
Next
I also tried another method , but same result.
Sub PictureBox1_Paint(sender1 As Object, er As PaintEventArgs)
If myImage IsNot Nothing Then
Dim r As New Rectangle(x, y, xlatime, ylungime)
er.Graphics.DrawImage(myImage, r)
End If
End Sub
Sub deseneaza(ByVal poza As String, ByRef x_perm As Integer, ByRef y_perm As Integer, ByRef lungime As Integer, ByRef latime As Integer)
myImage = Image.FromFile(poza)
x = x_perm
y = y_perm
xlatime = latime
ylungime = lungime
Refresh()
End Sub
'this part of code is in body of another function
Dim x_locatie As Integer = 1, y_locatie As Integer = 0
For i = 0 To 10
x_locatie = 210
For j = 0 To 12
Dim locatie As String = folder + "\harta\test.png"
deseneaza(locatie, x_locatie, y_locatie, 61, 61)
Next
y_locatie += 61
Next
I saw in other threads that their problem solution was something like that Dim teren() As PictureBox {teren1, teren2 , ... , teren n} But the problem in my case is that I need 120 PictureBoxes, and I think that it must be a way to do this without writing 120 pictureboxes.

Please try this...it will generate 16 picture box, size 20x20, in a row. I put it under "FormLoading" event.
Dim Shapes(16) As PictureBox
For i = 1 To 16
Shapes(i) = New PictureBox
With Shapes(i)
.BackColor = SystemColors.Control 'Color.Green
.BackgroundImage = New Bitmap(My.Resources.led_blk)
.BackgroundImageLayout = ImageLayout.Zoom
.Size = New Size(20, 20)
.Visible = True
.Location = New Point( 23 * i, 50)
End With
Me.Controls.Add(Shapes(i))
Next

I think GDI+ will be the way to go. I think you need a custom class that has a rectangle structure as a member with other properties that help you with further logic with the character intersecting with them. Paint should be done in the Paint event of the surface control you are using - PictureBox has the best rendering - IMO.
Public Class Tile
Public Property Bounds As New Rectangle
Public Property IsImpassable As Boolean
'others you think of
End Class

Dim iTop = 325
Dim pBox(48) As PictureBox
Dim pinColor = Color.SkyBlue
Dim leftStart = 50
For j = 0 To 3
For i = 0 To 11
pBox(i) = New PictureBox
'pBox(i).Image = Image.FromFile("\NoTest.bmp")
pBox(i).Visible = True
pBox(i).BackColor = pinColor
pBox(i).Top = iTop + (j * 40)
pBox(i).Width = 20
pBox(i).Height = 20
pBox(i).Left = leftStart + (35 * i)
If i > 9 Then
pBox(i).Left = leftStart + (35 * i) + 15
pBox(i).Width = 25
End If
pBox(i).BringToFront()
pBox(i).SizeMode = PictureBoxSizeMode.StretchImage
Controls.Add(pBox(i))
Next
Next

Related

Access different panels using loop

I'm trying to create multiple labels in different panels, but it keeps creating only one panel.
Here is my code
Dim i As Integer = 0
For i = 0 To 7
Dim lbl As New Label() With
{
.Text = "Suppliant Name:",
.Location = New Point(117, 10 * 1),
.Height = 15,
.Width = 95}
req1.Controls.Add(lbl)
req2.Controls.Add(lbl)
req3.Controls.Add(lbl)
req4.Controls.Add(lbl)
req5.Controls.Add(lbl)
req6.Controls.Add(lbl)
req7.Controls.Add(lbl)
Next
End Sub
Private Sub Add
Dim i As Integer = 0
For i = 0 To 7
AddlbltoPanel(req1)
AddlbltoPanel(req2)
AddlbltoPanel(req3)
AddlbltoPanel(req4)
AddlbltoPanel(req5)
AddlbltoPanel(req6)
AddlbltoPanel(req7)
Next
End Sub
Private Sub AddlbltoPanel(ByVal req as Panel)
'if it doesnt work with byval then check with byref
Dim lbl As New Label
lbl.Text = "Suppliant Name:"
lbl.Location = New Point(117, 10 * 1)
lbl.Height = 15
lbl.Width = 95
req.Controls.Add(lbl)
Me.SuspendLayout()
End Sub
I assume req* are your panels,
try above code

Positioning similar type objects on form programmatically in vb.net

I have a from which contains some PictureBoxes. They can be from one to many.
I create them at run-time depending on the existence of specific folders.
I create them and place them the one next to each other. This means that with a scrollable form I can view all of them easy.
My question is this: How do I position them in "rows"? For a specific form size, there can be 5 labels next to each other and infinite rows of them
How do I achieve this?
My (working) code:
Public allSeries As IEnumerable(Of String) = System.IO.Directory.EnumerateDirectories(root)
For i As Integer = 1 To allSeries.Count
Dim pb As New Windows.Forms.PictureBox With {
.Name = "pb" & i.ToString,
.Size = New Drawing.Size(500, 500),
.Location = New Point(5, 5),
.BorderStyle = BorderStyle.FixedSingle,
.SizeMode = PictureBoxSizeMode.Zoom,
.Image = Image.FromFile(allSeries(i - 1).ToString + "\sImage.jpg"),
.Tag = traveldestination, 'Store Directory path
.Cursor = Cursors.Hand}
Me.Controls.Add(pb)
For i As Integer = 2 To allSeries.Count
With Me
.Controls.Item("pb" + i.ToString).Left = .Controls.Item("pb" + (i - 1).ToString).Left + 520
End With
Next
My (bad) and (not workng) code:
Dim pbsOnForm As Integer = 13 'total PictureBoxes on Form /for this instance
Dim pbsOnRow As Integer = 5 'PictureBoxes that "fit" in a row /for this intance)
For i As Integer = 1 To pbsOnForm
If i <= pbsOnRow Then
Me.Controls.Item("pb" + i.ToString).Top = Me.Controls.Item("pb" + i.ToString).Top
End If
If i > pbsOnRow And i <= 10 Then
Me.Controls.Item("pb" + i.ToString).Top = Me.Controls.Item("pb" + (i - pbsOnRow).ToString).Top
End If
Works, but when the PcrureBoxes will be more than 10, I do not know......
While using the TableLayoutPanel would fulfill most cases for this and is probably the best way to achieve this, here is some code to align the PictureBox's in row / column.
First we want to setup a method to handle the positioning. We need some variables scoped to the Form.
Dim counter As Integer = 0
Dim xPos As Integer = 5
Dim yPos As Integer = 5
Now we use these variables in a method that sets the location.
Private Sub PositionPictureBox(pb As PictureBox, Optional imgPerRow As Integer = 5)
pb.Location = New Point(xPos, yPos)
counter += 1
If counter = imgPerRow Then
counter = 0
xPos = 5
yPos = pb.Location.Y + pb.Height + 5
Else
xPos = pb.Location.X + pb.Width + 5
End If
End Sub
Finally we call the method when the PictureBox is instantiated.
For i As Integer = 1 To allSeries.Count
Dim pb As New Windows.Forms.PictureBox
With pb
.Name = "pb" & i.ToString()
.Size = New Drawing.Size(50, 50)
.Location = New Point(5, 5)
.BorderStyle = BorderStyle.FixedSingle
.SizeMode = PictureBoxSizeMode.Zoom
.Image = Image.FromFile("...")
.Tag = allSeries(i)
.Cursor = Cursors.Hand
End With
PositionPictureBox(pb)
Me.Controls.Add(pb)
Next

Snake Game... Adding snake body function malfunctioning

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

dynamically layout buttons .net

Hie everyone
I have a procedure which puts buttons on a .net windows form using vb.net. It works ok but because I do not know the number of buttons I will be programming because they come from the database I would like a way to lay them out in rows of 10. I have programmed up to 50 which ios 5 rows but the method I am using will not work if there is more than 50. Is there a way do this. I have tried using mod of the number of boxes and it does not work.
Here is the code.
Private Sub AddButtons()
Dim xPos As Integer = 0
Dim yPos As Integer = 0
Dim n As Integer = 1
Dim numberOfBoxes As Integer
numberOfBoxes = txtNumberOfBoxes.Text
numberOfBoxes = numberOfBoxes + 1
' Declare and Initialize one variable
Dim btnArray(numberOfBoxes) As System.Windows.Forms.Button
For i As Integer = 0 To numberOfBoxes
btnArray(i) = New System.Windows.Forms.Button
Next i
While (n < numberOfBoxes)
With (btnArray(n))
.Tag = n + 1 ' Tag of button
.Width = 100 ' Width of button
.Height = 100 ' Height of button
If (n = 11) Then ' Location of second line of buttons:
xPos = 0
yPos = 120
ElseIf (n = 21) Then
xPos = 0
yPos = 240
ElseIf (n = 31) Then
xPos = 0
yPos = 360
ElseIf (n = 41) Then
xPos = 0
yPos = 480
ElseIf (n = 51) Then
xPos = 0
yPos = 600
End If
'If n Mod 10 = 0 Then
' xPos = xPos
' yPos = yPos + 50
'End If
' Location of button:
.Left = xPos
.Top = yPos
' Add buttons to a Panel:
pnlButtons.Controls.Add(btnArray(n)) ' Let panel hold the Buttons
xPos = xPos + .Width ' Left of next button
.Text = (n)
' for Event of click Button
AddHandler .Click, AddressOf Me.ClickButton
n += 1
End With
End While
btnAddButton.Enabled = False ' not need now to this button now
Label1.Visible = True
End Sub
I would suggest using a FlowLayoutPanel or, more likely, a TableLayoutPanel. You configure it to grow in the manner required and then all you have to do in code is Add the Button to its Controls collection. It handles all the layout so there's no calculation required.
Private Sub AddButtons()
Dim numberOfBoxes As Integer = txtNumberOfBoxes.Text
For i As Integer = 0 To numberOfBoxes - 1
'since row is an integer it won't have decimal places
'also \ divides without decimales-
Dim row As Integer = i \ 10
'The modulo operator is your friend. it gives you
'the rest of the devision.
' http://en.wikipedia.org/wiki/Modulo_operation
Dim col As Integer = i Mod 10
Dim newButton = New System.Windows.Forms.Button
With newButton
.Tag = i + 1 ' Tag of button
.Width = 100 ' Width of button
.Height = 100 ' Height of button
.Left = col * .Width
.Top = row * (.Height + 20)
.Text = i + 1
AddHandler .Click, AddressOf Me.ClickButton
End With
pnlButtons.Controls.Add(newButton)
Next i
btnAddButton.Enabled = False ' not need now to this button now
Label1.Visible = True
End Sub

Runtime error message Index was outside the bounds of the array. for Visual Basic 2010

I am computing the ROI with a moving rectangle and extracting the ROI to compute the standard deviation, mean, area and Pixel value coordinates X and Y in a seperate form2 by clicking the mouse. At this juncture I am trying to pass a function from the main Form that loads the Image and displays the rectangle to another Form that has the displayed properties of the mean and standard deviation etc. However, I'm receiving errors in runtime in the function that contains the standard deviation. The error displayed is
Index was outside the bounds of the array.
It is displayed at the end of this portion of the code in the function StD, i.e at the end of the mean part'
SD(count) = Double.Parse(pixelcolor.R) + Double.Parse(pixelcolor.G) + Double.Parse(pixelcolor.B) - mean
what is this actually saying and how can I fix this situation. Any tips and ideas, thanks.
My code is at the bottom
enterPublic Function StD(ByVal image As Bitmap, ByVal mean As Double, ByVal meancount As Integer) As Double
Dim SD(SquareHeight * SquareWidth) As Double
Dim count As Integer = 0
For i = 0 To SquareWidth
For j = 0 To SquareHeight
Dim pixelcolor As Color = image.GetPixel(i, j)
SD(count) = Double.Parse(pixelcolor.R) + Double.Parse(pixelcolor.G) + Double.Parse(pixelcolor.B) - mean
count += 1
Next
Next
Dim SDsum As Double = 0
For i = 0 To count
SDsum = SDsum + SD(i)
Next
SDsum = SDsum / (SquareHeight * SquareWidth)
SDsum = ((SDsum) ^ (1 / 2))
Return SDsum
End Function code here
I would like to pass this using the code below
enterPrivate Sub PictureBox1_MouseDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown
Dim mean As Double = 0
Dim meancount As Integer = 0
Dim bmap As New Bitmap(400, 400)
bmap = PictureBox1.Image
Dim colorpixel As Color = bmap.GetPixel(e.X, e.Y)
' Dim pixels As Double = colorpixel.R + colorpixel.G + colorpixel.B
If e.Button = Windows.Forms.MouseButtons.Left AndAlso Rect.Contains(e.Location) Then
If (PictureBox1.Image Is Nothing) Or (PictureBox1.Height - (e.Y + SquareHeight) < 0) Or (PictureBox1.Width - (e.X + SquareWidth) < 0) Then
Else
Dim ROI As New Bitmap(400, 400)
Dim x As Integer = 0
Dim countx As Integer = 0
Dim county As Integer = 0
For i = e.X To (e.X + SquareWidth)
For j = (e.Y + x) To (e.Y + SquareHeight)
Dim pixelcolor As Color = bmap.GetPixel(i, j)
ROI.SetPixel(countx, county, pixelcolor)
mean = mean + pixelcolor.R + pixelcolor.G + pixelcolor.B
county += 1
meancount += 1
Next
county = 0
countx += 1
x = x + 1
Next
mean = mean / (meancount * 3)
Dim SD = mean - 75
Dim area As Integer = (SquareHeight * SquareWidth)
Dim anotherForm As Form2
anotherForm = New Form2(mean, StD(bmap, mean, meancount), area, 34)
anotherForm.Show()
End If
End If
' Catch ex As Exception
' MessageBox.Show(ex.Message())
' End Try
End Sub code here
To be displayed with this code
enter Public Sub New(ByVal mean As Double, ByVal StD As Double, ByVal Area As Integer, ByVal pixel As Double)
MyBase.New()
InitializeComponent()
TextBox1.Text = mean.ToString()
TextBox2.Text = StD.ToString()
TextBox3.Text = Area.ToString()
TextBox4.Text = pixel.ToString()
End Sub code here
The problem probably is because of these lines:
For i = 0 To SquareWidth
For j = 0 To SquareHeight
Try using this instead:
For i = 0 To SquareWidth - 1
For j = 0 To SquareHeight - 1