borderAndreaVB free resources for Visual Basic developersborder
borderAndreaVB Visual Basic and VB.NET source code resources - Copyright © 1999-2014 Andrea Tincaniborder

AndreaVB | Forum | News | Downloads | Register | Help | Member List | Statistics | Search | PM | Profile

Print This Topic
Previous Topic (Cut, Copy, and Paste!)Next Topic (Creating An IE Level Browser) New Topic New Poll Post Reply
AndreaVB Forum : VB General : Orthodromic Distance Code
Poster Message
Jonathan_Korvitch
Level: Guest


icon Orthodromic Distance Code

Hello!!

I have a lot of work and i want please if someone may help me and give the complete code in VB6 of the following formula:
It is the formula of the shortest distance between two points of the terrestrial surface.
Supposing a spherical erath model, the formula will be: formula of the ORTHODROMIC DISTANCE BETWEEN TWO POINTS OF TERRESTRIAL SURFACE.

Let the points be: A(lat1, lon1) And B(lat2, lon2)
dlat = lat1 - lat2
dlon = lon1 - lon2
a = sinČ(dlat/2) + cos(lat1).cos(lat2).sinČ(dlon/2)

d(A,B) = 2.R.arctan[square root (a) / square root (1-a)]

Formulas of conversion:
The unit of the co-ordinates is either in degree (°), or in (hour, minute, second), or in (°, '," ).

Conversion degree - > radian: 1° = pi/180 radians

Conversion (hr, min, sec) - > degree: 1 hr = 15°; 1 min = (15/60)°; 1 sec = (15/3600)°

Conversion (dd° mm' ss" ) - > degree: 1' = (1/60)°; 1"= (1/3600)°

For the unit of the distance we have:
the inch (in), the foot (ft), the yard (yd), kilometer (km), the international nautical mile  (Int nmi) and the statute mile (mi).

1 km = E+5/2,54 in;
1 km = E+4/3,048 ft;
1 km = E+4/9,144 yd;
1 km = 1/1.852 Int nmi;
1 km = 1/1,609344 mi

The unit of the distance will be the same one as the earth's mean radius R .

For calculations we will take R = 6371 km exactly.
For better results it is necessary to take in calculation 7 significant figures at least.

Thank you for your assistance!

07-10-2002 at 11:05 AM
| Quote Reply
stickleprojects
Level: Moderator


Registered: 09-09-2002
Posts: 1036
icon Re: Orthodromic Distance Code

Heres the code for the first part, the formula. Paste it into a module in your VB app.
The conversion for the units is unclear, as the formula is in lon/lat.. If you could explain how the units relate to the formula i could assist with the rest.
Hope this helps
Kieron
Option Explicit

Public Type a_pos
    lat As Single
    lng As Single
End Type
Private Const R = 6371  ' radius of earth = 6371 km

Private Function SinSquared(a As Single) As Single
    SinSquared = (Sin(a) * Sin(a))
End Function
Public Function GetSmallestDistance(posA As a_pos, posB As a_pos) As a_pos
    Dim dlat As Single
    Dim dlon As Single
    Dim a As Single
    Dim smallest_distance As Double
    
    dlat = posA.lat - posB.lat
    dlon = posA.lng - posB.lng
    
    a = SinSquared(dlat / 2) + (Cos(posA.lat) * Cos(posB.lat) * SinSquared(dlon / 2))
    
    smallest_distance = 2 * R * Atn(Sqr(a) / Sqr(1 - a))
    
    GetSmallestDistance=smallest_distance
End Function


____________________________
Build it better, faster, quicker, easier.. then fix it (non-offical MS mission statement)

08-10-2002 at 09:03 PM
View Profile Send Email to User Show All Posts | Quote Reply
Jonathan_Korvitch
Level: Guest

icon Re: Orthodromic Distance Code

Hi stickleprojects,

Thanks for your help.

First i want to tell 2 things:
1. If we want to enter the geographic coordinates (Lat/Long) given by a GPS receiver, with 7 significant digits at least dont we have to use Lat/Long as Double instead of single ?

2. The value returned by the function GetSmallestDistance must be as Double and not as a_pos.

Now, listen what i want exactly to do:

I want to create an application with a menu bar so a user can after specifying an item, enter the coordinates manually in another window. Then after he hit a button the values must be scaned and automatically the function GetSmallestDistance must run, return the value of distance and then i want to write (not manually) the information which are Latitude Longitude Distance in a "edges.txt" file in a simple line.

Now we must have two ComboBoxes; one for coordinate units and one for the unit of distance we want.
So, we select the format in which the coordinates are entered, we choose the unit of the corresponding distance and we hit a button so the information are writen in the txt file.

AS for the coordinates units, if they are entered in (hr, min, sec) or in (ddd° mm' ss" ) we must convert them internally to decimal degrees by the formulas of conversion i wrote in the first post.
For example, if the format is (hr, min, sec)
we convert hr, min and sec to degree and then add: (hr in degree + min in degree + sec in degree) to obtain the cooresponding coordinate in degree.
If the format is in (ddd° mm' ss" ); we convert mm to degree, ss to degree and then add: (ddd + mm in dgree + ss in degree) to obtain the corresponding coordinate in degree.

We have also to specifie for each Lat coord the N/S (North/South) direction.
By convension, positive values are for North coord and negative values are for South coord.
For us, we use a ComboBox in which we have N and S.
(0° <= Lat <= 90° for North; -90° <= Lat <= 0° for South).

And,

we have also to indicate the E/W (Est/West) direction for each Lon coord.
by convension, positive values are for Est coord and negative values are for west coord.
Another ComboBox is used with E and W.
(0° <= Lon <= 180° for Est; -180° <= Lon <= 0° for west).

As for the unit od the distance it is very easy, the default one is in km; so we multiply by a constant to convert to the wanted unit.


[Edited by Jonathan_Korvitch on 10-10-2002 at 03:22 PM GMT]

10-10-2002 at 02:53 PM
| Quote Reply
stickleprojects
Level: Moderator


Registered: 09-09-2002
Posts: 1036
icon Re: Orthodromic Distance Code

Hi JK,
1. Apologies, the variable returned by the function was a double, my function specified the return-value incorrectly.
2. I take your point about the singles, just change them to doubles.
3. (the biggie)
I am sorry, but i still do not understand the relationship between the dddmmss and the distiance.
I will forward your question on to a friend who deals with GIS (in the hope that this will provide more assistance).
Kieron

____________________________
Build it better, faster, quicker, easier.. then fix it (non-offical MS mission statement)

10-10-2002 at 08:06 PM
View Profile Send Email to User Show All Posts | Quote Reply
yronium
Level: Moderator


Registered: 14-04-2002
Posts: 776
icon Re: Orthodromic Distance Code

(very good exercise)
Well, I'm humbly trying to build a small program to do that, both in VB and in Excel 2000, just to have a test on it.

I didn't understand the input format of the coordinates, by the user.

If I correctly understood, you need to be able to input them either in decimal degrees (e.g. 43.575°), or in h.m.s (e.g. 18.13.27, or maybe 18 hh, 13 mm, 27 ss), or in divided degrees (e.g. 43°13'38" ). Is it right?

So, if I'm not wrong, in the first case we can input a number and calculate it directly, and in the second and third cases we first must convert the entered value in a number (like the degrees format), and then we can calculate it. Is it this way? Is that you want to obtain? You could select the desired format by a combo, and by it choose the conversion way. Is it that? (If so, it will be a bit hard to make it in Excel).

I have some questions:

Is it possible, or correct, to input a latitude value by an hour?

And more, if I input a longitude by an hour value, can the result be correct? I mean, if I inputed the  Algiers' logitude and the Barcelona's longitude in time format, the time would be the same (Barcelona is directly at the north of Algiers).

And, regarding the final conversion from kilometers, what does it mean the E in the formulas?

Can you confirm, or correct, what I understood? If you help me, I can try it too.

____________________________
Real Programmer can count up to 1024 on his fingers

14-10-2002 at 05:52 PM
View Profile Send Email to User Show All Posts | Quote Reply
Jonathan_Korvitch
Level: Guest

icon Re: Orthodromic Distance Code

quote:
If I correctly understood, you need to be able to input them either in decimal degrees (e.g. 43.575°), or in h.m.s (e.g. 18.13.27, or maybe 18 hh, 13 mm, 27 ss), or in divided degrees (e.g. 43°13'38" ). Is it right?

Yes. Right and a half.
In fact i want that either the user entered them manually or may be read directly from the GPS which is attached to the computer.
quote:
in the first case we can input a number and calculate it directly

No, you must convert them to radians (Sorry, i didn't specify this before)bcs most computers require the arguments of trigonometric functions to be expressed in radians. To convert decimal degrees to radians, multiply the number in degrees by pi/180
quote:
in the second and third cases we first must convert the entered value in a number

in the radians format, and then we calculate it.
In my first post about this topic, i showed the formulas of conversion to degrees. To convert directly to radians, simply multiply each result to degrees by pi/180 OR convert to degrees and the overall result to radians. This is the same.
Idea of that the equation used to convert is in the developped form or in the factorized form. That's all.
quote:
Is it possible, or correct, to input a latitude value by an hour?

The units of the coordinates are mentioned in my first post, if you look you will find yes. In fact i think that most GPS uses (°,'," ) format. But for protection and for all uses i will use the option of (hrs,min,sec).
quote:
And more, if I input a longitude by an hour value, can the result be correct? I mean, if I inputed the  Algiers' logitude and the Barcelona's longitude in time format, the time would be the same (Barcelona is directly at the north of Algiers).

Listen, the (hrs,min,sec) format is in the SENS OF DISTANCE and not real time.
So if the points are distant by 15° then they are distant by an hour. This a convention, WHATEVER THE TIME ZONE IS bcs, as i said, this in sens of distance and not time.The formulas of conversion are in the first post.
quote:
And, regarding the final conversion from kilometers, what does it mean the E in the formulas?

E means exponential, for instance:E-5 = 10^(-5); E+3 = 10^3

Thanks for your assistance!!

[Edited by Jonathan_Korvitch on 15-10-2002 at 12:52 PM GMT]
15-10-2002 at 10:46 AM
| Quote Reply
yronium
Level: Moderator


Registered: 14-04-2002
Posts: 776
icon Re: Orthodromic Distance Code

Ok, it's all clearer now. I apologize, but I am not so deep in degrees formats, so I asked you to confirm.
When I have a math prob to solve, I usually try to solve it by Excel first, but as I said it will be difficult to do.
Just I warn you not to expect a big help from me, and not in an immediate time. I'm testing my strenght, and I assume that yours is further than mine.
I will do my best, and let you know.
Let's keep in touch here anyway.

____________________________
Real Programmer can count up to 1024 on his fingers

17-10-2002 at 10:47 AM
View Profile Send Email to User Show All Posts | Quote Reply
yronium
Level: Moderator


Registered: 14-04-2002
Posts: 776
icon Re: Orthodromic Distance Code

Sorry, another request: can you provide me two known couples of coordinates values (in the three formats) and the known km. distance between them? I'll use them to test the results of my functions.
Thanks in advance.

____________________________
Real Programmer can count up to 1024 on his fingers

17-10-2002 at 11:00 AM
View Profile Send Email to User Show All Posts | Quote Reply
Jonathan_Korvitch
Level: Guest

icon Re: Orthodromic Distance Code

Hi!

As for some references, there is one that could help to compare the results:


www.fai.org/distance_calculation/


This is a self-executing file, enabled by highlighting and double-clicking the file name in Windows Explorer. The calculator does not work if called up in HTML format. For the calculator to operate, Javascript must be enabled. With MS Windows 98 or later and MS Internet Explorer, Javascript is normally enabled by default. For Netscape Navigator, see Options/ Network Preferences/ Languages, for Netscape Communicator see Edit/ References/ Advanced.

They use 6371 km earth's mean radius, and 2 formats from 3; the format is not a main problem as to calculate the distance with accepted error. (Use many significant digits in calculation to reduce the error).
For the separation within an enetered format, i prefer use blanks, you may use comas or semi-colon or semething on your own.

There is also a lot of distance calculators via the Web, you may look in "Google" if you want.

Good time.



[Edited by Jonathan_Korvitch on 17-10-2002 at 02:09 PM GMT]

17-10-2002 at 11:51 AM
| Quote Reply
admin
Level: Administrator


Registered: 04-04-2002
Posts: 531
icon Re: Orthodromic Distance Code

Hi,

what you asked can be coded like this:

Option Explicit

Public Const PI As Double = 3.14159265358979
'For calculations we will take R = 6371 km exactly.
Public Const R_EARTH = 6371

'Conversion (hr, min, sec) - > radian
Public Function ConvertHMS(hr As Integer, min As Integer, sec As Integer) As Double
    ConvertHMS = (hr * 15 + min * (15 / 60) + sec * (15 / 3600)) * (PI / 180)
End Function

'Conversion (dd° mm' ss" ) - > radian
Public Function ConvertDMS(deg As Integer, mm As Integer, ss As Integer) As Double
    ConvertDMS = (deg + mm * (1 / 60) + ss * (1 / 3600)) * (PI / 180)
End Function

Public Function DistanceKM(A_Lat As Double, A_Lon As Double, B_Lat As Double, B_Lon As Double) As Double
    Dim dlat As Double
    Dim dlon As Double
    Dim A As Double
    
    On Error Resume Next
    '    Let the points be: A(lat1, lon1) And B(lat2, lon2)
    'dlat = lat1 - lat2
    'dlon = lon1 - lon2
    dlat = A_Lat - B_Lat
    dlon = A_Lon - B_Lon
    'A = sinČ(dlat / 2) + Cos(lat1).Cos(lat2).sinČ(dlon / 2)
    A = Sin(dlat / 2) * Sin(dlat / 2) + Cos(A_Lat) * Cos(B_Lat) * Sin(dlon / 2) * Sin(dlon / 2)
    'd(A,B) = 2.R.arctan[square root (a) / square root (1-a)]
    DistanceKM = 2 * R_EARTH * Atn(Sqr(A) / Sqr(1 - A))
End Function

Function Calcolo() As Double
    Dim lat1 As Double
    Dim lat2 As Double
    Dim lon1 As Double
    Dim lon2 As Double
    
    lat1 = ConvertHMS(6, 0, 0) '6 hr 0 min 0 sec
    lon1 = ConvertHMS(0, 0, 0) ' 0 hr 0 min 0 sec
    lat2 = ConvertHMS(0, 0, 0)
    lon2 = ConvertHMS(0, 0, 0)
    Calcolo = DistanceKM(lat1, lon1, lat2, lon2)
End Function



I have tested it and seem to get the same results as the web page you suggested (your page requires the data in #deg mm ss# instead of #hr min sec#) ... to do this you can replace the ConvertHMS function with ConvertDMS

hope this helps


[Edited by admin on 17-10-2002 at 02:56 PM GMT]

____________________________
AndreaVB

17-10-2002 at 01:42 PM
View Profile Send Email to User Show All Posts Visit Homepage | Quote Reply
yronium
Level: Moderator


Registered: 14-04-2002
Posts: 776
icon Re: Orthodromic Distance Code

ugh! I did the third fourth of the race...

I almost completed the program, (and it was a little bitch to solve) but regardless at admin's contribution (I know it is a deadly sin, please forgive me, Lord), I made a system that inputs the entire coordinate value in a single text box, not in three. I made this because you said that your program has to receive input by a GPS system, and I don't really know what format it passes you the data. I thought that you may need to trim the coord strings sooner or later, so I did it in the program. Yes, it would be much easier if I could put the input in three different text boxes, as a human could do, for degrees, minutes and seconds (though it wouldn't be good to input a decimal degree value), so you will decide what system to use according with your input system.

So finally my code uses five text boxes (lat1, lon1, lat2, lon2, distance result), six buttons (NS1, EW1, NS2, EW2, calculate the distance, reset values), and two combos (coordinates format, distance units), and an external module Module1, that has the conversion functions in. I used stickleproject's GetSmallestDistace function (thx, stick!), a degrees->radians function, and another that provides a 00 00 00 format (separated by spaces), regardless what separation character is used (".", ":", space, ";", etc.), because I need a space separated format to trim the deg, mins and secs values. It would be simpler if I knew what format the GPS passes the deg, min, sec values, and if I knew what separator would be used....

I went on the site you wrote, and in other ones, and also I downloaded an Excel sheet that does the calculations (did I tell you I like Excel?), but I have some things to say.

- most sites that I visited allow the input using three text boxes for each value, and I thought it was not good for a GPS input;
- Each site provides a different result for the distance. I found first some coordinates in decimal and dms format, and tried in each site to calculate the distance among them, and wrote down the result. I found out that, though the conversion decimal/dms degree provides always the same values, the distance value has been ALWAYS different, as each site used its own personal calculation formula. I even found a site that stands that the mean earth radius is 6378 km, not 6371. I made my code with the formula you provide, but found no confirmations in the calculator sites. Also the formula in the downloaded Excel sheet is different.
- (most important): I never found any hms format value! And I need to know what it is, to set the strings trim functions. And I spoke with a friend that is a pilot. He told me that only the longitude value is specified in hours, when the latitude is usually divided in 90 degrees north and south. But it doesn't matter to us, we can specify any unit even if it's not used. Only, we must consider that hours value must be <24. Just mind it.

And now I need some other help by you: can you give me a sample of the hms format? I mean: it is 17.25.40 ? or 17/25/40 ? or 17:25:40 ? or 17h25m40, or 17hh 25mm 40, ... or what? I must work with strings, so I need to know what character I have to trim out. Don't send me to visit a site, I did it for a whole evening, but I found no referring to hms format. I need to know what format you have to use.

If you want the code and the project, I can e-mail it to you (did you give your e-mail address? and I don't remember if I did...: )).

well, the exit gets closer, keep in touch

____________________________
Real Programmer can count up to 1024 on his fingers

21-10-2002 at 12:57 PM
View Profile Send Email to User Show All Posts | Quote Reply
yronium
Level: Moderator


Registered: 14-04-2002
Posts: 776
icon Re: Orthodromic Distance Code

Sorry, admin, I apologize for the lenght of the last post.

____________________________
Real Programmer can count up to 1024 on his fingers

21-10-2002 at 12:58 PM
View Profile Send Email to User Show All Posts | Quote Reply
admin
Level: Administrator


Registered: 04-04-2002
Posts: 531
icon Re: Re: Orthodromic Distance Code

quote:
yronium wrote:
Sorry, admin, I apologize for the lenght of the last post.


Don't Worry...there's no Problem!! I have to thank you for your contribution to the forum!



Best Regards,
Andrea

____________________________
AndreaVB
21-10-2002 at 02:53 PM
View Profile Send Email to User Show All Posts Visit Homepage | Quote Reply
yronium
Level: Moderator


Registered: 14-04-2002
Posts: 776
icon Re: Orthodromic Distance Code

hey, JK, are you interested in it yet?  

____________________________
Real Programmer can count up to 1024 on his fingers

23-10-2002 at 12:18 PM
View Profile Send Email to User Show All Posts | Quote Reply
Jonathan_Korvitch
Level: Guest

icon Re: Orthodromic Distance Code

Hello yronium and Admin,

Thanks guys for your assistance i appreciate this very much.

Sure i'm interested, this is an important part of my project.

I will answer ASAP, wait for me ...

24-10-2002 at 07:00 AM
| Quote Reply
Jonathan_Korvitch
Level: Guest

icon Re: Orthodromic Distance Code

quote:
So finally my code uses five text boxes (lat1, lon1, lat2, lon2, distance result), six buttons (NS1, EW1, NS2, EW2, calculate the distance, reset values), and two combos (coordinates format, distance units), and an external module Module1, that has the conversion functions in. I used stickleproject's GetSmallestDistace function (thx, stick!), a degrees->radians function, and another that provides a 00 00 00 format (separated by spaces), regardless what separation character is used (".", ":", space, ";", etc.), because I need a space separated format to trim the deg, mins and secs values.
Yes, for the code as plan. Just remeber that the input may be entered manually or directly from the GPS.

quote:
It would be simpler if I knew what format the GPS passes the deg, min, sec values, and if I knew what separator would be used....
I don't know what format the GPS passes the deg, min, sec at the moment. Don't care about this now we may change anything we want in the future. Use blank separator for now.

quote:
I went on the site you wrote, and in other ones, and also I downloaded an Excel sheet that does the calculations (did I tell you I like Excel?)
In addition to the site i gived you, these are another files (including excel files) that could be interesting.

First the excel files:

http://www.anzlic.org.au/icsm/gdatm/gdaexcel.zip

An online application that uses 3D format as input (Longitude, Latitude, Ellipsoidal Height). This is the only 3D routine i'm aware:

http://www.ngs.noaa.gov/cgi-bin/Inv_Fwd/invers3d.prl

The invers3D program for pc (Less practical than the online application). Be careful to enter the ellipsoid height EHT in meter:

ftp://ftp.ngs.noaa.gov/pub/pcsoft/for_inv.3d/invers3d.exe
quote:
- most sites that I visited allow the input using three text boxes for each value, and I thought it was not good for a GPS input;
Just show me now what you do and anything may be upgradeable later.

quote:
- Each site provides a different result for the distance. I found first some coordinates in decimal and dms format, and tried in each site to calculate the distance among them, and wrote down the result. I found out that, though the conversion decimal/dms degree provides always the same values, the distance value has been ALWAYS different, as each site used its own personal calculation formula. I even found a site that stands that the mean earth radius is 6378 km, not 6371. I made my code with the formula you provide, but found no confirmations in the calculator sites. Also the formula in the downloaded Excel sheet is different.
The difference in the value of the distance could be due to the value of R, the significant digits used and rounding error in some constants. What is the relative error between your results and the others ?? Did you calculate it ??

As for the earth's mean radius the 6378 km is not a practical mean radius used for calculation of distance; even though it really has no credibility in scientific circles today, the 6371 km is a better approximation based on the same overall earth volume as the WGS84 ellipsoid.

As for errors tell me what is the relative error that you have made ?

quote:
- (most important): I never found any hms format value! And I need to know what it is, to set the strings trim functions. And I spoke with a friend that is a pilot. He told me that only the longitude value is specified in hours, when the latitude is usually divided in 90 degrees north and south.
I told u what is the format of the hms, it is an option that's it.

quote:
But it doesn't matter to us, we can specify any unit even if it's not used.
VBS

quote:
And now I need some other help by you: can you give me a sample of the hms format? I mean: it is 17.25.40 ? or 17/25/40 ? or 17:25:40 ? or 17h25m40, or 17hh 25mm 40, ... or what? I must work with strings, so I need to know what character I have to trim out. Don't send me to visit a site, I did it for a whole evening, but I found no referring to hms format. I need to know what format you have to use.
Listen don't ever use the dot format because it is used to indicate a decimal number OK!!
So it is not practical to use also it will lead to errors.
Use blanks.

quote:
If you want the code and the project, I can e-mail it to you
To the following address:
jonathan_korvitch@hotmail.com

Waiting for you ...
24-10-2002 at 04:33 PM
| Quote Reply
yronium
Level: Moderator


Registered: 14-04-2002
Posts: 776
icon Re: Orthodromic Distance Code

well, this one only to the followers of our comedy...

I sended my code to JK, and I asked him to verify if it matches his request. If so, I asked him to publish the code here. He was sick, but told me he would asap.

I wrote this just because I noticed that this topic is the most viewed in the forum, so I guess that somebody could be interested on the end of the story.

we'll be back soon

ciao

____________________________
Real Programmer can count up to 1024 on his fingers

30-10-2002 at 12:34 AM
View Profile Send Email to User Show All Posts | Quote Reply
yronium
Level: Moderator


Registered: 14-04-2002
Posts: 776
icon Re: Orthodromic Distance Code

ok, I'm back.
JK said that my code works, so I publish it here. Only, it's a bit long.

I used a form named Form1, with KeyPreview=True, and WindowState=2-Maximized.
in the form there are:
five text boxes, called txtLat1, txtLon1, txtLat2, txtLon2, txtDistance;
two combo boxes, called cboCoordinates and cboUnit, both with the Style property set on 2-Dropdown List;
six command buttons, called btnNS1, btnEW1, btnNS2, btnEW2 (all with no Caption), btnReset, btnCalc;
six labels, with one, named lblUnit, that changes its caption by code.

The project has also a module named Module1.

Here is the complete VB code:

====== Module1 Code ======
Option Explicit

Public Type a_pos
    lat As Double
    lng As Double
End Type

' ====== Constants ============

    ' values
Private Const R = 6371      ' radius of earth = 6371 km
Private Const pi = 3.14159265358979

    ' strings
Private Const STR_COO1 = "decimal degrees"
Private Const STR_COO2 = "h.m.s."
Private Const STR_COO3 = "°,',''"    ' to put a double quote ( " ) here, we must write two single apexes (')
Private Const STR_UNIT1 = "kilometers (km)"
Private Const STR_UNIT2 = "inches (in)"
Private Const STR_UNIT3 = "feet (ft)"
Private Const STR_UNIT4 = "yards (yd)"
Private Const STR_UNIT5 = "nautical miles (nmi)"
Private Const STR_UNIT6 = "statute miles (mi)"

' ====== Public Variables ==========
Public strUnit(5) As String, strCoo(2) As String

' (thanks to stickleproject, at www.andreavb.com)
' This function calculates the smallest distance between two points.
' Each point is defined by a couple of coordinates
Public Function GetSmallestDistance(posA As a_pos, posB As a_pos) As Double
    
    Dim dlat As Double
    Dim dlon As Double
    Dim a As Double
    
    dlat = posA.lat - posB.lat
    dlon = posA.lng - posB.lng
    
    a = Sin(dlat / 2) ^ 2 + (Cos(posA.lat) * Cos(posB.lat) * Sin(dlon / 2) ^ 2)
    
    GetSmallestDistance = 2 * R * Atn(Sqr(a) / Sqr(1 - a))
    
End Function

' This function calculates the radians by a decimal
' degrees measurement
Public Function Radians(deg As Double) As Double

    Radians = deg * pi / 180
    
End Function

' This function convertes the coordinate string, separated by any character
' in the dd mm ss format (separated by spaces)
Public Function Convert(str As String) As String
On Error GoTo Err_Routine

    If str <> "0" Then   ' if the string (a coordinate box) contains a value
        
        str = Trim(str)     ' cuts away any exceeding space in the string
            
        If Asc(Right(str, 1)) = 34 Then
        ' if the string ends now with a double quote ( " ), like 27°23'03"...
            Mid(str, Len(str)) = " "
            Mid(str, Len(str) - 6) = " "
            Mid(str, Len(str) - 3) = " "
        Else
        ' if the string ends now with a space, like 27:23:03, or 27.23.03...
            Mid(str, Len(str) - 5) = " "
            Mid(str, Len(str) - 2) = " "
        End If
    
    Else                ' if the string (a coordinate box) is empty (it WAS empty,
        str = "00 00 00"        ' but the empty value has been converted in a zero,
    End If                      ' within the calling routine)...
    
    ' Note: this function accepts no zero values, because in the calling
    ' sub there are instructions that convert the "" values in zeroes. So
    ' it can't receive any "" argument.
    
Exit_Routine:
    Exit Function

Err_Routine:
    MsgBox Err.Number & " " & Err.Description
    Resume Exit_Routine
    
End Function
    
    ' fills the arrays to be used to populate the combo's lists
Public Sub SetUnits()
    
    ' coordinates combo
    strCoo(0) = STR_COO1
    strCoo(1) = STR_COO2
    strCoo(2) = STR_COO3
    
    ' measurement units combo
    strUnit(0) = STR_UNIT1
    strUnit(1) = STR_UNIT2
    strUnit(2) = STR_UNIT3
    strUnit(3) = STR_UNIT4
    strUnit(4) = STR_UNIT5
    strUnit(5) = STR_UNIT6

End Sub

    ' according to whether measurement unit has been chosen for the distance
    ' calculation, sets the corresponding formula
Public Function SetCalculation(num As Double, unit As Integer) As Double
    
    Static dblCalcFactor(5) As Double

    dblCalcFactor(0) = 1
    dblCalcFactor(1) = 100000 / 2.54
    dblCalcFactor(2) = 10000 / 3.048
    dblCalcFactor(3) = 10000 / 9.144
    dblCalcFactor(4) = 1 / 1.852
    dblCalcFactor(5) = 1 / 1.609344
    
    SetCalculation = num * dblCalcFactor(unit)
    
End Function
====== End of Module1 Code ======

====== Form1 Code ======
Option Explicit

Dim CoordTag As Integer         ' sets whether format the coordinates are entered
Dim DistanceTag As Integer      ' sets whether measurement unit is to be used for the distance result
Dim distance As Double
Dim NS1 As Boolean, EW1 As Boolean, _
    NS2 As Boolean, EW2 As Boolean              ' set the sign of the calculations
      
Dim ctrl As Control                     ' used to clear the textboxes, or to fill them with zeroes
    
' does the distance calculation, after have read the coordinate values
Private Sub btnCalc_Click()
On Error GoTo Err_Routine
    
    Dim StartPos As a_pos, EndPos As a_pos
    Dim strLa1 As String, strLo1 As String, _
        strLa2 As String, strLo2 As String
    Dim la1 As Double, lo1 As Double, _
        la2 As Double, lo2 As Double
    Dim strLa1Arr() As String, strLo1Arr() As String, _
        strLa2Arr() As String, strLo2Arr() As String
    
        ' checks if any text box is empty. If it is, fills it with a zero value.
        ' The distance will be calculated from the 0° earth coordinates
        ' We need this block of code to avoid an "Index not included in
        ' interval" error, if a coord box is empty.
    If txtLat1.Text = "" Then txtLat1.Text = "0"
    If txtLon1.Text = "" Then txtLon1.Text = "0"
    If txtLat2.Text = "" Then txtLat2.Text = "0"
    If txtLon2.Text = "" Then txtLon2.Text = "0"
                    
            ' puts the four strings in four variables
        strLa1 = Me.txtLat1.Text
        strLo1 = Me.txtLon1.Text
        strLa2 = Me.txtLat2.Text
        strLo2 = Me.txtLon2.Text
        
            ' determine whether format are written the coordinates,
            ' and set the calculation variables accordind with each specific format
    Select Case CoordTag
        Case 1      ' decimal degrees format
            la1 = Val(strLa1)
            lo1 = Val(strLo1)
            la2 = Val(strLa2)
            lo2 = Val(strLo2)
        Case 2      ' hours, minutes, seconds format
            Convert strLa1
                strLa1Arr() = Split(strLa1, , -1)
                la1 = CDbl(strLa1Arr(0)) * 15 + CDbl(strLa1Arr(1)) * 15 / 60 + CDbl(strLa1Arr(2)) * 15 / 3600
            Convert strLo1
                strLo1Arr() = Split(strLo1, , -1)
                lo1 = CDbl(strLo1Arr(0)) * 15 + CDbl(strLo1Arr(1)) * 15 / 60 + CDbl(strLo1Arr(2)) * 15 / 3600
            Convert strLa2
                strLa2Arr() = Split(strLa2, , -1)
                la2 = CDbl(strLa2Arr(0)) * 15 + CDbl(strLa2Arr(1)) * 15 / 60 + CDbl(strLa2Arr(2)) * 15 / 3600
            Convert strLo2
                strLo2Arr() = Split(strLo2, , -1)
                lo2 = CDbl(strLo2Arr(0)) * 15 + CDbl(strLo2Arr(1)) * 15 / 60 + CDbl(strLo2Arr(2)) * 15 / 3600
        Case 3      ' degrees, minutes, seconds format
            Convert strLa1
                strLa1Arr() = Split(strLa1, , -1)
                la1 = CDbl(strLa1Arr(0)) + CDbl(strLa1Arr(1)) / 60 + CDbl(strLa1Arr(2)) / 3600
            Convert strLo1
                strLo1Arr() = Split(strLo1, , -1)
                lo1 = CDbl(strLo1Arr(0)) + CDbl(strLo1Arr(1)) / 60 + CDbl(strLo1Arr(2)) / 3600
            Convert strLa2
                strLa2Arr() = Split(strLa2, , -1)
                la2 = CDbl(strLa2Arr(0)) + CDbl(strLa2Arr(1)) / 60 + CDbl(strLa2Arr(2)) / 3600
            Convert strLo2
                strLo2Arr() = Split(strLo2, , -1)
                lo2 = CDbl(strLo2Arr(0)) + CDbl(strLo2Arr(1)) / 60 + CDbl(strLo2Arr(2)) / 3600
    End Select
                
        ' set the appropriate NS and EW calculation
    If Not NS1 Then la1 = -la1
    If Not EW1 Then lo1 = -lo1
    If Not NS2 Then la2 = -la2
    If Not EW2 Then lo2 = -lo2
            
        ' converts the coordinates in radians
    StartPos.lat = Radians(la1)
    StartPos.lng = Radians(lo1)
    EndPos.lat = Radians(la2)
    EndPos.lng = Radians(lo2)
    
        ' calculates the distance
    distance = GetSmallestDistance(StartPos, EndPos)
    Me.txtDistance.Text = SetCalculation(distance, DistanceTag - 1)
    
Exit_Routine:
    Exit Sub

Err_Routine:
    MsgBox Err.Number & " " & Err.Description
    Resume Exit_Routine
    
End Sub

' first East/West button
Private Sub btnEW1_Click()

    If EW1 Then
        EW1 = False
        btnEW1.Caption = "W"
    Else
        EW1 = True
        btnEW1.Caption = "E"
    End If
    
End Sub

' switch the button caption and the tag value by hitting the E and W keys
' (it works also by hitting the spacebar)
Private Sub btnEW1_KeyDown(KeyCode As Integer, Shift As Integer)
    
    If KeyCode = vbKeyE Or KeyCode = vbKeyW Then btnEW1_Click
    
End Sub

' second East/West button
Private Sub btnEW2_Click()
    
    If EW2 Then
        EW2 = False
        btnEW2.Caption = "W"
    Else
        EW2 = True
        btnEW2.Caption = "E"
    End If
    
End Sub

' switch the button caption and the tag value by hitting the E and W keys
' (it works also by hitting the spacebar)
Private Sub btnEW2_KeyDown(KeyCode As Integer, Shift As Integer)
    
    If KeyCode = vbKeyE Or KeyCode = vbKeyW Then btnEW2_Click
    
End Sub

' first North/South button
Private Sub btnNS1_Click()
    
    If NS1 Then
        NS1 = False
        btnNS1.Caption = "S"
    Else
        NS1 = True
        btnNS1.Caption = "N"
    End If
    
End Sub

' switch the button caption and the tag value by hitting the N and S keys
' (it works also by hitting the spacebar)
Private Sub btnNS1_KeyDown(KeyCode As Integer, Shift As Integer)
    
    If KeyCode = vbKeyN Or KeyCode = vbKeyS Then btnNS1_Click
    
End Sub

' second North/South button
Private Sub btnNS2_Click()
    
    If NS2 Then
        NS2 = False
        btnNS2.Caption = "S"
    Else
        NS2 = True
        btnNS2.Caption = "N"
    End If
    
End Sub

' switch the button caption and the tag value by hitting the N and S keys
' (it works also by hitting the spacebar)
Private Sub btnNS2_KeyDown(KeyCode As Integer, Shift As Integer)
    
    If KeyCode = vbKeyN Or KeyCode = vbKeyS Then btnNS2_Click
    
End Sub
    
    ' resets the form
Private Sub btnReset_Click()

    ' clears all text boxes in Form1
    For Each ctrl In Me.Controls
        If TypeOf ctrl Is TextBox Then ctrl.Text = ""
    Next ctrl
    
        ' sets the captions for the NS and EW buttons
    btnNS1.Caption = "N"
    btnEW1.Caption = "E"
    btnNS2.Caption = "N"
    btnEW2.Caption = "E"
    
        ' put the pointer in the first text box
    Me.txtLat1.SetFocus
    
End Sub

    ' sets the coordinate's format unit
Private Sub cboCoordinates_Click()
    
    ' sets the tag to use the appropriate coordinates reading method
    CoordTag = Me.cboCoordinates.ListIndex + 1

End Sub

    ' sets the distance measurement unit
Private Sub cboUnit_Click()

        ' sets the tag to use the appropriate calculation formula
    DistanceTag = Me.cboUnit.ListIndex + 1
    
    ' updates an existing value in the distance box
    If txtDistance.Text <> "" Then
        Me.txtDistance.Text = SetCalculation(distance, DistanceTag - 1)
    End If
    
    ' updates the measurement unit label
    Me.lblUnit.Caption = strUnit(DistanceTag - 1)
    
End Sub

Private Sub Form_Load()
    
    Dim IndCoo As Integer, IndDist As Integer
        
        ' clears all textboxes in Form1
    For Each ctrl In Me.Controls
        If TypeOf ctrl Is TextBox Then ctrl.Text = ""
    Next ctrl
        
        ' fills the lists of the combos
    SetUnits    ' loads the strings arrays
    
    For IndCoo = 0 To 2
        Me.cboCoordinates.List(IndCoo) = strCoo(IndCoo)
    Next IndCoo
    For IndDist = 0 To 5
        Me.cboUnit.List(IndDist) = strUnit(IndDist)
    Next IndDist
    
    '  sets the default values of the combos
    Me.cboCoordinates.Text = Me.cboCoordinates.List(0)
    Me.cboUnit.Text = Me.cboUnit.List(0)
        
        ' tags for coordinates format, measurement units and directions
    CoordTag = 1
    DistanceTag = 1
    NS1 = True
    EW1 = True
    NS2 = True
    EW2 = True
    
        ' sets the captions for the NS and EW buttons, and for the unit label
    btnNS1.Caption = "N"
    btnEW1.Caption = "E"
    btnNS2.Caption = "N"
    btnEW2.Caption = "E"
    Me.lblUnit.Caption = Me.cboUnit.Text

End Sub


====== End of Form1 Code ======

If anybody has any suggestion for improvement, we are here waiting.

Thank you all, and thanks to Admin for hosting. I think this is one of the best made and more useful sites on the web.  

____________________________
Real Programmer can count up to 1024 on his fingers

03-11-2002 at 11:05 PM
View Profile Send Email to User Show All Posts | Quote Reply
AndreaVB Forum : VB General : Orthodromic Distance Code
Previous Topic (Cut, Copy, and Paste!)Next Topic (Creating An IE Level Browser) New Topic New Poll Post Reply
Surf To:


Not Logged In? Username: Password: Lost your password?
borderAndreaVB free resources for Visual Basic developersborder
borderAndreaVB Visual Basic and VB.NET source code resources - Copyright © 1999-2014 Andrea Tincaniborder