SoloCodigo

Hecho en Borland Delphi es para el calculo del dia de semana y dia juliano.

Rango de fechas:
[01/01/4713 a.C. hasta 01/01/4713 d.C.]

Me tope con un problema con la clase "TDateTime" de Delphi que solo admite fechas desde 1900 para arriba pero antes de esta fecha nada...entonces hice este programa con un rango de -4713 antes de Cristo hasta 4713 despues de Cristo inclusive calcula el dia de la semana.



Lo programe en el Borland Developer Studio 2006 adjunto los archivos fuente y el ejecutable en el zip en caso que tengas un version antigua aqui el codigo fuente de la Unit1.

//*******************************************************
unit Unit1;

interface

uses
  Windows Messages SysUtils Variants Classes Graphics Controls Forms
  Dialogs StdCtrls ComCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Edit1: TEdit;
    UpDown1: TUpDown;
    Edit2: TEdit;
    UpDown2: TUpDown;
    Edit3: TEdit;
    UpDown3: TUpDown;
    ComboBox1: TComboBox;
    Edit4: TEdit;
    Edit5: TEdit;
    Button1: TButton;
    Button2: TButton;
    Label7: TLabel;
    Edit6: TEdit;
    procedure FormShow(Sender: Tobject);
    procedure Button1Click(Sender: Tobject);
    procedure Button2Click(Sender: Tobject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

 //**
 //* Universal Date :
 //*
 //* programa de conversion de fechas gregorianas a julianas
 //* incluido el nombre del dia de la semana
 //* a partir de 01/01/4713 a.C. hasta una fecha actual o futura (d.C)
 //*
 //* version 1.00 15/06/05
 //*
 //**

procedure TForm1.Button1Click(Sender: Tobject);
var
   diamesano : integer;
   ano1mes1:integer;
   era:String;
   abcdediajulianod2e2f2g2h2i2l2 : real;
   diasemana:integer;
   Nomdiasemana NomMes:String;
begin

     dia:=UpDown1.Position;
     mes:=UpDown2.Position;
     ano:=UpDown3.Position;
     if (ComboBox1.ItemIndex=0) then era:=\'dc\';
     if (ComboBox1.ItemIndex=1) then era:=\'ac\';

     if (era = \'ac\') then
     begin
          ano := ano * (-1) + 1;
     end;

     if (mes < 3) then
     begin
          ano1 := ano - 1;
          mes1 := mes + 12;
     end
     else
     begin
          ano1 := ano;
          mes1 := mes;
     end;

     if ((ano > 1582) or (mes > 10) and (ano = 1582) or (dia >= 15) and (mes = 10) and (Ano = 1582)) then
     begin
          A := trunc((Ano1 / 100) - trunc(Ano1 / 100) mod 1);
          B := trunc((A / 4) - trunc(A / 4) mod 1);
          C := trunc(2 - A + ;
     end;

     if ((Ano < 1582) or (Mes < 10) and (Ano = 1582) or (Dia <= 4) and (Mes = 10) and (Ano = 1582)) then
     begin
          C := 0;
     end;

     D := trunc((365.25 * (Ano1 + 4716)) - trunc(365.25 * (Ano1 + 4716)) mod 1);
     E := trunc((30.6001 * (Mes1 + 1)) - trunc(30.6001 * (Mes1 + 1)) mod 1);

     DiaJuliano := (D + E + Dia + C - 1524);

     DiaSemana := trunc(DiaJuliano) mod 7;

     if (DiaSemana = 0) then NomDiaSemana := \'Lunes\';
     if (DiaSemana = 1) then NomDiaSemana := \'Martes\';
     if (DiaSemana = 2) then NomDiaSemana := \'Miercoles\';
     if (DiaSemana = 3) then NomDiaSemana := \'Jueves\';
     if (DiaSemana = 4) then NomDiaSemana := \'Viernes\';
     if (DiaSemana = 5) then NomDiaSemana := \'Sabado\';
     if (DiaSemana = 6) then NomDiaSemana := \'Domingo\';

     Edit5.Text:=NomDiaSemana;
     Edit6.Text:=floattostr(diajuliano);

     //**************************************************

     if (DiaJuliano < 2299161) then
     begin
          D2 := DiaJuliano;
     end;

     if (DiaJuliano > 2299160) then
     begin
          E2 := trunc(((DiaJuliano - 1867216.25) / 36524.25) - trunc((DiaJuliano - 1867216.25) / 36524.25) mod 1);
          D2 := (DiaJuliano + 1 + E2 - (trunc(E2 / 4) - trunc(E2 / 4) mod 1));
     end;

     F2 := (D2 + 1524);
     G2 := trunc(((F2 - 122.1) / 365.25) - trunc((F2 - 122.1) / 365.25) mod 1);
     H2 := trunc((G2 * 365.25) - trunc(G2 * 365.25) mod 1);
     I2 := trunc(((F2 - H2) / 30.6001) - trunc((F2 - H2) / 30.6001) mod 1);

     Dia := round(F2 - H2 - trunc((I2 * 30.6001) - trunc(I2 * 30.6001) mod 1));

     if (I2 < 14) then Mes := trunc(I2 - 1);
     if (I2 > 13) then Mes := trunc(I2 - 13);
     if (Mes > 2) then L2 := G2 - 4716;
     if (Mes < 3) then L2 := G2 - 4715;

     if (L2 > 0)  then Ano := trunc(L2);
     if (L2 < 1)  then Ano := trunc(L2 * (-1) + 1);

     if (L2 > 0) then Era := \'d.C.\';
     if (L2 < 1) then Era := \'a.C.\';

     if (Mes = 1) then NomMes := \'Enero\';
     if (Mes = 2) then NomMes := \'Febrero\';
     if (Mes = 3) then NomMes := \'Marzo\';
     if (Mes = 4) then NomMes := \'Abril\';
     if (Mes = 5) then NomMes := \'Mayo\';
     if (Mes = 6) then NomMes := \'Junio\';
     if (Mes = 7) then NomMes := \'Julio\';
     if (Mes = 8) then NomMes := \'Agosto\';
     if (Mes = 9) then NomMes := \'Septiembre\';
     if (Mes = 10) then NomMes := \'Octubre\';
     if (Mes = 11) then NomMes := \'Noviembre\';
     if (Mes = 12) then NomMes := \'Diciembre\';

     Edit4.Text:=floattostr(dia)+\' de \'+NomMes+\' de \'+floattostr(ano)+\' \'+era;

end;

procedure TForm1.Button2Click(Sender: Tobject);
begin
     Close;
end;

procedure TForm1.FormShow(Sender: Tobject);
var
   YearMonthDayHourMinSecMsec : word;
   Present:TDateTime;
begin
     Present:=now;
     DecodeDate(PresentYearMonthDay);
     UpDown1.Position:=Day;
     UpDown2.Position:=Month;
     UpDown3.Position:=Year;
end;

end.
//*******************************************************

Espero os sirva Saludos
Alexis León.

P.D. La misma logica del programa tambien lo hice para Java con algunas diferencias en la nomenclatura propias del lenjuage Java.

Autor: Alexis León