Version du code "Calculatrice de Jours" sans utilisation de la librairie Calendar.DLL.
ATTENTION la librairie Calendar.dll fonctionne qu'avec une version 32bits de PureBasic
Code : Tout sélectionner
;http://mikhajduk.houa.org/EN/index.php?f=Links
' ATTENTION la librairie Calendar.dll fonctionne qu'avec une version 32bits de PureBasic
; Mesa http://www.purebasic.fr/french/viewtopic.php?f=12&t=14145
; Kernadec http://www.purebasic.fr/french/viewtopic.php?f=3&t=14026
; The library contains 8 functions For operations With dates:
;
; DayOfWeek - calculates the day of the week For the given date,
; IsLeapYear - determines If the given year is leap IN the chosen calendar,
; MDToDayNum - calculates the ordinal number of the day IN the year,
; DayNumToMD - converts the ordinal number of the day IN the year To the adequate month And day numbers,
; DateToAbsDayNum - calculates the absolute day number For the given date,
; AbsDayNumToDate - converts the absolute day number To the adequate Date (For the chosen calendar),
; GregorianToJulian - converts the Gregorian date To the adequate Julian date,
; JulianToGregorian - converts the Julian date To the adequate Gregorian date.
; Calendar functions library written with FASM assembler.
;
; Abilities:
; * works with dates from the interval of 11 million years:
; - from 1 Jan 5843880 BCE to 3 Aug 5915100 for the Julian calendar,
; - from 30 Dec 5844001 BCE to 17 Jan 5915222 for the Gregorian calendar,
; * convenient conversions between Julian and Gregorian calendars for dates
; from supported time interval,
; * calculation of the day of the week for the given date,
; * calculation of the number of the day in the year,
; * determining if the given year is leap in chosen calendar,
; * calculation of the "absolute" day number for the given date (it could be
; used to calculation of the distance between two dates).
;
; (C) Mikolaj Hajduk, 16.06.2008.
; Translation in PureBasic 5.xx by Mesa.
; Definitions of the used constants.
;
; Global C1 = 365 ; Number of days in a normal year.
;
; Global C4 = 4*C1 + 1 ; Number of days in the 4-year cycle (base cycle of the Julian
; ; calendar).
;
; Global C100 = 25*C4 - 1 ; Number of days in a "normal" century in the Gregorian calendar
; ; (i.e. century ending with a normal, 365-day, year).
;
; Global C400 = 4*C100 + 1 ; Number of days in the complete 400-year cycle of the Gregorian
; ; calendar.
;
; Global k = 30
;
; Global J = 194796 ; The constants J and G are equal to the numbers of the complete years
; Global G = 194800 ; of the Julian and Gregorian calendars respectively contained in the
; time interval given by "Great Cycle" T.
; section '.data' Data readable writeable
; Table containing lengths of months of a normal year (first 12 elements) and a leap year
; (next 12 elements).
;
; MonthLen DB 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31
; DB 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31
; Table containing values of the function 'DaySum' for every pair (month number, leap year flag).
;
; DaySum DW 0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334
; DW 0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335
;=============================== Debug =====================================
;Global debugexx ; Use for debugging
; --------debug--------------
; MOV debugexx, eax
; Debug debugexx
; ---------------------------
;=============================== Procedures =================================
; DWORD IsLeapYear(DWORD Y, DWORD Gregorian)
;
; This function determines if the given year is leap in the chosen calendar.
;
; Parameters:
; Y - year,
; Gregorian - chosen calendar (0 - Julian, 1 - Gregorian).
;
; Returned values:
; * 1 if the year Y is leap, 0 - in opposite case,
; * -1 for the invalid parameters.
;
;proc IsLeapYear, Y, Gregorian
Procedure.l IsLeapYear(year.l, gregorian.l)
EnableASM
; PUSHFD
; PUSH ebx edx
checkparameters:
TEST gregorian, -2 ; 0 <= Gregorian <= 1
JNZ l_isleapyear_error
isynegative:
MOV eax, year ; eax := Y =year
TEST eax, eax
JZ l_isleapyear_error
JNS l_isleapyear_checkcalendar
; eax < 0 (Y < 0)
INC eax ; eax := eax + 1
NEG eax ; eax := -eax = -(Y + 1) = -Y - 1 =
; = |Y| - [Y < 0] = Y'
checkcalendar:
CMP gregorian, 0
JE l_isleapyear_mod4
gregorian:
XOr edx, edx ; eax := E(eax / 100) = E(Y' / 100)
MOV ecx, 100 ; edx := eax mod 100 = Y' mod 100
DIV ecx ; div=(edx:eax)/ecx -> Quotient=eax Reste=edx
; Long .l 4 octets -2147483648 à +2 147 483 647
TEST edx, edx
JZ l_isleapyear_mod4
MOV eax, edx ; eax := edx = Y' mod 100
; {(Y' mod 100) mod 4 = Y' mod 4}
mod4:
SHR eax, 1 ; eax := E(eax / 2); CF := eax mod 2
JC l_isleapyear_result ;
SHR eax, 1 ; eax := E(eax / 2); CF := eax mod 2
JMP l_isleapyear_result ;
error:
MOV eax, -1
JMP l_isleapyear_theend
result:
SETNC al ; eax := not CF
MOVZX eax, al
theend:
; POP edx ebx
; POPFD
DisableASM
ProcedureReturn
EndProcedure
; DWORD MDToDayNum(DWORD M, DWORD D, DWORD LeapYearFlag)
;
; This function calculates the ordinal number of the day in the year.
;
; Parameters:
; M - month,
; D - day,
; LeapYearFlag - flag determining if the year is leap (0 - normal year, 1 - leap year).
;
; Returned values:
; * 1, 2, ..., 365 for the normal year, 1, 2, ..., 366 for the leap year,
; * -1 for the invalid parameters.
;
;proc MDToDayNum, M, D, LeapYearFlag
Procedure.l MDToDayNum(M.l, D.l, LeapYearFlag.l)
EnableASM
leapyearflag:
TEST LeapYearFlag, -2 ; 0 <= LeapYearFlag <= 1
JNZ l_mdtodaynum_error ;
month:
CMP M, 1
JB l_mdtodaynum_error ; 1 <= M <= 12
CMP M, 12
JA l_mdtodaynum_error
day:
CMP D, 1 ; D >= 1
JB l_mdtodaynum_error
MOV eax, LeapYearFlag ; eax := LeapYearFlag
LEA eax, [eax + 2*eax] ; eax := 3*eax = 3*LeapYearFlag
SHL eax, 2 ; eax := 4*eax = 12*LeapYearFlag
LEA ecx,[monthlen2] ;eax => MonthLen[M - 1 + 12*LeapYearFlag]
DEC ecx ; -1
MOV edx, M ;+M
ADD ecx, edx
ADD ecx, eax ;+12*LeapYearFlag
MOV edx, eax ; Sauvegarde de 12*LeapYearFlag
MOVZX eax, byte [ecx]
CMP D, eax ; D <= MonthLen[M - 1 + 12*LeapYearFlag]
JA l_mdtodaynum_error ;
calculatedaynum:
SHL edx, 1 ; edx := 2*edx = 24*LeapYearFlag (2 parce que word et non byte)
;MOVZX eax, [DaySum - 2 + edx + 2*M]
LEA ecx,[daysum2]
DEC ecx ; -1
DEC ecx ; -1
ADD ecx, edx ;+24*LeapYearFlag
MOV edx, M
ADD ecx, edx ;+M
ADD ecx, edx ;+M
MOVZX eax, word [ecx]
ADD eax, D ; eax := eax + D = DaySum(M, LeapYearFlag) + D
JMP l_mdtodaynum_theend
error:
MOV eax, -1
theend:
DisableASM
ProcedureReturn
!monthlen2:
!DB 31,28,31,30,31,30,31,31,30,31,30,31,31,29,31,30,31,30,31,31,30,31,30,31
!daysum2:
!DW 0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334
!DW 0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335
EndProcedure
;
; DWORD DayNumToMD(DWORD n, DWORD LeapYearFlag, DWORD* M, DWORD* D)
;
; This function converts the ordinal number of the day in the year to the adequate month and day numbers.
; The result strongly depends on the flag determining if the year is leap.
;
; Parameters:
; n - number of the day in the year,
; LeapYearFlag - flag determining if the year is leap (0 - normal year, 1 - leap year),
; M - pointer to variable where the calculated month number will be stored,
; D - pointer to variable where the calculated day number will be stored.
;
; Returned values:
; * 0 for the valid parameters (n, LeapYearFlag),
; * -1 in opposite case.
;
;proc DayNumToMD, n, LeapYearFlag, M, D
Procedure.l DayNumToMD(N.l, LeapYearFlag.l, M.l, D.l)
Protected tmp.l
EnableASM
checkparameters:
TEST LeapYearFlag, -2 ; 0 <= LeapYearFlag <= 1
JNZ l_daynumtomd_error
CMP n, 1 ; n >= 1
JB l_daynumtomd_error ;Jump short if below (CF=1).
MOV eax, 365
ADD eax, LeapYearFlag ; eax := 365 + LeapYearFlag
CMP n, eax ; n <= eax
JA l_daynumtomd_error
calculatemd:
MOV eax, LeapYearFlag ; eax := LeapYearFlag
LEA eax, [eax + 2*eax]; eax := 3*eax = 3*LeapYearFlag
SHL eax, 3 ; eax := 8*eax = 24*LeapYearFlag
MOV tmp, eax ; Sauvegarde de 24*LeapYearFlag dans tmp
MOV ecx, 12 ;
lloop: ; ecx := max{i; 1 <= i <= 12, DaySum(i, LeapYearFlag) < n} = m
LEA eax,[daysum]
DEC eax
DEC eax
ADD eax, tmp
ADD eax, ecx
ADD eax, ecx
MOVZX edx, word [eax];MOVZX edx, [DaySum - 2 + ebx + 2*ecx]
CMP n, edx ; edx := DaySum(m, LeapYearFlag)
JA l_daynumtomd_loopend
LOOP l_daynumtomd_lloop
loopend:
MOV eax, M ; M := ecx = m
MOV [eax], ecx
MOV ecx, n ; ecx := n
SUB ecx, edx ; ecx := ecx - edx = n - DaySum(m, LeapYearFlag)
MOV eax, D ; D := ecx
MOV [eax], ecx
XOr eax, eax
JMP l_daynumtomd_theend
error:
MOV eax, -1
theend:
DisableASM
ProcedureReturn
!daysum:
!DW 0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334
!DW 0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335
EndProcedure
;
; DWORD DateToAbsDayNum(DWORD Y, DWORD M, DWORD D, DWORD Gregorian)
;
; This function calculates the absolute day number for the given date.
;
; Parameters:
; Y - year,
; M - month,
; D - day,
; Gregorian - chosen calendar (0 - Julian, 1 - Gregorian).
;
; Returned values:
; * 1, 2, ..., 2^32-1 for the valid date in the chosen calendar,
; * 0 for the invalid parameters.
;
;proc DateToAbsDayNum, Y, M, D, Gregorian
Procedure.l DateToAbsDayNum( Y.l, M.l, D.l, Gregorian.l)
;PUSHFD
;PUSH ebx ecx edx
Protected X.l
EnableASM
TEST Gregorian, -2 ; 0 <= Gregorian <= 1
JNZ l_datetoabsdaynum_error
IsLeapYear(Y, Gregorian)
CMP eax, -1 ; eax := IsLeapYear(Y, Gregorian)
JE l_datetoabsdaynum_error
; Y <> 0
;MOV ebx, eax ; ebx := eax
MOV X, eax
MDToDayNum(M, D, X) ;ebx
CMP eax, -1 ; eax := MDToDayNum(M, D, ebx) = n
JE l_datetoabsdaynum_error
MOV ecx, Y
CMP ecx, 0 ; ecx := Y
JG l_datetoabsdaynum_calculatedaynum
INC ecx ; Y < 0
; ecx := ecx + 1 = Y + 1 = Y + [Y < 0]
calculatedaynum:
; Global k = 30
; Global J = 194796 ; The constants J and G are equal to the numbers of the complete years
; Global G = 194800 ; of the Julian and Gregorian calendars respectively contained in the
; time interval given by "Great Cycle" T.
ADD ecx, 5843880; k*J
CMP Gregorian, 0 ; ecx := ecx + kJ + k(G-J)[Gregorian = 1] =
JE l_datetoabsdaynum_yprim0 ; = Y + [Y < 0] + kJ + k(G-J)[Gregorian = 1] = Y'
ADD ecx, 120; k*(G-J) ;
; Global k = 30
; Global J = 194796 ; The constants J and G are equal to the numbers of the complete years
; Global G = 194800 ; of the Julian and Gregorian calendars respectively contained in the
; time interval given by "Great Cycle" T.
yprim0:
CMP ecx, 0
JNE l_datetoabsdaynum_yprimpositive ; Y' = 0
SUB eax, 364 ; eax := eax - 364 = n - 364
JMP l_datetoabsdaynum_theend
yprimpositive: ; Y' > 0
DEC ecx ; ecx := ecx - 1 = Y' - 1
MOV X, eax
MOV eax, 365 ; eax := 365
MUL ecx ; eax := 365 * ecx = 365(Y' - 1);(EDX:EAX <- EAX * r/m32
SHR ecx, 2 ; ecx := E(ecx / 4) = E((Y' - 1) / 4)
ADD eax, ecx ; eax := eax + ecx = 365(Y' - 1) + E((Y' - 1) / 4)
ADD eax, X ; = 365(Y' - 1) + E((Y' - 1) / 4) + n
CMP Gregorian, 0
JZ l_datetoabsdaynum_theend
gregorian:
MOV X, eax ; Sauvegarde de eax
XOr edx, edx ;
MOV eax, ecx ; eax := ecx = E((Y' - 1) / 4)
MOV ecx, 25 ;
DIV ecx ; eax := E(eax / 25) = E(E((Y' - 1) / 4) / 25) =
; = E((Y' - 1) / 100)
;Unsigned divide EDX:EAX by r/m32, with
;result stored IN EAX <- Quotient, EDX <- Remainder.
MOV ecx, eax ; ecx := eax = E((Y' - 1) / 100)
; eax := X = 365(Y' - 1) + E((Y' - 1) / 4) + n
MOV eax, X
SUB eax, ecx ; eax := eax - ecx = 365(Y' - 1) + E((Y' - 1) / 4) + n -
; - E((Y' - 1) / 100)
SHR ecx, 2 ; ecx : = E(ecx / 4) = E(E((Y' - 1) / 100) / 4) =
; = E((Y' - 1) / 400)
ADD eax, ecx ; eax := eax + ecx = 365(Y' - 1) + E((Y' - 1) / 4) + n -
; - E((Y' - 1) / 100) + E((Y' - 1) / 400)
ADD eax, 2 ; eax := eax + 2 = 365(Y' - 1) + E((Y' - 1) / 4) + n -
; - E((Y' - 1) / 100) + E((Y' - 1) / 400) + 2 =
; = N
JMP l_datetoabsdaynum_theend
error:
XOr eax, eax
theend:
;POP edx ecx ebx
;POPFD
DisableASM
ProcedureReturn
EndProcedure
;
;
; DWORD AbsDayNumToDate(DWORD N, DWORD Gregorian, DWORD* Y, DWORD* M, DWORD* D)
;
; This function converts the absolute day number N = 1, 2, ..., 2^32-1 to the adequate date (for the chosen calendar).
;
; Parameters:
; N - absolute day number,
; Gregorian - chosen calendar (0 - Julian, 1 - Gregorian),
; Y - pointer to variable where the calculated year number will be stored,
; M - pointer to variable where the calculated month number will be stored,
; D - pointer to variable where the calculated day number will be stored.
;
; Returned values:
; * 0 for the valid parameters (N, Gregorian),
; * -1 in opposite case.
;
;proc AbsDayNumToDate, N, Gregorian, Y, M, D
Procedure AbsDayNumToDate( N.l, Gregorian.l, Y.l, M.l, D.l)
;PUSHFD
;PUSH ebx ecx edx
Protected.l tmpeax, tmpecx, tmpedx, tmpeflags, tmp
EnableASM
CMP N, 0 ; N <> 0 ; l'année n'existe pas
JE l_absdaynumtodate_error ;
TEST Gregorian, -2 ; 0 <= Gregorian <= 1
JNZ l_absdaynumtodate_error ;
XOr ecx, ecx ; ecx := 0
MOV eax, N ; eax := N - 1
DEC eax ;
CMP Gregorian, 0
JE l_absdaynumtodate_julian
gregorian:
CMP eax, 1
JA l_absdaynumtodate_nextdays ;Jump short if above (CF=0 and ZF=0).
; 0 <= eax <= 1 (1 <= N <= 2)
MOV ecx, M ; M := 12
MOV dword [ecx], 12 ;
ADD eax, 30 ; eax := eax + 30 = N - 1 + 30 = N + 29
MOV ecx, D ; D := eax = N + 29
MOV [ecx], eax ;
MOV ecx, -5844001 ; -k*G - 1 ; ecx := -kG - 1 = -5844001
; Global k = 30
; Global J = 194796 ; The constants J and G are equal to the numbers of the complete years
; Global G = 194800 ; of the Julian and Gregorian calendars respectively contained in the
; time interval given by "Great Cycle" T.
JMP l_absdaynumtodate_yearr
nextdays: ; eax > 1 (N > 2)
SUB eax, 2 ; eax := eax - 2 = N - 1 - 2 = N - 3
XOr edx, edx ;
; Global C1 = 365 ; Number of days in a normal year.
; Global C4 = 4*C1 + 1 = 1461 ; Number of days in the 4-year cycle (base cycle of the Julian calendar).
; Global C100 = 25*C4 - 1 = 36524; Number of days in a "normal" century in the Gregorian calendar
; ; (i.e. century ending with a normal, 365-day, year).
; Global C400 = 4*C100 + 1 = 146097 ; Number of days in the complete 400-year cycle of the Gregorian calendar.
MOV ecx, 146097 ;C400 ; eax := E(eax / C400) = E((N - 3) / C400)
DIV ecx ; edx := eax mod C400 = (N - 3) mod C400
LEA eax, [eax + 4*eax] ; eax := 5*eax = 5*E((N - 3) / C400)
LEA eax, [eax + 4*eax] ; eax := 5*eax = 5*(5*E((N - 3) / C400)) =
; = 25*E((N - 3) / C400)
SHL eax, 4 ; eax := 16*eax = 16*(25*E((N - 3) / C400)) =
; = 400*E((N - 3) / C400)
XCHG ecx, eax ; ecx := eax = 400*E((N - 3) / C400)
XCHG eax, edx ; eax := edx = (N - 3) mod C400
centuries: ;
CMP eax, 36524 ; C100
JB l_absdaynumtodate_julian ;Jump short if below (CF=1).
ADD ecx, 100
SUB eax, 36524 ; C100
CMP eax, 36524 ; C100 ; (eax, ecx) := P(eax, ecx) =
JB l_absdaynumtodate_julian ; = P((N - 3) mod C400, 400*E((N - 3) / C400)) =
; = (N100, Y100)
ADD ecx, 100
SUB eax, 36524 ; C100
CMP eax, 36524 ; C100
JB l_absdaynumtodate_julian
ADD ecx, 100
SUB eax, 36524 ; C100
julian:
; /
; | (N - 1, 0) ; Gregorian = 0
; (N100, Y100) = (eax, ecx) = <
; | P((N - 3) mod C400, 400*E((N - 3) / C400)) ; Gregorian = 1
; \
PUSH ecx
XOr edx, edx
MOV ecx, 1461 ; C4 ; eax := E(eax / C4) = E(N100 / C4)
DIV ecx ; edx := eax mod C4 = N100 mod C4
POP ecx
SHL eax, 2 ; eax := 4*eax = 4*E(N100 / C4)
ADD ecx, eax ; ecx := ecx + eax = Y100 + 4*E(N100 / C4)
years:
INC ecx
CMP edx, 365 ; C1
JB l_absdaynumtodate_md
SUB edx, 365 ; C1
INC ecx ; (edx, ecx) := Q(edx, ecx) =
CMP edx, 365 ; C1 ; = Q(N100 mod C4, Y100 + 4*E(N100 / C4)) =
JB l_absdaynumtodate_md ; = (N', Y*)
SUB edx, 365 ; C1
INC ecx
CMP edx, 365 ; C1
JB l_absdaynumtodate_md
SUB edx, 365 ; C1
INC ecx
md:
INC edx ; edx := edx + 1 = N' + 1
;sauvegarde
MOV tmpeax, eax
MOV tmpecx, ecx
MOV tmpedx, edx
IsLeapYear(tmpecx, Gregorian) ; eax := IsLeapYear(ecx=year, Gregorian) =
; = IsLeapYear(Y*, Gregorian)
MOV tmpeax, eax
;DayNumToMD(n.l, LeapYearFlag.l, M.l, D.l)
DayNumToMD(tmpedx, tmpeax, M, D)
MOV ecx,tmpecx
MOV edx,tmpedx
CMP Gregorian, 0
JE l_absdaynumtodate_julianyears
gregorianyears:
SUB ecx, 120 ;k*(G - J) ;k*(G - J)=180
; ecx := ecx - kJ - k(G - J)[Gregorian = 1] =
julianyears: ; = Y* - kJ - k(G - J)[Gregorian = 1] =
SUB ecx, 5843880 ;k*J ; = Y';k*J=5843880
CMP ecx, 0
JG l_absdaynumtodate_yearr
; ecx <= 0 (Y' <= 0)
DEC ecx ; ecx := ecx - 1 = Y' - 1 = Y' - [Y' <= 0]
yearr:
MOV eax, Y ; Y := ecx
MOV [eax], ecx
XOr eax, eax
JMP l_absdaynumtodate_theend
error:
MOV eax, -1
theend:
;POP edx ecx ebx
;POPFD
DisableASM
ProcedureReturn
EndProcedure
;
;
; DWORD DayOfWeek(DWORD Y, DWORD M, DWORD D, DWORD Gregorian)
;
; This function calculates the day of the week for the given date. Each day of the week is identified by number:
; 0 - Sunday, 1 - Monday, 2 - Tuesday, 3 - Wednesday, 4 - Thursday, 5 - Friday, 6 - Saturday.
;
; Parameters:
; Y - year,
; M - month,
; D - day,
; Gregorian - chosen calendar (0 - Julian, 1 - Gregorian).
;
; Returned values:
; * 0, 1, ..., 6 if the date is valid,
; * -1 for the invalid parameters.
;
Procedure.l DayOfWeekAsm(Y.l, M.l, D.l, Gregorian.l)
EnableASM
; PUSHFD
; PUSH ebx edx
DateToAbsDayNum(Y, M, D, Gregorian)
TEST eax, eax
JZ l_dayofweekasm_error
MOV ecx, 7 ;
XOr edx, edx ;
ADD eax, 5 ; edx := (eax + 5) mod 7 = (N + 5) mod 7
ADC edx, edx ;
DIV ecx
XCHG eax, edx ; eax := edx
JMP l_dayofweekasm_theend
error:
MOV eax, -1
theend:
DisableASM
ProcedureReturn
; POP edx ebx
; POPFD
EndProcedure
;
;
;
; DWORD GregorianToJulian(DWORD Yg, DWORD Mg, DWORD Dg, DWORD* Yj, DWORD* Mj, DWORD* Dj)
;
; This function converts the Gregorian date to the adequate Julian date.
;
; Parameters:
; Yg - year of the Gregorian date,
; Mg - month of the Gregorian date,
; Dg - day of the Gregorian date,
; Yj - pointer to variable where the calculated year number of the Julian date will be stored,
; Mj - pointer to variable where the calculated month number of the Julian date will be stored,
; Dj - pointer to variable where the calculated day number of the Julian date will be stored.
;
; Returned values:
; * 0 for the valid Gregorian date,
; * -1 in opposite case.
;
Procedure.l GregorianToJulian( Yg.l, Mg.l, Dg.l, Yj.l, Mj.l, Dj.l)
Protected tmpeax.l
EnableASM
gregoriantonum:
DateToAbsDayNum( Yg, Mg, Dg, 1)
MOV tmpeax, eax
TEST eax, eax
JZ l_gregoriantojulian_error
numtojulian:
AbsDayNumToDate( tmpeax, 0, Yj, Mj, Dj)
JMP l_gregoriantojulian_theend
error:
MOV eax, -1
theend:
DisableASM
ProcedureReturn
EndProcedure
;
; DWORD JulianToGregorian(DWORD Yj, DWORD Mj, DWORD Dj, DWORD* Yg, DWORD* Mg, DWORD* Dg)
;
; This function converts the Julian date to the adequate Gregorian date.
;
; Parameters:
; Yj - year of the Julian date,
; Mj - month of the Julian date,
; Dj - day of the Julian date,
; Yg - pointer to variable where the calculated year number of the Gregorian date will be stored,
; Mg - pointer to variable where the calculated month number of the Gregorian date will be stored,
; Dg - pointer to variable where the calculated day number of the Gregorian date will be stored.
;
; Returned values:
; * 0 for the valid Julian date,
; * -1 in opposite case.
;
Procedure.l JulianToGregorian( Yj.l, Mj.l, Dj.l, Yg.l, Mg.l, Dg.l)
Protected tmpeax.l
EnableASM
juliantonum:
DateToAbsDayNum( Yj, Mj, Dj, 0)
MOV tmpeax, eax
TEST eax, eax
JZ l_juliantogregorian_error
numtogregorian:
AbsDayNumToDate( tmpeax, 1, Yg, Mg, Dg)
JMP l_juliantogregorian_theend
error:
MOV eax, -1
theend:
DisableASM
ProcedureReturn
EndProcedure
;#################################################################################
; Calculatrice de Jours - kernadec - 10-2013 Version 2014.1.7 avec années avant J.C.
; PB 5.20LTS - Windows XP (x86) & Seven 32 - sans la bibliothèque calendar.dll
; utilisation des procedures calendar.dll adaptées en PB ASM par Mesa
; Remerciement : Mikołaj Hajduk et Mesa pour leur excellent travail.
;#################################################################################
Enumeration
#window
EndEnumeration
Enumeration
#font0
#font1
#font2
EndEnumeration
Enumeration
#gadget11
#gadget12
#gadget13
#gadget14
#gadget15
#gadget16
#gadget17
#gadget18
#gadget19
#gadget20
#gadget21
#gadget23
#gadget22
#gadget24
#gadget26
#gadget29
#gadget27
#gadget30
#gadget31
#gadget33
#gadget25
#gadget32
#gadget34
#gadget28
#gadget35
#gadget36
#gadget37
#gadget38
EndEnumeration
Structure calcul
njour.l
n1jour.l
njour_or.l
jour_mois$
Nbjour2GJ.l
Nbjour2date$
greg2jul$
jul2greg$
EndStructure
Global Dim result.calcul(1)
Global Dim Jours.s(6)
Global Dim mois.s(12)
Global Dim saint.s(366)
Global Dim semaine(53,1)
Global Dim bissextile(1) ; ajout d'un tableau pour éviter la confusion à l'affichage de deux dates différentes
Global Gregorian.l = 1, LeapYearFlag.l, article$, Y.l, M.l, D.l, Yg.l, Mg.l, Dg.l, Yj.l, Mj.l, Dj.l, N.l
Restore Jour
For i=0 To 6
Read.s jours.s(i)
Next i
Restore mois
For i=1 To 12
Read.s mois.s(i)
Next i
Restore fetes
For i=1 To 366
Read.s saint.s(i)
Next i
Macro Fete(N)
If Left(saint(N),1)="A" Or Left(saint(N),1)="E" Or Left(saint(N),1)="I" Or Left(saint(N),1)="O" Or Left(saint(N),1)="U" Or Left(saint(N),1)="I" Or Left(saint(N),1)="Y" Or Left(saint(N),1)="H"
If Left(saint(N),1)=" "
article$ = ""
Else
article$ = " Fête d' "
EndIf
Else
If Left(saint(N),1)=" "
article$ = ""
Else
article$ = " Fête de "
EndIf
EndIf
EndMacro
Macro Calculs_Fevrier(a,b,c,dat)
If GetGadgetState(b) = 2 And GetGadgetState(a) = 31 ;no exist
If Bissextile(dat) = 0 : SetGadgetText(a, "28") : SetGadgetState(a,28)
Else : Bissextile(dat) = 1 : SetGadgetText(a, "29") : SetGadgetState(a,29) : EndIf : EndIf
If GetGadgetState(b) = 2 And GetGadgetState(a) = 30 ;no exist
If Bissextile(dat) = 0 : SetGadgetText(a, "28") : SetGadgetState(a,28)
Else : Bissextile(dat) = 1 : SetGadgetText(a, "29") : SetGadgetState(a,29) : EndIf : EndIf
If GetGadgetState(b) = 2 And GetGadgetState(a) = 29
If Bissextile(dat) = 0 : SetGadgetText(a, "28") : SetGadgetState(a,28)
Else : Bissextile(dat) = 1 : SetGadgetText(a, "29") : SetGadgetState(a,29) : EndIf
EndIf
EndMacro
Procedure Affiche_resultats( dat, g)
;Debug "Nombre Ordinal du Jour de l'année = "+Str(result(dat)\njour_or)
;Debug "Jour et Mois de l'année à partir d'un nombre ordinal = "+result(dat)\jour_mois$
;Debug "Nombre de Jours = "+Str(result(dat)\Nbjour2GJ)
;Debug "Reconversion nb Jour en Date = "+result(dat)\Nbjour2date$
;Debug "Conversion de Date Gregorian en Julien = "+result(dat)\greg2jul$
;Debug "Conversion de Date Julian en Gregorian = "+result(dat)\jul2greg$
;Debug "Nombre de Jours entre date= "+Str(result(1)\Nbjour2GJ-result(0)\Nbjour2GJ)
If dat = 0 ; affiche le jour
If (GetGadgetState(#gadget11) =>1 And GetGadgetState(#gadget11) <= 31) And (GetGadgetState(#gadget12) =>1 And GetGadgetState(#gadget12) <= 12) ;test wheel inc / dec trop rapide
; Debug "Le "+Str(GetGadgetState(#gadget11))+"/"+Str(GetGadgetState(#gadget12))+"/"+Str(GetGadgetState(#gadget13))+" est un "+Jours(result(dat)\njour)
If GetGadgetState(#gadget12) = 4 Or GetGadgetState(#gadget12) = 6 Or GetGadgetState(#gadget12) = 9 Or GetGadgetState(#gadget12) = 11
If GetGadgetState(#gadget11) = 31 ; test les mois de 30 jours
Else
SetGadgetText(#gadget26, Jours(result(dat)\njour))
EndIf
Else
SetGadgetText(#gadget26, Jours(result(dat)\njour))
EndIf
EndIf
Else ; affiche le jour
If (GetGadgetState(#gadget14) =>1 And GetGadgetState(#gadget14) <= 31) And (GetGadgetState(#gadget15) =>1 And GetGadgetState(#gadget15) <= 12) ;test wheel inc / dec trop rapide
; Debug "Le "+Str(GetGadgetState(#gadget14))+"/"+Str(GetGadgetState(#gadget15))+"/"+Str(GetGadgetState(#gadget16))+" est un "+Jours(result(dat)\njour)
If GetGadgetState(#gadget15) = 4 Or GetGadgetState(#gadget15) = 6 Or GetGadgetState(#gadget15) = 9 Or GetGadgetState(#gadget15) = 11
If GetGadgetState(#gadget14) = 31 ; test les mois de 30 jours
Else
SetGadgetText(#gadget29, Jours(result(dat)\njour))
EndIf
Else
SetGadgetText(#gadget29, Jours(result(dat)\njour))
EndIf
EndIf
EndIf
;
If Bissextile(dat) = 1 ; affiche prénoms des fêtes
If result(dat)\njour_or = 60
fete(result(dat)\njour_or)
SetGadgetText(g, article$ + saint(366)) ; 29 février saint auguste a été changé de place dans le tableau de (60) vers (366)
ElseIf result(dat)\njour_or > 60
fete(result(dat)\njour_or - 1)
SetGadgetText(g, article$ + saint(result(dat)\njour_or - 1))
Else
fete(result(dat)\njour_or)
SetGadgetText(g, article$ + saint(result(dat)\njour_or))
EndIf
EndIf
If Bissextile(dat) = 0
If GetGadgetState(#gadget12) = 2
fete(result(dat)\njour_or)
SetGadgetText(g, article$ + saint(result(dat)\njour_or))
EndIf
If GetGadgetState(#gadget12) = 4 Or GetGadgetState(#gadget12) = 6 Or GetGadgetState(#gadget12) = 9 Or GetGadgetState(#gadget12) = 11
If GetGadgetState(#gadget11) = 31 ; test les mois de 30 jours
Else
fete(result(dat)\njour_or)
SetGadgetText(g, article$ + saint(result(dat)\njour_or))
EndIf
EndIf
If GetGadgetState(#gadget12) = 1 Or GetGadgetState(#gadget12) = 3 Or GetGadgetState(#gadget12) = 5 Or GetGadgetState(#gadget12) = 7 Or GetGadgetState(#gadget12) = 8 Or GetGadgetState(#gadget12) = 10 Or GetGadgetState(#gadget12) = 12
fete(result(dat)\njour_or)
SetGadgetText(g, article$ + saint(result(dat)\njour_or))
EndIf
EndIf
If Bissextile(dat) = 0
If GetGadgetState(#gadget15) = 2
fete(result(dat)\njour_or)
SetGadgetText(g, article$ + saint(result(dat)\njour_or))
EndIf
If GetGadgetState(#gadget15) = 4 Or GetGadgetState(#gadget15) = 6 Or GetGadgetState(#gadget15) = 9 Or GetGadgetState(#gadget15) = 11
If GetGadgetState(#gadget14) = 31 ; test les mois de 30 jours
Else
fete(result(dat)\njour_or)
SetGadgetText(g, article$ + saint(result(dat)\njour_or))
EndIf
EndIf
If GetGadgetState(#gadget15) = 1 Or GetGadgetState(#gadget15) = 3 Or GetGadgetState(#gadget15) = 5 Or GetGadgetState(#gadget15) = 7 Or GetGadgetState(#gadget15) = 8 Or GetGadgetState(#gadget15) = 10 Or GetGadgetState(#gadget15) = 12
fete(result(dat)\njour_or)
SetGadgetText(g, article$ + saint(result(dat)\njour_or))
EndIf
EndIf
;
If dat = 0 ; affiche en date julien 1
SetGadgetText(#gadget17,result(dat)\greg2jul$)
SetGadgetText(#gadget32,mois(Val(StringField(result(dat)\jour_mois$, 2,"/")))) ; affiche mois
; calcul du numéro de la semaine ISO à partir d'un nombre ordinal
If result(dat)\n1jour = 0
SetGadgetText(#gadget33,"Semaine "+Str(Int((result(dat)\njour_or-2)/7)+1))
EndIf
If result(dat)\n1jour = 1
SetGadgetText(#gadget33,"Semaine "+Str(Int((result(dat)\njour_or-1)/7)+1))
EndIf
If result(dat)\n1jour = 2
SetGadgetText(#gadget33,"Semaine "+Str(Int((result(dat)\njour_or)/7)+1))
EndIf
If result(dat)\n1jour = 3
SetGadgetText(#gadget33,"Semaine "+Str(Int((result(dat)\njour_or-6)/7)+1))
EndIf
If result(dat)\n1jour = 4
SetGadgetText(#gadget33,"Semaine "+Str(Int((result(dat)\njour_or-5)/7)+2))
EndIf
If result(dat)\n1jour = 5
SetGadgetText(#gadget33,"Semaine "+Str(Int((result(dat)\njour_or-4)/7)+2))
EndIf
If result(dat)\n1jour = 6
SetGadgetText(#gadget33,"Semaine "+Str(Int((result(dat)\njour_or-3)/7)+1))
EndIf
SetGadgetText(#gadget34, "Nombre Ordinal "+Str(result(dat)\njour_or)) ; affiche Jour Ordinal
EndIf
If dat = 1 ; affiche en date julien 2
SetGadgetText(#gadget18,result(dat)\greg2jul$)
SetGadgetText(#gadget36,mois(Val(StringField(result(dat)\jour_mois$, 2,"/")))) ; affiche mois
; calcul du numéro de la semaine ISO à partir d'un nombre ordinal
If result(dat)\n1jour = 0
SetGadgetText(#gadget37,"Semaine "+Str(Int((result(dat)\njour_or-2)/7)+1))
EndIf
If result(dat)\n1jour = 1
SetGadgetText(#gadget37,"Semaine "+Str(Int((result(dat)\njour_or-1)/7)+1))
EndIf
If result(dat)\n1jour = 2
SetGadgetText(#gadget37,"Semaine "+Str(Int((result(dat)\njour_or)/7)+1))
EndIf
If result(dat)\n1jour = 3
SetGadgetText(#gadget37,"Semaine "+Str(Int((result(dat)\njour_or-6)/7)+1))
EndIf
If result(dat)\n1jour = 4
SetGadgetText(#gadget37,"Semaine "+Str(Int((result(dat)\njour_or-5)/7)+2))
EndIf
If result(dat)\n1jour = 5
SetGadgetText(#gadget37,"Semaine "+Str(Int((result(dat)\njour_or-4)/7)+2))
EndIf
If result(dat)\n1jour = 6
SetGadgetText(#gadget37,"Semaine "+Str(Int((result(dat)\njour_or-3)/7)+1))
EndIf
SetGadgetText(#gadget38, "Nombre Ordinal "+Str(result(dat)\njour_or)) ; affiche Jour Ordinal
EndIf
If GetGadgetState(#gadget13) = 0 ;pas d'année zéro
result(0)\Nbjour2GJ = 0
SetGadgetText(#gadget17,"0")
SetGadgetText(#gadget20," Pas de calculs - Année zéro inexistante")
Else
result(0)\Nbjour2GJ = DateToAbsDayNum(GetGadgetState(#gadget13),GetGadgetState(#gadget12),GetGadgetState(#gadget11), Gregorian.l)
EndIf
If GetGadgetState(#gadget16) = 0 ;pas d'année zéro
result(1)\Nbjour2GJ = 0
SetGadgetText(#gadget18,"0")
SetGadgetText(#gadget20," Pas de calculs - Année zéro inexistante")
Else
result(1)\Nbjour2GJ = DateToAbsDayNum(GetGadgetState(#gadget16),GetGadgetState(#gadget15),GetGadgetState(#gadget14), Gregorian.l)
EndIf
If result(0)\Nbjour2GJ <> 0 And result(1)\Nbjour2GJ <> 0 ; affiche différence en jours
SetGadgetText(#gadget20,Str(result(1)\Nbjour2GJ)+" - "+Str(result(0)\Nbjour2GJ)+" = "+Str(result(1)\Nbjour2GJ-result(0)\Nbjour2GJ)+" Jours" )
EndIf
EndProcedure
Procedure calendar(Y.l, M.l, D.l, dat)
If Y <> 0
If M > 12 : M = 1 ; test avant calcul si erreur mois du spingadget avec wheel et fleche active
ElseIf M < 1 : M = 12
EndIf
If D <= 0 : D = 1 : EndIf ; test avant calcul si erreur jour du spingadget avec wheel et fleche active
;Cette fonction calcule le jour de la semaine pour la date donnée
result(dat)\njour = DayOfWeekAsm(Y.l, M.l, D.l, Gregorian.l)
;Cette fonction calcule le nom du jour premier janvier de l'année
result(dat)\n1jour = DayOfWeekAsm(Y, 1, 1, Gregorian.l)
;Cette fonction calcule le nombre ordinal du jour dans l'année
result(dat)\njour_or = MDToDayNum(M.l, D.l, bissextile(dat))
N.l = result(dat)\njour_or
;Cette fonction calcule à partir d'un nombre ordinal le jour dans l'année.
Result3 = DayNumToMD(N.l, bissextile(dat), @M.l, @D.l)
result(dat)\jour_mois$=Str(D)+"/"+Str(M)
;Cette fonction convertit la date en nombre absolu de jour (pour le calendrier choisi)
result(dat)\Nbjour2GJ = DateToAbsDayNum( Y.l, M.l, D.l, Gregorian.l)
N.l = result(dat)\Nbjour2GJ
;Cette fonction convertit le nombre absolu de jour "N(epsilon) {1,2,...2^32}" à la date appropriée (pour le calendrier choisi).
Result5 = AbsDayNumToDate( N.l, Gregorian.l, @Y.l, @M.l, @D.l)
result(dat)\Nbjour2date$ = Str(D)+"/"+Str(M)+"/"+Str(Y)
Yg=Y:Mg=M:Dg=D
;Cette fonction convertit la date grégorienne à la date appropriée Julian
Result6 = GregorianToJulian( Yg.l, Mg.l, Dg.l, @Yj.l, @Mj.l, @Dj.l)
result(dat)\greg2jul$ = Str(Dj)+"/"+Str(Mj)+"/"+Str(Yj)
;Cette fonction convertit la date julienne à la date appropriée grégorien.
Result7 = JulianToGregorian( Yj.l, Mj.l, Dj.l, @Yg.l, @Mg.l, @Dg.l)
result(dat)\jul2greg$ = Str(Dg)+"/"+Str(Mg)+"/"+Str(Yg)
EndIf
EndProcedure
Procedure Calculs_Jour(a,b,c,co,dat)
bissextile(dat) = IsLeapYear(GetGadgetState(c), gregorian.l)
For i = 0 To 5
SetGadgetColor(#gadget11 + i, #PB_Gadget_FrontColor, RGB(0,0,0))
Next i
SetGadgetColor(a, #PB_Gadget_FrontColor , co) ; texte spingadget rouge actif
If GetGadgetState(b) = 2 And bissextile(dat) = 0: Jm = 28
ElseIf GetGadgetState(b) = 2 And bissextile(dat) = 1 : Jm = 29
ElseIf GetGadgetState(b) = 4 Or GetGadgetState(b) = 6 Or GetGadgetState(b) = 9 Or GetGadgetState(b) = 11 : Jm = 30
ElseIf GetGadgetState(b) = 1 Or GetGadgetState(b) = 3 Or GetGadgetState(b) = 5 Or GetGadgetState(b) = 7 Or GetGadgetState(b) = 8 Or GetGadgetState(b) = 10 Or GetGadgetState(b) = 12 : Jm = 31
EndIf
If GetGadgetState(a) > Jm :SetGadgetState(a,1) ;test roue +
EndIf
If GetGadgetState(a) < 1 :SetGadgetState(a,Jm) ;test roue -
Else
If Len(Str(GetGadgetState(a))) < 2 : SetGadgetText(a,"0"+Str(GetGadgetState(a))) ;affichage du 0
Else
SetGadgetText(a,Str(GetGadgetState(a)))
EndIf
EndIf
Calculs_Fevrier(a,b,c,dat) ;second test wheel inc / dec trop rapide
If GetGadgetState(#gadget13) <> 0 And GetGadgetState(#gadget16) <> 0 ;pas d'an zero
If GetGadgetState(a) =>1 And GetGadgetState(a) <= 31 ;test wheel inc / dec trop rapide
calendar(GetGadgetState(c), GetGadgetState(b), GetGadgetState(a),dat)
EndIf
EndIf
EndProcedure
Procedure Calculs_Mois(a,b,c,co,dat)
bissextile(dat) = IsLeapYear(GetGadgetState(c), gregorian.l)
For i = 0 To 5
SetGadgetColor(#gadget11 + i, #PB_Gadget_FrontColor, RGB(0,0,0))
Next i
SetGadgetColor(b, #PB_Gadget_FrontColor , co) ; texte spingadget rouge actif
If GetGadgetState(b) = 2 And bissextile(dat) = 0
If GetGadgetState(a) > 28 :SetGadgetText(a, "28") : SetGadgetState(a,28)
EndIf
ElseIf GetGadgetState(b) = 2 And bissextile(dat) = 1
If GetGadgetState(a) > 29 :SetGadgetText(a, "29") : SetGadgetState(a,29)
EndIf
ElseIf GetGadgetState(b) = 4 Or GetGadgetState(b) = 6 Or GetGadgetState(b)=9 Or GetGadgetState(b) = 11
If GetGadgetState(a) = 31 :SetGadgetText(a, "30") : SetGadgetState(a,30)
EndIf
EndIf
If GetGadgetState(b) > 12 :SetGadgetState(b,1): SetGadgetText(b,"01") ;test roue +
ElseIf GetGadgetState(b) < 1 :SetGadgetState(b,12): SetGadgetText(b,"12") ;test roue -
Else
If Len(Str(GetGadgetState(b))) < 2 : SetGadgetText(b,"0"+Str(GetGadgetState(b))) ;affichage du 0
Else
SetGadgetText(b,Str(GetGadgetState(b)))
EndIf
EndIf
Calculs_Fevrier(a,b,c,dat) ;second test wheel inc / dec trop rapide
If GetGadgetState(#gadget13) <> 0 And GetGadgetState(#gadget16) <> 0 ;pas d'an zero
If GetGadgetState(b) =>1 And GetGadgetState(b) <= 12 ;test wheel inc / dec trop rapide
calendar(GetGadgetState(c), GetGadgetState(b), GetGadgetState(a),dat)
EndIf
EndIf
EndProcedure
Procedure Calculs_Annee(a,b,c,co,dat)
For i = 0 To 5
SetGadgetColor(#gadget11 + i , #PB_Gadget_FrontColor, RGB(0,0,0))
Next i
SetGadgetColor(c, #PB_Gadget_FrontColor , co) ; texte spingadget rouge actif
SetGadgetText (c,Str(GetGadgetState(c)))
;Cette fonction détermine si l'année donnée est bissextile dans le calendrier choisi
bissextile(dat) = IsLeapYear(GetGadgetState(c), gregorian.l)
If GetGadgetState(b) = 2 And bissextile(dat) = 0
If GetGadgetState(a) > 28 :SetGadgetText(a, "28") : SetGadgetState(a,28)
EndIf
ElseIf GetGadgetState(b) = 2 And bissextile(dat) = 1
If GetGadgetState(a) > 29 :SetGadgetText(a, "29") : SetGadgetState(a,29)
EndIf
ElseIf GetGadgetState(b) = 4 Or GetGadgetState(b) = 6 Or GetGadgetState(b)=9 Or GetGadgetState(b) = 11
If GetGadgetState(a) = 31 :SetGadgetText(a, "30") : SetGadgetState(a,30)
EndIf
EndIf
If GetGadgetState(b) > 12 :SetGadgetState(b,1) ;test roue +
ElseIf GetGadgetState(b) < 1 :SetGadgetState(b,12) ;test roue -
Else
If Len(Str(GetGadgetState(b))) < 2 : SetGadgetText(b,"0"+Str(GetGadgetState(b))) ;affichage du 0
Else
SetGadgetText(b,Str(GetGadgetState(b)))
EndIf
EndIf
Calculs_Fevrier(a,b,c,dat) ;second test wheel inc / dec trop rapide
If GetGadgetState(#gadget13) <> 0 And GetGadgetState(#gadget16) <> 0 ;pas d'an zero
calendar(GetGadgetState(c), GetGadgetState(b), GetGadgetState(a),dat)
EndIf
EndProcedure
If OpenWindow(#window, 0, 0, 400, 290, Space(24)+"CALCULATRICE DE JOURS", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget)
colorwin=RGB(230,230,230)
SetWindowColor(#window,colorwin)
Police$ = "arial"
LoadFont (#font0, Police$ ,16,#PB_Font_Bold)
LoadFont (#font1, Police$ ,12,#PB_Font_Bold)
LoadFont (#font2, Police$ ,10,#PB_Font_Bold)
SetGadgetFont (#PB_Default, FontID(#font0))
SpinGadget (#gadget11, 20, 65, 58, 28, 0, 32,#PB_Spin_Numeric)
SetGadgetState (#gadget11, 6) : SetGadgetText(#gadget11, Str(Day(Date()))) ; définit la valeur initiale du jour
SpinGadget (#gadget12, 84, 65, 58, 28, 0, 13,#PB_Spin_Numeric)
SetGadgetState (#gadget12, 10) : SetGadgetText(#gadget12, Str(Month(Date()))) ; définit la valeur initiale du mois
SpinGadget (#gadget13, 148, 65, 90, 28, -9999, 9999,#PB_Spin_Numeric)
SetGadgetState (#gadget13, 2013) : SetGadgetText(#gadget13,Str(Year(Date()))) ; définit la valeur initiale de l'année
SpinGadget (#gadget14, 20, 180, 58, 28, 0, 32,#PB_Spin_Numeric)
SetGadgetState (#gadget14, 6) : SetGadgetText(#gadget14, Str(Day(Date()))) ; définit la valeur initiale du jour
SpinGadget (#gadget15, 84, 180, 58, 28, 0, 13,#PB_Spin_Numeric)
SetGadgetState (#gadget15, 10) : SetGadgetText(#gadget15, Str(Month(Date()))) ; définit la valeur initiale du mois
SpinGadget (#gadget16, 148, 180, 90, 28, -9999, 9999,#PB_Spin_Numeric)
SetGadgetState (#gadget16, 2013) : SetGadgetText(#gadget16,Str(Year(Date()))) ; définit la valeur initiale de l'année
SetActiveGadget(#gadget11)
SetGadgetColor (#gadget11, #PB_Gadget_FrontColor , #Red)
;Texte -------------------------------------------------------------
TextGadget (#gadget17, 256, 65, 125, 28, "",#PB_Text_Border|#PB_Text_Right) ; date initiale julian
SetGadgetColor (#gadget17, #PB_Gadget_BackColor,RGB(234,234,234))
TextGadget (#gadget18, 256, 180, 125, 28, "",#PB_Text_Border|#PB_Text_Right) ; date Finale julian
SetGadgetColor (#gadget18, #PB_Gadget_BackColor, RGB(234,234,234))
SetGadgetFont (#PB_Default, FontID(#font1))
ContainerGadget(#gadget19, 18, 240, 365, 30, #PB_Container_Raised )
SetGadgetColor (#gadget19, #PB_Gadget_BackColor,RGB(200,240,140))
TextGadget (#gadget20, 15, 3, 346, 28, "0") ; nombre total de jours
SetGadgetColor (#gadget20, #PB_Gadget_BackColor,RGB(200,240,140))
CloseGadgetList()
ContainerGadget(#gadget21, 18, 10, 365, 32, #PB_Container_Raised )
SetGadgetColor (#gadget21, #PB_Gadget_BackColor,RGB(200,235,255))
TextGadget (#gadget22, 5, 4, 440, 28, "Date Initiale en Gregorien */* Date en Julien") ;titre 1
SetGadgetColor (#gadget22, #PB_Gadget_BackColor,RGB(200,235,255))
CloseGadgetList()
ContainerGadget(#gadget23, 18, 125, 365, 32,#PB_Container_Raised )
SetGadgetColor (#gadget23, #PB_Gadget_BackColor,RGB(250,225,160))
TextGadget (#gadget24, 5, 4, 440, 28, "Date Finale en Gregorien */* Date en Julien") ;titre 2
SetGadgetColor (#gadget24, #PB_Gadget_BackColor,RGB(250,225,190))
CloseGadgetList()
SetGadgetFont (#PB_Default, FontID(#font2))
ContainerGadget(#gadget25, 19, 45, 362, 16 )
SetGadgetColor (#gadget25, #PB_Gadget_BackColor,colorwin)
TextGadget (#gadget26, 2, 0, 75, 16, "") ; affiche jour 1
SetGadgetColor (#gadget26, #PB_Gadget_BackColor,colorwin)
TextGadget (#gadget27, 72, 0, 292, 16, "" ) ; affiche fête 1
SetGadgetColor (#gadget27, #PB_Gadget_BackColor,colorwin)
CloseGadgetList()
ContainerGadget(#gadget28, 19, 160, 362, 16 )
SetGadgetColor (#gadget28, #PB_Gadget_BackColor,colorwin)
TextGadget (#gadget29, 2, 0, 75, 16, "") ; affiche jour 2
SetGadgetColor (#gadget29, #PB_Gadget_BackColor,colorwin)
TextGadget (#gadget30, 72, 0, 292, 16, "" ) ; affiche fête 2
SetGadgetColor (#gadget30, #PB_Gadget_BackColor,colorwin)
CloseGadgetList()
ContainerGadget(#gadget31, 19, 97, 362, 16 )
SetGadgetColor (#gadget31, #PB_Gadget_BackColor,colorwin)
TextGadget (#gadget32, 4, 0, 75, 16, "" ) ; affiche mois 1
SetGadgetColor (#gadget32, #PB_Gadget_BackColor,colorwin)
TextGadget (#gadget33, 80, 0, 80, 16, "" ) ; affiche numéro semaine 1
SetGadgetColor (#gadget33, #PB_Gadget_BackColor,colorwin)
TextGadget (#gadget34, 165, 0, 130, 16, "" ) ; affiche nombre ordinal 1
SetGadgetColor (#gadget34, #PB_Gadget_BackColor,colorwin)
CloseGadgetList()
ContainerGadget(#gadget35, 19, 212, 362, 16 )
SetGadgetColor (#gadget35, #PB_Gadget_BackColor,colorwin)
TextGadget (#gadget36, 4, 0, 75, 16, "" ) ; affiche mois 2
SetGadgetColor (#gadget36, #PB_Gadget_BackColor,colorwin)
TextGadget (#gadget37, 80, 0, 80, 16, "" ) ; affiche numéro semaine 2
SetGadgetColor (#gadget37, #PB_Gadget_BackColor,colorwin)
TextGadget (#gadget38, 165, 0, 130, 16, "" ) ; affiche nombre ordinal 2
SetGadgetColor (#gadget38, #PB_Gadget_BackColor,colorwin)
CloseGadgetList()
SetGadgetFont (#PB_Default, #PB_Default)
; Spingadget affiche date par défaut
Calculs_Jour(#gadget14,#gadget15,#gadget16,#Red,1) ; date 2
Affiche_resultats(1,#gadget30)
Calculs_Jour(#gadget11,#gadget12,#gadget13,#Red,0) ; date 1
Affiche_resultats(0,#gadget27)
StickyWindow(#window, 1)
Repeat
Event = WaitWindowEvent() ;SpinGadget wheel mouse
Select Event
Case #PB_Event_Gadget
Select EventGadget()
Case #gadget11
Calculs_Jour(#gadget11,#gadget12,#gadget13,#Red,0)
Affiche_resultats(0,#gadget27)
Case #gadget12
Calculs_Mois(#gadget11,#gadget12,#gadget13,#Red,0)
Affiche_resultats(0,#gadget27)
Case #gadget13
Calculs_Annee(#gadget11,#gadget12,#gadget13,#Red,0)
Affiche_resultats(0,#gadget27)
Case #gadget14
Calculs_Jour(#gadget14,#gadget15,#gadget16,#Red,1)
Affiche_resultats(1,#gadget30)
Case #gadget15
Calculs_Mois(#gadget14,#gadget15,#gadget16,#Red,1)
Affiche_resultats(1,#gadget30)
Case #gadget16
Calculs_Annee(#gadget14,#gadget15,#gadget16,#Red,1)
Affiche_resultats(1,#gadget30)
EndSelect
EndSelect
Until Event = #PB_Event_CloseWindow
EndIf
CloseLibrary(YMD_DLL)
End
DataSection
jour:
Data.s "Dimanche","Lundi","Mardi","Mercredi","Jeudi","Vendredi","Samedi"
mois:
Data.s "Janvier","Février","Mars","Avril","Mai","Juin","Juillet","Août","Septembre","Octobre","Novembre","Décembre"
fetes:
Data.s " Fête du Jour de l'An","Basile","Geneviève","Odilon","Edouard","Mélaine","Raymond","Lucien","Alix","Guillaume"
Data.s "Pauline","Tatiana","Yvette","Nina","Rémi","Marcel","Roseline","Prisca","Marius","Sébastien"
Data.s "Agnès","Vincent","Banard","François de Sales"," Conversion de Paul","Paule","Angèle","Thomas d'Aquin"
Data.s "Gildas","Martine","Marcelle","Ella","la Présentation","Blaise","Véronique","Agathe","Gaston","Eugènie"
Data.s "Jacqueline","Apolline","Arnaud","Notre Dame de Lourdes","Félix","Béatrice","Valentin","Claude"
Data.s "Julienne","Alexis","Bernadette","Gabin","Aimée","Damien","Isabelle","Lazare","Modeste","Roméo"
Data.s "Nestor","Honorine","Romain","Aubin","Charles le Bon","Guénolé","Casimir","Olive","Colette"
Data.s "Félicité","Jean de Dieu","Françoise","Vivien","Rosine","Justine","Rodrigue","Mathilde","Louise"
Data.s "Bénédicte","Patrice","Cyrille","Joseph","du Printemps / Rameaux","Clémence","Léa","Victorien","Catherine"
Data.s "l' Annonciation","Larissa","Habib","Gontran","Gwladys","Amédée","Benjamin","Hugues","Sandrine","Richard"
Data.s "Isidore","Irène","Marcellin","Jean-Baptiste de la Salle","Julie","Gautier","Fulbert","Stanislas"
Data.s "Jules","Ida","Maxime","Paterne","Benoît-Joseph","Anicet","Parfait","Emma","Odette","Anselme"
Data.s "Alexandre","Georges","Fidèle","Marc","Alida","Zita","Valérie","Catherine de Sienne","Robert"
Data.s " Fête du travail","Boris","Philippe / Jacques","Sylvain","Judith","Prudence","Gisèle","l' Armistice de 1945"
Data.s "Pacôme","Solange","Estelle","Achille","Rolande","Matthias","Denise","Honoré","Pascal","Eric","Yves"
Data.s "Bernardin","Constantin","Emile","Didier","Donatien","Sophie","Bérenger","Augustin","Germain","Aymar"
Data.s "Ferdinand","la Visitation de la Sainte Vierge","Justin","Blandine","Kévin","Clotilde","Igor","Norbert"
Data.s "Gilbert","Médard","Diane","Landry","Barnabé","Guy","Antoine de Padoue","Elisée","Germaine"
Data.s "Jean-François / Régis","Hervé","Léonce","Romuald","Silvère","l' Eté","Alban","Audrey","Jean-Baptiste"
Data.s "Prosper","Anthelme","Fernand","Irénée","Pierre / Paul","Martial","Thierry","Martinien","Thomas"
Data.s "Florent","Antoine","Mariette","Raoul","Thibault","Amandine","Ulrich","Benoît","Olivier","Henri / Joël"
Data.s " Fête Nationale","Donald","Notre Dame du Mont Carmel","Charlotte","Frédéric","Arsène","Marina"
Data.s "Victor","Marie-Madeleine","Brigitte","Christine","Jacques","Anne / Joachin","Nathalie","Samson"
Data.s "Marthe","Juliette","Ignace de Loyola","Alphonse","Julien / Eymard","Lydie","Jean-Marie Vianney","Abel"
Data.s "la Transfiguration","Gaétan","Dominique","Amour","Laurent","Claire","Clarisse","Hippolyte","Evrard"
Data.s "l' Assomption","Armel","Hyacinthe","Hélène","Jean-Eudes","Bernard","Christophe","Fabrice","Rose de Lima"
Data.s "Barthélémy","Louis","Natacha","Monique","Augustin","Sabine","Fiacre","Aristide","Gilles","Ingrid"
Data.s "Grégoire","Rosalie","Raïssa","Bertrand","Reine","la Nativité","Alain","Inès","Adelphe","Apollinaire"
Data.s "Aimé","la Croix Glorieuse","Roland","Edith","Renaud","Nadège","Emilie","Davy","Matthieu","Maurice"
Data.s "l' Automne","Thècle","Hermann","Côme / Damien","Vincent de Paul","Venceslas","Michel / Gabriel / Raphaël"
Data.s "Jérôme","Thérèse de l' Enfant Jésus","Léger","Gérard","François d'Assise","Fleur","Bruno"
Data.s "Serge","Pélagie","Denis","Ghislain","Firmin","Wilfried","Géraud","Juste","Thérèse d'Avila","Edwige"
Data.s "Baudoin","Luc","René","Adeline","Céline","Elodie","Jean de Capistran","Florentin","Crépin","Dimitri"
Data.s "Emeline","Jude","Narcisse","Bienvenu","Quentin","la Toussaint"," Fête des Défunts","Hubert","Charles","Sylvie"
Data.s "Bertille","Carine","Geoffroy","Théodore","Léon","l' Armistice de 1918","Christian","Brice","Sidoine"
Data.s "Albert","Marguerite","Elisabeth","Aude","Tanguy","Edmond","la Présence de Marie","Cécile","Clément"
Data.s "Flora","Catherine","Delphine","Sévrin","Jacques de la Marche","Saturnin","André","Florence","Viviane"
Data.s "François-Xavier","Barbara","Gérald","Nicolas","Ambroise","l' Immaculée Conception","Pierre Fourier"
Data.s "Romaric","Daniel","Jeanne-Françoise de Chantal","Lucie","Odile","Ninon","Alice","Gaël","Gatien"
Data.s "Urbain","Théophile","l' Hiver","Françoise-Xavière","Armand","Adèle","Noël","Etienne","Jean"," Fête des Innocents"
Data.s "David","Roger","Sylvestre","Auguste"
EndDataSection
