Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

Видеокурс программиста и крэкера 5D 2O17
(актуальность: август 2O17)
Свежие инструменты, новые видеоуроки!

  • 400+ видеоуроков
  • 800 инструментов
  • 100+ свежих книг и статей

УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

БОЛЬШОЙ FAQ ПО DELPHI



Как вычислить расстояние, имея широту и долготу

Ни что так не пугает мир. Как всем известный Дядя Билл!

Попробуйте следующий код. Я им пользуюсь продолжительное время.

Входные данные:

  • StartLat (начальная широта) = Градусы и сотые доли
  • StartLong (начальная долгота) = Градусы и сотые доли
  • EndLat (конечная широта) = Градусы и сотые доли
  • EndLong (конечная долгота) = Градусы и сотые доли

Выходные данные:

  • Distance (расстояние) = Расстояние в метрах
  • Bearing (смещение) = Смещение в градусах

Не забудьте включить модуль Math в список используемых (USES) модулей.


 var
   // Передаваемые широта/долгота в градусах и сотых долях
   StartLat: double; // Начальная широта
   StartLong: double; // Начальная долгота
   EndLat: double; // Конечная широта
   EndLong: double; // Конечная долгота
 
   // Переменные, используемые для вычисления смещения и расстояния
   fPhimean: Double; // Средняя широта
   fdLambda: Double; // Разница между двумя значениями долготы
   fdPhi: Double; // Разница между двумя значениями широты
   fAlpha: Double; // Смещение
   fRho: Double; // Меридианский радиус кривизны
   fNu: Double; // Поперечный радиус кривизны
   fR: Double; // Радиус сферы Земли
   fz: Double; // Угловое расстояние от центра сфероида
   fTemp: Double; // Временная переменная, использующаяся в вычислениях
   Distance: Double; // Вычисленное расстояния в метрах
   Bearing: Double; // Вычисленное от и до смещение
 end
 
 const
   // Константы, используемые для вычисления смещения и расстояния
   D2R: Double = 0.017453; // Константа для преобразования градусов в радианы
   R2D: Double = 57.295781; // Константа для преобразования радиан в градусы
   a: Double = 6378137.0; // Основные полуоси
   b: Double = 6356752.314245; // Неосновные полуоси
   e2: Double = 0.006739496742337; // Квадрат эксцентричности эллипсоида
   f: Double = 0.003352810664747; // Выравнивание эллипсоида
 
 begin
   // Вычисляем разницу между двумя долготами и широтами и получаем среднюю широту
   fdLambda := (StartLong - EndLong) * D2R;
   fdPhi := (StartLat - EndLat) * D2R;
   fPhimean := ((StartLat + EndLat) / 2.0) * D2R;
 
   // Вычисляем меридианные и поперечные радиусы кривизны средней широты
   fTemp := 1 - e2 * (Power(Sin(fPhimean), 2));
   fRho := (a * (1 - e2)) / Power(fTemp, 1.5);
   fNu := a / (Sqrt(1 - e2 * (Sin(fPhimean) * Sin(fPhimean))));
 
   // Вычисляем угловое расстояние
   fz :=
     Sqrt(Power(Sin(fdPhi / 2.0), 2) + Cos(EndLat * D2R) * Cos(StartLat * D2R) *
       Power(Sin(fdLambda / 2.0), 2));
 
   fz := 2 * ArcSin(fz);
 
   // Вычисляем смещение
   fAlpha := Cos(EndLat * D2R) * Sin(fdLambda) * 1 / Sin(fz);
   fAlpha := ArcSin(fAlpha);
 
   // Вычисляем радиус Земли
   fR := (fRho * fNu) / ((fRho * Power(Sin(fAlpha), 2)) + (fNu *
     Power(Cos(fAlpha), 2)));
 
   // Получаем смещение и расстояние
   Distance := (fz * fR);
   if ((StartLat < EndLat) and (StartLong < EndLong)) then
     Bearing := Abs(fAlpha * R2D)
   else if ((StartLat < EndLat) and (StartLong > EndLong)) then
     Bearing := 360 - Abs(fAlpha * R2D)
   else if ((StartLat > EndLat) and (StartLong > EndLong)) then
     Bearing := 180 + Abs(fAlpha * R2D)
   else if ((StartLat > EndLat) and (StartLong < EndLong)) then
     Bearing := 180 - Abs(fAlpha * R2D);
 end;
 

Лирическое отступление автора: в качестве входных параметров используются ШИРОТЫ (в множественном числе, ударение на втором слоге), ведь их две. Но хмммм.... долгота(ы???) тоже две, а как будет звучать множественное число? Загадка. Наверное не существует такой формы. (P.S. зато я знаю как будет множественное число от слова ДНО! Слабо?)




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS