Определение восхода и захода солнца и луны

Определение восхода и захода солнца и луны

Автор: Александр Ермолаев

{

Программа вычисляет время восхода и захода

солнца по дате (с точностью до минуты) в пределах

нескольких текущих столетий. Производит корректировку, если

географическая

точка находится в арктическом или антарктическом регионе, где заход

или восход солнца

на текущую дату может не состояться. Вводимые данные: положительная

северная широта и

отрицательная западная долгота. Часовой пояс указывается относительно

Гринвича

(например, 5 для EST и 4 для EDT). Алгоритм обсуждался в

"Sky & Telescope" за август 1994, страница 84.

}




program sunproject;

uses

 Forms,

 main in 'main.pas' {Sun};

{$R *.RES}

begin

 Application.Initialize;

 Application.Title := 'Sun';

 Application.CreateForm(TSun, Sun);

 Application.Run;

end.

main.dfm

object Sun: TSun
 Left = 210
   = 106
  BorderIcons = [biSystemMenu, biMinimize]
  BorderStyle = bsSingle
  Caption = 'Sun'
  ClientHeight = 257
  ClientWidth = 299
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  Position = poDesktopCenter
  OnCreate = CreateForm
  PixelsPerInch = 96
  TextHeight = 13
  object GroupBoxInput: TGroupBox
  Left = 4
   = 4
  Width = 173
  Height = 93
  Caption = ' Ввод '
  TabOrder = 0
  object LabelLongitude: TLabel
  Left = 35
   = 44
  Width = 78
  Height = 13
  Alignment = taRightJustify
  Caption = 'Долгота (град):'
  end
  object LabelTimeZone: TLabel
  Left = 13
   = 68
  Width = 100
  Height = 13
  Alignment = taRightJustify
  Caption = 'Часовая зона (час):'
  end
  object LabelAtitude: TLabel
  Left = 40
   = 20
  Width = 73
  Height = 13
  Alignment = taRightJustify
  Caption = 'Широта (град):'
  end
  object EditB5: TEdit
  Tag = 1
  Left = 120
   = 16
  Width = 37
  Height = 21
  TabOrder = 0
  Text = '0'
  end
  object EditL5: TEdit
  Tag = 2
  Left = 120
   = 40
  Width = 37
  Height = 21
  TabOrder = 1
  Text = '0'
  end
  object EditH: TEdit
  Tag = 3
  Left = 120
   = 64
  Width = 37
  Height = 21
  TabOrder = 2
  Text = '0'
  end
 end
 object GroupBoxCalendar: TGroupBox
  Left = 184
   = 4
  Width = 109
  Height = 93
  Caption = ' Календарь '
  TabOrder = 1
  object LabelD: TLabel
  Left = 19
   = 20
  Width = 30
  Height = 13
  Alignment = taRightJustify
  Caption = 'День:'
  end
  object LabelM: TLabel
  Left = 13
   = 44
  Width = 36
  Height = 13
  Alignment = taRightJustify
  Caption = 'Месяц:'
  end
  object LabelY: TLabel
  Left = 28
   = 68
  Width = 21
  Height = 13
  Alignment = taRightJustify
  Caption = 'Год:'
  end
  object EditD: TEdit
  Tag = 1
  Left = 56
   = 16
  Width = 37
  Height = 21
  TabOrder = 0
  Text = '0'
  end
  object EditM: TEdit
  Tag = 2
  Left = 56
   = 40
  Width = 37
  Height = 21
  TabOrder = 1
  Text = '0'
  end
  object EditY: TEdit
  Tag = 3
  Left = 56
   = 64
  Width = 37
  Height = 21
  TabOrder = 2
  Text = '0'
  end
 end
 object ButtonCalc: TButton
  Left = 12
   = 227
  Width = 169
  Height = 25
  Caption = '&Вычислить'
  TabOrder = 2
  OnClick = ButtonCalcClick
 end
 object ListBox: TListBox
  Left = 4
   = 104
  Width = 289
  Height = 117
  ItemHeight = 13
  TabOrder = 3
 end
 object ButtonClear: TButton
  Left = 192
   = 227
  Width = 91
  Height = 25
  Caption = '&Очистить'
  TabOrder = 4
  OnClick = ButtonClearClick
 end
end

main.pas

unit main;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
 Dialogs,
 StdCtrls;
type
 TSun = class(TForm)
  GroupBoxInput: TGroupBox;
  LabelLongitude: TLabel;
  EditB5: TEdit;
  EditL5: TEdit;
  LabelTimeZone: TLabel;
  EditH: TEdit;
  GroupBoxCalendar: TGroupBox;
  LabelD: TLabel;
  LabelM: TLabel;
  LabelY: TLabel;
  EditD: TEdit;
  EditM: TEdit;
  EditY: TEdit;
  ButtonCalc: TButton;
  ListBox: TListBox;
  ButtonClear: TButton;
  LabelAtitude: TLabel;
  procedure Calendar; // Календарь
  procedure GetTimeZone; // Получение часового пояса
  procedure PosOfSun; // Получаем положение солнца
  procedure OutInform; // Процедура вывода информации
  procedure PossibleEvents(Hour: integer); // Возможные события на
  полученный час
  procedure GetDate; //Получить значения даты
  procedure GetInput; //Получить значения широты,...
  procedure ButtonCalcClick(Sender: TObject);
  procedure CreateForm(Sender: TObject);
  procedure ButtonClearClick(Sender: TObject);
 private
  function Sgn(Value: Double): integer; // Сигнум
 public
  { Public declarations }
 end;
var
 Sun: TSun;
 st: string;
 aA, aD: array[1..2] of double;
 B5: integer;
 L5: double;
 H: integer;
 Z, Z0, Z1: double;
 D: double;
 M, Y: integer;
 A5, D5, R5: double;
 J3: integer;
 T, T0, TT, T3: double;
 L0, L2: double;
 H0, H1, H2, H7, N7, D7: double;
 H3, M3: integer;
 M8, W8: double;
 A, B, A0, D0, A2, D1, D2, DA, DD: double;
 E, F, J, S, C, P, L, G, V, U, W: double;
 V0, V1, V2: double;
 C0: integer;
 AZ: double;
const
 P2 = Pi * 2; // 2 * Pi
 DR = Pi / 180; // Радиан на градус
 K1 = 15 * DR * 1.0027379;
implementation
{$R *.DFM}
function TSun.Sgn(Value: Double): integer;
begin
 {if Value = 0 then} Result := 0;
 if Value > 0 then
  Result := 1;
 if Value < 0 then
  Result := -1;
end;
procedure TSun.Calendar;
begin
 G := 1;
 if Y < 1583 then
  G := 0;
 D1 := Trunc(D);
 F := D - D1 - 0.5;
 J := -Trunc(7 * (Trunc((M + 9) / 12) + Y) / 4);
 if G = 1 then
 begin
  S := Sgn(M - 9);
  A := Abs(M - 9);
  J3 := Trunc(Y + S * Trunc(A / 7));
  J3 := -Trunc((Trunc(J3 / 100) + 1) * 3 / 4);
 end;
 J := J + Trunc(275 * M / 9) + D1 + G * J3;
 J := J + 1721027 + 2 * G + 367 * Y;
 if F >= 0 then
  Exit;
 F := F + 1;
 J := J - 1;
end;
procedure TSun.GetTimeZone;
begin
 T0 := T / 36525;
 S := 24110.5 + 8640184.813 * T0;
 S := S + 86636.6 * Z0 + 86400 * L5;
 S := S / 86400;
 S := S - Trunc(S);
 T0 := S * 360 * DR;
end;
procedure TSun.PosOfSun;
begin
 // Фундаментальные константы
 // (Van Flandern & Pulkkinen, 1979)
 L := 0.779072 + 0.00273790931 * T;
 G := 0.993126 + 0.0027377785 * T;
 L := L - Trunc(L);
 G := G - Trunc(G);
 L := L * P2;
 G := G * P2;
 V := 0.39785 * Sin(L);
 V := V - 0.01000 * Sin(L - G);
 V := V + 0.00333 * Sin(L + G);
 V := V - 0.00021 * TT * Sin(L);
 U := 1 - 0.03349 * Cos(G);
 U := U - 0.00014 * Cos(2 * L);
 U := U + 0.00008 * Cos(L);
 W := -0.00010 - 0.04129 * Sin(2 * L);
 W := W + 0.03211 * Sin(G);
 W := W + 0.00104 * Sin(2 * L - G);
 W := W - 0.00035 * Sin(2 * L + G);
 W := W - 0.00008 * TT * Sin(G);
 // Вычисление солнечных координат
 S := W / Sqrt(U - V * V);
 A5 := L + ArcTan(S / Sqrt(1 - S * S));
 S := V / Sqrt(U);
 D5 := ArcTan(S / Sqrt(1 - S * S));
 R5 := 1.00021 * Sqrt(U);
end;
procedure TSun.PossibleEvents(Hour: integer);
var
 num: string;
begin
 st := '';
 L0 := T0 + Hour * K1;
 L2 := L0 + K1;
 H0 := L0 - A0;
 H2 := L2 - A2;
 H1 := (H2 + H0) / 2; // Часовой угол,
 D1 := (D2 + D0) / 2; // наклон в получасе
 if Hour <= 0 then
  V0 := S * Sin(D0) + C * Cos(D0) * Cos(H0) - Z;
 V2 := S * Sin(D2) + C * Cos(D2) * Cos(H2) - Z;
 if Sgn(V0) = Sgn(V2) then
  Exit;
 V1 := S * Sin(D1) + C * Cos(D1) * Cos(H1) - Z;
 A := 2 * V2 - 4 * V1 + 2 * V0;
 B := 4 * V1 - 3 * V0 - V2;
 D := B * B - 4 * A * V0;
 if D < 0 then
  Exit;
 D := Sqrt(D);
 if (V0 < 0) and (V2 > 0) then
  st := st + 'Восход солнца в ';
 if (V0 < 0) and (V2 > 0) then
  M8 := 1;
 if (V0 > 0) and (V2 < 0) then
  st := st + 'Заход солнца в ';
 if (V0 > 0) and (V2 < 0) then
  W8 := 1;
 E := (-B + D) / (2 * A);
 if (E > 1) or (E < 0) then
  E := (-B - D) / (2 * A);
 T3 := Hour + E + 1 / 120; // Округление
 H3 := Trunc(T3);
 M3 := Trunc((T3 - H3) * 60);
 Str(H3: 2, num);
 st := st + num + ':';
 Str(M3: 2, num);
 st := st + num;
 H7 := H0 + E * (H2 - H0);
 N7 := -Cos(D1) * Sin(H7);
 D7 := C * Sin(D1) - S * Cos(D1) * COS(H7);
 AZ := ArcTan(N7 / D7) / DR;
 if (D7 < 0) then
  AZ := AZ + 180;
 if (AZ < 0) then
  AZ := AZ + 360;
 if (AZ > 360) then
  AZ := AZ - 360;
 Str(AZ: 4: 1, num);
 st := st + ', азимут ' + num;
end;
procedure TSun.OutInform;
begin
 if (M8 = 0) and (W8 = 0) then
 begin
  if V2 < 0 then
  ListBox.Items.Add('Солнце заходит весь день ');
  if V2 > 0 then
  ListBox.Items.Add('Солнце восходит весь день ');
 end
 else
 begin
  if M8 = 0 then
  ListBox.Items.Add('В этот день солнце не восходит ');
  if W8 = 0 then
  ListBox.Items.Add('В этот день солнце не заходит ');
 end;
end;
procedure TSun.GetDate;
begin
 D := StrToInt(EditD.text);
 M := StrToInt(EditM.text);
 Y := StrToInt(EditY.text);
end;
procedure TSun.GetInput;
begin
 B5 := StrToInt(EditB5.Text);
 L5 := StrToInt(EditL5.Text);
 H := StrToInt(EditH.Text);
end;
procedure TSun.ButtonCalcClick(Sender: TObject);
var
 C0: integer;
begin
 GetDate;
 GetInput;
 ListBox.Items.Add('Широта: ' + EditB5.Text +
  ' Долгота: ' + EditL5.Text +
  ' Зона: ' + EditH.Text +
  ' Дата: ' + EditD.Text +
  '/' + EditM.Text +
  '/' + EditY.Text);
 L5 := L5 / 360;
 Z0 := H / 24;
 Calendar;
 T := (J - 2451545) + F;
 TT := T / 36525 + 1; // TT - столетия, начиная с 1900.0
 GetTimeZone; // Получение часового пояса
 T := T + Z0;
 PosOfSun; // Получаем положение солнца
 aA[1] := A5;
 aD[1] := D5;
 T := T + 1;
 PosOfSun;
 aA[2] := A5;
 aD[2] := D5;
 if aA[2] < aA[1] then
  aA[2] := aA[2] + P2;
 Z1 := DR * 90.833; // Вычисление зенита
 S := Sin(B5 * DR);
 C := Cos(B5 * DR);
 Z := Cos(Z1);
 M8 := 0;
 W8 := 0;
 A0 := aA[1];
 D0 := aD[1];
 DA := aA[2] - aA[1];
 DD := aD[2] - aD[1];
 for C0 := 0 to 23 do
 begin
  P := (C0 + 1) / 24;
  A2 := aA[1] + P * DA;
  D2 := aD[1] + P * DD;
  PossibleEvents(C0);
  if st <> '' then
  ListBox.Items.Add(st);
  A0 := A2;
  D0 := D2;
  V0 := V2;
 end;
 OutInform;
 ListBox.Items.Add(''); // Разделяем данные
end;
procedure TSun.CreateForm(Sender: TObject);
begin
 EditD.Text := FormatDateTime('d', Date);
 EditM.Text := FormatDateTime('m', Date);
 EditY.Text := FormatDateTime('yyyy', Date);
end;
procedure TSun.ButtonClearClick(Sender: TObject);
begin
 ListBox.Clear;
end;
end.

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...