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

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

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

{
Программа вычисляет время восхода и захода
солнца по дате (с точностью до минуты) в пределах
нескольких текущих столетий. Производит корректировку, если
географическая

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

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

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

(например, 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
    Top = 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
      Top = 4
      Width = 173
      Height = 93
      Caption = ' Ввод '
      TabOrder = 0
      object LabelLongitude: TLabel
      Left = 35
        Top = 44
        Width = 78
        Height = 13
        Alignment = taRightJustify
        Caption = 'Долгота (град):'
    end
    object LabelTimeZone: TLabel
      Left = 13
        Top = 68
        Width = 100
        Height = 13
        Alignment = taRightJustify
        Caption = 'Часовая зона (час):'
    end
    object LabelAtitude: TLabel
      Left = 40
        Top = 20
        Width = 73
        Height = 13
        Alignment = taRightJustify
        Caption = 'Широта (град):'
    end
    object EditB5: TEdit
      Tag = 1
        Left = 120
        Top = 16
        Width = 37
        Height = 21
        TabOrder = 0
        Text = '0'
    end
    object EditL5: TEdit
      Tag = 2
        Left = 120
        Top = 40
        Width = 37
        Height = 21
        TabOrder = 1
        Text = '0'
    end
    object EditH: TEdit
      Tag = 3
        Left = 120
        Top = 64
        Width = 37
        Height = 21
        TabOrder = 2
        Text = '0'
    end
  end
  object GroupBoxCalendar: TGroupBox
    Left = 184
      Top = 4
      Width = 109
      Height = 93
      Caption = ' Календарь '
      TabOrder = 1
      object LabelD: TLabel
      Left = 19
        Top = 20
        Width = 30
        Height = 13
        Alignment = taRightJustify
        Caption = 'День:'
    end
    object LabelM: TLabel
      Left = 13
        Top = 44
        Width = 36
        Height = 13
        Alignment = taRightJustify
        Caption = 'Месяц:'
    end
    object LabelY: TLabel
      Left = 28
        Top = 68
        Width = 21
        Height = 13
        Alignment = taRightJustify
        Caption = 'Год:'
    end
    object EditD: TEdit
      Tag = 1
        Left = 56
        Top = 16
        Width = 37
        Height = 21
        TabOrder = 0
        Text = '0'
    end
    object EditM: TEdit
      Tag = 2
        Left = 56
        Top = 40
        Width = 37
        Height = 21
        TabOrder = 1
        Text = '0'
    end
    object EditY: TEdit
      Tag = 3
        Left = 56
        Top = 64
        Width = 37
        Height = 21
        TabOrder = 2
        Text = '0'
    end
  end
  object ButtonCalc: TButton
    Left = 12
      Top = 227
      Width = 169
      Height = 25
      Caption = '&Вычислить'
      TabOrder = 2
      OnClick = ButtonCalcClick
  end
  object ListBox: TListBox
    Left = 4
      Top = 104
      Width = 289
      Height = 117
      ItemHeight = 13
      TabOrder = 3
  end
  object ButtonClear: TButton
    Left = 192
      Top = 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.

Взято с www.delphiworld.narod.ru

DELPHI FAQ