Having a problem in drawing a 180degree arc (changing color after 90 Degrees) - The issue is the Arc's Horizontal and Vertical lines are not straight.
I know the start and Sweep angles are correct 180, 90 and 270, 90
Any help is aspirated.
my Code is....
Private Sub drawArc(ByVal g As Graphics)
Dim a = valueRange / 2
drawArcSegment(g, minValue, a, optimumRangeColor)
drawArcSegment(g, a, maxValue, actionRangeColor)End Sub
Sub drawArcSegment(ByVal g As Graphics, ByVal startValue As Double, ByVal EndValue As Double, ByVal segmentColor As Color)
' Set The Rectanglefor the Arc Segment
Dim rect As New Rectangle(boarder + arcWidth2, arcCenter.Y - arcRadius, arcDiameter, arcDiameter)
' Set The Color of the Arc Segment
Dim arcColor As New SolidBrush(segmentColor)
Dim arcPen As New Pen(arcColor, arcWidth)
' Calulate the Start and Sweep Angle of the Arc Segment
Dim startAngle As Single = (startValue * valueAngle) + 180
Dim sweepAngle As Single = ((EndValue * valueAngle) + 180) - startAngle
' Draw Arc Segment
g.DrawArc(arcPen, rect, startAngle, sweepAngle)
End Sub
Related
I am having problems with a project which should show the acceleration of a simple pendulum swinging over time. It should model a negative cosine curve, and I have the X and Y axis set so that the cosine curve will peak at the top of the chart area. However, it does not do this. For example, the maximum acceleration is calculated to be 17.746 m/s^2, however on the chart it says the maximum is around 1.71 m/s^2. Screenshot attached below.
https://drive.google.com/file/d/1AcmIDXsJIbzihH8Nq4mgSn1CofJCkQ6T/view?usp=sharing
I have wondered whether my maths are wrong or whether the problem lies somewhere in the chart. I have two other charts working, displacement and velocity of the pendulum, so I am confused as to why this will not work, especially as the coding behind each different chart is almost identical. I will attach all necessary code beneath.
Private Function CalculateAcceleration(ByVal amplitude As Double, ByVal frequency As Double, ByVal time As Double) As Double
Dim acceleration, maxAcc As Double
maxAcc = sq((2 * PI * frequency)) * amplitude
acceleration = -(maxAcc * Cos(2 * PI * frequency * time))
Return acceleration
End Function
Private Sub CreateAccelerationGraph(ByVal angularSpeed As Double, ByVal amplitude As Double, ByVal timePeriod As Double, ByVal frequency As Double)
If AccelerationChart.Series("Acceleration").Points.Count <> 0 Then
AccelerationChart.Series("Acceleration").Points.Clear()
End If
Dim maxAcceleration As Double = sq(angularSpeed) * amplitude
With AccelerationChart.ChartAreas("Default")
.AxisX.Minimum = 0
.AxisX.Maximum = (1 * timePeriod)
.AxisY.Minimum = -(maxAcceleration)
.AxisY.Maximum = maxAcceleration
End With
Dim increment As Double = (1 * timePeriod) / 100
For time As Double = 0 To (1 * timePeriod) Step increment
Dim xPos, yPos As Double
yPos = CalculateAcceleration(amplitude, frequency, time)
xPos = time
AccelerationChart.Series("Acceleration").Points.AddXY(xPos, yPos)
Dim label As New CalloutAnnotation
With label
AccelerationChart.Annotations.Add(label)
End With
Next
End Sub
Private Sub SetUpAccelerationGraph()
Dim innerPlotPosition As ElementPosition = New ElementPosition(10, 10, 80, 80)
AccelerationChart.Series.Add("Acceleration")
AccelerationChart.ChartAreas.Add("Default")
With AccelerationChart.Series("Acceleration")
.Color = Color.BlueViolet
.BorderWidth() = 5
.ChartType = DataVisualization.Charting.SeriesChartType.Spline
End With
With AccelerationChart.ChartAreas("Default")
.IsSameFontSizeForAllAxes = True
.InnerPlotPosition = innerPlotPosition ' sets the inner plot position
End With
AccelerationChart.ChartAreas.FirstOrDefault.AxisX.LabelStyle.Format = "{0:0.0}" 'sets the format of labels to 1dp
AccelerationChart.ChartAreas.FirstOrDefault.AxisY.LabelStyle.Format = "{0:0.000}"
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
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
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.
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)