Giving Dynamically Created Shapes a Name - vb.net

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

Related

Window Media player adding Grids on playing video using VB.net

I have developed coding in vb.net to insert media player and also i am able to add all features to media player like time, seek bar but for my project, it is mandatory to show flexible grid over the playing video which requires advanced level of programming.I learned to add lines grids on a form but forming grids over playing video and transform it size graphically is difficult,i would be glad if you help me...thank you in advance
the following code help in forming grids but it cannot be transformed and also it cannot be placed over media player
Option Strict On
Option Explicit On
Option Infer Off
Public Class Form1
Sub DrawGrid(g As Graphics, origin As Point, rows As Integer, columns As Integer, cellSize As Size)
Dim gridWidth As Integer = columns * cellSize.Width
Dim gridHeight As Integer = rows * cellSize.Height
Dim left As Integer = origin.X - (gridWidth \ 2)
Dim right As Integer = origin.X + (gridWidth \ 2)
Dim top As Integer = origin.Y - (gridHeight \ 2)
Dim bottom As Integer = origin.Y + (gridHeight \ 2)
For y As Integer = top To bottom + 1 Step cellSize.Height
Dim pt1 As New Point(left, y)
Dim pt2 As New Point(right, y)
g.DrawLine(Pens.Black, pt1, pt2)
Next
For x As Integer = left To right + 1 Step cellSize.Width
Dim pt1 As New Point(x, top)
Dim pt2 As New Point(x, bottom)
g.DrawLine(Pens.Black, pt1, pt2)
Next
g.DrawEllipse(Pens.Red, New Rectangle(origin.X - 5, origin.Y - 5, 10, 10))
End Sub
Private Sub Form1_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint
Dim origin As New Point(Me.ClientRectangle.Width \ 2, Me.ClientRectangle.Height \ 2)
Dim cellSize As New Size(10, 10)
Dim rowCount As Integer = 10
Dim columnCount As Integer = 10
DrawGrid(e.Graphics, origin, rowCount, columnCount, cellSize)
End Sub
End Class

How to rotate an image on key press in vb.net

I am making a lunar lander game, and want the spaceship to rotate when the left and right arrow keys are pressed.
I know how to move an image using a picture box and the keydown event, but there isn't anyway to directly rotate a picture box. Do i need to use the image a different way to be able to achieve what I want? Any help is much appreciated.
Make a new class inheriting from picturebox. Use that. You can edit the designer.vb to change the type.
This is pseudocode, untested, so it certainly won't run.
class RotateablePictureBox
inherits picturebox
public property RotationAngle as single
overrides onpaint(e as ...)
e.graphics.rotatetransform(rotationangle)
mybase.onpaint(e)
That's the idea that Hans Passant is talking about (might have to do the DrawImage yourself too and skip the mybase.onpaint - it's done like e.graphics.onpaint(TheImage,dimensions etc...))
This is my first time posting code so let me know how I can improve it for the group. I developed this class using code from http://www.devasp.net/net/articles/display/391.htmlenter code here
I hope this helps. This is the button code
Private Sub btnRotateLeft_Click(sender As Object, e As EventArgs) Handles btnRotateLeft.Click
' IMAGE IS THE NEW OBJECT FROM THE CLASS. PASS THE PICTUREBOX CONTROL(pbItems)
image.RotateLeft(pbItems)
End Sub
This is the class
Imports System.Math
Public Class clsImage
Private wid As Single
Private hgt As Single
Public Function RotateLeft(ByVal picSource As PictureBox) As PictureBox
'ROTATES THE IMAGE LEFT
Dim bm_in = New Bitmap(picSource.Image)
wid = bm_in.Width
hgt = bm_in.Height
Dim corners As Point() = {New Point(0, 0), New Point(wid, 0), New Point(0, hgt), New Point(wid, hgt)}
Dim cx As Single = wid / 2
Dim cy As Single = hgt / 2
Dim i As Long
'ROTATES LEFT
For i = 0 To 3
corners(i).X -= cx
corners(i).Y -= cy
Next i
'THE ROTATION ANGLE IS HARD CODED HERE BUT COULD BE PASS TO THE CLASS
Dim theta As Single = Single.Parse(90) * PI / 180.0
Dim sin_theta As Single = Sin(theta)
Dim cos_theta As Single = Cos(theta)
Dim X As Single
Dim Y As Single
For i = 0 To 3
X = corners(i).X
Y = corners(i).Y
corners(i).X = X * cos_theta + Y * sin_theta
corners(i).Y = -X * sin_theta + Y * cos_theta
Next i
Dim xmin As Single = corners(0).X
Dim ymin As Single = corners(0).Y
For i = 1 To 3
If xmin > corners(i).X Then xmin = corners(i).X
If ymin > corners(i).Y Then ymin = corners(i).Y
Next i
For i = 0 To 3
corners(i).X -= xmin
corners(i).Y -= ymin
Next i
Dim bm_out As New Bitmap(CInt(-2 * xmin), CInt(-2 * ymin))
Dim gr_out As Graphics = Graphics.FromImage(bm_out)
ReDim Preserve corners(2)
gr_out.DrawImage(bm_in, corners)
picSource.Image = bm_out
Return picSource
End Function
Public Function RotateRight(ByVal picSource As PictureBox) As PictureBox
'ROTATES THE IMAGE RIGHT
Dim bm_in = New Bitmap(picSource.Image)
wid = bm_in.Width
hgt = bm_in.Height
Dim corners As Point() = {New Point(0, 0), New Point(wid, 0), New Point(0, hgt), New Point(wid, hgt)}
Dim cx As Single = wid / 2
Dim cy As Single = hgt / 2
Dim i As Long
'ROTATES RIGHT
For i = 0 To 3
corners(i).X -= cx
corners(i).Y -= cy
Next i
'THE ROTATION ANGLE IS HARD CODED HERE BUT COULD BE PASS TO THE CLASS
Dim theta As Single = Single.Parse(-90) * PI / 180.0
Dim sin_theta As Single = Sin(theta)
Dim cos_theta As Single = Cos(theta)
Dim X As Single
Dim Y As Single
For i = 0 To 3
X = corners(i).X
Y = corners(i).Y
corners(i).X = X * cos_theta + Y * sin_theta
corners(i).Y = -X * sin_theta + Y * cos_theta
Next i
Dim xmin As Single = corners(0).X
Dim ymin As Single = corners(0).Y
For i = 1 To 3
If xmin > corners(i).X Then xmin = corners(i).X
If ymin > corners(i).Y Then ymin = corners(i).Y
Next i
For i = 0 To 3
corners(i).X -= xmin
corners(i).Y -= ymin
Next i
Dim bm_out As New Bitmap(CInt(-2 * xmin), CInt(-2 * ymin))
Dim gr_out As Graphics = Graphics.FromImage(bm_out)
ReDim Preserve corners(2)
gr_out.DrawImage(bm_in, corners)
picSource.Image = bm_out
Return picSource
End Function
End Class

Creating a Custom Polygon Class in vb.net

I want to make a custom polygon shape class, which i can drag and drop unto my form at will (just as it is done in the case of OvalShape and RectangleShape objects in VS toolbox). I checked site1, site2 and site3, one of which specifically said that the OnPaint Event of my form should be overridden. Is there any way I can achieve the same while creating the custom polygon shape, and still have my polygon appear on the toolbox?
Edit:
#Jens: I'll like the control to generate its code with the following tested code:
Me.ClientSize = New Point(24, 24)
Dim r1 As Integer = Min(cx, cy) - 10
Dim r2 As Integer = Min(cx, cy) \ 2
Dim pts(9) As Point
For i As Integer = 0 To 9 Step 2
pts(i).X = cx + CInt(r1 * Cos(i * PI / 5 - PI / 2))
pts(i).Y = cy + CInt(r1 * Sin(i * PI / 5 - PI / 2))
pts(i + 1).X = cx + CInt(r2 * Cos((i + 1) * PI / 5 - PI / 2))
pts(i + 1).Y = cy + CInt(r2 * Sin((i + 1) * PI / 5 - PI / 2))
Next i
That gives me a star with 5 spikes. How can i store them in the Points variable created,
OR
store the points as a region so that whenever i change forecolor, it fills the region (i.e. polygn) with the selected color. I also want to prevent painting the backcolor. Please take a look at the links below to a c# solution of what i really want, but i suck at converting c# to vb.
link1; Link2
Thanks a lot
I am not entirely sure that that is what you want. You can always derive a new class from Control and use its Paint event to draw whatever you like. In your case a polygon.
The control therefore contains a Points property that is just an array of PointF values that define the edges of the polygon. By using the DesignerSerializationVisible.Content attribute you make it possible to edit these values through the designer directly. The code looks like this:
Public Class PolygonControl
Inherits Control
Private _Points(2) As PointF
<System.ComponentModel.DesignerSerializationVisibility(System.ComponentModel.DesignerSerializationVisibility.Content)>
Public Property Points As PointF()
Get
Return _Points
End Get
Set(value As PointF())
_Points = value
End Set
End Property
Public Property LineColor As Color = Color.Black
Public Property LineWidth As Integer = 2
Private Sub PolygonControl_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint
e.Graphics.Clear(Me.BackColor)
If Points IsNot Nothing AndAlso Points.Count > 1 Then
e.Graphics.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
Using b As New SolidBrush(ForeColor)
Using p As New Pen(b, LineWidth)
e.Graphics.DrawPolygon(p, Points)
End Using
End Using
End If
End Sub
End Class
I added a color and width property as well. This is just to give you a rough idea. Notice the attribute above the Points property.
In "action" it looks like this:
Adding better designer support is certainly possible, but I have no experience with that whatsoever. But it is a start.
Edit
Since you always draw the same shape, you can precalculate the points in the control's constructor and just draw the shape in the paint event:
Public Class StarControl
Inherits Control
'Storage for the shape's points
Private pts(9) As Point
'Constructor
Public Sub New()
Me.ClientSize = New Size(24, 24)
SetStyle(ControlStyles.SupportsTransparentBackColor, True)
Me.BackColor = Color.Transparent
'Precalculate the shape
Dim cx = CInt(Me.ClientSize.Width / 2)
Dim cy = CInt(Me.ClientSize.Height / 2)
Dim r1 As Integer = Min(cx, cy) - 10
Dim r2 As Integer = Min(cx, cy) \ 2
ReDim pts(9)
For i As Integer = 0 To 9 Step 2
pts(i).X = cx + CInt(r1 * Cos(i * PI / 5 - PI / 2))
pts(i).Y = cy + CInt(r1 * Sin(i * PI / 5 - PI / 2))
pts(i + 1).X = cx + CInt(r2 * Cos((i + 1) * PI / 5 - PI / 2))
pts(i + 1).Y = cy + CInt(r2 * Sin((i + 1) * PI / 5 - PI / 2))
Next i
End Sub
Public Property LineColor As Color = Color.Black
Public Property FillColor As Color = Color.Gold
Public Property LineWidth As Integer = 1
Public Sub PaintMe(sender As Object, e As PaintEventArgs) Handles Me.Paint
'Draw the precalculated shape
e.Graphics.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
Using b As New SolidBrush(FillColor)
e.Graphics.FillPolygon(b, pts)
End Using
Using b As New SolidBrush(LineColor)
Using p As New Pen(b, LineWidth)
e.Graphics.DrawPolygon(p, pts)
End Using
End Using
End Sub
End Class
For an even cooler effect move the shape calculation into the Paint event handler so the shape resizes itself based on the control's size. This allows you to draw stars of arbitrary size.

How to draw circular arcs in VB.NET

I have to generate the following figure according to user fed values. How do I go about drawing the arcs (B-C-F as in figure, circular in nature) given their start point & end point (B & F respectively) & the height from the segment BF? I can do some geometric calculations & get the radius & all, but how do I draw the arc?
I have tried using the Graphics.DrawCurve() method, but it doesn't work as expected. How can I make this method work for circular arcs? Any other workaround is also welcome.
From my comment:
If you have computed the necessary radius to generate the curve, then
simply draw the entire circle with Graphics.DrawEllipse(), but use
Graphics.SetClip() and pass a rectangle using the points B and F as a
side and computing the other two points using the height C. This will
clip the entire circle to just the part visible within that rectangle.
Then call Graphics.ResetClip() and draw the rest of the lines. Repeat
the SetClip() trick to draw the curve at the bottom as well.
Here's a proof of concept for the top curve thru B, C, and F.
I used the formulas provided by Donna Roberts at Investigative Circle Activity Using Three Points.
Here's a screenshot:
...and the code that produced it:
Public Class Form1
Private B As New Point(50, 100)
Private F As New Point(250, 100)
Private DistanceFromBF As Integer = 50
Private Sub Form1_Paint(sender As System.Object, e As System.Windows.Forms.PaintEventArgs) Handles MyBase.Paint
If B.Y = F.Y Then
Dim C As New Point(B.X + (F.X - B.X) / 2, B.Y - DistanceFromBF)
Dim ctr As Point
Dim rad As Double
CircleFromPointsOnCircumference(B, C, F, ctr, rad)
Dim rc As New Rectangle(ctr, New Size(1, 1))
rc.Inflate(rad, rad)
e.Graphics.DrawRectangle(Pens.Black, rc)
Dim clip As New Rectangle(New Point(B.X, B.Y - DistanceFromBF), New Size(F.X - B.X, DistanceFromBF))
e.Graphics.SetClip(clip)
e.Graphics.DrawEllipse(Pens.Green, rc)
e.Graphics.ResetClip()
DrawPoint(B, e.Graphics, Color.Red)
DrawPoint(C, e.Graphics, Color.Red)
DrawPoint(F, e.Graphics, Color.Red)
DrawPoint(ctr, e.Graphics, Color.Green)
End If
End Sub
Private Sub DrawPoint(ByVal pt As Point, ByVal G As Graphics, ByVal clr As Color)
Dim rc As New Rectangle(pt, New Size(1, 1))
rc.Inflate(3, 3)
Using brsh As New SolidBrush(clr)
G.FillEllipse(brsh, rc)
End Using
End Sub
Private Sub CircleFromPointsOnCircumference(ByVal ptA As Point, ByVal ptB As Point, ByVal ptC As Point, ByRef Center As Point, ByRef Radius As Double)
Dim mR As Double = CDbl(ptA.Y - ptB.Y) / CDbl(ptA.X - ptB.X)
Dim mT As Double = CDbl(ptC.Y - ptB.Y) / CDbl(ptC.X - ptB.X)
Dim X As Double = (mR * mT * (ptC.Y - ptA.Y) + mR * (ptB.X + ptC.X) - mT * (ptA.X + ptB.X)) / CDbl(2) * (mR - mT)
Dim Y As Double = CDbl(-1) / mR * (X - CDbl(ptA.X + ptB.X) / CDbl(2)) + (CDbl(ptA.Y + ptB.Y) / CDbl(2))
Center = New Point(X, Y)
Radius = Math.Sqrt(Math.Pow(ptA.X - Center.X, 2) + Math.Pow(ptA.Y - Center.Y, 2))
End Sub
End Class
Got it! Thanks #Mitch & #Idle_Mind
Using the builtin DrawArc method of Graphics
Friend Function draw_tank() As Boolean
' Create pen.
Dim blackPen As New Pen(Color.Black, 3)
' Create rectangle to bound ellipse.
Dim rect As New Rectangle(100, 100, 200, 200)
' Keeping the width & length same (200) we get a circle
' Create start and sweep angles on ellipse.
Dim startAngle As Single = 225.0F
Dim sweepAngle As Single = 90.0F
' Draw arc to screen.
Dim myarc As Graphics = Me.CreateGraphics
myarc.DrawArc(blackPen, rect, startAngle, sweepAngle)
Return True
End Function
Suggestions/Improvements welcome.
Note - This isn't the actual function from my code.

Drawing a septagon in vb.net

Does anyone have any code that can draw an equilateral septagon in vb.net?
All sides and angles need to be equal.
Thanks
No, but if you think of a clock face with 60 minutes, each 8.5 minutes marks one point of your 7-sided shape.
Here is a function to draw a regular polygon of specified number of sides:
Sub poly(ByVal center As PointF, ByVal radius As Double, ByVal nSides As Integer, ByVal g As Graphics)
Dim pts(nSides) As PointF
Dim Angle As Double = Math.PI * 2 / nSides
Dim i As Integer
Dim a As Double
a = Math.PI / 2 ' first point on top
For i = 0 To UBound(pts)
pts(i) = center + New Point(radius * Math.Cos(a), -radius * Math.Sin(a))
a = a + Angle
Next i
g.DrawPolygon(Pens.DarkGreen, pts)
End Sub
To call it, setup a graphics object where you want it drawn. For example, to draw it in PictureBox1, you could call it like this:
Dim g As Graphics
PictureBox1.Image = New Bitmap(PictureBox1.Width, PictureBox1.Height) ' new bitmap
g = Graphics.FromImage(PictureBox1.Image) ' assign graphics object to g
g.FillRectangle(Brushes.White, 0, 0, PictureBox1.Width, PictureBox1.Height) ' white background
' draw 7-sided polygon in the center of the picturebox
poly(New PointF(PictureBox1.Width / 2, PictureBox1.Height / 2), PictureBox1.Height / 3, 7, g)