Public Class Form1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
End Sub
Protected Overrides Sub OnPaint(e As PaintEventArgs)
MyBase.OnPaint(e)
e.Graphics.DrawImage(DrawCompass(175, 2, 80, 1, 80, New Size(200, 200)), New Point(0, 0))
End Sub
Public Function DrawCompass(degree As Double, pitch As Double, maxpitch As Double, tilt As Double, maxtilt As Double, s As Size) As Bitmap
Dim maxRadius As Double = If(s.Width > s.Height, s.Height / 2, s.Width / 2)
Dim sizeMultiplier As Double = maxRadius / 200
Dim relativepitch As Double = pitch / maxpitch
Dim relativetilt As Double = tilt / maxtilt
Dim result As Bitmap = Nothing
Dim drawBrushWhite As New SolidBrush(Color.FromArgb(255, 244, 255))
Dim drawBrushRed As New SolidBrush(Color.FromArgb(240, 255, 0, 0))
Dim drawBrushOrange As New SolidBrush(Color.FromArgb(240, 255, 150, 0))
Dim drawBrushBlue As New SolidBrush(Color.FromArgb(100, 0, 250, 255))
Dim drawBrushWhiteGrey As New SolidBrush(Color.FromArgb(20, 255, 255, 255))
Dim outerradius As Double = (((maxRadius - sizeMultiplier * 60) / maxRadius) * maxRadius)
Dim innerradius As Double = (((maxRadius - sizeMultiplier * 90) / maxRadius) * maxRadius)
Dim degreeRadius As Double = outerradius + 37 * sizeMultiplier
Dim dirRadius As Double = innerradius - 30 * sizeMultiplier
Dim TriRadius As Double = outerradius + 20 * sizeMultiplier
Dim PitchTiltRadius As Double = innerradius * 0.55
If s.Width * s.Height > 0 Then
result = New Bitmap(s.Width, s.Height)
Using font2 As New Font("Arial", CSng(16 * sizeMultiplier))
Using font1 As New Font("Arial", CSng(14 * sizeMultiplier))
Using penblue As New Pen(Color.FromArgb(100, 0, 250, 255), (If(CInt(Math.Truncate(sizeMultiplier)) < 4, 4, CInt(Math.Truncate(sizeMultiplier)))))
Using penorange As New Pen(Color.FromArgb(255, 150, 0), (If(CInt(Math.Truncate(sizeMultiplier)) < 1, 1, CInt(Math.Truncate(sizeMultiplier)))))
Using penred As New Pen(Color.FromArgb(255, 0, 0), (If(CInt(Math.Truncate(sizeMultiplier)) < 1, 1, CInt(Math.Truncate(sizeMultiplier)))))
Using pen1 As New Pen(Color.FromArgb(255, 255, 255), CInt(Math.Truncate(sizeMultiplier * 4)))
Using pen2 As New Pen(Color.FromArgb(255, 255, 255), (If(CInt(Math.Truncate(sizeMultiplier)) < 1, 1, CInt(Math.Truncate(sizeMultiplier)))))
Using pen3 As New Pen(Color.FromArgb(0, 255, 255, 255), (If(CInt(Math.Truncate(sizeMultiplier)) < 1, 1, CInt(Math.Truncate(sizeMultiplier)))))
Using g As Graphics = Graphics.FromImage(result)
' Calculate some image information.
Dim sourcewidth As Double = s.Width
Dim sourceheight As Double = s.Height
Dim xcenterpoint As Integer = CInt(s.Width / 2)
Dim ycenterpoint As Integer = CInt((s.Height / 2))
' maxRadius;
Dim pA1 As New Point(xcenterpoint, ycenterpoint - CInt(Math.Truncate(sizeMultiplier * 45)))
Dim pB1 As New Point(xcenterpoint - CInt(Math.Truncate(sizeMultiplier * 7)), ycenterpoint - CInt(Math.Truncate(sizeMultiplier * 45)))
Dim pC1 As New Point(xcenterpoint, ycenterpoint - CInt(Math.Truncate(sizeMultiplier * 90)))
Dim pB2 As New Point(xcenterpoint + CInt(Math.Truncate(sizeMultiplier * 7)), ycenterpoint - CInt(Math.Truncate(sizeMultiplier * 45)))
Dim a2 As Point() = New Point() {pA1, pB1, pC1}
Dim a3 As Point() = New Point() {pA1, pB2, pC1}
g.DrawPolygon(penred, a2)
g.FillPolygon(drawBrushRed, a2)
g.DrawPolygon(penred, a3)
g.FillPolygon(drawBrushWhite, a3)
Dim Cos As Double() = New Double(359) {}
Dim Sin As Double() = New Double(359) {}
'draw centercross
g.DrawLine(pen2, New Point(CInt(Math.Truncate(xcenterpoint - (PitchTiltRadius - sizeMultiplier * 50))), ycenterpoint), New Point(CInt(Math.Truncate(xcenterpoint + (PitchTiltRadius - sizeMultiplier * 50))), ycenterpoint))
g.DrawLine(pen2, New Point(xcenterpoint, CInt(Math.Truncate(ycenterpoint - (PitchTiltRadius - sizeMultiplier * 50)))), New Point(xcenterpoint, CInt(Math.Truncate(ycenterpoint + (PitchTiltRadius - sizeMultiplier * 50)))))
'draw pitchtiltcross
Dim PitchTiltCenter As New Point(CInt(Math.Truncate(xcenterpoint + PitchTiltRadius * relativetilt)), CInt(Math.Truncate(ycenterpoint - PitchTiltRadius * relativepitch)))
Dim rad As Integer = CInt(Math.Truncate(sizeMultiplier * 8))
Dim rad2 As Integer = CInt(Math.Truncate(sizeMultiplier * 25))
Dim r As New Rectangle(CInt(PitchTiltCenter.X - rad2), CInt(PitchTiltCenter.Y - rad2), CInt(rad2 * 2), CInt(rad2 * 2))
g.DrawEllipse(pen3, r)
g.FillEllipse(drawBrushWhiteGrey, r)
g.DrawLine(penorange, PitchTiltCenter.X - rad, PitchTiltCenter.Y, PitchTiltCenter.X + rad, PitchTiltCenter.Y)
g.DrawLine(penorange, PitchTiltCenter.X, PitchTiltCenter.Y - rad, PitchTiltCenter.X, PitchTiltCenter.Y + rad)
'prep here because need before and after for red triangle.
For d As Integer = 0 To 359
' map[y] = new long[src.Width];
Dim angleInRadians As Double = ((CDbl(d) + 270.0) - degree) / 180.0F * Math.PI
Cos(d) = Math.Cos(angleInRadians)
Sin(d) = Math.Sin(angleInRadians)
Next
For d As Integer = 0 To 359
Dim p1 As New Point(CInt(Math.Truncate(outerradius * Cos(d))) + xcenterpoint, CInt(Math.Truncate(outerradius * Sin(d))) + ycenterpoint)
Dim p2 As New Point(CInt(Math.Truncate(innerradius * Cos(d))) + xcenterpoint, CInt(Math.Truncate(innerradius * Sin(d))) + ycenterpoint)
'Draw Degree labels
If d Mod 30 = 0 Then
g.DrawLine(penblue, p1, p2)
Dim p3 As New Point(CInt(Math.Truncate(degreeRadius * Cos(d))) + xcenterpoint, CInt(Math.Truncate(degreeRadius * Sin(d))) + ycenterpoint)
Dim s1 As SizeF = g.MeasureString(d.ToString(), font1)
p3.X = p3.X - CInt(s1.Width / 2)
p3.Y = p3.Y - CInt(s1.Height / 2)
g.DrawString(d.ToString(), font1, drawBrushWhite, p3)
Dim pA As New Point(CInt(Math.Truncate(TriRadius * Cos(d))) + xcenterpoint, CInt(Math.Truncate(TriRadius * Sin(d))) + ycenterpoint)
Dim width As Integer = CInt(Math.Truncate(sizeMultiplier * 3))
Dim dp As Integer = If(d + width > 359, d + width - 360, d + width)
Dim dm As Integer = If(d - width < 0, d - width + 360, d - width)
Dim pB As New Point(CInt(Math.Truncate((TriRadius - (15 * sizeMultiplier)) * Cos(dm))) + xcenterpoint, CInt(Math.Truncate((TriRadius - (15 * sizeMultiplier)) * Sin(dm))) + ycenterpoint)
Dim pC As New Point(CInt(Math.Truncate((TriRadius - (15 * sizeMultiplier)) * Cos(dp))) + xcenterpoint, CInt(Math.Truncate((TriRadius - (15 * sizeMultiplier)) * Sin(dp))) + ycenterpoint)
Dim p As Pen = penblue
Dim b As Brush = drawBrushBlue
If d = 0 Then
p = penred
b = drawBrushRed
End If
Dim a As Point() = New Point() {pA, pB, pC}
g.DrawPolygon(p, a)
g.FillPolygon(b, a)
ElseIf d Mod 2 = 0 Then
g.DrawLine(pen2, p1, p2)
End If
'draw N,E,S,W
If d Mod 90 = 0 Then
Dim dir As String = (If(d = 0, "N", (If(d = 90, "E", (If(d = 180, "S", "W"))))))
Dim p4 As New Point(CInt(Math.Truncate(dirRadius * Cos(d))) + xcenterpoint, CInt(Math.Truncate(dirRadius * Sin(d))) + ycenterpoint)
Dim s2 As SizeF = g.MeasureString(dir, font1)
p4.X = p4.X - CInt(s2.Width / 2)
p4.Y = p4.Y - CInt(s2.Height / 2)
g.DrawString(dir, font1, If(d = 0, drawBrushRed, drawBrushBlue), p4)
End If
Next
Dim deg As [String] = Math.Round(degree, 2).ToString("0.00") & "°"
Dim s3 As SizeF = g.MeasureString(deg, font1)
g.DrawString(deg, font2, drawBrushOrange, New Point(xcenterpoint - CInt(s3.Width / 2), ycenterpoint - CInt(Math.Truncate(sizeMultiplier * 40))))
End Using
End Using
End Using
End Using
End Using
End Using
End Using
End Using
End Using
End If
Return result
End Function
End Class
