Rhumb-Line Algorithm (VB 6)

'Kenneth Patrick UNCLASSIFIED 06 Jan 1999

Public Const YD_NM As Single = 0.0004937365
Public Const YD_MTRS As Single = 0.9144
Public Const KM_NM As Single = 0.54
Public Const MTRS_YD As Single = 1.094
Public Const MTRS_FT As Single = 3.281
Public Const FT_MTRS As Single = 0.3048
Public Const Pi As Single = 3.1415926535897
Public Const RAD_DGRS As Single = 57.2957795130823
Public Const DGRS_RAD As Single = 0.0174532925199

'32 Bit Sleep Function
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Function fnctn_RHUMB(START_LAT As Single, START_LON As Single, CRS As Single, DST As Single, OUTPUT_FRMT As String) As String

'Author Kenneth Patrick AD&D Inc. UNCLASSIFIED
'fnctn_RHUMB
'Created: 06 Jan 1999
'Last Update 16 Apr 1999
'RHUMB LINE ALGORITHM Mid-Latitude sailing Formula From "Dutton's Navigation and Piloting" Adapted to Code
'Equation: (L = DST X cosCRS) (p = DST X sinCRS) (Dlo = p / cosLM)
'Input: "Start LAT (+NORTH/-SOUTH single),Start LON (+EAST/-WEST single), COURSE in Degree's, DISTANCE in Nautical Miles,OUTPUT FORMAT: String"
'Output Formats: "Lat(+/- Single)", "Lon(+/- Single)", "Lon@Lat", "Lon,Lat"

On Error GoTo errorhandler

Dim L As Single
Dim P As Single
Dim LM As Single
Dim COS_LM As Single
Dim DLO As Single
Dim END_LAT As Single
Dim END_LON As Single

L = (DST / 60) * Cos(CRS / RAD_DGRS) 'L used in the equation to figure END_LAT / DLO
P = (DST / 60) * Sin(CRS / RAD_DGRS) 'P used in the equation to Figure DLO
LM = ((L / 2) + START_LAT) / RAD_DGRS 'DLO (step 1)
COS_LM = Cos(LM) 'DLO (step 2)
DLO = P / COS_LM 'DLO (step 3)
END_LAT = Format(START_LAT + L, "###.##########") ' format the Destination Latitude in decimal degrees

Dim v_LAT As Variant
v_LAT = END_LAT
v_LAT = CDec(v_LAT)

If START_LON < 0 Then 'Added to resolve the positive and negative issue with Longitudes
END_LON = Format(DLO + START_LON, "###.##########") ' format the Destination Longitude in decimal degrees
Else
END_LON = Format(START_LON + DLO, "###.##########") ' format the Destination Longitude in decimal degrees
End If

Dim v_LON As Variant
v_LON = END_LON
v_LON = CDec(v_LON)


Select Case OUTPUT_FRMT 'select output type based on input parameter passed to this function
Case "AT"
fnctn_RHUMB = v_LON & "@" & v_LAT 'output 75.56005@12.22208
Case "COMMA"
fnctn_RHUMB = v_LON & "," & v_LAT 'output 75.56005,12.22208
Case "LON"
fnctn_RHUMB = v_LON 'output 75.56005
Case "LAT"
fnctn_RHUMB = v_LAT 'output 12.22208
Case Else
fnctn_RHUMB = ""

End Select
Exit Function

errorhandler:

If Err.Number > 0 Then
Call LogErr("Errorhandler-FUNCTION functn_RHUMB Error Number: " & Err.Description)
End If

End Function

Read from and write to the Registry (I didn't write this but it's handy) (VB6)

Private Function getRegSetting(ByVal Major_Keyname As String,
ByVal Minor_Keyname As String, ByVal entity_name As String) As String
Try
Dim key As Microsoft.Win32.RegistryKey
Dim key_inst As Microsoft.Win32.RegistryKey
Dim key_val As String
key = Microsoft.Win32.Registry.LocalMachine.OpenSubKey(Major_Keyname, True)
key_inst = key.OpenSubKey(Minor_Keyname, True)
key_val = key_inst.GetValue(entity_name, "")
Return key_val
Catch ex As Exception
Return ""
Finally

End Try

End Function

Private Function setRegSetting(ByVal Major_Keyname As String,
ByVal Minor_Keyname As String, ByVal entity_name As String,
ByVal val_To_set As String) As Boolean
Try
Dim key As Microsoft.Win32.RegistryKey
Dim key_inst As Microsoft.Win32.RegistryKey
key = Microsoft.Win32.Registry.LocalMachine.OpenSubKey(Major_Keyname, True)
key_inst = key.OpenSubKey(Minor_Keyname, True)
key_inst.SetValue(entity_name, val_To_set)
Return True 'value set no casualties
Catch ex As Exception
Return False 'value could not be set
Finally

End Try

End Function

NAVAL Message Line Extraction Function (VB 6)

Public Function fnctn_line_parser(MSGString As String, SRCHString As String, ENDCHAR As String, STARTPOS As Integer) As String

'Author: Kenneth Patrick UNCLASSIFIED 17 September, 1998
'General fnctn to return any formatted line or string from a NAVAL message
'The line is taken verbatim from the message string , work is done on that string by the calling routine

On Error GoTo error_Handler

Dim lMLINE_Start As Long
Dim lMLINE_End As Long
Dim lMLINE_Len As Long
Dim tMLINE_Line As String

lMLINE_Start = InStr(STARTPOS, MSGString, SRCHString) 'Position of the message line within the message string
lMLINE_End = InStr(lMLINE_Start, MSGString, ENDCHAR) 'Find the position of the end of the line by locating the ending charecter
lMLINE_Len = lMLINE_End - lMLINE_Start + 2 'Length of the message line
tMLINE_Line = Mid(MSGString, lMLINE_Start, lMLINE_Len) 'the message line

fnctn_line_parser = tMLINE_Line
Exit function

error_Handler:

If Err.Number > 0 Then
Debug.Print "Errorhandler-fnctn_line_parser Error Number: " & Err.Number & " " & Err.Description
fnctn_line_parser = " " 'return an empty string on an error
End If

End Function

Ellipse function which writes an Arcview Ellipse Polyline string (VB 6)

Public Function fnctn_ELLIPSE(Lat As Single, Lon As Single, Major As Single, Minor As Single, Orient As Single) As String
'
'Author Kenneth Patrick UNCLASSIFIED
'fnctn_ELLIPSE
'Created: 16 may 1998
'Last Update 17 March 1999
'ELLIPSE ALGORITHM - Writes an ARCVIEW Ellipse Polyline Shape String, based on input

On Error GoTo errorhandler

Dim X As Single 'Variable to figure for first X (LON), X is the X offset from the origon of the ELLIPSE
Dim Y As Single 'Variable to figure for first Y (LAT), Y is the Y offset from the origon of the ELLIPSE
Dim New_X As Single 'Variable to figure for NEW X (LON), X is the X offset (USING the Axis Orientation) from the origon
Dim New_Y As Single 'Variable to figure for NEW Y (LAT), Y is the Y offset (USING the Axis Orientation) from the origon
Dim Angle As Integer 'Angle from 1 to 361 used to run in the DO LOOP
Dim CSign_Orient As Single 'COS of the AXIS ORIENTATION (Orient) used to fig NEW_X and NEW_Y
Dim SSign_Orient As Single 'SIN of the AXIS ORIENTATION (Orient) used to fig NEW_X and NEW_Y
Dim Neg_X As Single ' Negative of the X used to figure NEW_Y
Dim New_Script_Str As String 'Holds the New Script calculated with Axis Orientation

Major = Major / 60
Minor = Minor / 60

Angle = 1

'reverse the Orientation, positive numbers rotate the origional axis counterclockwise, I use
'negative numbers to coincide with the clockwise direction of increasing bearings
Orient = -(Orient)

'Main Do loop...overlaps past 360 degrees because ARCVIEW drops the last point whether or not the graphic shape is a complete unit

Do Until Angle >= 370
'Sin the major and Cos the minor
'Figure initial X and Y offset (orientation axis offset) based off of these figured points.
X = Sin(Angle * DGRS_RAD) * Major 'Figure X (Longitude) based off Major Ellipse (.01745 = the radian to angle ratio)
Y = Cos(Angle * DGRS_RAD) * Minor 'Figure Y (Latitude) based off Minor Ellipse (.01745 = the radian to angle ratio)

START_LON = Lon ' utilize the Lon value passed to it...must be a single
START_LAT = Lat ' utilize the Lat value passed to it...must be a single

'Prerequisite figures to perform the NEW_X and NEW_Y
CSign_Orient = Cos(Orient * DGRS_RAD)
SSign_Orient = Sin(Orient * DGRS_RAD)
Neg_X = -(X)

New_X = (X * CSign_Orient) + (Y * SSign_Orient)
New_Y = (Neg_X * SSign_Orient) + (Y * CSign_Orient)
New_X = New_X + START_LAT 'Add the offset to the origon point
New_Y = New_Y + START_LON 'Add the offset to the origon point
Dim My_Y As Variant
My_Y = New_Y
My_Y = CDec(My_Y)

Select Case Angle
Case 1
'First Point for the ELLIPSE script, needs the opening "( {{"
New_Script_Str = "thepolyLine = PolyLine.Make ( {{" & My_Y & "@" & New_X & ","
Case 361
'Last Point for the ELLIPSE script, needs the "}} )"
New_Script_Str = New_Script_Str & My_Y & "@" & New_X & "}} )" 'Format the ARCVIEW SCRIPT using Axis Rotation
Case Else
'The remainder of points get the standard formatting "Lon@Lat,"
New_Script_Str = New_Script_Str & My_Y & "@" & New_X & "," 'Format the ARCVIEW SCRIPT using Axis Rotation

End Select

Angle = Angle + 10 'increment the loop by 10 degrees, clockwise
'Changed 11/15/99
Angle = Angle + 5 'increment the loop by 5 degrees, clockwise

Loop

'Assign the script as the output of this function
fnctn_ELLIPSE = New_Script_Str

errorhandler:

If Err.Number > 0 Then
Debug.Print "Errorhandler-MODULE1.functn_ELLIPSE Error Number: " & Err.Description
End If

End Function