How to flip a User Control added in a picturebox by 180 degrees? - vb.net

I'm adding a control to a picturebox. This control is a component, precisely it's a toggle switch posted here. I'd like this control to be vertical and not horizontal .
So, since objects can't be rotated or flipped, I found a way to flip the picturebox image with:
PictureBox1.Image.RotateFlip(RotateFlipType.Rotate180FlipNone)
PictureBox1.Refresh()
The error I'm getting at RunTime is:
System.Windows.Forms.PictureBox.Image.get returned Nothing
Endeed the control is not an image so is there a way to flip the control inside of the picturebox by 180 degrees?
Also, You think there is a way to know when the value of the toggle switch is on or off?
Thanks

As already mentioned above, extend the control to have it drawn either horizontally or vertically.
Imports System.Drawing
Imports System.Drawing.Drawing2D
Imports System.Windows.Forms
Public Class ToggleSwitch
Inherits CheckBox
Public Sub New()
MyBase.New
SetStyle(ControlStyles.AllPaintingInWmPaint Or
ControlStyles.UserPaint, True)
UpdateStyles()
Padding = New Padding(6)
End Sub
Private _orientation As Orientation = Orientation.Horizontal
Public Property Orientation As Orientation
Get
Return _orientation
End Get
Set(value As Orientation)
_orientation = value
Dim max = Math.Max(Width, Height)
Dim min = Math.Min(Width, Height)
If value = Orientation.Vertical Then
Size = New Size(min, max)
Else
Size = New Size(max, min)
End If
End Set
End Property
'Fix by: #41686d6564
<Browsable(False),
Bindable(False),
DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden),
EditorBrowsable(EditorBrowsableState.Never)>
Public Overrides Property AutoSize As Boolean
Get
Return False
End Get
Set(value As Boolean)
End Set
End Property
Protected Overrides Sub OnPaint(e As PaintEventArgs)
Dim g = e.Graphics
g.Clear(BackColor)
g.SmoothingMode = SmoothingMode.AntiAlias
g.PixelOffsetMode = PixelOffsetMode.Half
Dim p = Padding.All
Dim r = 0
Dim rec As Rectangle
Using gp = New GraphicsPath
If _orientation = Orientation.Vertical Then
r = Width - 2 * p
gp.AddArc(p, p, r, r, -180, 180)
gp.AddArc(p, Height - r - p, r, r, 0, 180)
r = Width - 1
rec = New Rectangle(0, If(Checked, Height - r - 1, 0), r, r)
'Or
'rec = New Rectangle(0, If(Checked, 0, Height - r - 1), r, r)
'To get the ON on top.
Else
r = Height - 2 * p
gp.AddArc(p, p, r, r, 90, 180)
gp.AddArc(Width - r - p, p, r, r, -90, 180)
r = Height - 1
rec = New Rectangle(If(Checked, Width - r - 1, 0), 0, r, r)
End If
gp.CloseFigure()
g.FillPath(If(Checked, Brushes.DarkGray, Brushes.LightGray), gp)
g.FillEllipse(If(Checked, Brushes.Green, Brushes.WhiteSmoke), rec)
End Using
End Sub
End Class
As for the second part of your question, please read CheckBox.Checked property and CheckBox.CheckedChanged event.
Impelemntation example:
Private Sub ToggleSwitch1_CheckedChanged(sender As Object, e As EventArgs) Handles ToggleSwitch1.CheckedChanged
If ToggleSwitch1.Checked Then
'ToDo with ON state...
Else
'ToDo with OFF state..
End If
End Sub

Related

The cropping area has an x and y offset in the new bitmap, but only if the original has been scaled

a strange phenomenon occurs.
With my edge detection program, I can transfer the inside of the GraphicsPath to a new image.
It always works great – except when I scale the original image with GIMP and Word (aspect ratio remains, only the dimensions are changed). Then the area is shifted. To the left and up. See attachement. In line 68, I looked what is in rectCutout. Everything OK.
Does this have anything to do with GIMP? The dots per inch are the same (72). The compression quality of the JPEG also (100%).
I just realized: if I scale an image larger, the result is completely black.
The strange thing is: I'm not saying: the picture that is drawn on is larger than the picture that is saved. Then it would be logical that the path is not in the same position. It's about the fact that the loaded image is just smaller.
I would be happy if someone could tell me why. 😄
this is the scaled image which is loaded
Here you see the GUI, ready to save
cropped image, area has x and y offset
#Disable Warning CA1707 ' Bezeichner dürfen keine Unterstriche enthalten
Imports System.Drawing.Drawing2D
Imports Microsoft.WindowsAPICodePack.Dialogs
Public NotInheritable Class AllesGrafische
Public Shared Sub Paint_the_Rectangle(ByVal g As Graphics, ByVal recta As Rectangle)
If g IsNot Nothing Then
g.SmoothingMode = SmoothingMode.AntiAlias
g.CompositingQuality = CompositingQuality.HighQuality
g.PixelOffsetMode = PixelOffsetMode.HighQuality
g.InterpolationMode = InterpolationMode.HighQualityBilinear
Using Pen_Hellblau As Pen = New Pen(Color.FromArgb(0, 200, 255), 1.0F)
g.DrawRectangle(Pen_Hellblau, recta)
End Using
End If
End Sub
Public Shared Sub Draw_Curve(ByVal g As Graphics, ByVal theList As List(Of Point))
If theList IsNot Nothing AndAlso theList.Count > 0 AndAlso g IsNot Nothing Then
g.SmoothingMode = SmoothingMode.AntiAlias
g.CompositingQuality = CompositingQuality.HighQuality
g.PixelOffsetMode = PixelOffsetMode.HighQuality
g.InterpolationMode = InterpolationMode.HighQualityBilinear
Dim theList_neu As New List(Of Point)
Using gp As New GraphicsPath
For i As Integer = 1 To theList.Count - 1 Step 1
Dim a As Integer = theList(i).X
Dim b As Integer = theList(i).Y
Dim c As Integer = theList(i - 1).X
Dim d As Integer = theList(i - 1).Y
Dim Entfernungsbetrag As Double = Math.Sqrt(Math.Pow(a, 2) + Math.Pow(b, 2) + Math.Pow(c, 2) + Math.Pow(d, 2) - 2 * a * c - 2 * b * d)
If Entfernungsbetrag < Form1.erlaubte_Entfernung Then
theList_neu.Add(theList(i))
End If
Next
If theList_neu.Count = 0 Then Return
gp.AddLines(theList_neu.ToArray())
Using Pen_hellrosa As Pen = New Pen(Color.FromArgb(255, 64, 239), 1.0F)
g.DrawPath(Pen_hellrosa, gp)
End Using
If Form1.ClosePath Then
gp.CloseFigure()
End If
If Form1.CheckBox1.Checked Then
Dim Speicherpfad As String
Using SFD1 As New CommonSaveFileDialog
SFD1.Title = "Wo soll das Bild gespeichert werden?"
SFD1.Filters.Add(New CommonFileDialogFilter("PNG", ".png"))
If System.IO.Directory.Exists("C:\Users\...\source\repos\VB.NET\Get mouse position and draw rectangle on screen") Then
SFD1.InitialDirectory = "C:\Users\...\source\repos\VB.NET\Get mouse position and draw rectangle on screen"
Else
SFD1.InitialDirectory = Environment.GetFolderPath(Environment.SpecialFolder.Desktop)
End If
If SFD1.ShowDialog = CommonFileDialogResult.Ok Then
Speicherpfad = SFD1.FileName & ".png"
Else
Return
End If
End Using
Using bmpSource As Bitmap = New Bitmap(Form1.Pfad_Bild)
Dim rectCutout As RectangleF = gp.GetBounds()
Using m As Matrix = New Matrix()
m.Translate(-rectCutout.Left, -rectCutout.Top)
gp.Transform(m)
End Using
Using bmpCutout As Bitmap = New Bitmap(CInt(Math.Round(rectCutout.Width, 0)), CInt(Math.Round(rectCutout.Height, 0)))
Using graphicsCutout As Graphics = Graphics.FromImage(bmpCutout)
graphicsCutout.Clip = New Region(gp)
graphicsCutout.DrawImage(bmpSource, CInt(-rectCutout.Left), CInt(-rectCutout.Top))
bmpCutout.Save(Speicherpfad, Imaging.ImageFormat.Png)
Form1.CheckBox1.Checked = False
End Using
End Using
End Using
End If
End Using
End If
End Sub
End Class
#Enable Warning CA1707 ' Bezeichner dürfen keine Unterstriche enthalten
The solution is to use .SetResolution()
Using Original As Bitmap = New Bitmap(Form1.Pfad_Bild)
Dim rectCutout As RectangleF = gp.GetBounds()
Using m As System.Drawing.Drawing2D.Matrix = New System.Drawing.Drawing2D.Matrix()
m.Translate(-rectCutout.Left, -rectCutout.Top)
gp.Transform(m)
End Using
Using bmpCutout As Bitmap = New Bitmap(CInt(Math.Round(rectCutout.Width, 0)), CInt(Math.Round(rectCutout.Height, 0)))
bmpCutout.SetResolution(Original.HorizontalResolution, Original.VerticalResolution)
.
.
.
.
.

Redraw Picturebox at offset and back to simulate as a button effect

I have some images of document and book covers and those are displayed using pictureboxes in a Table layout panel.
Image excerpt from winform app
I am following this code
(From: https://social.msdn.microsoft.com/Forums/vstudio/en-US/da545e8e-e059-4681-9893-6d5dbdf6eba6/drop-shadow-around-the-image-in-picturebox?forum=vbgeneral)
to make picturebox work as a button when clicked and open the desired book or document.
Public Enum ShadowPosition As Integer
TopLeft = 0
TopRight = 1
BottomLeft = 2
BottomRight = 3
End Enum
Private Sub AddImageWithShadow(ByVal img As System.Drawing.Image, ByVal area As ShadowPosition, ByVal thickness As Integer, ByVal clr As Color, ByVal PicBox As PictureBox)
Using bm As New Bitmap(img.Width + thickness, img.Height + thickness)
Using gr As Graphics = Graphics.FromImage(bm)
Dim ix, iy As Integer
Dim rect As New Rectangle(thickness, thickness, img.Width, img.Height)
If area = ShadowPosition.TopLeft Or area = ShadowPosition.TopRight Then
iy = thickness
rect.Y = 0
End If
If area = ShadowPosition.TopLeft Or area = ShadowPosition.BottomLeft Then
ix = thickness
rect.X = 0
End If
gr.FillRectangle(New SolidBrush(clr), rect)
gr.DrawImage(img, ix, iy)
End Using
If PicBox.Image IsNot Nothing Then PicBox.Image.Dispose()
PicBox.Image = New Bitmap(bm)
End Using
End Sub
I tried to change the position of image:
Picturebox1.Location = New Point(10, 10)
Is there a way someone could guess to redarw picturebox at some offset without its drop shadow and back to initial state.

How do I "move" a picturebox image around a grid of pictureboxes?

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.

Giving Dynamically Created Shapes a Name

I'm designing a hexagon grid and I need to be able to name each hexagon, so I can refer to them later. Below is my class, it generates the hexagon grid, and I've labeled the code throughout so you can understand what's happening.
I've been searching for a while now reading a lot about Graphics, but I can't get a working design with the answers I've seen offered. Perhaps, I'm going about this wrong by using Graphics, but my plan is to be able to click on each hexagon and do something with it.
Note: If you see a way to improve my code let me know. It's appreciated!
' Generate Hexagon Grid
Private Sub Form1_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint
' Hexagon Grid Parameters
Dim HexagonRadius As Integer = 20 ' Fix "Position Hexagon Grid Columns" Before Changing Hexagon Radius
Dim GridSize As Integer = 10
' Generate Hexagon Grid
Dim HexagonX As Integer = HexagonRadius
Dim HexagonY As Integer = HexagonRadius
For i As Integer = 1 To GridSize
For j As Integer = 1 To GridSize
' Hexagon Vertex Coordinates
Dim point1 As New Point((HexagonX - HexagonRadius), (HexagonY))
Dim point2 As New Point((HexagonX - (HexagonRadius / 2)), (HexagonY + ((HexagonRadius / 2) * Math.Sqrt(3))))
Dim point3 As New Point((HexagonX + (HexagonRadius / 2)), (HexagonY + ((HexagonRadius / 2) * Math.Sqrt(3))))
Dim point4 As New Point((HexagonX + HexagonRadius), (HexagonY))
Dim point5 As New Point((HexagonX + (HexagonRadius / 2)), (HexagonY - ((HexagonRadius / 2) * Math.Sqrt(3))))
Dim point6 As New Point((HexagonX - (HexagonRadius / 2)), (HexagonY - ((HexagonRadius / 2) * Math.Sqrt(3))))
Dim hexagonPoints As Point() = {point1, point2, point3, point4, point5, point6}
' Create Hexagon
e.Graphics.FillPolygon(Brushes.Green, hexagonPoints)
' Hexagon Outline
e.Graphics.DrawLine(Pens.Black, point1, point2)
e.Graphics.DrawLine(Pens.Black, point2, point3)
e.Graphics.DrawLine(Pens.Black, point3, point4)
e.Graphics.DrawLine(Pens.Black, point4, point5)
e.Graphics.DrawLine(Pens.Black, point5, point6)
e.Graphics.DrawLine(Pens.Black, point6, point1)
' Position Hexagon Grid Columns
HexagonY += 34 ' Specific to Hexagon Radius: 20
Next
If i Mod 2 > 0 Then
HexagonY = 36.75 ' Specific to Hexagon Radius: 20
Else
HexagonY = 20 ' Specific to Hexagon Radius: 20
End If
HexagonX += 30 ' Specific to Hexagon Radius: 20
Next
End Sub
You'll need to create some Hexagon class with it's coordinates and (maybe name, if really needed). And save them to some suitable collection (2-dimensional array maybe?)
This should happen somewhere outside your Paint event and might be recalculated on grid SizeChanged event.
Inside your Paint event you'll just iterate throught existing collection and render according to pre-computed coordinates.
OnClick event will loop throught the same collection to find specific Hexagon for updating (changing background color for example) and forcing form to repaint to take effect.
For large rendering you should consider rendering to bitmap first and drawing that final bitmap to e.Graphics for faster work. Your bitmap could be cached as well to speed up even more.
EDIT: Code sample added
Turn Option Strict On in your project properties to avoid many problems in your code that you're not aware of.
Public Class frmTest
Private Const HexagonRadius As Integer = 20
Private Const GridSize As Integer = 10
Private fHexagons As New List(Of Hexagon)
Private fCache As Bitmap
Private fGraphics As Graphics
Private Sub ResetHexagons() 'Call when some parameter changes (Radius/GridSize)
fHexagons.Clear()
Invalidate()
End Sub
Private Function EnsureHexagons() As List(Of Hexagon)
Dim X, Y As Single, xi, yi As Integer
If fHexagons.Count = 0 Then
X = HexagonRadius : Y = HexagonRadius
For xi = 1 To GridSize
For yi = 1 To GridSize
fHexagons.Add(New Hexagon(HexagonRadius, X, Y))
Y += 34
Next
'Do your math to get theese values from HexagonRadius value
If xi Mod 2 > 0 Then
Y = 36.75
Else
Y = 20
End If
X += 30
Next
fCache?.Dispose()
fGraphics?.Dispose()
fCache = New Bitmap(GridSize * HexagonRadius * 2, GridSize * HexagonRadius * 2)
fGraphics = Graphics.FromImage(fCache)
For Each H As Hexagon In fHexagons
H.Render(fGraphics)
Next
End If
Return fHexagons
End Function
Private Sub frmTest_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint
EnsureHexagons()
e.Graphics.DrawImageUnscaled(fCache, Point.Empty)
End Sub
Private Sub frmTest_MouseClick(sender As Object, e As MouseEventArgs) Handles Me.MouseClick
Dim H As Hexagon = EnsureHexagons.FirstOrDefault(Function(X) X.Contains(e.Location))
If H IsNot Nothing Then
H.Checked = Not H.Checked
H.Render(fGraphics) 'Update cache without repainting all
Invalidate()
End If
End Sub
End Class
Public Class Hexagon
Public ReadOnly Radius, X, Y As Single
Public ReadOnly Points() As PointF
Public Property Checked As Boolean
Public Sub New(Radius As Single, X As Single, Y As Single)
Me.Radius = Radius : Me.X = X : Me.Y = Y
Points = {New PointF((X - Radius), (Y)),
New PointF((X - (Radius / 2)), CSng(Y + ((Radius / 2) * Math.Sqrt(3)))),
New PointF((X + (Radius / 2)), CSng(Y + ((Radius / 2) * Math.Sqrt(3)))),
New PointF((X + Radius), (Y)),
New PointF((X + (Radius / 2)), CSng(Y - ((Radius / 2) * Math.Sqrt(3)))),
New PointF((X - (Radius / 2)), CSng(Y - ((Radius / 2) * Math.Sqrt(3.0!))))}
End Sub
Public Sub Render(G As Graphics)
' Create Hexagon
G.FillPolygon(If(Checked, Brushes.Blue, Brushes.Green), Points)
' Hexagon Outline
For i As Integer = 0 To Points.Length - 1
G.DrawLine(Pens.Black, Points(i), Points((i + 1) Mod Points.Length))
Next
End Sub
Public Function Contains(P As Point) As Boolean
'Do your math here, this is just simplified estimation
Return X - Radius <= P.X AndAlso P.X <= X + Radius AndAlso Y - Radius <= P.Y AndAlso P.Y <= Y + Radius
End Function
End Class

Trying to change an image in a Label, when a certain Button is clicked

I am creating a game for my Visual Basic class.
So far I have been successful, except for movement on my label grid. I have a 16, 21 Label grid that I am using for the main map.
The X axis is numeric 1-21 and the Y axis is letters A-P. So the upper left Label is named A1 and the bottom right Label is named P21.
The player starts on Label P11 and has an image of an arrow indicating their location.
I also have an up, down, left, right buttons as well. When I press the up Button, I want the image to move itself to O11, or the above Label.
I have a solution, but it is very code extensive, and the up Button alone is 1600+ line of code, which I think is a little excessive.
My variables that I declared and the initial starting Label:
Public Letters As New List(Of String)
Public Shared x = 15
Public Shared locationLetter As String
Public Shared locationNumber As Integer = 11
Public Shared locationPlayer As String
'Put player's ship in starting grid P11
P11.Image = My.Resources.Arrow
This code loops through each Label and then finds the one that has the image and then sets its Image property to nothing.
It also changes the players location to what it should be, in this case I want the image to go from P11 to O11.
Dim nextMove As String
Controls.Find(locationPlayer)
For Each lbl As Label In Controls.OfType(Of Label)
If lbl.Image IsNot Nothing And x >= 0 Then
x -= 1
lbl.Image = Nothing
locationLetter = Letters.Item(x)
locationPlayer = CStr(locationLetter & locationNumber)
If lbl.Name = locationPlayer Then
lbl.Image = My.Resources.Arrow
End If
End If
Next
This line of code adds the appropriate letters to the Letters list, so that I can call up it to concatenate to find the current position the player should be in:
Letters.Add("A") ' 0 position
Letters.Add("B") ' 1 position
Letters.Add("C") ' 2 position
Letters.Add("D") ' 3 position
Letters.Add("E") ' 4 position
Letters.Add("F") ' 5 position
Letters.Add("G") ' 6 position
Letters.Add("H") ' 7 position
Letters.Add("I") ' 8 position
Letters.Add("J") ' 9 position
Letters.Add("K") ' 10 position
Letters.Add("L") ' 11 position
Letters.Add("M") ' 12 position
Letters.Add("N") ' 13 position
Letters.Add("O") ' 14 position
Letters.Add("P") ' 15 position
locationLetter = Letters.Item(15)
The code that I have now that is working, but is way excessive is:
If P1.Tag = "player" Then
O1.Tag = "player"
O1.Image = My.Resources.Arrow
P1.Tag = ""
P1.Image = Nothing
btnDOWN.Enabled = True
btnLEFT.Enabled = False
ElseIf P2.Tag = "player" Then
O2.Tag = "player"
O2.Image = My.Resources.Arrow
P2.Tag = ""
P2.Image = Nothing
btnDOWN.Enabled = True
ElseIf P3.Tag = "player" Then
O3.Tag = "player"
O3.Image = My.Resources.Arrow
P3.Tag = ""
P3.Image = Nothing
btnDOWN.Enabled = True
'[...]
End If
And so on. I would have to do this for every single Button, so that's 336 blocks x4 Buttons, or roughly 6,720 lines of code to move an image to another box.
My pseudo code for this is:
If playerlocation = (some grid number, like P11 for example)
Find the label with the name = to playerlocation and add image to label
i.e.
so if playerlocation = D4
find the label with the name D4 and add the image to the label
Procedural programming is good!
Some semi-OOP:
A description of what you said you need:
A Board
- it has Dimensions;
- contains a array of, lets say, Cells (which have their own properties);
- has to allow the movement of a dummy player over its Cells;
A Player:
- It has a position
- a picture which is the visual expression of its position;
- an action range: can move and only inside the range of the Cells that
the Board defines
Building a Board object (of course):
Public Class GameBoard
Private _BoardSize As New Size 'Board size
Private _CellsArray As BoardCell(,) 'The Cells array
Private _PlayerDummy As PlayerDummy
Private _Cells As BoardCell
Private _cell As BoardCell
Private _Location As Point
Private _Container As Control
Private _PlayerPosition As Point 'Current or default position of the player
Private _PlayerImage As Image 'Player dummy Image
Private _Initialized As Boolean = False
'The BoardSize defaults to 21x15
Public Sub New()
Me.New(New Size(0, 0))
End Sub
Public Sub New(_size As Size)
Me._BoardSize = _size
Me._cell = New BoardCell
Me._cell.Size = New Size(50, 50)
Me._PlayerDummy = New PlayerDummy
End Sub
Friend Property BoardSize() As Size
Get
Return Me._BoardSize
End Get
Set(ByVal value As Size)
Me._BoardSize = value
End Set
End Property
Friend Property Cell() As BoardCell
Get
Return Me._cell
End Get
Set(ByVal value As BoardCell)
Me._cell = value
End Set
End Property
Friend ReadOnly Property Cells(_id As Point) As BoardCell
Get
Return Me._CellsArray(_id.X, _id.Y)
End Get
End Property
Public Property Container() As Control
Get
Return _Container
End Get
Set(ByVal value As Control)
_Container = value
Me._PlayerDummy.Parent = value
End Set
End Property
Public Property Location() As Point
Get
Return _Location
End Get
Set(ByVal value As Point)
_Location = value
End Set
End Property
Public Property PlayerPosition() As Point
Get
Return Me._PlayerPosition
End Get
Set(value As Point)
If Me._Initialized = True Then
'If a player position changes, move the dummy image in the new Cell
If Me._PlayerPosition <> value Then
Me._PlayerPosition = value
Me._PlayerDummy.Location = Me._CellsArray(value.X, value.Y).Location
End If
End If
End Set
End Property
Public Property PlayerImage() As Image
Get
Return Me._PlayerImage
End Get
Set(value As Image)
Me._PlayerImage = New Bitmap(value)
Me._PlayerDummy.Image = Me.PlayerImage
End Set
End Property
'Dimension (0, 0) is used to show Rows/Columns headers
Public Sub Initialize(_size As Size)
Me._BoardSize = _size
'Defines the number of Cells
Me._CellsArray = New BoardCell(_size.Width, _size.Height) {}
'Add Cells classes per dimensions(x, y)
Dim x As Integer = 0
While x <= _BoardSize.Width
Dim y As Integer = 0
While y <= _BoardSize.Height
Me._CellsArray(x, y) = CreateBoardCell()
y += 1
End While
x += 1
End While
'Paint the Board
For x = 0 To Me._BoardSize.Width
For y = 0 To Me._BoardSize.Height
Dim _position As Point = New Point(x, y)
If x > 0 And y = 0 Then
Me.Cells(_position).Text = x.ToString
Me.Cells(_position).BackColor = Color.FromArgb(32, 32, 32)
Me.Cells(_position).ForeColor = Color.White
End If
If y > 0 And x = 0 Then
Me.Cells(_position).Text = Chr(y + 64).ToString
Me.Cells(_position).BackColor = Color.FromArgb(32, 32, 32)
Me.Cells(_position).ForeColor = Color.White
End If
Me.Cells(_position).Location = New Point(Me._Location.X + x * Me.Cell.Size.Width, _
Me._Location.Y + y * Me.Cell.Size.Height)
Me.Cells(_position).Parent = Me.Container
Next
Next
Me.Cells(New Point(0, 0)).BorderStyle = BorderStyle.None
Me.Cells(New Point(0, 0)).BackColor = Me.Container.BackColor
Me._Initialized = True
End Sub
Private Function CreateBoardCell() As BoardCell
Dim _boardcell As BoardCell = New BoardCell
_boardcell.Size = Me._cell.Size
_boardcell.BackColor = Me._cell.BackColor
_boardcell.BorderStyle = Me._cell.BorderStyle
Me._PlayerDummy.Size = New Size(Me._cell.Size.Width - 1, Me._cell.Size.Height - 1)
Return _boardcell
End Function
'A class defining a Cell object. Inherits from Label.
'May be a Panel gives more options. Do not use PictureBoxes.
Public Class BoardCell
Inherits Label
Public Sub New()
'Setup default properties
Me.AutoSize = False
Me.TextAlign = ContentAlignment.MiddleCenter
Me.Visible = True
End Sub
End Class
Friend Class PlayerDummy
Inherits PictureBox
Private _Image As Image
Private _Parent As Control
Public Sub New()
Me.SizeMode = PictureBoxSizeMode.Zoom
Me.BorderStyle = Windows.Forms.BorderStyle.Fixed3D
Me.Visible = True
End Sub
Public Shadows Property Image() As Image
Get
Return Me._Image
End Get
Set(ByVal value As Image)
MyBase.Image = value
Me._Image = value
End Set
End Property
Public Shadows Property Parent() As Control
Get
Return _Parent
End Get
Set(ByVal value As Control)
_Parent = value
MyBase.Parent = value
End Set
End Property
End Class
End Class
To create a new Board, instantiate it and definine its properties
MyGameBoard = New GameBoard
'Starting position to draw this GameBoard
MyGameBoard.Location = New Point(50, 50)
MyGameBoard.Cell.Size = New Size(50, 50)
MyGameBoard.Cell.BackColor = Color.Wheat
MyGameBoard.Cell.BorderStyle = BorderStyle.FixedSingle
'Define the container class (Form, Panel, PictureBox...) that will contain this Board
MyGameBoard.Container = Me
'Assign an Image to the new player object and Position it inside its Board Cell
MyGameBoard.PlayerImage = New Bitmap(My.Resources.horse2)
'Paint the Board giving it desired size
MyGameBoard.Initialize(New Size(10, 10))
Now, the Player
Public Class Player
Public Enum Direction 'Enumerates this player allowed directions
Up = 0 'Maybe it could also move diagonally
Down
Left
Right
End Enum
Private _Position As Point 'Player Position
Private _Boundaries As New Rectangle 'The Boundaries of its movements
Public Sub New()
Me.New(Nothing)
End Sub
Public Sub New(_boundaries As Rectangle)
Me._Boundaries = New Rectangle(1, 1, _boundaries.Width - 1, _boundaries.Height - 1)
End Sub
Public Property Position() As Point
Get
Return Me._Position
End Get
Set(value As Point)
'Evaluates whether the position being set violates the
'constraints imposed by the Boundaries
Me._Position.X = If(value.X > Me._Boundaries.Right, Me._Boundaries.Right, value.X)
Me._Position.X = If(value.X < Me._Boundaries.Left, Me._Boundaries.Left, value.X)
Me._Position.Y = If(value.Y > Me._Boundaries.Bottom, Me._Boundaries.Bottom, value.Y)
Me._Position.Y = If(value.Y < Me._Boundaries.Top, Me._Boundaries.Top, value.Y)
End Set
End Property
Public Property Boundaries() As Rectangle
Get
Return Me._Boundaries
End Get
Set(ByVal value As Rectangle)
Me._Boundaries = value
End Set
End Property
'Move of the Player. Evaluates if the requested action violates Boundaries
Public Function Move(_direction As Direction) As Point
Select Case _direction
Case Direction.Up
Me.Position = New Point(Me.Position.X, If(Me.Position.Y > Me._Boundaries.Top, Me.Position.Y - 1, Me.Position.Y))
Exit Select
Case Direction.Down
Me.Position = New Point(Me.Position.X, If(Me.Position.Y < Me._Boundaries.Bottom, Me.Position.Y + 1, Me.Position.Y))
Exit Select
Case Direction.Left
Me.Position = New Point(If(Me.Position.X > Me._Boundaries.Left, Me.Position.X - 1, Me.Position.X), Me.Position.Y)
Exit Select
Case Direction.Right
Me.Position = New Point(If(Me.Position.X < Me._Boundaries.Right, Me.Position.X + 1, Me.Position.X), Me.Position.Y)
Exit Select
End Select
Return Me._Position
End Function
End Class
Create a new player with movement Boundaries = to the board Size
MyPlayer = New Player(New Rectangle(New Point(1, 1), MyGameBoard.BoardSize))
Starting position:
MyPlayer.Position = New Point(10, 10)
Place the Player Dummy
MyGameBoard.PlayerPosition = MyPlayer.Position
To move it just use the Move method and let the Board know about:
MyPlayer.Position = MyPlayer.Move(Player.Direction.Up)
MyGameBoard.PlayerPosition = MyPlayer.Position
Place some controls to let the actual human player move the dummy.
Well, using labels as fields is a bit weird. However, you could put all the labels into an 2D-Array and remember the player's position. Then, when a movement button is pressed you first check if the player's new position is out of range. if not, you clear the old label and set the new won remembering the new position.
I haven't tested it but something like this should work:
Private playfield as Label() = {{P11,P12,P13,...},{P21,P22,P23,...},...}
Private playerX as Integer = 11
Private playerY as Integer = 14
Public Sub btnDOWN_Clicked() Handles btnDOWN.Clicked
If playerY+1 < 14 Then
playfield(playerX, playerY).Image = Nothing
playerY = playerY + 1
playfield(playerX, playerY).Image = My.Ressources.Arrow
End If
End Sub
Repeat the stuff in btnDown_Clicked for btnUP, btnLEFT and btnRIGHT and change the related variables. Remember to check if your move is valid before you do it or you might get out of range exceptions when walking out of screen.