umoon.pas

支持公历、农历及公历转农历使用公式法（不是查表法）的日历控件

(*@\\\*)

(*@/// function sun_coordinate(date:TDateTime):t_coord; *)
{ Based upon Chapter 25 (24) of Meeus - low accurancy }

(*@/// function sun_coordinate_low(date:TDateTime):t_coord; *)
function sun_coordinate_low(date:TDateTime):t_coord;
var
  t,e,m,c,nu: extended;
  l0,o,omega,lambda: extended;
begin
  t:=(julian_date(date)-2451545.0)/36525;

  (* geometrical mean longitude of the sun *)
  l0:=280.46645+(36000.76983+0.0003032*t)*t;

  (* excentricity of the earth orbit *)
  e:=0.016708617+(-0.000042037-0.0000001236*t)*t;

  (* mean anomaly of the sun *)
  m:=357.52910+(35999.05030-(0.0001559+0.00000048*t)*t)*t;

  (* mean point of sun *)
  c:= (1.914600+(-0.004817-0.000014*t)*t)*sin_d(m)
     +(0.019993-0.000101*t)*sin_d(2*m)
     +0.000290*sin_d(3*m);

  (* true longitude of the sun *)
  o:=put_in_360(l0+c);

  (* true anomaly of the sun *)
  nu:=m+c;

  (* distance of the sun in km *)
  result.radius:=(1.000001018*(1-e*e))/(1+e*cos_d(nu))*AU;

  (* apparent longitude of the sun *)
  omega:=125.04452+(-1934.136261+(0.0020708+1/450000*t)*t)*t;
  lambda:=put_in_360(o-0.00569-0.00478*sin_d(omega)
                     -20.4898/3600/(result.radius/AU));

  result.longitude:=lambda;
  result.latitude:=0;

  calc_geocentric(result,date);
  end;
(*@\\\*)
(*@/// function sun_coordinate(date:TDateTime):t_coord; *)
function sun_coordinate(date:TDateTime):t_coord;
var
  l,b,r: extended;
  lambda,t: extended;
begin
  earth_coord(date,l,b,r);
  (* convert earth coordinate to sun coordinate *)
  l:=l+180;
  b:=-b;
  (* conversion to FK5 *)
  t:=(julian_date(date)-2451545.0)/365250.0*10;
  lambda:=l+(-1.397-0.00031*t)*t;
  l:=l-0.09033/3600;
  b:=b+0.03916/3600*(cos_d(lambda)-sin_d(lambda));
  (* aberration *)
  l:=l-20.4898/3600/r;
  (* correction of nutation - is done inside calc_geocentric *)
{   calc_epsilon_phi(date,delta_phi,epsilon); }
{   l:=l+delta_phi; }
  (* fill result and convert to geocentric *)
  result.longitude:=put_in_360(l);
  result.latitude:=b;
  result.radius:=r*AU;
  calc_geocentric(result,date);
  end;
(*@\\\*)
(*@\\\0000000126*)
(*@/// function moon_coordinate(date:TDateTime):t_coord; *)
{ Based upon Chapter 47 (45) of Meeus }

function moon_coordinate(date:TDateTime):t_coord;
const
  (*@/// arg_lr:array[0..59,0..3] of shortint = (..); *)
  arg_lr:array[0..59,0..3] of shortint = (
     ( 0, 0, 1, 0),
     ( 2, 0,-1, 0),
     ( 2, 0, 0, 0),
     ( 0, 0, 2, 0),
     ( 0, 1, 0, 0),
     ( 0, 0, 0, 2),
     ( 2, 0,-2, 0),
     ( 2,-1,-1, 0),
     ( 2, 0, 1, 0),
     ( 2,-1, 0, 0),
     ( 0, 1,-1, 0),
     ( 1, 0, 0, 0),
     ( 0, 1, 1, 0),
     ( 2, 0, 0,-2),
     ( 0, 0, 1, 2),
     ( 0, 0, 1,-2),
     ( 4, 0,-1, 0),
     ( 0, 0, 3, 0),
     ( 4, 0,-2, 0),
     ( 2, 1,-1, 0),
     ( 2, 1, 0, 0),
     ( 1, 0,-1, 0),
     ( 1, 1, 0, 0),
     ( 2,-1, 1, 0),
     ( 2, 0, 2, 0),
     ( 4, 0, 0, 0),
     ( 2, 0,-3, 0),
     ( 0, 1,-2, 0),
     ( 2, 0,-1, 2),
     ( 2,-1,-2, 0),
     ( 1, 0, 1, 0),
     ( 2,-2, 0, 0),
     ( 0, 1, 2, 0),
     ( 0, 2, 0, 0),
     ( 2,-2,-1, 0),
     ( 2, 0, 1,-2),
     ( 2, 0, 0, 2),
     ( 4,-1,-1, 0),
     ( 0, 0, 2, 2),
     ( 3, 0,-1, 0),
     ( 2, 1, 1, 0),
     ( 4,-1,-2, 0),
     ( 0, 2,-1, 0),
     ( 2, 2,-1, 0),
     ( 2, 1,-2, 0),
     ( 2,-1, 0,-2),
     ( 4, 0, 1, 0),
     ( 0, 0, 4, 0),
     ( 4,-1, 0, 0),
     ( 1, 0,-2, 0),
     ( 2, 1, 0,-2),
     ( 0, 0, 2,-2),
     ( 1, 1, 1, 0),
     ( 3, 0,-2, 0),
     ( 4, 0,-3, 0),
     ( 2,-1, 2, 0),
     ( 0, 2, 1, 0),
     ( 1, 1,-1, 0),
     ( 2, 0, 3, 0),
     ( 2, 0,-1,-2)
                   );
  (*@\\\*)
  (*@/// arg_b:array[0..59,0..3] of shortint = (); *)
  arg_b:array[0..59,0..3] of shortint = (
     ( 0, 0, 0, 1),
     ( 0, 0, 1, 1),
     ( 0, 0, 1,-1),
     ( 2, 0, 0,-1),
     ( 2, 0,-1, 1),
     ( 2, 0,-1,-1),
     ( 2, 0, 0, 1),
     ( 0, 0, 2, 1),
     ( 2, 0, 1,-1),
     ( 0, 0, 2,-1),  (* !!! Error in German Meeus *)
     ( 2,-1, 0,-1),
     ( 2, 0,-2,-1),
     ( 2, 0, 1, 1),
     ( 2, 1, 0,-1),
     ( 2,-1,-1, 1),
     ( 2,-1, 0, 1),
     ( 2,-1,-1,-1),
     ( 0, 1,-1,-1),
     ( 4, 0,-1,-1),
     ( 0, 1, 0, 1),
     ( 0, 0, 0, 3),
     ( 0, 1,-1, 1),
     ( 1, 0, 0, 1),
     ( 0, 1, 1, 1),
     ( 0, 1, 1,-1),
     ( 0, 1, 0,-1),
     ( 1, 0, 0,-1),
     ( 0, 0, 3, 1),
     ( 4, 0, 0,-1),
     ( 4, 0,-1, 1),
     ( 0, 0, 1,-3),
     ( 4, 0,-2, 1),
     ( 2, 0, 0,-3),
     ( 2, 0, 2,-1),
     ( 2,-1, 1,-1),
     ( 2, 0,-2, 1),
     ( 0, 0, 3,-1),
     ( 2, 0, 2, 1),
     ( 2, 0,-3,-1),
     ( 2, 1,-1, 1),
     ( 2, 1, 0, 1),
     ( 4, 0, 0, 1),
     ( 2,-1, 1, 1),
     ( 2,-2, 0,-1),
     ( 0, 0, 1, 3),
     ( 2, 1, 1,-1),
     ( 1, 1, 0,-1),
     ( 1, 1, 0, 1),
     ( 0, 1,-2,-1),
     ( 2, 1,-1,-1),
     ( 1, 0, 1, 1),
     ( 2,-1,-2,-1),
     ( 0, 1, 2, 1),
     ( 4, 0,-2,-1),
     ( 4,-1,-1,-1),
     ( 1, 0, 1,-1),
     ( 4, 0, 1,-1),
     ( 1, 0,-1,-1),
     ( 4,-1, 0,-1),
     ( 2,-2, 0, 1)
    );
  (*@\\\*)
  (*@/// sigma_r: array[0..59] of longint = (..); *)
  sigma_r: array[0..59] of longint = (
   -20905355,
    -3699111,
    -2955968,
     -569925,
       48888,
       -3149,
      246158,
     -152138,
     -170733,
     -204586,
     -129620,
      108743,
      104755,
       10321,
           0,
       79661,
      -34782,
      -23210,
      -21636,
       24208,
       30824,
       -8379,
      -16675,
      -12831,
      -10445,
      -11650,
       14403,
       -7003,
           0,
       10056,
        6322,
       -9884,
        5751,
           0,
       -4950,
        4130,
           0,
       -3958,
           0,
        3258,
        2616,
       -1897,
       -2117,
        2354,
           0,
           0,
       -1423,
       -1117,
       -1571,
       -1739,
           0,
       -4421,
           0,
           0,
           0,
           0,
        1165,
           0,
           0,
        8752
              );
  (*@\\\*)
  (*@/// sigma_l: array[0..59] of longint = (..); *)
  sigma_l: array[0..59] of longint = (
    6288774,
    1274027,
     658314,
     213618,
    -185116,
    -114332,
      58793,
      57066,
      53322,
      45758,
     -40923,
     -34720,
     -30383,
      15327,
     -12528,
      10980,
      10675,
      10034,
       8548,
      -7888,
      -6766,
      -5163,
       4987,
       4036,
       3994,
       3861,
       3665,
      -2689,
      -2602,
       2390,
      -2348,
       2236,
      -2120,
      -2069,
       2048,
      -1773,
      -1595,
       1215,
      -1110,
       -892,
       -810,
        759,
       -713,
       -700,
        691,
        596,
        549,
        537,
        520,
       -487,
       -399,
       -381,
        351,
       -340,
        330,
        327,
       -323,
        299,
        294,
          0
    );
  (*@\\\*)
  (*@/// sigma_b: array[0..59] of longint = (..); *)
  sigma_b: array[0..59] of longint = (
    5128122,
     280602,
     277693,
     173237,
      55413,
      46271,
      32573,
      17198,
       9266,
       8822,
       8216,
       4324,
       4200,
      -3359,
       2463,
       2211,
       2065,
      -1870,
       1828,
      -1794,
      -1749,
      -1565,
      -1491,
      -1475,
      -1410,
      -1344,
      -1335,
       1107,
       1021,
        833,
        777,
        671,
        607,
        596,
        491,
       -451,
        439,
        422,
        421,
       -366,
       -351,
        331,
        315,
        302,
       -283,
       -229,
        223,
        223,
       -220,
       -220,
       -185,
        181,
       -177,
        176,
        166,
       -164,
        132,
       -119,
        115,
        107
    );
  (*@\\\*)
var
  t,d,m,ms,f,e,ls : extended;
  sr,sl,sb,temp: extended;
  a1,a2,a3: extended;
  lambda,beta,delta: extended;
  i: integer;
begin
  t:=(julian_date(date)-2451545)/36525;

  (* mean elongation of the moon *)
  d:=297.8502042+(445267.1115168+(-0.0016300+(1/545868-1/113065000*t)*t)*t)*t;

  (* mean anomaly of the sun *)
  m:=357.5291092+(35999.0502909+(-0.0001536+1/24490000*t)*t)*t;

  (* mean anomaly of the moon *)
  ms:=134.9634114+(477198.8676313+(0.0089970+(1/69699-1/1471200*t)*t)*t)*t;

  (* argument of the longitude of the moon *)
  f:=93.2720993+(483202.0175273+(-0.0034029+(-1/3526000+1/863310000*t)*t)*t)*t;

  (* correction term due to excentricity of the earth orbit *)
  e:=1.0+(-0.002516-0.0000074*t)*t;

  (* mean longitude of the moon *)
  ls:=218.3164591+(481267.88134236+(-0.0013268+(1/538841-1/65194000*t)*t)*t)*t;

  (* arguments of correction terms *)
  a1:=119.75+131.849*t;
  a2:=53.09+479264.290*t;
  a3:=313.45+481266.484*t;

  (*@/// sr :=