Public Sub DrawOneFix()
''ToDo
''Not ready yet
''03-04-2013
''06-04-2013
''08-04-2013
''09-04-2013
''Only Call this sub after Sub CalcFixes
''Something Like DDF007 R&S
''Divide map in 10 by 10 also 100 squares
''Check Each fix to see if it's on the map
''Then count how many fixes are in each square
''Then draw one dot at the center of the square where the most fixes are
''Const integer
Const t As Integer = 10 ''X and Y division squares
''Integer
Dim arrSquare((t * t) - 1) As Integer ''This array has 100 elements
Dim c As Integer
Dim c1 As Integer
Dim x As Integer
Dim v As Integer
Dim yRow As Integer
Dim xRow As Integer
Dim m As Integer
''Float
Dim Xpixel As Single
Dim Ypixel As Single
Dim xs As Single
Dim ys As Single
''String
Dim myval As String
''Divide map in 10 x 10 squares
''Example squares of map
''Use this one
''00 01 02 03 04 05 06 07 08 09 -xRows
''10 11 12 13 14 15 16 17 18 19
''20 21 22 23 24 25 26 27 28 29
''30 31 32 33 34 35 36 37 38 39
''40 41 42 43 44 45 46 47 48 49
''50 51 52 53 54 55 56 57 58 59
''60 61 62 63 64 65 66 67 68 69
''70 71 72 73 74 75 76 77 78 79
''80 81 82 83 84 85 86 87 88 89
''90 91 92 93 94 95 96 97 98 99
'-yRows
''Count the dots in a squares
''Format arrFixedPixel X and Y fix
xs = CSng(Pict1Width / t)
ys = CSng(Pict1Height / t)
For x = 0 To MaxFixes
If CheckFixOnMap(arrFixedPixel(x, 0), arrFixedPixel(x, 1)) Then ''No fix on map
''Do not round but take integer values
''Find yRow
yRow = CInt((CSng(arrFixedPixel(x, 1)) / ys) + 0.5) ''Value between 0 and 10
yRow = yRow - 1
If yRow < 0 Then yRow = 0 ''Value between 0 and 9
''Find xrow
xRow = CInt((CSng(arrFixedPixel(x, 0)) / xs) + 0.5) ''Value between 0 and 10
xRow = xRow - 1
If xRow < 0 Then xRow = 0 ''Value between 0 and 9
''Create the index here 0 > 99
c = (yRow * t) + xRow
If c <= UBound(arrSquare) Then
''Count here
arrSquare(c) += 1
Else
Debug.Print("Sub DrawOneFix error=" & xRow & "*" & yRow & " = " & c)
End If
End If
Next x
''Find the index count square with most fixes
''What if there is 2 or more the maximums ?
c = 0 ''Must reset c here because it's used
For x = LBound(arrSquare) To UBound(arrSquare)
If arrSquare(x) > c Then
c = x ''Index number where max value is
v = arrSquare(x) ''Max value
End If
Next x
''Nothing found No fixes on map
If c = 0 Then Exit Sub
''Backup Index for drawing amount off fixes in rectangle x
c1 = c
''Search for more then 1 maximum
''Dot is color coral if more then 2 and > 2 color dark red the same maximums.
For x = LBound(arrSquare) To UBound(arrSquare) Step 1
If v > 0 Then
If v = arrSquare(x) Then
m += 1
End If
End If
Next x
''c is the index number of arrSquare
''Extract xRow and yRow from c
myval = c.ToString
If myval.Length < 3 Then
myval = "0" & myval
End If
yRow = CInt(Val((myval.Substring(0, myval.Length - 1))))
xRow = CInt(Val((myval.Substring(myval.Length - 1, 1))))
''Because it goes from 0 to 9
''Make it go from 1 to 10
xRow += 1
yRow += 1
''Take center x and y coordinate of c
''ReCalc xRow and yRow in pixels
Xpixel = CSng((xRow * xs) - (0.5 * xs))
Ypixel = CSng((yRow * ys) - (0.5 * ys))
''Plot the OneFix dot
''Size of circle
v = 6
c = 2 * v
''Object
Dim grp As Graphics
Dim p As Pen
Dim newfont As Font
With My.Forms.Form1
grp = .PictureBox1.CreateGraphics
p = New Pen(Color.Black, 2)
'Debug.Print("Sub DrawOneFix")
'Debug.Print("c=" & arrSquare(c1) & " Field(0>99)=" & c1)
'Debug.Print("m=" & m)
Select Case m
Case 0, 1
grp.FillEllipse(Brushes.Yellow, Xpixel - v, Ypixel - v, c, c)
Case 2
grp.FillEllipse(Brushes.Coral, Xpixel - v, Ypixel - v, c, c)
Case Else
grp.FillEllipse(Brushes.DarkRed, Xpixel - v, Ypixel - v, c, c)
End Select
v = v + 1
c = 2 * v
grp.DrawEllipse(p, Xpixel - v, Ypixel - v, c, c)
''Draw a rectangle around the dot
v = CInt(0.5 * xs)
c = CInt(0.5 * ys)
p = New Pen(Color.Black, 1)
grp.DrawRectangle(p, Xpixel - v, Ypixel - c, xs, ys)
newfont = New Font("sans MS", 8, FontStyle.Bold)
grp.DrawString(arrSquare(c1).ToString & " x", newfont, Brushes.Black, Xpixel - v, Ypixel - c)
End With
p.Dispose()
newfont.Dispose()
grp.Dispose()
End Sub
Public Function MaxTopDetector() As String
''ToDo
''18-04-2013
''19-04-2013
''22-04-2013
''Amplitude peiler
''Find maximum amplitude in SCF
''Try to extract max adjacent max amplitude width
''Average x1 and x2 and recalc to degrees
''Also try to calculate the Q ?
''Not ready yet
''Const Float
Const threshold As Single = 0.3 ''Percentage
''Integer
Dim x As Integer
Dim x1 As Integer
Dim x2 As Integer
Dim max As Long
Dim min As Long
Dim smax As Long
Dim Max1 As Long
Dim Min1 As Long
''String
Dim arrmax As String
Dim myval As String
''Remember
''UboundArrSwitchCap1 Used size
''UboundArrSwitchCap Real size
''Find Max and Min
For x = 0 To UboundArrSwitchCap1
Select Case arrSwitchCap(x)
Case Is > max
max = arrSwitchCap(x)
Case Is < min
min = arrSwitchCap(x)
End Select
Next x
''Could be a spike but not likely because of SCF
If max > Math.Abs(min) Then
smax = 1
ElseIf Math.Abs(min) > max Then
smax = 2
Else
MaxTopDetector = strcEmpty
Debug.Print "Whoops bad directive antenna's or NoSignal"
Exit Function
End If
Max1 = max - (threshold * max)
Min1 = min - (threshold * min)
''Fill threshold level adjacent values arrays
For x = 0 To UboundArrSwitchCap
Select Case arrSwitchCap(x)
Case max, Is > Max1
arrmax = arrmax & "1"
Case min, Is < Min1
arrmax = arrmax & "2"
Case Else
arrmax = arrmax & "0"
End Select
Next x
''Search for max value adjacent in arrmax
Select Case smax
Case 1 ''Pos
For x = Len(arrmax) To 1 Step -1
myval = String(x, "1")
x1 = InStr(1, arrmax, myval)
If x1 > 0 Then
''ArrSwitchCap filter is zero based
''The arrmax is 1 based
x1 = x1 - 1
x2 = x1 + Len(myval)
Exit For
End If
Next x
Call CalcAdjacentTopMax(arrmax, smax, x1, x2)
Case 2 ''Neg
For x = Len(arrmax) To 1 Step -1
myval = String(x, "2")
x1 = InStr(1, arrmax, myval)
If x1 > 0 Then
''ArrSwitchCap filter is zero based
''The arrMax is 1 based
x1 = x1 - 1
x2 = x1 + Len(myval)
Exit For
End If
Next x
Call CalcAdjacentTopMax(arrmax, smax, x1, x2)
End Select
''Average maximum
x = Round((x1 + x2) * 0.5)
''It can be negative if changed by CalcAdjacentTopMax
''If negative add x
If x < 0 Then
x = UboundArrSwitchCap + x
End If
''Calc degrees
MaxTopDetector = Conv3(Str$(x) * ZeroCrossFactor)
End Function
Public Sub CalcAdjacentTopMax(ByVal arrmax As String, ByVal smax As String, ByRef x1 As Integer, ByRef x2 As Integer)
''ToDo
''21-04-2013
''22-04-2013
''Calc MaxTop if it is around 0 degrees
''Only Called from Sub MaxTopDetector
''Integer
Dim x As Integer
Dim x12 As Integer
Dim x22 As Integer
Dim h As Integer
''String
Dim arrmax1 As String
Dim myval As String
''Nothing ToDo
If Left$(arrmax, 1) <> smax And Right$(arrmax, 1) <> smax Then Exit Sub
''Pre add last elements from string arrMax
h = Len(arrmax) \ 4
arrmax1 = Right$(arrmax, h) & Left$(arrmax, h)
For x = Len(arrmax1) To 1 Step -1
myval = String(x, smax)
x12 = InStr(1, arrmax1, myval)
If x12 > 0 Then
''ArrSwitchCap filter is zero based
''The arrmax is 1 based
x12 = x12 - 1
x22 = x12 + Len(myval)
Exit For
End If
Next x
''Change x1 and x2
If (x2 - x1) < (x22 - x12) Then
x1 = x12 - h
x2 = x22 - h
End If
End Sub
Public Function SinCosDetector() As String
''ToDo
''22-04-2013
''25-04-2013
''Runs excellent
''Integer
Dim x As Integer
Dim Y As Integer
''Float
Dim Degrees As Double
Dim SinSum As Double
Dim CosSum As Double
Dim z As Double
''UboundArrSwitchCap Real Size
''UboundArrSwitchCap1 Used Elements
Y = UboundArrSwitchCap + 1
For x = 0 To UboundArrSwitchCap
z = twopi * (x / Y)
SinSum = SinSum + (arrSwitchCap(x) * Math.Sin(z))
CosSum = CosSum + (arrSwitchCap(x) * Math.Cos(z))
Next x
''Now check kwadrant ambiguity
''Nothing there
If SinSum = 0 And CosSum = 0 Then
SinCosDetector = strcEmpty
Exit Function
End If
If CosSum = 0 Then
z = 1000000 ''Must be large ''No division by zero
Else
z = SinSum / CosSum
End If
''Debug.Print SinSum, CosSum, Round(Degrees)
If SinSum = 0 Then SinSum = 0.0000001
''Now SinSum <> 0 and CosSum <> 0
''Sin = y axis
''Cos = x axis
''Atn(y/x) * rad1
''Atn gives from -90 to + 90 degrees * pi/180 (Rad1)
Degrees = Math.Atn(z) * rad1
''Find the right degrees
If SinSum < 0 And CosSum > 0 Then
''0 to 90 = -90 to 0
''Debug.Print "1 " & Degrees & strcDegrees
Degrees = 90 - Math.Abs(Degrees)
GoTo under
End If
If SinSum > 0 And CosSum > 0 Then
'' 90 to 180 = 0 to 90
''Debug.Print "2 " & Degrees & strcDegrees
Degrees = 90 + Degrees
GoTo under
End If
If SinSum < 0 And CosSum < 0 Then
''270 > 360 90 to 0
''Debug.Print "3 " & Degrees & strcDegrees
Degrees = 270 + Degrees
GoTo under
End If
If SinSum > 0 And CosSum < 0 Then
''180 to 270 = -90 to 0
''Debug.Print "4 " & Degrees & strcDegrees
Degrees = 270 + Degrees
GoTo under
End If
Debug.Print "Sub SinCosError " & Time$
under:
''It may not be larger then 360 or lower then 0 degrees
Select Case Degrees
Case Is >= 360
Degrees = Degrees - 360
Case Is < 0
Degrees = 360 - Degrees
End Select
SinCosDetector = Conv3(Str$(Math.Round(Degrees)))
End Function