{ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º TDA FECHAS – Unit para el manejo º
º de fechas. º
º Desarrollado por: H. Vivani. º
º Universidad CAECE – Mar del Plata º
º 11/09/2000 º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
}
unit fechas;
INTERFACE
uses
dos;
type
str10=string[10];
tfecha=record
anio:word;
mes:byte;
dia:byte;
end;
mes=array[0..1,1..12] of word;
semana=array[0..6] of str10;
const
dias:mes=((0,31,59,90,120,151,181,212,243,273,304,334),(0,31,60,91,121,152,182,213,244,274,305,335));
diasem:semana=(‘Domingo’,’Lunes’,’Martes’,’Miercoles’,’Jueves’,’Viernes’,’Sabado’);
procedure LeeFecha(var f:tfecha); {Ingresa una fecha desde el teclado}
procedure EscribeFecha(f:tfecha); {Escribe la fecha}
function ObtMes(f:tfecha):byte; {Obtengo el mes}
function ObtAnio(f:tfecha):word; {Obtengo el a€o}
function ObtDia(f:tfecha):byte; {Obtengo el d¡a}
function Bisiesto(f:tfecha):boolean; {Analizo si es bisiesto}
function FechaValida(f:tfecha):boolean; {Verifico si es valida la fecha}
function CantDias(f1,f2:tfecha):word; {Obtengo cantidad de dias e/fechas}
function CantAnios(f1,f2:tfecha):word; {Obtengo cantidad de anios e/fechas}
procedure FechaFinal(f1:tfecha; dd:word;var f2:tfecha); {Obtengo fecha a dd dias}
function DiaSemana(f:tfecha):str10; {Obtengo el dia de la semana}
function FechaMayor(f1,f2:tfecha):boolean;{Determino si la 1er fecha es > que la 2da}
procedure Obtfsys(var f:tfecha); {Obtengo la fecha del sistema}
IMPLEMENTATION
procedure leefecha;
begin
write(‘A€o? ‘);readln(f.anio);
write(‘Mes? ‘);readln(f.mes);
write(‘D¡a? ‘);readln(f.dia);
end;
procedure escribefecha;
begin
writeln(‘A€o? ‘,f.anio);
writeln(‘Mes? ‘,f.mes);
writeln(‘D¡a? ‘,f.dia);
end;
function obtmes;
begin
obtmes:=f.mes;
end;
function obtanio;
begin
obtanio:=f.anio;
end;
function obtdia;
begin
obtdia:=f.dia;
end;
function Bisiesto;
begin
if (f.anio mod 4=0) and ((f.anio mod 1000) or (f.anio mod 400=0)) then
Bisiesto:=true
else
Bisiesto:=false;
end;
function ObtIndBis(f:tfecha):byte; {Obtengo el indice del arreglo}
begin
if bisiesto(f) then
obtindbis:=1
else
obtindbis:=0;
end;
function ObtDiasMes(f:tfecha):byte; {Obtengo cantidad de dias del mes}
var
ind:byte;
begin
ind:=obtindbis(f);
if f.mes=12 then
obtdiasmes:=365+ind-dias[ind,f.mes] {verifico si es valido el dia}
else
if f.mes=1 then
obtdiasmes:=31
else
obtdiasmes:=dias[ind,f.mes+1]-dias[ind,f.mes];
end;
function fechavalida;
var
d,ind:byte;
dd,mm:boolean;
begin
ind:=obtindbis(f);
if (f.mes>=1) and (f.mes<=12) then {verifico si es valido el mes}
begin
mm:=true;
if f.dia<=obtdiasmes(f) then
dd:=true
else
dd:=false;
end
else
begin
mm:=false;
end;
if (f.anio>1900) and (dd=true) and (mm=true) then
fechavalida:=true
else
fechavalida:=false;
end;
function BisiestoW(anio:word):boolean;{comprueba si el anio(word) es bisiesto}
begin
if (anio mod 4=0) and ((anio mod 1000) or (anio mod 400=0)) then
BisiestoW:=true
else
BisiestoW:=false;
end;
function cantdias;
var
i1,i2:byte;
d1,d2:word;
i,acu:word;
begin
acu:=0;
i1:=obtindbis(f1);
i2:=obtindbis(f2);
d1:=dias[i1,f1.mes]+f1.dia;
d2:=dias[i2,f2.mes]+f2.dia;
if f1.anio=f2.anio then
begin
if d1<d2 then
cantdias:=d2-d1
else
cantdias:=d1-d2;
end
else
begin
if f1.anio<f2.anio then
begin
for i:=f1.anio to f2.anio-1 do {acumulo los dias de los anios}
begin
if bisiestow(i)=true then
acu:=acu+366
else
acu:=acu+365;
end;
cantdias:=(acu)-d1+d2;
end
else
begin
for i:=f1.anio-1 downto f2.anio do {acumulo los dias de los anios}
begin
if bisiestow(i)=true then
acu:=acu+366
else
acu:=acu+365;
end;
cantdias:=(acu)+d1-d2;
end
end
end;
function Cantanios;
begin
cantanios:=cantdias(f1,f2) div 365;
end;
procedure FechaFinal; {VALIDA PARA +365 dias}
var
ind,i,dia:byte;
d1,d2,anio:word;
begin
ind:=obtindbis(f1); {obtengo el indice del arreglo}
d1:=dias[ind,f1.mes]+f1.dia+dd; {acumulo el total de dias}
writeln(‘acumulado de dias: ‘,d1);
if d1<(365+ind) then {si no supero el anio actual}
begin
i:=f1.mes;
while d1 > dias[ind,i] do {busco el mes en el arreglo}
i:=i+1;
dia:=d1-dias[ind,i-1];
f2.anio:=f1.anio;
f2.mes:=i-1;
f2.dia:=dia;
end
else
begin
d2:=d1-(365+ind);
writeln(‘acumulado de dias 2: ‘,d2);
i:=1;
while d2 > dias[ind,i] do {busco el mes en el arreglo}
i:=i+1;
dia:=d2-dias[ind,i-1];
f2.anio:=f1.anio+1;
f2.mes:=i-1;
f2.dia:=dia;
end
end;
function diasemana;
var
fbase:tfecha;
begin
fbase.dia:=06;
fbase.mes:=01;
fbase.anio:=1980;
diasemana:=diasem[cantdias(fbase,f) mod 7];
end;
function fechamayor;
var
ind1,ind2:byte;
d1,d2:word;
begin
ind1:=obtindbis(f1);
ind2:=obtindbis(f2);
d1:=dias[ind1,f1.mes]+f1.dia;
d2:=dias[ind2,f2.mes]+f2.dia;
if obtanio(f1)>obtanio(f2) then
fechamayor:=true
else
if obtanio(f1)<obtanio(f2) then
fechamayor:=false
else
begin
if d1>d2 then
fechamayor:=true
else
fechamayor:=false;
end;
end;
procedure obtfsys;
var
y,m,d,dow:word; {en dow tengo el dia de la semana 0..6}
begin
GetDate(y,m,d,dow);
f.anio:=y;
f.mes:=m;
f.dia:=d
end;
end.