Related
I'm making a custom winforms button in VB.Net with rounded edges and other features. I create a path using various inputs defined by the user and draw and fill it using pens and brushes.
When I call e.Graphics.FillEllipse(Brush1, Rect1) and e.Graphics.DrawEllips(Pen1, Rect1) it just works fine without any problems, but when I try e.Graphics.FillPath(Brush1, OuterPath) and e.Graphics.DrawPath(Pen1, OuterPath) it doesn't work at all. I get this error:
ArgumentException: The parameter is not valid
I tried giving the right types of each variable used in the process and not letting the compiler decide, creating more variables to calculate and manage the inputs individually to not make all the calculations in the inputs of each function, which makes my work easier honestly, and even using the CType function in the inputs of each function to make sure that the function understands what I want as inputs. But everything failed and I don't know what to do next to fix the issue.
Here is the code:
Private Sub MetaniumButton_Paint(sender As Object, e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
Dim PathWidth As Integer = Width - BorderSize / 2
Dim PathHeight As Integer = Height - BorderSize / 2
_Roundnes = RoundnesMemory
If PathHeight < Roundenes.Height Then
_Roundnes.Height = PathHeight - 1
End If
If PathWidth < Roundenes.Width Then
_Roundnes.Width = PathWidth - 1
End If
e.Graphics.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
Dim OuterPath As New GraphicsPath
Dim Rec1 As Rectangle = New Rectangle(CType(BorderSize / 2, Int32), CType(BorderSize / 2, Int32), CType(_Roundnes.Width, Int32), CType(_Roundnes.Height, Int32))
Dim Rec2 As Rectangle = New Rectangle(PathWidth - _Roundnes.Width, BorderSize / 2, _Roundnes.Width, _Roundnes.Height)
Dim Rec3 As Rectangle = New Rectangle(PathWidth - _Roundnes.Width, PathHeight - _Roundnes.Height, _Roundnes.Width, _Roundnes.Height)
Dim Rec4 As Rectangle = New Rectangle(BorderSize / 2, PathHeight - _Roundnes.Height, _Roundnes.Width, _Roundnes.Height)
OuterPath.StartFigure()
OuterPath.AddLine(CInt(_Roundnes.Width / 2 + BorderSize / 2), CInt(BorderSize / 2), CInt(PathWidth - _Roundnes.Width / 2), CInt(BorderSize / 2))
OuterPath.AddArc(Rec1, 180.0, 90.0) ' Here is the problem and it could probably in any AddArc Function i used
OuterPath.AddLine(PathWidth, CInt(_Roundnes.Height / 2 + BorderSize / 2), PathWidth, CInt(PathHeight - _Roundnes.Height / 2))
OuterPath.AddArc(Rec2, -90, 90)
OuterPath.AddLine(CInt(_Roundnes.Width / 2 + BorderSize / 2), PathHeight, CInt(PathWidth - _Roundnes.Width / 2), PathHeight)
OuterPath.AddArc(Rec3, 0, 90)
OuterPath.AddLine(CInt(BorderSize / 2), CInt(_Roundnes.Height / 2), CInt(BorderSize / 2), CInt(PathHeight - _Roundnes.Height / 2))
OuterPath.AddArc(Rec4, 90, 90)
OuterPath.CloseFigure()
e.Graphics.FillPath(Brush1, OuterPath)
e.Graphics.DrawPath(Pen1, OuterPath)
Dim LabelCount As Integer = 0
For Each l As Label In Controls
LabelCount += 1
Next
Dim TextPlace As New Label With {.Name = "TextLabel",
.Text = Text,
.AutoEllipsis = True,
.Size = New Size(Width -
Margin.Left + Margin.Right + 2 * _Roundnes.Width) / 2, Height - (Margin.Top + Margin.Bottom + 2 * _Roundnes.Height) / 2),
.TextAlign = _TextAlign,
.ForeColor = _FontColor,
.BackColor = _MetaniumBackColor,
.Location = New Point((Width - .Width) / 2, (Height - .Height) / 2)}
AddHandler TextPlace.TextChanged, AddressOf MetaniumButton_TextChanged
AddHandler Me.TextChanged, AddressOf MetaniumButton_TextChanged
Controls.Add(TextPlace)
T += 1
If LabelCount <= 0 Then
0: For Each l As Label In Controls
If l.Name = "TextLabel" Then
l.Text = Text
l.AutoEllipsis = True
l.Size = New Size(Width - (Margin.Left + Margin.Right + 2 * _Roundnes.Width) / 2, Height - (Margin.Top + Margin.Bottom + 2 * _Roundnes.Height) / 2)
l.TextAlign = _TextAlign
l.ForeColor = _FontColor
l.BackColor = _MetaniumBackColor
l.Location = New Point((Width - l.Width) / 2, (Height - l.Height) / 2)
End If
Next
ElseIf LabelCount = 1 Then
For Each l As Label In Controls
If l.Name <> "TextLabel" Then
Controls.Remove(l)
Else
GoTo 1
End If
1: GoTo 0
Next
Else
End If
End Sub
When I track down the bug it seems the problem is in the AddArc() function, and I really don't know why it doesn't work. Any help appreciated.
BTW, I use VB.Net Express 2010 with .Net Framework 4.8.
PS: you can post an answer using either VB.Net or C# I can translate the code from both of them.
I solved My problem, and the answer was to initialize the value or Roundnes to (1,1) at least because my code creates the arcs of the edges using Roundnes to know how wide and long the curving edge
so the solution is to add this line of code before the code responsible for creating the arc.
If _Roundnes = New Size(0, 0) Then _Roundnes = New Size(1, 1)
And that's pretty much it! Thank you for helping me out!
I'm creating a public function for 1D linear interpolation. I was asking if it could be possible to work with List of Double, instead of Double() because there arrays don't have fixed lenght, but it is parametric, depending on the number of rows inserted in a datagridview. I've tried to declare double() as list of double() but I'm receiving an error about subtraction between members - that seems to be not allowed. Here is the code:
Public Shared Function Interp1(ByVal xnative As Double(), ByVal ynative As Double(), ByVal xinterpol As Double()) As Double()
Dim yinterpol As Double()
For i = 1 To ynative.Length - 1
For j = 0 To xnative.Length - 1
If xinterpol(j) > xnative(i - 1) And xinterpol(j) < xnative(i) Then
yinterpol(j) = (ynative(i - 1) * (xinterpol(j) - xnative(i + 1)) / (xnative(i - 1) - xnative(i + 1))) - (ynative(i + 1) * (xinterpol(j) - xnative(i - 1)) / (xnative(i - 1) - xnative(i + 1)))
Else i += 1
End If
Next
If xinterpol(xinterpol.Length) > xnative(xnative.Length) Then
Exit For
End If
Next
End Function
Where am I doing wrong? I can't understand where the mistake can be. Other thing I was asking is, if with the provided code, yinterpol is the result of my function, because that is what I need to have as result. Thanks in advance
Edit: Here is the version of my code using List of Double():
Public Shared Function Interp1(ByVal xnative As List(Of Double)(), ByVal ynative As List(Of Double)(), ByVal xinterpol As List(Of Double)()) As List(Of Double)()
Dim yinterpol As New List(Of Double)()
For i = 1 To ynative.Length - 1
For j = 0 To xnative.Length - 1
If xinterpol(j) > xnative(i - 1) And xinterpol(j) < xnative(i) Then
yinterpol.add((ynative(i - 1) * (xinterpol(j) - xnative(i + 1)) / (xnative(i - 1) - xnative(i + 1))) - (ynative(i + 1) * (xinterpol(j) - xnative(i - 1)) / (xnative(i - 1) - xnative(i + 1))))
Else i += 1
End If
Next
If xinterpol(xinterpol.Length) > xnative(xnative.Length) Then
Exit For
End If
Next
End Function
I'm having back the error BC30452: operators "-", ">" and "<" are not defined for List of Double
Edit II: What I have to do with this function is to rebuild two list of double that I'm gonna type in the application through a Datagridview.
What I need to have is:
To rebuild the starting List, I have to implement a 1D linear interpolation function, in which, with the values in the column x-ending (from 0 to 106 in the example), I can obtain the y-ending. I've updated my code with your corrections but I think that my code is missing something to do what is my aim. I hope this is clearer now.
Your parameters for your function look like arrays of lists considering the trailing (). This can be used when declaring a New list to indicate you are calling the constructor, although in vb.net it is not necessary (unlike C#). You are asking calling code to provide and arrays of lists.
The error you are getting is because xinterpol(j) is the list present at index j in the array of list. Obviously you can't convert a List(Of Double) to a Double.
.Length is not available for List(Of T). You should use .Count
Your index j makes me a bit nervous. You are basing this on the .Count of xnative but applying it to xinterpol. What if xnative is longer than xinerpol? You are begging for an Index Out of Range exception.
I can't see why you want to possibly add a single item to yinterpol and then quit if the .Count of xinterpol is greater than the .Count of xnative
Public Shared Function Interp1(xnative As List(Of Double), ynative As List(Of Double), xinterpol As List(Of Double)) As List(Of Double)
Dim yinterpol As New List(Of Double)
For i = 1 To ynative.Count - 1
For j = 0 To xnative.Count - 1
If xinterpol(j) > xnative(i - 1) And xinterpol(j) < xnative(i) Then
yinterpol.Add((ynative(i - 1) * (xinterpol(j) - xnative(i + 1)) / (xnative(i - 1) - xnative(i + 1))) - (ynative(i + 1) * (xinterpol(j) - xnative(i - 1)) / (xnative(i - 1) - xnative(i + 1))))
Else i += 1
End If
Next
If xinterpol(xinterpol.Count) > xnative(xnative.Count) Then
Exit For
End If
Next
Return yinterpol
End Function
Re: The error you're receiving using arrays, you have a couple of issues here.
One is that you're not actually returning a value from the function.
Another is that you haven't initialized the yinterpol array with a size.
It's also good practice to declare the types of your indices rather than infer them (set Option Explicit on, Option Infer off and always set Option Strict on).
Try this:
Public Shared Function Interp1(ByVal xnative As Double(), ByVal ynative As Double(), ByVal xinterpol As Double()) As Double()
Dim yinterpol(9) As Double '<- Initialize array length
For i As Integer = 1 To ynative.Length - 1 '<- Declare type of i
For j As Integer = 0 To xnative.Length - 1 '<- Declare type of j
If xinterpol(j) > xnative(i - 1) AndAlso xinterpol(j) < xnative(i) Then
yinterpol(j) = (ynative(i - 1) * (xinterpol(j) - xnative(i + 1)) / (xnative(i - 1) - xnative(i + 1))) - (ynative(i + 1) * (xinterpol(j) - xnative(i - 1)) / (xnative(i - 1) - xnative(i + 1)))
Else
i += 1 '<- Don't modify outer loop index
End If
Next j
If xinterpol(xinterpol.Length) > xnative(xnative.Length) Then Exit For
Next i
Return yinterpol '<- Return a value
End Function
I prefer Lists over Arrays personally. Let me know if you want that version posted. Some sample data for the call would be helpful.
UPDATE: You shouldn't change a loop variable directly. So i += 1 within the "j" For is a bad idea. (In fact, I'm not even sure the changed value will persist in the outer "i" loop.)
List Version
You List example is using ARRAYs of List(of Double) on account of the trailing "()". Most of the other issues still apply, eg changing loop index, missing return value, etc.
Public Shared Function Interp1(ByVal xnative As List(Of Double), ByVal ynative As List(Of Double), ByVal xinterpol As List(Of Double)) As List(Of Double)
Dim yinterpol As New List(Of Double)
For i As Integer = 1 To ynative.Count - 1
For j As Integer = 0 To xnative.Count - 1
If xinterpol(j) > xnative(i - 1) AndAlso xinterpol(j) < xnative(i) Then
yinterpol.Add((ynative(i - 1) * (xinterpol(j) - xnative(i + 1)) / (xnative(i - 1) - xnative(i + 1))) - (ynative(i + 1) * (xinterpol(j) - xnative(i - 1)) / (xnative(i - 1) - xnative(i + 1))))
Else
i += 1
End If
Next j
If xinterpol(xinterpol.Count) > xnative(xnative.Count) Then Exit For
Next i
Return yinterpol
End Function
I'm trying to remove corners that are not included in the button border.
I draw my button border with this method:
Private Sub BTN_Connexion_Paint(sender As System.Object, e As System.Windows.Forms.PaintEventArgs) Handles BTN_Connexion.Paint
Me.DrawRectangle(e.Graphics, New Pen(Color.White), 0, 0, BTN_Connexion.Width - 1, BTN_Connexion.Height - 1, 10)
End Sub
Public Sub DrawRectangle(ByVal g As Graphics, ByVal pen As Pen, ByVal x As Int32, ByVal y As Int32, ByVal width As Int32, ByVal height As Int32, ByVal radius As Int32)
'Create a rectangle
Dim area As RectangleF = New RectangleF(x, y, width, height)
Dim path As Drawing2D.GraphicsPath = New Drawing2D.GraphicsPath
'Add the corners
path.AddArc(area.Left, area.Top, radius * 2, radius * 2, 180, 90) 'Upper-Left
path.AddArc(area.Right - (radius * 2), area.Top, radius * 2, radius * 2, 270, 90) 'Upper-Right
path.AddArc(area.Right - (radius * 2), area.Bottom - (radius * 2), radius * 2, radius * 2, 0, 90) 'Lower-Right
path.AddArc(area.Left, area.Bottom - (radius * 2), radius * 2, radius * 2, 90, 90) 'Lower-Left
path.CloseAllFigures()
'Draw the rounded rectangle
g.DrawPath(pen, path)
End Sub
Corners can take the main form color. Like this they would not appear on the button. But I don't know if it's good practice and more I didn't know how to do this.
So could you tell me how can I remove these corners?
I have resolved my problem, here is the solution:
In the form that you want to implement your rounded button do:
Private Sub BTN_Paint(sender As System.Object, e As System.Windows.Forms.PaintEventArgs) Handles BTN_Connect.Paint, BTN_Disconnect.Paint
DirectCast(sender, Button).Region = New Region(SpecificDesign.DrawRoundRectangle(0, 0, BTN_Connect.Width - 1, BTN_Connect.Height - 1, 10))
End Sub
The class SpecificDesign contains:
Public Class SpecificDesign
''' <summary>
''' Create the path of a rounded rectangle.
''' </summary>
''' <param name="left">Ordinate of the left top corner</param>
''' <param name="Top">Abscissa of the left top corner</param>
''' <param name="width">Width of the rounded rectangle (Left and right lines)</param>
''' <param name="height">Height of the rounded rectangle(Top and bottom lines)</param>
''' <param name="radius">Radius of the rounded corner </param>
''' <returns></returns>
Public Shared Function DrawRoundRectangle(ByVal left As Int32, ByVal Top As Int32, ByVal width As Int32, ByVal height As Int32, ByVal radius As Int32) As Drawing2D.GraphicsPath
Dim path As Drawing2D.GraphicsPath = New Drawing2D.GraphicsPath
path.AddArc(left, Top, radius * 2, radius * 2, 180, 90) 'Upper-Left
path.AddArc(left + width - (radius * 2), Top, radius * 2, radius * 2, 270, 90) 'Upper-Right
path.AddArc(left + width - (radius * 2), Top + height - (radius * 2), radius * 2, radius * 2, 0, 90) 'Lower-Right
path.AddArc(left, Top + height - (radius * 2), radius * 2, radius * 2, 90, 90) 'Lower-Left
path.CloseAllFigures()
Return path
End Function
End Class
i'm trying to display pitch, roll and yaw indications in term of graphic so i build an GUI using user control in visual basic. this is my code for the GUI only.
Private g As Graphics
Private _roll_angle As Double
Public Property roll_angle() As Double
Get
Return _roll_angle
End Get
Set(ByVal value As Double)
_roll_angle = value
Invalidate()
End Set
End Property
Private _pitch_angle As Double
Public Property pitch_angle() As Double
Get
Return _pitch_angle
End Get
Set(ByVal value As Double)
_pitch_angle = value
Invalidate()
End Set
End Property
Private Sub ArtificialHorizon_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
End Sub
Private Function pitch_to_pix(ByVal pitch As Double) As Integer
Return pitch / 35.0 * Me.Height / 2
'Return pitch / 45.0 * Me.Height / 2
End Function
Private Sub ArtificialHorizon_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
g = e.Graphics
g.SmoothingMode = Drawing2D.SmoothingMode.HighQuality
g.Clear(Me.BackColor)
Dim sin As Double = Math.Sin(roll_angle / 180 * 3.14)
g.ResetTransform()
' g.FillRegion(Brushes.White, New Region(New Rectangle(0, 0, Me.Width, Me.Height)))
' rounded rectangle
Dim path As New Drawing2D.GraphicsPath()
Dim r As Single = 50
path.AddArc(0, 0, r, r, 180, 90)
path.AddArc(Me.Width - r, 0, r, r, 270, 90)
path.AddArc(Me.Width - r, Me.Height - r, r, r, 0, 90)
path.AddArc(0, Me.Height - r, r, r, 90, 90)
'path.AddEllipse(0, 0, Me.Width, Me.Height)
path.CloseFigure()
g.SetClip(path)
g.TranslateTransform(Me.Width / 2, Me.Height / 2)
g.RotateTransform(roll_angle)
g.TranslateTransform(0, pitch_to_pix(pitch_angle))
' chocolate
Dim b As New System.Drawing.Drawing2D.LinearGradientBrush(New RectangleF(-Me.Width, 0, Me.Height * 2, Me.Width * 2), Color.FromArgb(255, 219, 140, 21), Color.Brown, Drawing2D.LinearGradientMode.Vertical)
g.FillRectangle(b, New RectangleF(-Me.Width * 2, +1, Me.Height * 4, Me.Width * 4))
g.RotateTransform(180)
' color.aqua
b = New System.Drawing.Drawing2D.LinearGradientBrush(New RectangleF(-Me.Width, -1, Me.Height * 2, Me.Width * 2), Color.FromArgb(255, 28, 134, 186), Color.DarkBlue, Drawing2D.LinearGradientMode.Vertical)
g.FillRectangle(b, New RectangleF(-Me.Width * 2, 0, Me.Height * 4, Me.Width * 4))
g.ResetTransform()
Dim w2 As Single = Me.Width / 2
Dim s As Single = Me.Width / 38
g.TranslateTransform(Me.Width / 2, Me.Height / 2)
g.RotateTransform(45)
g.TranslateTransform(-w2 + s, 0)
g.DrawLine(New Pen(Color.White, 2), 0, 0, s * 2, 0)
g.TranslateTransform(+w2 - s, 0)
g.RotateTransform(15)
g.DrawLine(New Pen(Color.White, 2), -w2 + s, 0, -w2 + s * 2, 0)
g.RotateTransform(15)
g.DrawLine(New Pen(Color.White, 2), -w2 + s, 0, -w2 + s * 2, 0)
g.RotateTransform(15)
g.DrawLine(New Pen(Color.White, 2), -w2 + s, 0, -w2 + s * 3, 0)
'g.DrawString("0°", New System.Drawing.Font("sans-serif", 9), Brushes.White, -w2 + 40, -4)
g.RotateTransform(15)
g.DrawLine(New Pen(Color.White, 2), -w2 + s, 0, -w2 + s * 2, 0)
g.RotateTransform(15)
g.DrawLine(New Pen(Color.White, 2), -w2 + s, 0, -w2 + s * 2, 0)
g.RotateTransform(15)
g.DrawLine(New Pen(Color.White, 2), -w2 + s, 0, -w2 + s * 3, 0)
'g.DrawString("+45°", New System.Drawing.Font("sans-serif", 9), Brushes.White, -w2 + 40, -4)
g.ResetTransform()
Dim length As Single = Me.Width / 4
Dim notch As Single = Me.Width / 30
g.TranslateTransform(Me.Width / 2, Me.Height / 2)
g.DrawLine(New Pen(Color.White, 3), -length + notch * 2, 0, -notch, 0)
g.DrawLine(New Pen(Color.White, 3), notch, 0, length - notch * 2, 0)
g.DrawArc(New Pen(Color.White, 3), -notch, -notch, notch * 2, notch * 2, 180, -180)
g.ResetTransform()
' driehoekje
Dim ww As Single = Me.Width / 38
g.TranslateTransform(Me.Width / 2, Me.Height / 2)
g.RotateTransform(-90 + roll_angle)
path = New Drawing2D.GraphicsPath()
path.AddLine(w2 - ww * 3, 0, w2 - ww * 4, ww)
path.AddLine(w2 - ww * 4, -ww, w2 - ww * 4, ww)
path.AddLine(w2 - ww * 4, -ww, w2 - ww * 3, 0)
g.FillRegion(Brushes.White, New Region(path))
g.DrawLine(New Pen(Color.White, 1), w2 - ww * 3, 0, w2 - ww * 4, ww)
g.DrawLine(New Pen(Color.White, 1), w2 - ww * 4, -ww, w2 - ww * 4, ww)
g.DrawLine(New Pen(Color.White, 1), w2 - ww * 4, -ww, w2 - ww * 3, 0)
g.ResetTransform()
g.ResetClip()
path = New Drawing2D.GraphicsPath()
path.AddPie(New Rectangle(ww * 3, ww * 3, Me.Width - ww * 6, Me.Height - ww * 6), 0, 360)
g.SetClip(path)
g.TranslateTransform(Me.Width / 2, Me.Height / 2)
g.RotateTransform(roll_angle)
g.TranslateTransform(0, pitch_to_pix(pitch_angle))
For i As Integer = -80 To 80 Step 10
drawpitchline(g, i)
Next i
End Sub
Private Sub drawpitchline(ByVal g As Graphics, ByVal pitch As Double)
Dim w As Single = Me.Width / 8
g.DrawLine(Pens.White, -w, pitch_to_pix(-pitch + 5), w, pitch_to_pix(-pitch + 5))
g.DrawLine(Pens.White, -w * 5 / 3, pitch_to_pix(-pitch), w * 5 / 3, pitch_to_pix(-pitch))
g.DrawString(pitch, Me.Font, Brushes.White, -w * 75 / 30, pitch_to_pix(-pitch) - 5)
g.DrawString(pitch, Me.Font, Brushes.White, w * 2, pitch_to_pix(-pitch) - 5)
End Sub
Private Sub drawrollline(ByVal g As Graphics, ByVal a As Single)
Dim w2 As Single = Me.Width / 2
g.RotateTransform(a + 90)
g.TranslateTransform(-w2 + 10, 0)
g.DrawLine(Pens.White, 0, 0, 20, 0)
g.TranslateTransform(10, 5)
g.RotateTransform(-a - 90)
g.DrawString("" & (a) & "°", New System.Drawing.Font("sans-serif", 9), Brushes.White, 0, 0)
g.RotateTransform(+90 + a)
g.TranslateTransform(-10, -5)
g.TranslateTransform(+w2 - 10, 0)
g.RotateTransform(-a - 90)
End Sub
then i added in a button to give some testing readings. code below
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
AH.roll_angle = 45
AH.pitch_angle = 10
End Sub
when the button is clicked, the GUI is supposed to turn/rotate according to the inputs. however, it stays still (btw, code is able to debug thou and the graphic did show up). i believe it's because i did not refer to the AH variable in my painting. can someone pls give me a guide on this?
thanks in advance!
I might have something which can be used, I created this to display azimuth heading of parabolic antenna.
the heading is using simple pen
superimpose on top of circle image
the pen will rotate according to the degree movement
With 3 main functions
DrawAntenna() --> draw the pen/line
FindPointOnCircle() --> find end point of the pen (start point always center of circle)
RotateAntenna() --> this will rotate the pen and updating the image accordingly
call RotateAntenna from your function (e.g. TextChanged), and pass the change angle to RotateAntenna
One key thing is to do a refresh on the image whenever the angle change, this will provide rotate effect.
I suggest making this on a different thread, as not to bogged down your main thread, because usually this data acquisition for the azm/elv/roll will happen continuously.
Down to the code:
Private Function FindPointOnCircle(ByVal originPoint As Point, ByVal radius As Double, ByVal angleDegrees As Double) As Point
Dim x As Double = radius * Math.Cos(Math.PI * angleDegrees / 180.0) + originPoint.X
Dim y As Double = radius * Math.Sin(Math.PI * angleDegrees / 180.0) + originPoint.Y
Return New Point(x, y)
End Function
Private Sub DrawAntenna(ByVal originPoint As Point, ByVal endPoint As Point, ByVal g As Graphics, Optional ByVal aPen As Pen = Nothing)
If aPen Is Nothing Then
Using BluePen = New Pen(Color.Blue)
BluePen.Width = 2
g.DrawLine(BluePen, originPoint.X, originPoint.Y, endPoint.X, endPoint.Y)
End Using
Else
g.DrawLine(aPen, originPoint.X, originPoint.Y, endPoint.X, endPoint.Y)
End If
End Sub
Private Sub RotateAntenna(ByVal ang As Double, ByVal g As Graphics, ByVal typeOfDisplay As Integer)
' Radius of 95% of half the width of the panel
Dim radius As Double = (Me.picDestTop.Width / 2) * 0.95
' Origin half of width and height of panel
Dim origin As New Point(Me.picDestTop.Width / 2, Me.picDestTop.Height / 2)
Select Case typeOfDisplay
Case displayAntenna.DisplayTop
'rotate start at 270deg, pointing up
Dim antennaDegrees As Double = ang + 170
'find point
Dim secondsPoint As Point = FindPointOnCircle(origin, radius, antennaDegrees)
Using p As New Pen(Color.Red)
p.Width = 5
DrawAntenna(origin, secondsPoint, g, p)
End Using
Case displayAntenna.DisplaySide
'display elevation
Case displayAntenna.DisplayRoll
'display pitch
End Select
g.Dispose()
End Sub
'azimuth
Private Sub lblEncCurrent_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lblEncCurrent.TextChanged
Dim iint As Double
Me.picDestTop.Refresh()
iint = CDbl(lblEncCurrent.Text)
If iint >= 360 Then
iint = iint - 360
End If
RotateAntenna(iint, Me.picDestTop.CreateGraphics, displayAntenna.DisplayTop)
End Sub
Hope this help!!. Thanks.
I am creating a DXF parser for use by an industrial robot. The robot can only move in lines and arcs, so I've had to decompose ellipse entities into a series of biarcs (thanks to Keeper for the arc function). The conversion works perfectly, but when I try to draw the arcs as a path on the canvas, some are misaligned.
I know that these arcs are really cotangent as otherwise my contour grouping algorithm would have made them separate paths, so it's definitely a display issue (I've also checked the Startpoints and Endpoints manually and have confirmed this). I've also exported a series of biarcs using the same method but by hand out of SolidWorks and have encountered the same problem.
Here is an image of the output on the form, I've circled where the biarcs are misaligned:
Here is the ellipse conversion code for reference, it simply samples the ellipse segment 2n times, where n is the number of arcs wanted. Then using the 3 point arc function by Keeper it draws arcs for every set of 3 points.
Public Function Ellipse2DToArcs(ByVal CenterPoint As XYZPoint, ByVal MajorRadius As Double, ByVal MinorRadius As Double, ByVal StartAngle As Double, ByVal EndAngle As Double, ByVal OffsetAngle As Double)
Dim PointList As New List(Of XYZPoint)
Dim ArcList As New List(Of ShapeClasses.ArcClass)
For i = StartAngle To EndAngle Step (EndAngle - StartAngle) / (My.Settings.EllipseApprox * 2)
PointList.Add(New XYZPoint With {.X = CenterPoint.X + MajorRadius * Math.Cos(i) * Math.Cos(OffsetAngle) - MinorRadius * Math.Sin(i) * Math.Sin(OffsetAngle), .Y = CenterPoint.Y + MajorRadius * Math.Cos(i) * Math.Sin(OffsetAngle) + MinorRadius * Math.Sin(i) * Math.Cos(OffsetAngle)})
Next
For i As UInteger = 1 To PointList.Count - 2 Step 2
Dim D As Double = 2 * (PointList(i - 1).X - PointList(i + 1).X) * (PointList(i + 1).Y - PointList(i).Y) + 2 * (PointList(i).X - PointList(i + 1).X) * (PointList(i - 1).Y - PointList(i + 1).Y)
Dim M1 As Double = ((PointList(i - 1).X ^ 2) - (PointList(i + 1).X ^ 2) + (PointList(i - 1).Y ^ 2) - (PointList(i + 1).Y ^ 2))
Dim M2 As Double = ((PointList(i + 1).X ^ 2) - (PointList(i).X ^ 2) + (PointList(i + 1).Y ^ 2) - (PointList(i).Y ^ 2))
Dim NX As Double = M1 * (PointList(i + 1).Y - PointList(i).Y) + M2 * (PointList(i + 1).Y - PointList(i - 1).Y)
Dim NY As Double = M1 * (PointList(i).X - PointList(i + 1).X) + M2 * (PointList(i - 1).X - PointList(i + 1).X)
Dim CX As Double = NX / D
Dim CY As Double = NY / D
ArcList.Add(New ShapeClasses.ArcClass With {.Radius = Math.Sqrt((CX - PointList(i + 1).X) ^ 2 + (CY - PointList(i + 1).Y) ^ 2), .CenterPoint = New XYZPoint With {.X = CX, .Y = CY}, .StartPoint = PointList(i - 1), .EndPoint = PointList(i + 1)})
Next
Return ArcList.ToArray
End Function
This is the code that converts the Arc Object to a graphic (it's stored as a startpoint, endpoint, centerpoint and radius):
Public Function Arc2DToDraw(ByVal Arc As ShapeClasses.ArcClass)
'calculate start angle
Dim StartAngle As Single = Math.Atan2(Arc.StartPoint.Y - Arc.CenterPoint.Y, Arc.StartPoint.X - Arc.CenterPoint.X) * (180 / Math.PI)
'calculate end angle
Dim EndAngle As Single = Math.Atan2(Arc.EndPoint.Y - Arc.CenterPoint.Y, Arc.EndPoint.X - Arc.CenterPoint.X) * (180 / Math.PI)
If StartAngle = EndAngle Then 'is a circle
'359.99 is a kludge to prevent a chord forming between 0 and 270 (why I have no idea)
Return {New System.Drawing.Rectangle(Arc.CenterPoint.X - Arc.Radius, Arc.CenterPoint.Y - Arc.Radius, Arc.Radius * 2, Arc.Radius * 2), StartAngle, CSng(359.99)}
Else
Return {New System.Drawing.Rectangle(Arc.CenterPoint.X - Arc.Radius, Arc.CenterPoint.Y - Arc.Radius, Arc.Radius * 2, Arc.Radius * 2), StartAngle, -(StartAngle - EndAngle)}
End If
End Function
Is there a solution to this problem, or is it an inherent display issue?
SOLVED:
The issue was that I was using the integer based Rectangle rather than float based RectangleF which was invoking a narrowing conversion when drawing the arc.
New System.Drawing.Rectangle(Arc.CenterPoint.X - Arc.Radius, Arc.CenterPoint.Y - Arc.Radius, Arc.Radius * 2, Arc.Radius * 2)
Should be changed to:
New System.Drawing.RectangleF(Arc.CenterPoint.X - Arc.Radius, Arc.CenterPoint.Y - Arc.Radius, Arc.Radius * 2, Arc.Radius * 2)