Paulo,
Tenho usado esta funçăo a um bom tempo com resultados satisfatórios:
Function Ve_Feriado(dData : TDateTime=0) : Boolean;
var
nMes : Integer;
y,m,d:Word;
G,I,J,C,H,L: Integer;
E:TDateTime;
dSexta : TDateTime;
dCarnaval : TDateTime;
ano : integer;
const
FERIADOSFIXOS : Array [1..12] of String =('01~', // Jan
'', // Fev
'', // Mar
'21~', // Abr
'01~', // Mai
'', // Jun
'', // Jul
'', // Ago
'07~', // Set
'12~', // Out
'02~15~', // Nov
'25~'); // Dez
Begin
If dData=0 then
Result:=False
else
Begin
Try
nMes :=StrToInt(FormatDateTime('mm',dData));
except
nMes :=0;
end;
If (nMes<1) or (nMes>12) then
Result:=False
else
Result:=Pos(FormatDateTime('dd',dData),FERIADOSFIXOS[nMes] )<>0;
end;
//---- Calcula o Feriado de Carnaval e Sexta-Feira Santa
DecodeDate(dData, Y, M, D);
ano := y;
G := ano mod 19;
C := ano div 100;
H := (C-C div 4-(8*C+13) div 25 + 19*G+15)mod 30;
I := H-(H div 28)*(1-(H div 28)*(29 div(H+1))*((21-G)div 11));
J := (ano + ano div 4 +I+2-C+C div 4) mod 7;
L := I-J;
m := 3+(L+40) div 44;
d := L+28-31*(m div 4);
//y := ano;
E := EncodeDate(y,m,d);
While DayOfWeek(E)>1 do
E := E+1;
//--- Sexta-feira Santa
dSexta := E - 2;
//--- Carnaval
dCarnaval := E - 47;
If (dData = dSexta) Or (dData = dCarnaval) then
Result := True;
End;
[ ]´s
Moacir
----- Original Message -----
From: "drummondfilho" <[EMAIL PROTECTED]>
To: <[EMAIL PROTECTED]>
Sent: Wednesday, December 01, 2004 8:59 AM
Subject: [delphi-br] Re: DIAS ÚTEIS
Gostaria de ajudar a montar o algoritmo se vocę puder me passar a
tabela de feriados ficaria muito feliz em poder ajudar.
[]'s
Paulo Drummond Filho
[EMAIL PROTECTED]
--
<<<<< FAVOR REMOVER ESTA PARTE AO RESPONDER ESTA MENSAGEM >>>>>
Para ver as mensagens antigas, acesse:
http://br.groups.yahoo.com/group/delphi-br/messages
Para falar com o moderador, envie um e-mail para:
[EMAIL PROTECTED] ou [EMAIL PROTECTED]
Links do Yahoo! Grupos
--
No virus found in this incoming message.
Checked by AVG Anti-Virus.
Version: 7.0.289 / Virus Database: 265.4.4 - Release Date: 30/11/2004
--
No virus found in this outgoing message.
Checked by AVG Anti-Virus.
Version: 7.0.289 / Virus Database: 265.4.4 - Release Date: 30/11/2004
--
<<<<< FAVOR REMOVER ESTA PARTE AO RESPONDER ESTA MENSAGEM >>>>>
Para ver as mensagens antigas, acesse:
http://br.groups.yahoo.com/group/delphi-br/messages
Para falar com o moderador, envie um e-mail para:
[EMAIL PROTECTED] ou [EMAIL PROTECTED]
Links do Yahoo! Grupos
<*> Para visitar o site do seu grupo na web, acesse:
http://br.groups.yahoo.com/group/delphi-br/
<*> Para sair deste grupo, envie um e-mail para:
[EMAIL PROTECTED]
<*> O uso que vocę faz do Yahoo! Grupos está sujeito aos:
http://br.yahoo.com/info/utos.html
