i was trying to write a program that draws circles around the center of the form (creating a larger circle) and i noticed that it isn't really working, the circles are in the wrong coordinates, the following pictures explain what i mean
when the input is 3:
when the input is 10:
as you see, the circles aren't uniformed, here is the code:
Dim center As Integer = Convert.ToInt32(Me.Width / 2)
Dim angels As Integer = 360 / deviceCount
TextBox1.Text = deviceCount
Dim i As Integer
For i = 1 To deviceCount
e.Graphics.DrawEllipse(Pens.Red, Convert.ToInt32(center + 275 * Math.Cos(i * angels)) - 25, Convert.ToInt32(center + 275 * Math.Sin(i * angels)) - 25, 50, 50)
Next
*note: the form is 600*600 and deviceCount is the number in the textbox (the number of circles)
thanks in advance!
Edit:
The lazy way.
Private Sub DrawCircles(ByVal Graphics As Graphics, ByVal Number As Integer, ByVal Radius As Integer)
Dim Center = New Point(Me.ClientSize.Width \ 2, Me.ClientSize.Height \ 2)
Dim BigRadius = Math.Min(Center.X, Center.Y) - Radius
Dim CurrentState = Graphics.Save()
Graphics.ResetTransform()
Graphics.TranslateTransform(Center.X, Center.Y)
Graphics.DrawEllipse(Pens.Blue, -BigRadius, -BigRadius, BigRadius * 2, BigRadius * 2)
For i As Integer = 1 To Number
Graphics.RotateTransform(360 \ Number)
Graphics.DrawEllipse(Pens.Red, 0, -BigRadius - Radius, Radius * 2, Radius * 2)
Next
Graphics.Restore(CurrentState)
End Sub
Related
For fun I'm trying to recreate the first level of one my favorite games, Fire Emblem 7. I got a picture of the map online. I've broken down the image into "squares" with each square assigned a picture box to display the image. This is because each square needs to have certain properties such as terrain values, units inside them, etc.
The actual image is quite small (240 x 160), so I want to be able to scale it to any user defined value. The size of each square should be 16c x 16c with a scaler of c (all map dimensions are divisible by 16). For some reason, when c > 1, white lines appear between the squares. I've check the code and it looks like the squares should be adjacent with no empty spaces regardless of c.
I have provided a piece of my code and links to the images of different values of c below. Thank you for you help.
'This Sub Creates The Map From Initial Image And Assigns Part Of Image to Each Square
Public Sub New(Name As String, Image As Image)
Dim cropRect As Rectangle
Dim cropImage As Bitmap
Me.Name = Name
Me.Image = Image
Height = Me.Image.Height / 16
Width = Me.Image.Width / 16
ReDim Squares(Height - 1, Width - 1)
For i = 0 To Height - 1
For j = 0 To Width - 1
cropRect = New Rectangle(16 * j, 16 * i, 16, 16)
cropImage = New Bitmap(16, 16)
Graphics.FromImage(cropImage).DrawImage(Me.Image, 0, 0, cropRect, GraphicsUnit.Pixel)
Squares(i, j) = New Square(cropImage)
Next
Next
End Sub
'This Sub Sizes Each Square With User Defined Scale Value
Public Sub Draw(Scale As Double)
For i = 0 To Height - 1
For j = 0 To Width - 1
With Squares(i, j).Box
.Size = New Size(16 * Scale, 16 * Scale)
.Location = New Point(16 * j * Scale, 16 * i * Scale)
.SizeMode = PictureBoxSizeMode.StretchImage
End With
Next
Next
End Sub
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
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
Im trying to create a pie chart and have seen many different ways of doing so. I am trying to do it with the seemingly simplest method that I could find however I cannot get it to work. My code is below
If chkboxPieChart.CheckState = True Then
Dim percents() As Decimal = {EStock, EWages, EAdvertising, ERent, EElectricity, ERepayments, EPackaging}
Dim colors() As Color = {Color.Blue, Color.Green, Color.Red, Color.Orange, Color.Purple, Color.Azure, Color.Chartreuse}
Dim graphics As Graphics = Me.picboxPieChart.CreateGraphics
Dim location As Point = New Point(462, 257)
Dim size As Size = New Size(200, 200)
DrawPieChart(percents, colors, graphics, location, size)
End If
With this being the code for the DrawPieChart Sub
Public Sub DrawPieChart(ByVal percents() As Decimal, ByVal colors() As Color, ByVal surface As Graphics, ByVal location As Point, ByVal pieSize As Size)
Dim sum As Integer = 0
For Each percent As Integer In percents
sum += percent
Next
Dim percentTotal As Integer = 0
For percent As Integer = 0 To percents.Length() - 1
surface.FillPie(New SolidBrush(colors(percent)), New Rectangle(location, pieSize), CType(percentTotal * 360 / 100, Single), CType(percents(percent) * 360 / 100, Single))
percentTotal += percents(percent)
Next
Return
End Sub
Any help is greatly appreciated, thanks
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)