Newsgroup: it.comp.lang.visual-basic
Titolo: festività

ciao, siete a conoscenza di qualche funzione sul controllo delle festivitą
comandate ( Natale, Pasqua, 2 Giugno ecc.)
in buona sostanza devo vagliare solo i giorni che non siano domenica o
festivitą...
thanks
hi
Paolo


"in buona sostanza" ?!
per caso sei un discendente di leonardo da vinci? (di "Non ci resta che piangere")

=326)
   '   method 2: Original calculation, Gregorian calendar date (years 1583
to 4099)
   '   method 3: New calculation, Gregorian calendar date (years 1583 to
4099)
   'OUTPUTS
   'd day of month
   'm month
   '==========================================================
   'This algorithm is adapted from a faq document by Claus Tondering
   'URL: 
http://www.pip.dknet.dk/~pip10160/calendar.faq2.txt
   'E-mail: 
c...@pip.dknet.dk
.
   'The FAQ algorithm is based in part on the algorithm of Oudin (1940)
   'as quoted in "Explanatory Supplement to the Astronomical Almanac",
   'P. Kenneth Seidelmann, editor.
   'Additions by GM Arts:
   '(1) checks year and method arguments are valid
   '(2) adds method 2 calculations (original calculation, converted to
Gregorian date)
   '(3) modified d and m calculations to account for later dates produced
by method 2
   '==========================================================
   Dim g   'golden year - 1
   Dim c   'century
   Dim h   ' = (23 - Epact) mod 30
   Dim i   'no of days from March 21 to Paschal Full Moon
   Dim j   'weekday for PFM (0=Sunday, etc)
   Dim p   'no of days from March 21 to Sunday on or before PFM
               '(-6 to 28 methods 1 & 3, to 56 for method 2)
   Dim e   'extra days to add for method 2 (converting Julian date to
Gregorian date)
   'calc intermediate vars
   '~~~~~~~~~~~~~~~~~~~~~~
       g = y Mod 19
       If method = 1 Or method = 2 Then 'old method
           i = (19 * g + 15) Mod 30
           j = (y + y \ 4 + i) Mod 7
           If method = 2 Then  'extra dates to convert Julian to Gregorian
date
               e = 10
               If y > 1600 Then e = e + y \ 100 - 16 - (y \ 100 - 16) \ 4
           End If
 
       ElseIf method = 3 Then          'new method
           c = y \ 100
           h = (c - c \ 4 - (8 * c + 13) \ 25 + 19 * g + 15) Mod 30
           i = h - (h \ 28) * (1 - (h \ 28) * (29 \ (h + 1)) * ((21 - g) \
11))
           j = (y + y \ 4 + i + 2 - c + c \ 4) Mod 7
 
       End If
   'return day and month
   '~~~~~~~~~~~~~~~~~~~~
       p = i - j + e
   ' p can be from -6 to 56 (for all valid years 326 to 4099, all methods)
   ' corresponds to dates 22 March to 23 May
   ' (later dates apply to method 2, although 23 May never actually occurs)
       d = 1 + (p + 27 + (p + 6) \ 40) Mod 31
       m = 3 + (p + 26) \ 30
   End Sub
   Sub GetEasterDate2(d, m, y, method)
   '==========================================================
   ' This algorithm is an arithmetic interpretation
   ' of the 3 step Easter Dating Method developed
   ' by Ron Mallen 1985, as a vast improvement on
   ' the method described in the Common Prayer Book
   ' Published Australian Almanac 1988
   ' Refer to this publication, or the Canberra Library
   ' for a clear understanding of the method used
   ' Because this algorithm is a direct translation of the
   ' official tables, it can be easily proved to be 100%
   ' correct
   ' It's free!  Please do not modify code or comments!
   '==========================================================
       Dim FirstDig, Remain19, temp    'intermediate results
       Dim tA, tB, tC, td, tE          'table A to E results
       FirstDig = y \ 100              'first 2 digits of year
       Remain19 = y Mod 19             'remainder of year / 19
       If method = 1 Or method = 2 Then
       ' calculate PFM date
           tA = ((225 - 11 * Remain19) Mod 30) + 21
       ' find the next Sunday
           tB = (tA - 19) Mod 7
           tC = (40 - FirstDig) Mod 7
           temp = y Mod 100
           td = (temp + temp \ 4) Mod 7
           tE = ((20 - tB - tC - td) Mod 7) + 1
           d = tA + tE
           If method = 2 Then  'convert Julian to Gregorian date
               '10 days were 'skipped' in the Gregorian calendar from 5-14
Oct 1582
               temp = 10
               'Only 1 in every 4 century years are leap years in the
Gregorian
               'calendar (every century is a leap year in the Julian
calendar)
               If y > 1600 Then temp = temp + FirstDig - 16 - ((FirstDig -
16) \ 4)
               d = d + temp
           End If
       ElseIf method = 3 Then
        ' calculate PFM date
           temp = (FirstDig - 15) \ 2 + 202 - 11 * Remain19
           If FirstDig > 26 Then temp = temp - 1
           If FirstDig > 38 Then temp = temp - 1
 
           'this next line uses underscore (_) line continuation characters
           'in older versions of VB you may need to revert to one long line
           If ((FirstDig = 21) Or (FirstDig = 24) Or (FirstDig = 25) _
               Or (FirstDig = 33) Or (FirstDig = 36) Or (FirstDig = 37)) _
               Then temp = temp - 1
 
           temp = temp Mod 30
 
           tA = temp + 21
           If temp = 29 Then tA = tA - 1
           If (temp = 28 And Remain19 > 10) Then tA = tA - 1
 
       ' find the next Sunday
           tB = (tA - 19) Mod 7
 
           tC = (40 - FirstDig) Mod 4
           If tC = 3 Then tC = tC + 1
           If tC > 1 Then tC = tC + 1
 
           temp = y Mod 100
           td = (temp + temp \ 4) Mod 7
 
           tE = ((20 - tB - tC - td) Mod 7) + 1
           d = tA + tE
       End If
   ' return the date
       If d > 61 Then
           d = d - 61  'when the original calculation is converted to the
           m = 5       'Gregorian calendar, Easter Sunday can occur in May
       ElseIf d > 31 Then
           d = d - 31
           m = 4
       Else
           m = 3
       End If
   End Sub
Public Function VerificaFestivo(ByVal DATA_VALUTA As Date) As Boolean
Static LunedìDiPasqua As Date
Dim Giorno
Dim Mese
If Format(DATA_VALUTA, "mm") = "03" Or _
   Format(DATA_VALUTA, "mm") = "04" Then
   Call EasterDate(Giorno, Mese, Format(DATA_VALUTA, "yyyy"), 3)
   LunedìDiPasqua = Giorno & "/" & Mese & "/" & Format(DATA_VALUTA, "yyyy")
   LunedìDiPasqua = CDate(Format(LunedìDiPasqua, "dd/mm/yyyy")) + 1
End If
'
' Vengono considerati festivi :
'   1 gennaio
'  25 aprile
'   1 maggio
'  15 agosto
'   1 novembre
'   8 dicembre
'  25 dicembre
'  26 dicembre
'  lunedì di pasqua
'  tutti i sabati o domeniche
'
If DATA_VALUTA = LunedìDiPasqua Or _
   Format(DATA_VALUTA, "DD/MM/YYYY") = "01/01/" & Format(DATA_VALUTA,
"YYYY") Or _
   Format(DATA_VALUTA, "DD/MM/YYYY") = "06/01/" & Format(DATA_VALUTA,
"YYYY") Or _
   Format(DATA_VALUTA, "DD/MM/YYYY") = "25/04/" & Format(DATA_VALUTA,
"YYYY") Or _
   Format(DATA_VALUTA, "DD/MM/YYYY") = "01/05/" & Format(DATA_VALUTA,
"YYYY") Or _
   Format(DATA_VALUTA, "DD/MM/YYYY") = "15/08/" & Format(DATA_VALUTA,
"YYYY") Or _
   Format(DATA_VALUTA, "DD/MM/YYYY") = "01/11/" & Format(DATA_VALUTA,
"YYYY") Or _
   Format(DATA_VALUTA, "DD/MM/YYYY") = "08/12/" & Format(DATA_VALUTA,
"YYYY") Or _
   Format(DATA_VALUTA, "DD/MM/YYYY") = "25/12/" & Format(DATA_VALUTA,
"YYYY") Or _
   Format(DATA_VALUTA, "DD/MM/YYYY") = "26/12/" & Format(DATA_VALUTA,
"YYYY") Or _
   Format(DATA_VALUTA, "W", vbMonday) = "6" Or _
   Format(DATA_VALUTA, "W", vbMonday) = "7" Then
   VerificaFestivo = True
Else
   VerificaFestivo = False
 
End If
End Function
Private Sub Command1_Click()
    MsgBox VerificaFestivo(Text1.Text)
End Sub
 
-- 
questo articolo e` stato inviato via web dal servizio gratuito 
http://www.newsland.it/news
 segnala gli abusi ad 
ab...@newsland.it

 ha scritto nel messaggio 
news:42496520$1...@news.unimib.it...

Sei sicuro? A me sembrava che quell'intercalare fosse tipico dell'avvocato 
cocainomane di Johnny Stecchino...ma magari sbaglio eh???
Bye

 ha scritto nel messaggio 
news:d2bp2b$t4o$1...@news.newsland.it...


 spettacolo...
ben ben meno il tuo quoting :-(
-- 
ciao, hal

"Phanqlow" <one...@NOSPAMinterfree.it> ha scritto nel messaggio news:d2c1bm$aqi$1...@carabinieri.cs.interbusiness.it...

adesso che ci penso in effetti hai ragione...
devo rivederlo + spesso!

 Ciao
Hai fatto centro.
Grazie
Paolo

Hal ti becco sul NG perchè non ho un tuo indirizzo email.
Mi è arrivata una mail importante da Aruba e vorrei forwardartela su 
qualche indirizzo valido.
bye
-- 
Gestione Ottica - Gestionale per Ottici e Programmi Gratuiti su:
http://www.nicolaottomano.it
Sinapsi Antispam. Antispam Gratuito.
http://www.nicolaottomano.it/sinapsi.htm
email spamtrap: 
spam...@nicolaottomano.it