DevMedia

Calcular feriados variaveis

0
Alguem tem alguma rotina para calcular o dia de feriados variaveis tipo pascoa e carnaval. Eu consegui uma para calcular o dia de pascoa mais falta os outros feriados. Parece que o carnaval e 40 dias antes da pascoa, mas não tenho certeza. Alguem sabe ao certo informar isso. E os outros feriados moveis. Como eu faço?


Respostas (1)

0
Estude as funções abaixo:

Function SeDiaUtil(rData:TDateTime):Boolean;
type
DefineVetor = Array[1..13] Of TDateTime;
var
wAno,wMes,wDia:Word;
a,ww,cc,xx,zz,dd,ee,nn,bb,mm,ss,o,f : Real;
ano,dp,dt : string;
dAux,dp1 : TdateTime;
I : Integer;
dia : DefineVetor;
teste : Boolean;
begin
dt := FormatDateTime(´dd/mm/yyyy´,rData);
DecodeDate(rData,wAno,wMes,wDia);
f := 0;
o := 0;
ano := FormatFloat(´0000´,wAno);
dp := dt;
dp1 := StrToDate(dt);
a := StrToInt(Copy(FormatDateTime(´dd/mm/yyyy´,dp1),7,4));
ww := a - Int(a /19 )* 19 + 1;
cc := Int ( a / 100 ) + 1;
xx := Int ( 3 * cc / 4 ) - 12;
zz := Int ( ( 8 * cc + 5 ) / 25 ) - 5 ;
dd := Int ( 5 * a / 4 ) - xx - 10;
ee := 11 * ww + 20 + zz - xx;
//---------------------------------------------------------------------------
If ee < 0 Then
ee := ee + 30;
ee := ee - Int ( ee / 30 ) * 30;
If (ee = 25) and (ww > 11) Then
ee := ee + 1;
nn := 44 - ee;
If nn < 21 Then
nn := nn + 30;
//---------------------------------------------------------------------------
bb := dd + nn;
bb := bb - Int (bb / 7 ) * 7;
nn := nn + 7 - bb;
mm := nn + 9;
bb := 0;
//---------------------------------------------------------------------------
If (( a - Int ( a / 4 ) * 4 ) = 0) or (( a - Int ( a / 100 ) * 100 ) = 0) Then
begin
bb := 1;
mm := mm+1;
end;
mm := mm + 3;
If bb = 1 Then
ss := 60
Else
ss := 59;
If mm <= ss Then
f := mm - 31
Else
o := mm - ss;
If f>0 Then
If f < 10 Then
dAux := StrToDate(´0´+FloatToStr(f) + ´/02/´ + FloatToStr(a))
Else
dAux := StrToDate(FloatToStr(f) + ´/02/´ + FloatToStr(a))
Else
If o < 10 Then
dAux := StrtoDate(´0´+ FloatToStr(o) + ´/03/´ + FloatToStr(a) )
Else
dAux := StrToDate(FloatToStr(o) + ´/03/´ + FloatToStr(a) );
If DayOfweek(dAux) = 4 Then
dAux := dAux - 1;
dia[01] := StrToDate(´01/01/´+Copy(DT,7,4));
dia[02] := StrToDate(´21/04/´+Copy(DT,7,4));
dia[03] := StrToDate(´01/05/´+Copy(DT,7,4));
dia[04] := StrToDate(´07/09/´+Copy(DT,7,4));
dia[05] := StrToDate(´12/10/´+Copy(DT,7,4));
dia[06] := StrToDate(´02/11/´+Copy(DT,7,4));
dia[07] := StrToDate(´15/11/´+Copy(DT,7,4));
dia[08] := StrToDate(´25/12/´+Copy(DT,7,4));
If StrToFloat(Copy(FormatDateTime(´dd/mm/yyyy´,rData),7,4)) < 2000 Then
begin
dia[09] := dAux-1;
dia[10] := dAux;
dia[11] := dAux+44;
dia[12] := dAux+45;
dia[13] := dAux+107;
end
Else
begin
dia[09] := dAux-1;
dia[10] := dAux;
dia[11] := dAux+45;
dia[12] := dAux+107;
end;
teste := True;
For I := 1 To 13 Do
begin
If DP1 = dia[I] Then
teste := False;
end;
If DayOfWeek(DP1) = 1 Then
teste := False;
If DayOfWeek(DP1) = 7 Then
teste := False;
Result := teste;
end;

Function RetornaDiaUtil(dData:TDateTime;nDias:Integer):TDateTime;
var
Datatemp:TDatetime;
i:Integer;
begin
Datatemp := dData;
for i := 1 to nDias do
begin
Datatemp := Datatemp + 1;
while not SeDiaUtil(Datatemp) do
Datatemp := Datatemp + 1;
end;
Result := Datatemp;
end;