How to sort multidimensional arrays through a function - vb.net

I'm having some trouble in vb.net 2012 with sorting multidimensional arrays, I tried to make a custom sorting algorithm to sort the coordinates via the z axis, so that a four sided polygon can be drawn. This is so that the shape can be drawn in order like a z index in css
(also how do you add a thing to the array so that you can define the polygon colour)
'there's nothing here in the x and y sections right now
Dim G_ObjList(,,) As Double = {
{{0, 0, 1}, {0, 0, 0.75}, {0, 0, 0.75}, {0, 0, 0.95}},
{{0, 0, 1}, {0, 0, 0.75}, {0, 0, 0.75}, {0, 0, 0.95}},
{{0, 0, 1}, {0, 0, 0.75}, {0, 0, 0.75}, {0, 0, 0.95}},
{{0, 0, 1}, {0, 0, 0.75}, {0, 0, 0.75}, {0, 0, 0.95}},
{{0, 0, 0.75}, {0, 0, 0.75}, {0, 0, 0.75}, {0, 0, 0.75}}
}
Function p3DOrder(ByVal a(,,) As Double, ByVal p As Point)
'0 is point
'1 is depth
'2 is distance to p after being translated to p3d (probably only to be used here, but just in case for anyother use)
'a(depth/point, infopoint
'create new jagged array (not jagged array anymore)
Dim avDP(2, a.GetLength(0) - 1)
'sorts data into new jagged array
For i = 0 To (a.GetLength(0) - 1)
'calculate averages and set array
avDP(2, i) = (Math.Sqrt((a(i, 0, 0) - p.X) ^ 2 + (a(i, 0, 1) - p.Y) ^ 2) + Math.Sqrt((a(i, 1, 0) - p.X) ^ 2 + (a(i, 1, 1) - p.Y) ^ 2) + Math.Sqrt((a(i, 2, 0) - p.X) ^ 2 + (a(i, 2, 1) - p.Y) ^ 2) + Math.Sqrt((a(i, 3, 0) - p.X) ^ 2 + (a(i, 3, 1) - p.Y) ^ 2)) / 4 'calculate distance to main perspective point
avDP(1, i) = (a(i, 0, 2) + a(i, 1, 2) + a(i, 2, 2) + a(i, 3, 2)) / 4 'set depth side by side with distance calculated
avDP(0, i) = {New Point(a(i, 0, 0), a(i, 0, 1)), New Point(a(i, 1, 0), a(i, 1, 1)), New Point(a(i, 2, 0), a(i, 2, 1)), New Point(a(i, 3, 0), a(i, 3, 1))}
'have to keep the varibles in this way to prevent separation between data pairs
'sort jagged array
If i <= a.GetLength(0) - 2 Then
If (avDP(1, i) > avDP(1, i + 1)) Then
'test switch program
Dim _tm0() = {avDP(0, i), avDP(1, i), avDP(2, i)} 'temporary stores data to switch
Dim _tm1() = {avDP(0, i + 1), avDP(1, i + 1), avDP(2, i + 1)}
avDP(0, i) = _tm1(0) 'switch around array data
avDP(1, i) = _tm1(1)
avDP(2, i) = _tm1(2)
avDP(0, i + 1) = _tm0(0)
avDP(1, i + 1) = _tm0(1)
avDP(2, i + 1) = _tm0(2)
Dim _tmbStep As Integer = 0
Do While (avDP(1, i - _tmbStep) > avDP(1, i + 1 - _tmbStep)) 'step back if true
Dim _tm2() = {avDP(0, i - _tmbStep), avDP(1, i - _tmbStep), avDP(2, i - _tmbStep)} 'temporary stores data to switch
Dim _tm3() = {avDP(0, i + 1 - _tmbStep), avDP(1, i + 1 - _tmbStep), avDP(2, i + 1 - _tmbStep)}
avDP(0, i - _tmbStep) = _tm3(0) 'switch around array data
avDP(1, i - _tmbStep) = _tm3(1)
avDP(2, i - _tmbStep) = _tm3(2)
avDP(0, i + 1 - _tmbStep) = _tm2(0)
avDP(1, i + 1 - _tmbStep) = _tm2(1)
avDP(2, i + 1 - _tmbStep) = _tm2(2)
_tmbStep += 1 ' continue step back
If (i - _tmbStep < 0) Then 'stops error
Exit Do
End If
Loop
End If
End If
Next
'return resorted array
Return avDP
End Function
Me.Canvas.Image = New Bitmap(Me.Canvas.Width, Me.Canvas.Height, System.Drawing.Imaging.PixelFormat.Format24bppRgb)
Using g As Graphics = Graphics.FromImage(Me.Canvas.Image)
Dim mainPP = New Point(Me.Canvas.ClientRectangle.Width / 2, Me.Canvas.ClientRectangle.Height / 2)
For i = 0 To (G_ObjList.GetLength(0) - 1)
Dim _tmpy() As Point = {
p3d(G_ObjList(i, 0, 0), G_ObjList(i, 0, 1), G_ObjList(i, 0, 2), mainPP),
p3d(G_ObjList(i, 1, 0), G_ObjList(i, 1, 1), G_ObjList(i, 1, 2), mainPP),
p3d(G_ObjList(i, 2, 0), G_ObjList(i, 2, 1), G_ObjList(i, 2, 2), mainPP),
p3d(G_ObjList(i, 3, 0), G_ObjList(i, 3, 1), G_ObjList(i, 3, 2), mainPP)
}
Dim br As New SolidBrush(Color.FromArgb(255, G_ObjList(i, 0, 0) * 0.3, G_ObjList(i, 0, 0) * 0.3, G_ObjList(i, 0, 0) * 0.3))
g.FillPolygon(br, _tmpy)
Next
end using
'be aware that this isn't all the code

Related

Drawing letters in excel

Is there a plugin that helps generate letters (A-Z) in excel as seen below? Or can we write some sort of VBA script to do this?
Stackoverflow is not a code-for-me service. Anyhow, the task looked interesting, and I have decided to code something about it:
Option Explicit
Public Sub WriteLetterA()
Dim varLetterA(8) As Variant
Dim lngColCounter As Long
Dim lngRowCounter As Long
Dim blnReverse As Boolean
Dim rngCell As Range
blnReverse = True
varLetterA(0) = Array(1, 1, 1, 0, 0, 1, 1, 1)
varLetterA(1) = Array(1, 0, 0, 0, 0, 0, 0, 1)
varLetterA(2) = Array(1, 0, 0, 1, 1, 0, 0, 1)
varLetterA(3) = Array(1, 0, 0, 1, 1, 0, 0, 1)
varLetterA(4) = Array(0, 0, 0, 1, 1, 0, 0, 0)
varLetterA(5) = Array(0, 0, 0, 0, 0, 0, 0, 0)
varLetterA(6) = Array(0, 0, 0, 0, 0, 0, 0, 0)
varLetterA(7) = Array(0, 0, 1, 1, 1, 1, 0, 0)
varLetterA(8) = Array(0, 0, 1, 1, 1, 1, 0, 0)
Cells(1, 1).Select
For lngRowCounter = 0 To UBound(varLetterA)
For lngColCounter = 0 To UBound(varLetterA(lngRowCounter))
Set rngCell = Cells(lngRowCounter + 1, lngColCounter + 1)
If varLetterA(lngRowCounter)(lngColCounter) Then
rngCell.Interior.Color = IIf(blnReverse, vbBlack, vbWhite)
Else
rngCell.Interior.Color = IIf(blnReverse, vbWhite, vbBlack)
End If
Next lngColCounter
Next lngRowCounter
End Sub
' Points for improvement - varLetterA in a separate class
' Refer to the sheet, do not assume it
' Pass the first cell as a reference
This is what you get:
blnReverse = False
blnReverse = True
Take a look at the points for improvement - they can be useful, if you decide to build the rest of the alphabet. Good luck.

UID Validation - Verhoeff's Algorithm

I am using MS Access & SQL.
I wish to validate 0.1 Mn UID Numbers (Aadhar Cards) for their authenticity.
The UID is based on Verhoeff's Algorithm.
I did find some queries online. They pertained to C++/Java.
Is there a query which validates 0.1 Mn in MS Access for SQL?
As mentioned by Gord Thempson in the comments, you can find the VBA (and many more implementation on the Wikipedia page
For the sake of completeness,
''' <summary>
''' For more information cf. http://en.wikipedia.org/wiki/Verhoeff_algorithm
''' Dihedral Group: http://mathworld.wolfram.com/DihedralGroup.html
''' You can use this code in Excel, Access, etc...
''' </summary>
''' <remarks></remarks>
'The multiplication table
Dim d(0 To 9) As Variant
'The permutation table
Dim p(0 To 8) As Variant
'The inverse table
Dim inv(0 To 9) As Integer
Private Sub initVerhoeffConsts()
If IsArray(d(0)) Then Exit Sub 'Shortcut if already initiated
d(0) = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9)
d(1) = Array(1, 2, 3, 4, 0, 6, 7, 8, 9, 5)
d(2) = Array(2, 3, 4, 0, 1, 7, 8, 9, 5, 6)
d(3) = Array(3, 4, 0, 1, 2, 8, 9, 5, 6, 7)
d(4) = Array(4, 0, 1, 2, 3, 9, 5, 6, 7, 8)
d(5) = Array(5, 9, 8, 7, 6, 0, 4, 3, 2, 1)
d(6) = Array(6, 5, 9, 8, 7, 1, 0, 4, 3, 2)
d(7) = Array(7, 6, 5, 9, 8, 2, 1, 0, 4, 3)
d(8) = Array(8, 7, 6, 5, 9, 3, 2, 1, 0, 4)
d(9) = Array(9, 8, 7, 6, 5, 4, 3, 2, 1, 0)
p(0) = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9)
p(1) = Array(1, 5, 7, 6, 2, 8, 3, 0, 9, 4)
p(2) = Array(5, 8, 0, 3, 7, 9, 6, 1, 4, 2)
p(3) = Array(8, 9, 1, 6, 0, 4, 3, 5, 2, 7)
p(4) = Array(9, 4, 5, 3, 1, 2, 6, 8, 7, 0)
p(5) = Array(4, 2, 8, 6, 5, 7, 3, 9, 0, 1)
p(6) = Array(2, 7, 9, 3, 8, 0, 6, 4, 1, 5)
p(7) = Array(7, 0, 4, 6, 9, 1, 3, 2, 5, 8)
inv(0) = 0: inv(1) = 4: inv(2) = 3: inv(3) = 2: inv(4) = 1
inv(5) = 5: inv(6) = 6: inv(7) = 7: inv(8) = 8: inv(9) = 9
End Sub
''' <summary>
''' Validates that an entered number is Verhoeff compliant.
''' </summary>
''' <param name="num"></param>
''' <returns>True if Verhoeff compliant, otherwise false</returns>
''' <remarks>Make sure the check digit is the last one!</remarks>
Public Function validateVerhoeff(ByVal num As String) As Boolean
initVerhoeffConsts
Dim c As Integer
Dim i As Integer
c = 0
Dim myArray() As Integer
myArray = StringToReversedIntArray(num)
For i = 0 To UBound(myArray)
c = d(c)(p((i Mod 8))(myArray(i))) 'Version corrected by WHG gives error
Next i
validateVerhoeff = (c = 0)
End Function
''' <summary>
''' For a given number generates a Verhoeff digit
''' </summary>
''' <param name="num"></param>
''' <returns>Verhoeff check digit as Integer</returns>
''' <remarks>Append this check digit to num</remarks>
Public Function generateVerhoeff(ByVal num As String) As Integer
initVerhoeffConsts
Dim c As Integer
Dim i As Integer
c = 0
Dim myArray() As Integer
myArray = StringToReversedIntArray(num)
For i = 0 To UBound(myArray)
c = d(c)(p((i + 1) Mod 8)(myArray(i))) 'Version corrected by WHG gives error in compilation
Next i
generateVerhoeff = inv(c) 'str(inv(c))
End Function
''' <summary>
''' Converts a string to a reversed integer array.
''' </summary>
''' <param name="str"></param>
''' <returns>Reversed integer array</returns>
''' <remarks></remarks>
Private Function StringToReversedIntArray(ByVal str As String) As Integer()
Dim lg As Integer
lg = Len(str)
Dim myArray() As Integer
ReDim myArray(0 To lg - 1)
Dim i As Integer
For i = 0 To lg - 1
myArray(i) = AscW(Mid$(str, lg - i, 1)) - AscW("0")
Next
StringToReversedIntArray = myArray
End Function
''' In Excel don't copy this sub _AssertsVerhoeff()as get a compilation error. 4/21/2013
Public Sub _AssertsVerhoeff()
Debug.Print "Start Verhoeff's Asserts"
Debug.Assert generateVerhoeff("75872") = 2
Debug.Assert validateVerhoeff("758722") = True
Debug.Assert generateVerhoeff("12345") = 1
Debug.Assert validateVerhoeff("123451") = True
Debug.Assert generateVerhoeff("142857") = 0
Debug.Assert validateVerhoeff("1428570") = True
Debug.Assert generateVerhoeff("123456789012") = 0
Debug.Assert validateVerhoeff("1234567890120") = True
Debug.Assert generateVerhoeff("8473643095483728456789") = 2
Debug.Assert validateVerhoeff("84736430954837284567892") = True
Debug.Assert generateVerhoeff("12345") = 1
Debug.Assert validateVerhoeff("123451") = True
Debug.Assert validateVerhoeff("124351") = False
Debug.Assert validateVerhoeff("122451") = False
Debug.Assert validateVerhoeff("128451") = False
Debug.Assert validateVerhoeff("214315") = False
Debug.Print "End Verhoeff's Asserts"
End Sub

Easiest way to generate random array from {1,-1} with predefined mean value in Numpy?

What is the best way in numpy to generate a random array with n values of the form
arr = [1,-1,-1,1,1,1,...]
that average out as close as possible to a predefined value m, so that
print 1/n*np.sum(arr)
>>> #value that is as close as possible to m
I have been experimenting with
numpy.random.choice([-1,1], size=n)
but can't seem to find a solution.
You can optionally enter probabilities values for each element in the array you pass to random.choice. In this case your average or expected value is p - q where p is probability of a positive one and q the probability of a negative. Note that this is independent of n. If you set the probability of a positive one to p then the probability of a negative one is 1 - p. You can then solve 2p - 1 = m to get the p-value you want for a given m.
For example, for your average m to be .4 you would pass [.7, .3] as the probabilities:
numpy.random.choice([1, -1], n, p=[.7, .3])
Here's an example:
In [25]:
n = 1e6
m = .4
p = (m + 1) / 2
np.random.choice([1, -1], n, p=[p, 1-p]).sum() / n
Out[25]:
0.39873799999999998
First, recognize that for a fixed n, you can't (in general) choose the array whose mean is exactly an arbitrary value m. I'll assume that either you are choosing m for which a solution is possible, or you are OK getting something close to the given mean.
The mean of n1 1s and n2 -1s is (n1 - n2) / n where n = n1 + n2. So you want m = (n1 - n2) / n = (n1 - (n - n1)) / n = (2*n1 - n) / n = 2*n1/n - 1. This gives n1 = (m + 1)*n/2 (which works for -1 <= m <= 1). So you can create an array with n1 1s and n - n1 -1s, and then randomize that array.
For example, suppose n is 100, and the desired mean is 0.8:
In [35]: n = 100
In [36]: m = 0.8
Compute the number of positive 1s:
In [37]: n1 = int(round((m + 1) * n / 2.0)) # rounded to the nearest int
Create the array of 1s and -1s:
In [38]: x = np.ones(n, dtype=int)
In [39]: x[:n-n1] = -1
Shuffle it:
In [40]: np.random.shuffle(x)
In [41]: x
Out[41]:
array([ 1, -1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, -1, 1,
1, 1, 1, -1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, -1, 1, 1,
-1, 1, 1, 1, -1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, -1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, -1, 1, 1,
-1, 1, 1, 1, 1, 1, 1, 1, 1, 1, -1, 1, 1, 1, 1])
In [42]: x.mean()
Out[42]: 0.80000000000000004

GUI doesn't move accordingly

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.

Macro returns #REF! in excel

I don't know if this is the place to ask such a question, but since it was regarding some VBA scripting, I thought it might.
I have been writing this Macro function:
Function Mod10(tl As String) As Byte
Dim c(13) As Integer
Dim er As Integer
c(13) = Mid(tl, 14, 1) * 2
c(12) = Mid(tl, 13, 1)
c(11) = Mid(tl, 12, 1) * 2
c(10) = Mid(tl, 11, 1)
c(9) = Mid(tl, 10, 1) * 2
c(8) = Mid(tl, 9, 1)
c(7) = Mid(tl, 8, 1) * 2
c(6) = Mid(tl, 7, 1)
c(5) = Mid(tl, 6, 1) * 2
c(4) = Mid(tl, 5, 1)
c(3) = Mid(tl, 4, 1) * 2
c(2) = Mid(tl, 3, 1)
c(1) = Mid(tl, 2, 1) * 2
c(0) = Mid(tl, 1, 1)
For i = 0 To 13
If c(i) > 9 Then
c(i) = CInt(Left(c(i), 1)) + CInt(Right(c(i), 1))
End If
Next
er = 0
For i = 0 To 13
er = er + c(i)
Next
Mod10 = 10 - er Mod 10
End Function
But as you can see here in this picture:
it returns an error saying #REF!. i am writing this in the fx: =Mod10(a1).
The script is found here: http://kronsell.net/fikkontrol.htm (a danish site)
It is used to calculate the final digit to a string. A bit like when calculating the EAN-13 code, just another kind of calculation.
If anybody with VBA or EXCEL knowledge could tell me what to do, I'd really appreciate it.
Not sure why, but it looks like Mod10 is a reserved keyword. I tried renaming the function to Mod_10 and it worked.
You may need to declare some variables if you hold Option Explicit at the top of your module.
Try this and call it from a cell with =MOD_10(A1)
Function MOD_10(tl As String) As Byte
Dim i As Long
Dim c(13) As Integer
Dim er As Integer
c(13) = Mid(tl, 14, 1) * 2
c(12) = Mid(tl, 13, 1)
c(11) = Mid(tl, 12, 1) * 2
c(10) = Mid(tl, 11, 1)
c(9) = Mid(tl, 10, 1) * 2
c(8) = Mid(tl, 9, 1)
c(7) = Mid(tl, 8, 1) * 2
c(6) = Mid(tl, 7, 1)
c(5) = Mid(tl, 6, 1) * 2
c(4) = Mid(tl, 5, 1)
c(3) = Mid(tl, 4, 1) * 2
c(2) = Mid(tl, 3, 1)
c(1) = Mid(tl, 2, 1) * 2
c(0) = Mid(tl, 1, 1)
For i = 0 To 13
If c(i) > 9 Then
c(i) = CInt(Left(c(i), 1)) + CInt(Right(c(i), 1))
End If
Next
er = 0
For i = 0 To 13
er = er + c(i)
Next
MOD_10 = 10 - er Mod 10
End Function