Архив исходников программ, модулей и компонентов на Delphi


Начальная страница

Поиск по базе



Операционная система
Настройка приложения
Взаимодействия приложений
Файлы и директории
Строки и символы
Математика
Базы данных
Интернет и сеть
Мультимедиа
Аппаратная часть
VCL
Другие разделы [0]
 

Количество записей в базе - 537
Сегодня добавлено – 0

Вычисления



Вернуться к списку функций
 Расчет расстояния между двумя точками на земной поверхности.

 Прислал: Вячеслав ( 19 марта 2003 г. )
©  Опубликован в Survey Review №175 за Апрель 1976г.
 Описание:
Расчет расстояния между 2мя точками на земной поверхности методом Винсенти.


Dimka Maslov:
Lat1, Lon1 - широта и долгота точки 1 в градусах
Lat2, Lon2 - широта и долгота точки 2 в градусах
Функция возвращает результат в метрах.

Автор, правда, забыл упомянуть о правиле знаков для южных широт и западных
долгот...

 Зависимости:
Math

 Исходный текст:
{ **** UBPFD *********** by http://kladovka.net.ru/delphibase/ ****
>> Расчет расстояния между двумя точками на земной поверхности.

Расчет расстояния между 2мя точками на земной поверхности методом Винсенти.


Dimka Maslov:
Lat1, Lon1 - широта и долгота точки 1 в градусах
Lat2, Lon2 - широта и долгота точки 2 в градусах
Функция возвращает результат в метрах.

Автор, правда, забыл упомянуть о правиле знаков для южных широт и западных
долгот...


Зависимости: Math
Автор:       Вячеслав
Copyright:   Опубликован в Survey Review №175 за Апрель 1976г.
Дата:        19 марта 2003 г.
***************************************************************** }

function Vincenty(Lat1, Lon1, Lat2, Lon2: Extended): Extended;
const // Параметры эллипсоида:
  a = 6378245.0;
  f = 1 / 298.3;
  b = (1 - f) * a;
  EPS = 0.5E-30;
var
 APARAM, BPARAM, CPARAM, OMEGA, TanU1, TanU2,
 Lambda, LambdaPrev, SinL, CosL, USQR, U1, U2,
 SinU1, CosU1, SinU2, CosU2, SinSQSigma, CosSigma,
 TanSigma, Sigma, SinAlpha, Cos2SigmaM, DSigma : Extended;
begin
 lon1 := lon1 * (PI / 180);
 lat1 := lat1 * (PI / 180);
 lon2 := lon2 * (PI / 180);
 lat2 := lat2 * (PI / 180); //Пересчет значений координат в радианы
 TanU1 := (1 - f) * Tan(lat1);
 TanU2 := (1 - f) * Tan(lat2);
 U1 := ArcTan(TanU1);
 U2 := ArcTan(TanU2);
 SinCos(U1, SinU1, CosU1);
 SinCos(U2, SinU2, CosU2);
 OMEGA := lon2 - lon1;
 lambda := OMEGA;
 repeat //Начало цикла итерации
  LambdaPrev:= lambda;
  SinCos(lambda, SinL, CosL);
  SinSQSigma := (CosU2 * SinL * CosU2 * SinL) +
   (CosU1 * SinU2 - SinU1 * CosU2 * CosL) *
   (CosU1 * SinU2 - SinU1 * CosU2 * CosL);
  CosSigma := SinU1 * SinU2 + CosU1 * CosU2 * CosL;
  TanSigma:= Sqrt(SinSQSigma) / CosSigma;
  if TanSigma > 0
   then Sigma := ArcTan(TanSigma)
   else Sigma := ArcTan(TanSigma) + Pi;
  if SinSQSigma = 0
   then SinAlpha := 0
    else SinAlpha := CosU1 * CosU2 * SinL / Sqrt(SinSQSigma);
  if (Cos(ArcSin(SinAlpha)) * Cos(ArcSin(SinAlpha))) = 0
   then Cos2SigmaM := 0
   else Cos2SigmaM:= CosSigma -
    (2 * SinU1 * SinU2 / (Cos(ArcSin(SinAlpha)) * Cos(ArcSin(SinAlpha))));
  CPARAM:= (f / 16) * Cos(ArcSin(SinAlpha)) * Cos(ArcSin(SinAlpha)) *
   (4 + f * (4 - 3 * Cos(ArcSin(SinAlpha)) * Cos(ArcSin(SinAlpha))));
  lambda := OMEGA + (1 - CPARAM) * f * SinAlpha * (ArcCos(CosSigma) +
   CPARAM * Sin(ArcCos(CosSigma)) * (Cos2SigmaM + CPARAM * CosSigma *
   (-1 + 2 * Cos2SigmaM * Cos2SigmaM)));
 until Abs(lambda - LambdaPrev) < EPS; // Конец цикла итерации
 USQR:= Cos(ArcSin(SinAlpha)) * Cos(ArcSin(SinAlpha)) *
  (a * a - b * b) / (b * b);
 APARAM := 1 + (USQR / 16384) *
  (4096 + USQR * (-768 + USQR * (320 - 175 * USQR)));
 BPARAM := (USQR / 1024) * (256 + USQR * (-128 + USQR * (74 - 47 * USQR)));
 DSigma := BPARAM * SQRT(SinSQSigma) * (Cos2SigmaM + BPARAM / 4 *
  (CosSigma * (-1 + 2 * Cos2SigmaM * Cos2SigmaM) - BPARAM / 6 * Cos2SigmaM *
  (-3 + 4 * SinSQSigma) * (-3 + 4 * Cos2SigmaM * Cos2SigmaM)));
 Result := b * APARAM * (Sigma - DSigma);
end;

 Пример использования:
procedure TForm1.Button1Click(Sender: TObject);
var
 R: Extended;
begin
 R := Vicenty(59.8833, 30.2333, 55.7667, 37.5833);
 ShowMessageFmt('%g', [R]);
end;


Вернуться к списку функций

Наверх ▲