PureBasic

Forums PureBasic
Nous sommes le Dim 20/Mai/2018 20:47

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 20 messages ]  Aller à la page 1, 2  Suivante
Auteur Message
 Sujet du message: Calculateur de dates avancé
MessagePosté: Mer 15/Nov/2017 9:59 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 02/Oct/2011 16:17
Messages: 1900
Localisation: 50200 Coutances
Bonjour à tous,

voici le début de mon calculateur de dates avancé, celui-ci calcule le nombre de jours de semaine et les week-ends entre deux dates, il se compose de deux fichiers à inclure qui permettent de calculer les dates en quad qui vont du premier janvier 1601 au 31 décembre 9999.
Le prochain calculera tous les données sur une date, sur deux dates et sur le décalage sur deux horloges et peut-être d'autres surprises.

Je vous le donne parce que quand j'ai besoin de votre aide, vous êtes toujours présents.

https://www.dropbox.com/sh/gojsbcdy7t38i3d/AACDI5imTryf68LLSrKUKYeNa?dl=0

_________________
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce GT 640 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.45 LTS, 5.62
Un homme doit être poli, mais il doit aussi être libre !


Dernière édition par Micoute le Mer 15/Nov/2017 16:44, édité 3 fois.

Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Calculateur de dates avancé
MessagePosté: Mer 15/Nov/2017 13:36 
Hors ligne

Inscription: Jeu 05/Fév/2009 17:58
Messages: 815
@Micoute
La page d’accueil de ton cite est un épouvantail.
La seule chose que je perçois c'est connexion avec GOGOL mon numéro d’émail et un mot de passe.
Je doute fort que quelqu'un regarde ton logiciel. Sans compter sur les risques de virus.
Remet ton code en clair sur le forum ce sera bien mieux
Amicalement


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Calculateur de dates avancé
MessagePosté: Mer 15/Nov/2017 16:34 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 02/Oct/2011 16:17
Messages: 1900
Localisation: 50200 Coutances
J'ai changé l'url qui était celle de la Drop Box de mon frère, j'ai mieux la mienne.

_________________
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce GT 640 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.45 LTS, 5.62
Un homme doit être poli, mais il doit aussi être libre !


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Calculateur de dates avancé
MessagePosté: Mer 15/Nov/2017 17:46 
Hors ligne

Inscription: Jeu 05/Fév/2009 17:58
Messages: 815
@ Micoute
Désolé mais ton site ne fonctionne pas. Il n'y a pas d'aperçus de fichier. D'autre part il est hors de question de télécharger quoi que ce soit sur un cite dont je ne suis pas sur a 100/100%
Je pense sincèrement que je ne doit pas pas être le seul a réagir comme cela.
Je ne comprend pas pourquoi tu ne fait pas comme avant. Tu verra que beaucoup de gens n'irons pas sur ton cite et de ce fait tu n'aura qu'une aide très réduite. :roll:
Regarde pratiquement tous le monde met les codes sur le forum. :lol:
Mais encore une foi c'est a toi de voir :wink:


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Calculateur de dates avancé
MessagePosté: Mer 15/Nov/2017 17:58 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 02/Oct/2011 16:17
Messages: 1900
Localisation: 50200 Coutances
Décidemment, ce programme me cause beaucoup de soucis le problème c'est qu'il est très gros, car en plus du logiciel, il y a deux fichier à inclure, je vais voir ce que je peux faire.

_________________
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce GT 640 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.45 LTS, 5.62
Un homme doit être poli, mais il doit aussi être libre !


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Calculateur de dates avancé
MessagePosté: Mer 15/Nov/2017 18:01 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 02/Oct/2011 16:17
Messages: 1900
Localisation: 50200 Coutances
Voici déjà le programme principal, il est en deux parties à recoller bout à bout.

Code:
;Calculatrice Micoutesoft (Calculs de Date et Heure)

XIncludeFile "Fonctions DateF.pbi"
XIncludeFile "Conversion d'un entier en chiffres romains.pb"

Enumeration
  #Fenetre_Principale
EndEnumeration

Enumeration
  #Img_0
 
  #Paneau_DH_principal
 
  ;1 date
  #Txt_JDA_1D
  #Btn_1D_Vider
  #Btn_1D_Date
  #Spn_J_1D
  #Spn_M_1D
  #Spn_A_1D
  #Txt_Date_JDS_JJ_MM_AAAA_1D
  #Txt_SDA_1D
  #Txt_JDM_1D
  #Txt_AB_1D
  #Txt_AR_1D
  #Str_JDA_1D
  #Str_SDA_1D
  #Str_JDM_1D
  #Str_AB_1D
  #Str_AR_1D
 
  ;2 dates
  #Btn_2D_Vider
  #Txt_DD_2D
  #Txt_DF_2D
  #Btn_JED_2D
  #Frame_Diff_2D
  #Txt_Nb_annees_2D
  #Txt_Nb_mois_2D
  #Txt_Nb_jours_2D
  #Spn_J_DD_2D
  #Spn_M_DD_2D
  #Spn_A_DD_2D
  #Spn_J_DF_2D
  #Spn_M_DF_2D
  #Spn_A_DF_2D
  #Str_JED_2D
 
  ;heures
  #Btn_H_Vider
  #Btn_H_Valider
  #Txt_HD_H
  #Txt_HF_H
  #Frame_Diff_H
  #Spn_S_HD
  #Spn_M_HD
  #Spn_H_HD
  #Spn_S_HF
  #Spn_M_HF
  #Spn_H_HF
  #Txt_Nb_heures_H
  #Txt_Nb_Minutes_H
  #Txt_Nb_Secondes_H
  #Txt_Signature
 
  ;Panneau_Conv_Temps
  #Ctn_0
  #Ctn_1
  #Txt_Annee_0
  #Txt_Mois_0
  #Txt_Semaine_0
  #Txt_Jour_0
  #Txt_Heure_0
  #Txt_Minute_0
  #Txt_Seconde_0
  #Spn_Annee_0
  #Spn_Mois_0
  #Spn_Semaine_0
  #Spn_Jour_0
  #Spn_Heure_0
  #Spn_Minute_0
  #Spn_Seconde_0
  #Txt_Annee_1
  #Txt_Mois_1
  #Txt_Semaine_1
  #Txt_Jour_1
  #Txt_Heure_1
  #Txt_Minute_1
  #Txt_Seconde_1
  #Str_Annee_1
  #Str_Mois_1
  #Str_Semaine_1
  #Str_Jour_1
  #Str_Heure_1
  #Str_Minute_1
  #Str_Seconde_1
  #Timer
 
  #Btn_Annee_0
  #Btn_Mois_0
  #Btn_Semaine_0
  #Btn_Jour_0
  #Btn_Heure_0
  #Btn_Minute_0
  #Btn_Seconde_0
 
  ;Panneau_JDS_WE 
  #Ctn_1_JDS
  #Txt_de_JDS
  #Txt_a_JDS
  #Txt_de2_JDS
  #Txt_a2_JDS
  #Str_de2_JDS
  #Str_a2_JDS
  #Spn_J_de_JDS
  #Spn_M_de_JDS
  #Spn_A_de_JDS
  #Spn_J_a_JDS
  #Spn_M_a_JDS
  #Spn_A_a_JDS
 
  #Ctn_2_JDS
  #Frm_JDS_JDS
  #Txt_Lundi_JDS
  #Txt_Mardi_JDS
  #Txt_Mercredi_JDS
  #Txt_Jeudi_JDS
  #Txt_Vendredi_JDS
  #Txt_Samedi_JDS
  #Txt_Dimanche_JDS
  #Str_Lundi_JDS
  #Str_Mardi_JDS
  #Str_Mercredi_JDS
  #Str_Jeudi_JDS
  #Str_Vendredi_JDS
  #Str_Samedi_JDS
  #Str_Dimanche_JDS
 
  #Txt_Semaines_JDS
  #Date_Semaines_JDS
  #Txt_WE_JDS
  #Date_WE_JDS
 
  #Btn_Valider_JDS
 
EndEnumeration

Enumeration
  #Id_Img
EndEnumeration

Enumeration
  #Police_1
  #Police_2
EndEnumeration 

Structure sSemaine
  Lundi.q
  Mardi.q
  Mercredi.q
  Jeudi.q
  Vendredi.q
  Samedi.q
  Dimanche.q
EndStructure 

LoadFont(#Police_1, "Arial", 8, #PB_Font_HighQuality)
LoadFont(#Police_2, "Arial", 12, #PB_Font_Bold)

#UniteTemps = "an|s,mois,jour|s,heure|s,minute|s,seconde|s"

Structure sTemps
  Annee.f
  Mois.f
  Semaine.f
  Jour.f
  Heure.f
  Minute.f
  Seconde.f
EndStructure


Declare Calcul()
Declare _Annee_()
Declare _Mois_()
Declare _Semaine_()
Declare _Jour_()
Declare _Heure_()
Declare _Minute_()
Declare _Seconde_()

UsePNGImageDecoder()

Global Evenement, MaDiff.DiffTemps, Date1.q, Date2.q
Global.q Jour1_2D, Mois1_2D, Annee1_2D, Jour2_2D, Mois2_2D, Annee2_2D, DateAvant_2D, DateApres_2D
Global.s Date1_2D, Date2_2D, Txt_Total_Jours, Txt_An, Txt_Mois, Txt_Jour
Global.sTemps Temps
Global Evenement, JDSdate1$, JDSdate2$, JDSDate1.q, JDSDate2.q, JDSdateAvant.q, JDSdateApres.q, JDSannee1.q, JDSmois1.q, JDSjour1.q, JDSannee2.q, JDSmois2.q, JDSjour2.q, ResultatWE = 0
Global MaDiff.DiffTemps, NewList Jat.sSemaine()
Global Dim JS.s(6), Dim NomMois.s(11)

JS(0) = "dimanche" : JS(1) = "lundi" : JS(2) = "mardi" : JS(3) = "mercredi" : JS(4) = "jeudi" : JS(5) = "vendredi" : JS(6) = "samedi"
NomMois(0) = "janvier" : NomMois(1) = "février" : NomMois(2) = "mars" : NomMois(3) = "avril" : NomMois(4) = "mai" : NomMois(5) = "juin"
NomMois(6) = "juillet" : NomMois(7) = "août" : NomMois(8) = "septembre" : NomMois(9) = "octobre" : NomMois(10) = "novembre" : NomMois(11) = "décembre"

Declare Jours_de_semaine()
Declare Minimum(a, b, c) ;
Declare CalculerNbJDS()
Declare Calculer_Jours_JDS()
Declare Calculer_Mois_JDS()

Temps\Annee = 1
Temps\Mois = 12
Temps\Semaine = 52.17857142857
Temps\Jour = 365.25
Temps\Heure = 8766
Temps\Minute = 525960
Temps\Seconde = 31557600


Procedure Calculer_Heures() 
  ;Heure Début
  If GetGadgetState(#Spn_H_HD) > 23
    SetGadgetState(#Spn_H_HD,0)
  ElseIf GetGadgetState(#Spn_H_HD) < 0
    SetGadgetState(#Spn_H_HD,23)
  EndIf
  ;Heure Fin
  If GetGadgetState(#Spn_H_HF) > 23
    SetGadgetState(#Spn_H_HF,0)
  ElseIf GetGadgetState(#Spn_H_HF) < 0
    SetGadgetState(#Spn_H_HF,23)
  EndIf
EndProcedure

Procedure Calculer_Minutes() 
  ;Minute Début
  If GetGadgetState(#Spn_M_HD) > 59
    SetGadgetState(#Spn_M_HD,0)
  ElseIf GetGadgetState(#Spn_M_HD) < 0
    SetGadgetState(#Spn_M_HD,59)
  EndIf
  ;Minute Fin
  If GetGadgetState(#Spn_M_HF) > 59
    SetGadgetState(#Spn_M_HF,0)
  ElseIf GetGadgetState(#Spn_M_HF) < 0
    SetGadgetState(#Spn_M_HF,59)
  EndIf
EndProcedure

Procedure Calculer_Secondes() 
  ;Seconde Début
  If GetGadgetState(#Spn_S_HD) > 59
    SetGadgetState(#Spn_S_HD,0)
  ElseIf GetGadgetState(#Spn_S_HD) < 0
    SetGadgetState(#Spn_S_HD,59)
  EndIf
  ;Seconde Fin
  If GetGadgetState(#Spn_S_HF) > 59
    SetGadgetState(#Spn_S_HF,0)
  ElseIf GetGadgetState(#Spn_S_HF) < 0
    SetGadgetState(#Spn_S_HF,59)
  EndIf
EndProcedure

Procedure Calculer_Jours()
  ;Jour une date
  If GetGadgetState(#Spn_M_1D)
    Jm = JoursDansMoisF(GetGadgetState(#Spn_A_1D),GetGadgetState(#Spn_M_1D))
   
    If GetGadgetState(#Spn_J_1D) > Jm
      SetGadgetState(#Spn_J_1D,1)
    ElseIf GetGadgetState(#Spn_J_1D) < 1
      SetGadgetState(#Spn_J_1D,Jm)
    EndIf
   
  EndIf
  ;jour 2 dates
  If GetGadgetState(#Spn_M_DD_2D)
    Jm = JoursDansMoisF(GetGadgetState(#Spn_A_DD_2D),GetGadgetState(#Spn_M_DD_2D))
   
    If GetGadgetState(#Spn_J_DD_2D) > Jm
      SetGadgetState(#Spn_J_DD_2D,1)
    ElseIf GetGadgetState(#Spn_J_DD_2D) < 1
      SetGadgetState(#Spn_J_DD_2D,Jm)
    EndIf
   
  EndIf
  If GetGadgetState(#Spn_M_DF_2D)
    Jm = JoursDansMoisF(GetGadgetState(#Spn_A_DF_2D),GetGadgetState(#Spn_M_DF_2D))
   
    If GetGadgetState(#Spn_J_DF_2D) > Jm
      SetGadgetState(#Spn_J_DF_2D,1)
    ElseIf GetGadgetState(#Spn_J_DF_2D) < 1
      SetGadgetState(#Spn_J_DF_2D,Jm)
    EndIf
   
  EndIf
EndProcedure

Procedure Calculer_Mois()
  ;Mois une date
  If GetGadgetState(#Spn_M_1D) > 12
    SetGadgetState(#Spn_M_1D,1)
  ElseIf GetGadgetState(#Spn_M_1D) < 1
    SetGadgetState(#Spn_M_1D,12)
  EndIf
  ;Mois 2 dates
  If GetGadgetState(#Spn_M_DD_2D) > 12
    SetGadgetState(#Spn_M_DD_2D,1)
  ElseIf GetGadgetState(#Spn_M_DD_2D) < 1
    SetGadgetState(#Spn_M_DD_2D,12)
  EndIf
  If GetGadgetState(#Spn_M_DF_2D) > 12
    SetGadgetState(#Spn_M_DF_2D,1)
  ElseIf GetGadgetState(#Spn_M_DF_2D) < 1
    SetGadgetState(#Spn_M_DF_2D,12)
  EndIf
EndProcedure

Procedure.s AjouterUniteTemps(nombre.q, unite.q)
  Protected Resultat.s, uniteSeconde.s
  If nombre = 0 : ProcedureReturn "" : EndIf
  If nombre < 0 : nombre * -1 : EndIf
  uniteSeconde = StringField(#UniteTemps, unite, ",")
  If nombre > 1
    uniteSeconde = RemoveString(uniteSeconde, "|")
  Else
    uniteSeconde = StringField(uniteSeconde, 1, "|")
  EndIf
  Resultat + Space(1) + Str(nombre) + Space(1) + uniteSeconde
  ProcedureReturn Resultat
EndProcedure

Procedure.s sDiffTemps(Secondes.q)
  Protected Resultat.s
  Protected annees.q, mois.q, semaines.q, jours.q, heures.q, minutes.q
  annees = Secondes / 31557600 : Secondes = Secondes % 31557600
  mois = Secondes / 2629800 : Secondes = Secondes % 2629800
  jours  = Secondes / 86400 : Secondes = Secondes % 86400
  heures = Secondes / 3600 : Secondes = Secondes % 3600
  minutes = Secondes / 60  : Secondes = Secondes % 60
 
  MaDiff\Annees = annees
  MaDiff\Mois = mois
  MaDiff\JoursRestants = jours
  MaDiff\Heures = heures
  MaDiff\Minutes = minutes
  MaDiff\Secondes = Secondes
  MaDiff\TotalJours = annees*365.25 + mois*30.44 + jours
  Resultat = AjouterUniteTemps(annees, 1) + AjouterUniteTemps(mois, 2) + AjouterUniteTemps(jours,3)
  ProcedureReturn Resultat
EndProcedure

Procedure OpenWindow_Fenetre_Principale()
  If OpenWindow(#Fenetre_Principale, 0, 0, 570, 525, "Calculs de Date/Heure", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
   
    SetGadgetFont(#PB_Default, FontID(#Police_1))
   
    TextGadget(#Txt_Signature, 0, 495, 570, 30, "Calcul de Date/Heure par Micoutesoft", #PB_Text_Center|#SS_CENTERIMAGE)
    PanelGadget(#Paneau_DH_principal, 0, 0, 570, 495)
    ;- Une Date
    AddGadgetItem(#Paneau_DH_principal, -1, "Une Date")
    TextGadget(#Txt_JDA_1D, 10, 170, 320, 50, "Jour de l'année", #PB_Text_Right|#SS_CENTERIMAGE)
    ButtonGadget(#Btn_1D_Vider, 10, 10, 320, 40, "Vider")
   
    ButtonGadget(#Btn_1D_Date, 10, 80, 320, 40, "Valider")
   
    SpinGadget(#Spn_J_1D, 340, 90, 60, 25, 0, 32, #PB_Spin_Numeric)
    SpinGadget(#Spn_M_1D, 400, 90, 60, 25, 0, 13, #PB_Spin_Numeric)
    SpinGadget(#Spn_A_1D, 460, 90, 90, 25, 1601, 9999, #PB_Spin_Numeric)
   
    SetGadgetState(#Spn_J_1D, JourF(DateF()))
    SetGadgetState(#Spn_M_1D, MoisF(DateF()))
    SetGadgetState(#Spn_A_1D, AnneeF(DateF()))
   
    TextGadget(#Txt_Date_JDS_JJ_MM_AAAA_1D, 10, 130, 550, 50, "", #PB_Text_Center|#SS_CENTERIMAGE)     
    TextGadget(#Txt_SDA_1D, 10, 240, 320, 50, "Semaine de l'année", #PB_Text_Right|#SS_CENTERIMAGE)
    TextGadget(#Txt_JDM_1D, 10, 295, 320, 50, "Jours dans le mois", #PB_Text_Right|#SS_CENTERIMAGE)
    TextGadget(#Txt_AB_1D, 10, 350, 320, 50, "Année bissextile", #PB_Text_Right|#SS_CENTERIMAGE)
    TextGadget(#Txt_AR_1D, 10, 405, 320, 50, "Année en romain", #PB_Text_Right|#SS_CENTERIMAGE)
   
    StringGadget(#Str_JDA_1D, 340, 180, 220, 50, "", #PB_String_ReadOnly|#PB_Text_Center)
    StringGadget(#Str_SDA_1D, 340, 240, 220, 50, "", #PB_String_ReadOnly|#PB_Text_Center)
    StringGadget(#Str_JDM_1D, 340, 295, 220, 50, "", #PB_String_ReadOnly|#PB_Text_Center)
    StringGadget(#Str_AB_1D, 340, 350, 220, 50, "", #PB_String_ReadOnly|#PB_Text_Center)
    StringGadget(#Str_AR_1D, 340, 405, 220, 50, "", #PB_String_ReadOnly|#PB_Text_Center)
   
    SetGadgetFont(#Txt_Date_JDS_JJ_MM_AAAA_1D, FontID(#Police_2))
    SetGadgetFont(#Str_JDA_1D, FontID(#Police_2))
    SetGadgetFont(#Str_SDA_1D, FontID(#Police_2))
    SetGadgetFont(#Str_JDM_1D, FontID(#Police_2))
    SetGadgetFont(#Str_AB_1D,  FontID(#Police_2))
    SetGadgetFont(#Str_AR_1D,  FontID(#Police_2))
    SetGadgetFont(#Spn_J_1D,  FontID(#Police_2))
    SetGadgetFont(#Spn_M_1D,  FontID(#Police_2))
    SetGadgetFont(#Spn_A_1D,  FontID(#Police_2))
    SetGadgetFont(#Btn_1D_Vider,  FontID(#Police_2))
    SetGadgetFont(#Btn_1D_Date,  FontID(#Police_2))
   
    SetGadgetFont(#Txt_Signature,  FontID(#Police_2))
   
    ;- Deux Dates
    AddGadgetItem(#Paneau_DH_principal, -1, "Différence de Dates")
    ButtonGadget(#Btn_2D_Vider, 10, 10, 320, 40, "Vider")
    TextGadget(#Txt_DD_2D, 10, 80, 320, 40, "Date de début", #PB_Text_Right|#SS_CENTERIMAGE)
    TextGadget(#Txt_DF_2D, 10, 110, 320, 40, "Date de fin", #PB_Text_Right|#SS_CENTERIMAGE)
    ButtonGadget(#Btn_JED_2D, 10, 180, 320, 40, "Jours entre les dates choisies")
   
    SpinGadget(#Spn_J_DD_2D, 340, 90, 60, 25, 0, 32, #PB_Spin_Numeric)
    SpinGadget(#Spn_M_DD_2D, 400, 90, 60, 25, 0, 13, #PB_Spin_Numeric)
    SpinGadget(#Spn_A_DD_2D, 460, 90, 90, 25, 1601, 9999, #PB_Spin_Numeric)
   
    SetGadgetState(#Spn_J_DD_2D, JourF(DateF()))
    SetGadgetState(#Spn_M_DD_2D, MoisF(DateF()))
    SetGadgetState(#Spn_A_DD_2D, AnneeF(DateF()))
   
    SpinGadget(#Spn_J_DF_2D, 340, 120, 60, 25, 0, 32, #PB_Spin_Numeric)
    SpinGadget(#Spn_M_DF_2D, 400, 120, 60, 25, 0, 13, #PB_Spin_Numeric)
    SpinGadget(#Spn_A_DF_2D, 460, 120, 90, 25, 1601, 9999, #PB_Spin_Numeric)
   
    SetGadgetState(#Spn_J_DF_2D, JourF(DateF()))
    SetGadgetState(#Spn_M_DF_2D, MoisF(DateF()))
    SetGadgetState(#Spn_A_DF_2D, AnneeF(DateF()))
   
    StringGadget(#Str_JED_2D, 340, 180, 220, 40, "", #PB_String_ReadOnly)
   
    FrameGadget(#Frame_Diff_2D, 10, 220, 320, 210, "Temps entre les deux dates")
    TextGadget(#Txt_Nb_annees_2D, 20, 240, 300, 50, "", #PB_Text_Center|#SS_CENTERIMAGE)
    TextGadget(#Txt_Nb_mois_2D, 20, 295, 300, 50, "", #PB_Text_Center|#SS_CENTERIMAGE)
    TextGadget(#Txt_Nb_jours_2D, 20, 350, 300, 50, "", #PB_Text_Center|#SS_CENTERIMAGE)
   
    SetGadgetFont(#Btn_2D_Vider, FontID(#Police_2))
    SetGadgetFont(#Btn_JED_2D, FontID(#Police_2))
    i = #Txt_Nb_annees_2D
    While i <= #Str_JED_2D
      SetGadgetFont(i, FontID(#Police_2))
      i + 1
    Wend
    ;-  Jours de semaine & Week-ends
    AddGadgetItem(#Paneau_DH_principal, -1, "Nbre JDS et WE")
   
    SetGadgetFont(#PB_Default, FontID(#Police_1))
    ContainerGadget(#Ctn_1_JDS, 135, 10, 300, 80, #PB_Container_Raised)
    TextGadget(#Txt_de_JDS, 0, 10, 60, 20, "Du : ", #PB_Text_Right|#SS_CENTERIMAGE)
    TextGadget(#Txt_a_JDS, 0, 40, 60, 20, "au : ", #PB_Text_Right|#SS_CENTERIMAGE)
    SpinGadget(#Spn_J_de_JDS,  60, 10, 60, 20, 0, 32, #PB_Spin_Numeric)
    SpinGadget(#Spn_M_de_JDS, 120, 10, 60, 20, 0, 13, #PB_Spin_Numeric)
    SpinGadget(#Spn_A_de_JDS, 180, 10, 90, 20, 1601, 9999, #PB_Spin_Numeric)
    SpinGadget(#Spn_J_a_JDS, 60, 40, 60, 20, 0, 32, #PB_Spin_Numeric)
    SpinGadget(#Spn_M_a_JDS, 120, 40, 60, 20, 0, 13, #PB_Spin_Numeric)
    SpinGadget(#Spn_A_a_JDS, 180, 40, 90, 20, 1601, 9999, #PB_Spin_Numeric)
    CloseGadgetList()
   
    ContainerGadget(#Ctn_2_JDS, 0, 120, 570, 330, #PB_Container_Raised)
    TextGadget(#Txt_de2_JDS, 0, 30, 150, 20, "Date de début : ", #PB_Text_Right|#SS_CENTERIMAGE)
    TextGadget(#Txt_a2_JDS, 0, 60, 150, 20, "Date de fin   : ", #PB_Text_Right|#SS_CENTERIMAGE)
    StringGadget(#Str_de2_JDS, 160, 30, 250, 20, "", #ES_CENTER)
    StringGadget(#Str_a2_JDS, 160, 60, 250, 20, "", #ES_CENTER)
    TextGadget(#Txt_Semaines_JDS, 0, 90, 150, 20, "Nombre de jours de semaine :", #PB_Text_Right|#SS_CENTERIMAGE)
    TextGadget(#Txt_WE_JDS, 0, 120, 150, 20, "Nombre de WeekEnds :", #PB_Text_Right|#SS_CENTERIMAGE)
    StringGadget(#Date_Semaines_JDS, 160, 90, 250, 20, "", #ES_CENTER)
    StringGadget(#Date_WE_JDS, 160, 120, 250, 20, "", #ES_CENTER)
    ButtonGadget(#Btn_Valider_JDS, 200, 280, 170, 30, "Valider")
    FrameGadget(#Frm_JDS_JDS, 35, 160, 500, 110, "Jours")
    TextGadget(#Txt_Lundi_JDS, 40, 180, 50, 20, "Lundi", #PB_Text_Right|#SS_CENTERIMAGE)
    TextGadget(#Txt_Mardi_JDS, 190, 180, 50, 20, "Mardi", #PB_Text_Right|#SS_CENTERIMAGE)
    TextGadget(#Txt_Mercredi_JDS, 370, 180, 50, 20, "Mercredi", #PB_Text_Right|#SS_CENTERIMAGE)
    TextGadget(#Txt_Jeudi_JDS, 40, 210, 50, 20, "Jeudi", #PB_Text_Right|#SS_CENTERIMAGE)
    TextGadget(#Txt_Vendredi_JDS, 190, 210, 50, 20, "Vendredi", #PB_Text_Right|#SS_CENTERIMAGE)
    TextGadget(#Txt_Samedi_JDS, 370, 210, 50, 20, "Samedi", #PB_Text_Right|#SS_CENTERIMAGE)
    TextGadget(#Txt_Dimanche_JDS, 40, 240, 50, 20, "Dimanche", #PB_Text_Right|#SS_CENTERIMAGE)
    StringGadget(#Str_Lundi_JDS, 100, 180, 90, 20, "")
    StringGadget(#Str_Mardi_JDS, 250, 180, 90, 20, "")
    StringGadget(#Str_Mercredi_JDS, 430, 180, 90, 20, "")
    StringGadget(#Str_Jeudi_JDS, 100, 210, 90, 20, "")
    StringGadget(#Str_Vendredi_JDS, 250, 210, 90, 20, "")
    StringGadget(#Str_Samedi_JDS, 430, 210, 90, 20, "")
    StringGadget(#Str_Dimanche_JDS, 100, 240, 90, 20, "")
    CloseGadgetList()
       
    SetGadgetState(#Spn_J_de_JDS, JourF(DateF()))
    SetGadgetState(#Spn_M_de_JDS, MoisF(DateF()))
    SetGadgetState(#Spn_A_de_JDS, AnneeF(DateF()))
   
    SetGadgetState(#Spn_J_a_JDS, JourF(DateF()))
    SetGadgetState(#Spn_M_a_JDS, MoisF(DateF()))
    SetGadgetState(#Spn_A_a_JDS, AnneeF(DateF()))
   
    SetGadgetColor(#Ctn_1_JDS, #PB_Gadget_BackColor, $FFFFFF)
    SetGadgetColor(#Txt_de_JDS, #PB_Gadget_BackColor, GetGadgetColor(#Ctn_1_JDS, #PB_Gadget_BackColor))
    SetGadgetColor(#Txt_a_JDS, #PB_Gadget_BackColor, GetGadgetColor(#Ctn_1_JDS, #PB_Gadget_BackColor))
   
    SetGadgetColor(#Ctn_2_JDS, #PB_Gadget_BackColor, $FFFFFF)
    i = #Txt_Lundi_JDS
    While i <= #Txt_Dimanche_JDS
      SetGadgetColor(i, #PB_Gadget_BackColor, GetGadgetColor(#Ctn_2_JDS, #PB_Gadget_BackColor))
      i + 1
    Wend
    SetGadgetColor(#Txt_de2_JDS, #PB_Gadget_BackColor, GetGadgetColor(#Ctn_2_JDS, #PB_Gadget_BackColor))
    SetGadgetColor(#Txt_a2_JDS, #PB_Gadget_BackColor, GetGadgetColor(#Ctn_2_JDS, #PB_Gadget_BackColor))
    SetGadgetColor(#Txt_Semaines_JDS, #PB_Gadget_BackColor, GetGadgetColor(#Ctn_2_JDS, #PB_Gadget_BackColor))
    SetGadgetColor(#Txt_WE_JDS, #PB_Gadget_BackColor, GetGadgetColor(#Ctn_2_JDS, #PB_Gadget_BackColor))
   
    SetGadgetFont(#Spn_J_de_JDS, FontID(#Police_2))
    SetGadgetFont(#Spn_M_de_JDS, FontID(#Police_2))
    SetGadgetFont(#Spn_A_de_JDS, FontID(#Police_2))
    SetGadgetFont(#Spn_J_a_JDS, FontID(#Police_2))
    SetGadgetFont(#Spn_M_a_JDS, FontID(#Police_2))
    SetGadgetFont(#Spn_A_a_JDS, FontID(#Police_2))
    SetGadgetFont(#Str_de2_JDS, FontID(#Police_2))
    SetGadgetFont(#Str_a2_JDS, FontID(#Police_2))
    SetGadgetFont(#Date_Semaines_JDS, FontID(#Police_2))
    SetGadgetFont(#Date_WE_JDS, FontID(#Police_2))
    i = #Str_Lundi_JDS
    While i <= #Str_Dimanche_JDS
      SetGadgetFont(i, FontID(#Police_2))
      i + 1
    Wend
   
    i = #Txt_Lundi_JDS
    While i <= #Txt_Dimanche_JDS
      SetGadgetFont(i, FontID(#Police_2))
      i + 1
    Wend 
   
    SetGadgetFont(#Btn_Valider_JDS, FontID(#Police_2))
    SetGadgetFont(#Txt_a2_JDS, FontID(#Police_1))
    SetGadgetFont(#Txt_a_JDS, FontID(#Police_1))
    SetGadgetFont(#Txt_de2_JDS, FontID(#Police_1))
    SetGadgetFont(#Txt_de_JDS, FontID(#Police_1))
    SetGadgetFont(#Txt_Lundi_JDS, FontID(#Police_1))
    SetGadgetFont(#Txt_Mardi_JDS, FontID(#Police_1))
    SetGadgetFont(#Txt_Mercredi_JDS, FontID(#Police_1))
    SetGadgetFont(#Txt_Jeudi_JDS, FontID(#Police_1))
    SetGadgetFont(#Txt_Vendredi_JDS, FontID(#Police_1))
    SetGadgetFont(#Txt_Samedi_JDS, FontID(#Police_1))
    SetGadgetFont(#Txt_Dimanche_JDS, FontID(#Police_1))
   
    HideGadget(#Btn_Valider_JDS, 1)

    ;- Heures
    AddGadgetItem(#Paneau_DH_principal, -1, "Différence d'heures")
    ButtonGadget(#Btn_H_Vider, 10, 10, 320, 40, "Vider")
    TextGadget(#Txt_HD_H, 10, 70, 320, 40, "Heure de début", #PB_Text_Right|#SS_CENTERIMAGE)
    TextGadget(#Txt_HF_H, 10, 115, 320, 40, "Heure de fin", #PB_Text_Right|#SS_CENTERIMAGE)
    ButtonGadget(#Btn_H_Valider, 10, 160, 320, 40, "Valider")
   
    SpinGadget(#Spn_H_HD, 340, 70, 60, 25, -1, 24, #PB_Spin_Numeric)
    SpinGadget(#Spn_M_HD, 400, 70, 60, 25, -1, 60, #PB_Spin_Numeric)
    SpinGadget(#Spn_S_HD, 460, 70, 60, 25, -1, 60, #PB_Spin_Numeric)
   
    SetGadgetState(#Spn_H_HD, HeureF(DateF()))
    SetGadgetState(#Spn_M_HD, MinuteF(DateF()))
    SetGadgetState(#Spn_S_HD, SecondeF(DateF()))
   
    SpinGadget(#Spn_H_HF, 340, 115, 60, 25, -1, 24, #PB_Spin_Numeric)
    SpinGadget(#Spn_M_HF, 400, 115, 60, 25, -1, 60, #PB_Spin_Numeric)
    SpinGadget(#Spn_S_HF, 460, 115, 60, 25, -1, 60, #PB_Spin_Numeric)
   
    SetGadgetState(#Spn_H_HF, HeureF(DateF()))
    SetGadgetState(#Spn_M_HF, MinuteF(DateF()))
    SetGadgetState(#Spn_S_HF, SecondeF(DateF()))
   
    FrameGadget(#Frame_Diff_H, 10, 210, 320, 210, "Différence entre les deux heures")
    TextGadget(#Txt_Nb_heures_H, 20, 240, 300, 50, "")
    TextGadget(#Txt_Nb_Minutes_H, 20, 295, 300, 50, "")
    TextGadget(#Txt_Nb_Secondes_H, 20, 350, 300, 50, "")
   
    i = #Spn_S_HD
    While i <= #Spn_H_HF
      SetGadgetFont(i, FontID(#Police_2))
      i + 1
    Wend
    SetGadgetFont(#Btn_H_Vider, FontID(#Police_2))
    SetGadgetFont(#Btn_H_Valider, FontID(#Police_2))
    i = #Txt_Nb_heures_H
    While i <= #Txt_Nb_Secondes_H
      SetGadgetFont(i, FontID(#Police_2))
      i + 1
    Wend 
   
    ;- Convertisseurs de temps
    AddGadgetItem(#Paneau_DH_principal, -1, "Convertisseur de temps")
   
   
    ContainerGadget(#Ctn_0, 10, 0, 545, 220, #PB_Container_Raised)
   
    CatchImage(#Img_0, ?Image)
    ResizeImage(#Img_0, 25, 25)
   
    TextGadget(#Txt_Annee_0, 0, 10, 80, 30, "Année(s)", #PB_Text_Center|#SS_CENTERIMAGE)
    TextGadget(#Txt_Mois_0, 290, 10, 80, 30, "Mois", #PB_Text_Center|#SS_CENTERIMAGE)
    SpinGadget(#Spn_Annee_0, 100, 10, 125, 30, 0, 999, #PB_Spin_Numeric)
    SpinGadget(#Spn_Mois_0, 380, 10, 125, 30, 0, 999, #PB_Spin_Numeric) 
    ButtonImageGadget(#Btn_Annee_0, 225, 10, 30, 30, ImageID(#Id_Img))
    ButtonImageGadget(#Btn_Mois_0, 505, 10, 30, 30, ImageID(#Id_Img))
   
    TextGadget(#Txt_Semaine_0, 0, 60, 90, 30, "Semaine(s)", #PB_Text_Center|#SS_CENTERIMAGE)
    TextGadget(#Txt_Jour_0, 290, 60, 80, 30, "Jour(s)", #PB_Text_Center|#SS_CENTERIMAGE)
    SpinGadget(#Spn_Semaine_0, 100, 60, 125, 30, 0, 999, #PB_Spin_Numeric)
    SpinGadget(#Spn_Jour_0, 380, 60, 125, 30, 0, 99999, #PB_Spin_Numeric)
    ButtonImageGadget(#Btn_Semaine_0, 225, 60, 30, 30, ImageID(#Id_Img))
    ButtonImageGadget(#Btn_Jour_0, 505, 60, 30, 30, ImageID(#Id_Img))
   
    TextGadget(#Txt_Heure_0, 0, 120, 80, 30, "Heure(s)", #PB_Text_Center|#SS_CENTERIMAGE)
    TextGadget(#Txt_Minute_0, 290, 120, 90, 30, "Minute(s)", #PB_Text_Center|#SS_CENTERIMAGE)
    SpinGadget(#Spn_Heure_0, 100, 120, 125, 30, 0, 99999, #PB_Spin_Numeric)
    SpinGadget(#Spn_Minute_0, 380, 120, 125, 30, 0, 9999999, #PB_Spin_Numeric)
    ButtonImageGadget(#Btn_Heure_0, 225, 120, 30, 30, ImageID(#Id_Img))
    ButtonImageGadget(#Btn_Minute_0, 505, 120, 30, 30, ImageID(#Id_Img))
   
    TextGadget(#Txt_Seconde_0, 0, 180, 90, 30, "Seconde(s)", #PB_Text_Center|#SS_CENTERIMAGE)
    SpinGadget(#Spn_Seconde_0, 100, 180, 125, 30, 0, 999999999, #PB_Spin_Numeric)
    ButtonImageGadget(#Btn_Seconde_0, 225, 180, 30, 30, ImageID(#Id_Img))
        CloseGadgetList()
   
    ContainerGadget(#Ctn_1, 10, 225, 545, 220, #PB_Container_Raised)
   
    TextGadget(#Txt_Annee_1, 0, 10, 80, 30, "Année(s)", #PB_Text_Center|#SS_CENTERIMAGE)
    StringGadget(#Str_Annee_1, 100, 10, 155, 30, "", #PB_Text_Right)
    TextGadget(#Txt_Mois_1, 290, 10, 80, 30, "Mois", #PB_Text_Center|#SS_CENTERIMAGE)
    StringGadget(#Str_Mois_1, 380, 10, 155, 30, "", #PB_Text_Right)
   
    TextGadget(#Txt_Semaine_1, 0, 60, 90, 30, "Semaine(s)", #PB_Text_Center|#SS_CENTERIMAGE)
    StringGadget(#Str_Semaine_1, 100, 60, 155, 30, "", #PB_Text_Right)
    TextGadget(#Txt_Jour_1, 290, 60, 80, 30, "Jour(s)", #PB_Text_Center|#SS_CENTERIMAGE)
    StringGadget(#Str_Jour_1, 380, 60, 155, 30, "", #PB_Text_Right)
   
    TextGadget(#Txt_Heure_1, 0, 120, 80, 30, "Heure(s)", #PB_Text_Center|#SS_CENTERIMAGE)
    StringGadget(#Str_Heure_1, 100, 120, 155, 30, "", #PB_Text_Right)
    TextGadget(#Txt_Minute_1, 290, 120, 90, 30, "Minute(s)", #PB_Text_Center|#SS_CENTERIMAGE)
    StringGadget(#Str_Minute_1, 380, 120, 155, 30, "", #PB_Text_Right)
   
    TextGadget(#Txt_Seconde_1, 0, 180, 90, 30, "Seconde(s)", #PB_Text_Center|#SS_CENTERIMAGE)
    StringGadget(#Str_Seconde_1, 100, 180, 155, 30, "", #PB_Text_Right)
    CloseGadgetList()
   
   
    i = #Spn_Annee_0
    While  i <= #Spn_Seconde_0
      SetGadgetText(i, "0")
      SetGadgetFont(i, FontID(#Police_2))
      i + 1
    Wend
    i = #Str_Annee_1
    While i <= #Str_Seconde_1
      SetGadgetFont(i, FontID(#Police_2))
      i + 1
    Wend
   
    BindGadgetEvent(#Spn_Annee_0, @_Annee_())
    BindGadgetEvent(#Spn_Mois_0, @_Mois_())
    BindGadgetEvent(#Spn_Semaine_0, @_Semaine_())
    BindGadgetEvent(#Spn_Jour_0, @_Jour_())
    BindGadgetEvent(#Spn_Heure_0, @_Heure_())
    BindGadgetEvent(#Spn_Minute_0, @_Minute_())
    BindGadgetEvent(#Spn_Seconde_0, @_Seconde_())
   
    AddWindowTimer(#Fenetre_principale, #Timer, 100)
   
   
;  EndIf
;EndProcedure

    CloseGadgetList()
   
    ModeDateF(#Date_Seconde)
  EndIf
EndProcedure

OpenWindow_Fenetre_Principale()

;- Boucle evenementielle
Repeat
  Evenement = WaitWindowEvent()
  Select Evenement
     
    Case #PB_Event_Timer
      If EventTimer() = #Timer
        Calcul()
      EndIf
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #Spn_J_1D To #Spn_A_1D, #Spn_J_DD_2D To #Spn_A_DD_2D, #Spn_J_DF_2D To #Spn_A_DF_2D
          Calculer_Jours()
          Calculer_Mois()
        Case #Spn_S_HD To #Spn_H_HD, #Spn_S_HF To #Spn_H_HF
          Calculer_Heures()
          Calculer_Minutes()
          Calculer_Secondes()
         
          ;- boucle : Une date
        Case #Btn_1D_Vider
          i = #Str_JDA_1D
          While i <= #Str_AR_1D
            SetGadgetText(i, "")
            i + 1
          Wend 
          SetGadgetText(#Txt_Date_JDS_JJ_MM_AAAA_1D, "")
         
        Case #Btn_1D_Date
          Global JDS$ = FormatDateF("%jour %jj %mois %aaaa", DateF(GetGadgetState(#Spn_A_1D),GetGadgetState(#Spn_M_1D),GetGadgetState(#Spn_J_1D)))
          Global AJDS$ = Right(JDS$, 4) ;Année
          Global MJDS$ = Mid(Jds$, 8, 3);Mois abrégé
          Global MMJDS$                 ;Mois
          Global JJDM$ = Mid(JDS$, 5, 2);Jour du mois
          Global JJDS$                  ; Jour de semaine
          Select MJDS$
            Case "Jan"
              MMJDS$ = "Janvier"
            Case "Fev"
              MMJDS$ = "Février"
            Case "Mar"
              MMJDS$ = "Mars"
            Case "Avr"
              MMJDS$ = "Avril"
            Case "Mai"
              MMJDS$ = "Mai"
            Case "Jun"
              MMJDS$ = "Juin"
            Case "Jul"
              MMJDS$ = "Juillet"
            Case "Aou"
              MMJDS$ = "Août"
            Case "Sep"
              MMJDS$ = "Septembre"
            Case "Oct"
              MMJDS$ = "Octobre"
            Case "Nov"
              MMJDS$ = "Novembre"
            Case "Dec"
              MMJDS$ = "Décembre"
          EndSelect   
         
          Select Left(JDS$, 3)
            Case "Lun"
              JJDS$ = "Lundi"
            Case "Mar"
              JJDS$ = "Mardi"
            Case "Mer"
              JJDS$ = "Mercredi"
            Case "Jeu"
              JJDS$ = "Jeudi"
            Case "Ven"
              JJDS$ = "Vendredi"
            Case "Sam"
              JJDS$ = "Samedi"
            Case "Dim"
              JJDS$ = "Dimanche"
          EndSelect
          SetGadgetText(#Txt_Date_JDS_JJ_MM_AAAA_1D, JJDS$+" "+JJDM$+" "+MMJDS$+" "+AJDS$)
          Global JDA$ = Str(JourDAnneeF(DateF(GetGadgetState(#Spn_A_1D),GetGadgetState(#Spn_M_1D),GetGadgetState(#Spn_J_1D))))
          SetGadgetText(#Str_JDA_1D, JDA$)
          Global SDA$ = Str(SemaineDAnneeF(DateF(GetGadgetState(#Spn_A_1D),GetGadgetState(#Spn_M_1D),GetGadgetState(#Spn_J_1D))))
          SetGadgetText(#Str_SDA_1D, SDA$)
          Global JDM$ = Str(JoursDansMoisF(GetGadgetState(#Spn_A_1D),GetGadgetState(#Spn_M_1D)))
          SetGadgetText(#Str_JDM_1D, JDM$)
          If EstBissextileF(GetGadgetState(#Spn_A_1D))
            SetGadgetText(#Str_AB_1D, "Oui")
          Else
            SetGadgetText(#Str_AB_1D, "Non")
          EndIf
          Global AnneeRomaine$ = RomVal(GetGadgetState(#Spn_A_1D))
          SetGadgetText(#Str_AR_1D, AnneeRomaine$)
         
          ;- boucle : Deux dates
        Case #Btn_2D_Vider
          SetGadgetText(#Str_JED_2D, "")
          SetGadgetText(#Txt_Nb_annees_2D, "")
          SetGadgetText(#Txt_Nb_mois_2D, "")
          SetGadgetText(#Txt_Nb_jours_2D, "")
         
        Case #Btn_JED_2D
          Date1 = DateF(GetGadgetState(#Spn_A_DD_2D),
                        GetGadgetState(#Spn_M_DD_2D),
                        GetGadgetState(#Spn_J_DD_2D), 0, 0, 0)
          Date2 = DateF(GetGadgetState(#Spn_A_DF_2D),
                        GetGadgetState(#Spn_M_DF_2D),
                        GetGadgetState(#Spn_J_DF_2D), 0, 0, 0)
          Jour1_2D.q = Val(RSet(GetGadgetText(#Spn_J_DD_2D), 2, "0"))
          Mois1_2D.q = Val(RSet(GetGadgetText(#Spn_M_DD_2D), 2, "0"))
          Annee1_2D.q = Val(RSet(GetGadgetText(#Spn_A_DD_2D), 4, "0"))
          Jour2_2D.q = Val(RSet(GetGadgetText(#Spn_J_DF_2D), 2, "0"))
          Mois2_2D.q = Val(RSet(GetGadgetText(#Spn_M_DF_2D), 2, "0"))
          Annee2_2D.q = Val(RSet(GetGadgetText(#Spn_A_DF_2D), 4, "0"))
          Date1_2D.s = RSet(Str(Jour1_2D) , 2, "0")+"/"+
                       RSet(Str(Mois1_2D) , 2, "0")+"/"+
                       RSet(Str(Annee1_2D), 4, "0")
          Date2_2D.s = RSet(Str(Jour2_2D) , 2, "0")+"/"+
                       RSet(Str(Mois2_2D) , 2, "0")+"/"+
                       RSet(Str(Annee2_2D), 4, "0")
          DateAvant_2D.q = AnalyserDate(Date1_2D)
          DateApres_2D.q = AnalyserDate(date2_2D)
          sDiffTemps(DateApres_2D - DateAvant_2D)
          If MaDiff\TotalJours > 1
            Txt_Total_Jours = " jours "
          Else
            Txt_Total_Jours = " jour "
          EndIf
          SetGadgetText(#Str_JED_2D, Str(MaDiff\TotalJours) + Txt_Total_Jours)
          If MaDiff\Annees > 1
            Txt_An = " ans "
          Else 
            Txt_An = " an "
          EndIf 
          SetGadgetText(#Txt_Nb_annees_2D, Str(MaDiff\Annees) + Txt_An)
          Txt_Mois.s = " mois"
          SetGadgetText(#Txt_Nb_mois_2D, Str(MaDiff\Mois) + Txt_Mois)
          If MaDiff\JoursRestants > 1
            Txt_Jour = " jours "
          Else
            Txt_Jour = " jour "
          EndIf
          SetGadgetText(#Txt_Nb_jours_2D, Str(MaDiff\JoursRestants) + Txt_Jour)
         
          ;- boucle : Différence d'heures
        Case #Btn_H_Vider
          SetGadgetText(#Txt_Nb_heures_H, "")
          SetGadgetText(#Txt_Nb_Minutes_H, "")
          SetGadgetText(#Txt_Nb_Secondes_H, "")
        Case #Btn_H_Valider
          Date1 = DateF(AnneeF(DateF()),
                        MoisF(DateF()),
                        JourF(DateF()),
                        GetGadgetState(#Spn_H_HD),
                        GetGadgetState(#Spn_M_HD),
                        GetGadgetState(#Spn_S_HD))
          Date2 = DateF(AnneeF(DateF()),
                        MoisF(DateF()),
                        JourF(DateF()),
                        GetGadgetState(#Spn_H_HF),
                        GetGadgetState(#Spn_M_HF),
                        GetGadgetState(#Spn_S_HF))
          DateDiff(Date1,Date2,@MaDiff)
          Global TexteH$ = ""
          If MaDiff\Heures < 2
            TexteH$ = " heure"
          Else
            TexteH$ = " heures"
          EndIf
          If MaDiff\Heures
            SetGadgetText(#Txt_Nb_heures_H, ""+MaDiff\Heures+TexteH$)
          Else
            SetGadgetText(#Txt_Nb_heures_H, "")
          EndIf 
          Global texteMi$ = ""
          If MaDiff\Minutes < 2
            texteMi$ =  " minute"
          Else
            texteMi$ =  " minutes"
          EndIf
          If MaDiff\Minutes
            SetGadgetText(#Txt_Nb_Minutes_H, ""+MaDiff\Minutes+texteMi$)
          Else
            SetGadgetText(#Txt_Nb_Minutes_H, "")
          EndIf 
          Global texteS$ = ""
          If MaDiff\Secondes < 2
            texteS$ = " seconde"
          Else
            texteS$ = " secondes"
          EndIf
          If MaDiff\Secondes
            SetGadgetText(#Txt_Nb_Secondes_H, ""+MaDiff\Secondes+texteS$)
          Else
            SetGadgetText(#Txt_Nb_Secondes_H, "")
          EndIf
         
          ;- boucle : Convertisseur de temps
        Case #Btn_Annee_0
          SetGadgetState(#Spn_Annee_0, 0)
        Case #Btn_Mois_0
          SetGadgetState(#Spn_Mois_0, 0)
        Case #Btn_Semaine_0
          SetGadgetState(#Spn_Semaine_0, 0)
        Case #Btn_Jour_0
          SetGadgetState(#Spn_Jour_0, 0)
        Case #Btn_Heure_0
          SetGadgetState(#Spn_Heure_0, 0)
        Case #Btn_Minute_0
          SetGadgetState(#Spn_Minute_0, 0)
        Case #Btn_Seconde_0
          SetGadgetState(#Spn_Seconde_0,0)
     
      ;- boucle : Jours de semaine & Week-ends
        Case #spn_J_de_JDS To #Spn_A_a_JDS
          HideGadget(#Btn_Valider_JDS, 0)
          Calculer_Jours()
          Calculer_Mois()
        Case #Btn_Valider_JDS
          HideGadget(#Btn_Valider_JDS, 1)
          JDSDate1 = DateF(GetGadgetState(#Spn_A_de_JDS),
                           GetGadgetState(#Spn_M_de_JDS),
                           GetGadgetState(#Spn_J_de_JDS), 0, 0, 0)
          JDSdate2 = DateF(GetGadgetState(#Spn_A_a_JDS),
                           GetGadgetState(#Spn_M_a_JDS),
                           GetGadgetState(#Spn_J_a_JDS), 0, 0, 0)
          JDSdate1$ = RSet(GetGadgetText(#Spn_J_de_JDS), 2, "0") + "/" +
                      RSet(GetGadgetText(#Spn_M_de_JDS), 2, "0") + "/" +
                      RSet(GetGadgetText(#Spn_A_de_JDS), 4, "0")
          JDSdate2$ = RSet(GetGadgetText(#Spn_J_a_JDS), 2, "0") + "/" +
                      RSet(GetGadgetText(#Spn_M_a_JDS), 2, "0") + "/" +
                      RSet(GetGadgetText(#Spn_A_a_JDS), 4, "0")
          JDSannee1 = Val(RSet(GetGadgetText(#Spn_A_de_JDS), 4, "0"))
          JDSmois1 = Val(RSet(GetGadgetText(#Spn_M_de_JDS), 2, "0"))
          JDSjour1 = Val(RSet(GetGadgetText(#Spn_J_de_JDS), 2, "0"))
          JDSannee2 = Val(RSet(GetGadgetText(#Spn_A_a_JDS), 4, "0"))
          JDSmois2 = Val(RSet(GetGadgetText(#Spn_M_a_JDS), 2, "0"))
          JDSjour2 = Val(RSet(GetGadgetText(#Spn_J_a_JDS), 2, "0"))
          JDSdateAvant = AnalyserDate(JDSdate1$)
          JDSdateApres = AnalyserDate(JDSdate2$)
          DateDiff(JDSdateAvant,JDSdateApres,@MaDiff)
          CalculerNbJDS()
          SetGadgetText(#Str_Dimanche_JDS, Str(Jat()\Dimanche))
          SetGadgetText(#Str_Lundi_JDS, Str(Jat()\Lundi))
          SetGadgetText(#Str_Mardi_JDS, Str(Jat()\Mardi))
          SetGadgetText(#Str_Mercredi_JDS, Str(Jat()\Mercredi))
          SetGadgetText(#Str_Jeudi_JDS, Str(Jat()\Jeudi))
          SetGadgetText(#Str_Vendredi_JDS, Str(Jat()\Vendredi))
          SetGadgetText(#Str_Samedi_JDS, Str(Jat()\Samedi))
          ResultatWE = Minimum(Val(GetGadgetText(#Str_Vendredi_JDS)), Val(GetGadgetText(#Str_Samedi_JDS)), Val(GetGadgetText(#Str_Dimanche_JDS)))
          SetGadgetText(#Date_Semaines_JDS, Str(MaDiff\TotalJours - ResultatWE))
          SetGadgetText(#Date_WE_JDS, Str(ResultatWE))
          SetGadgetText(#Str_de2_JDS, JS((JourDeSemaineF(JDSdateAvant))) + " " + JourF(JDSdateAvant) + " " + NomMois(MoisF(JDSdateAvant) - 1) + " " + AnneeF(JDSdateAvant))
          SetGadgetText(#Str_a2_JDS, JS((JourDeSemaineF(JDSdateApres)))  + " " + JourF(JDSdateApres) + " " + NomMois(MoisF(JDSdateApres) - 1) + " " + AnneeF(JDSdateApres))         
      EndSelect ;- dernier endselect
      ;Fenêtre
    Case #PB_Event_CloseWindow
      Select EventWindow()
        Case #Fenetre_Principale
          CloseWindow(#Fenetre_Principale)
          Break
      EndSelect
  EndSelect
ForEver


EndDataSection

_________________
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce GT 640 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.45 LTS, 5.62
Un homme doit être poli, mais il doit aussi être libre !


Dernière édition par Micoute le Mer 15/Nov/2017 18:03, édité 1 fois.

Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Calculateur de dates avancé
MessagePosté: Mer 15/Nov/2017 18:02 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 02/Oct/2011 16:17
Messages: 1900
Localisation: 50200 Coutances
Code:
Procedure Calcul()
  _Annee_()
  _Mois_()
  _Semaine_()
  _Jour_()
  _Heure_()
  _Minute_()
  _Seconde_()
EndProcedure

Procedure _Annee_()
  SetGadgetText(#Str_Annee_1, StrF(GetGadgetState(#Spn_Annee_0) * Temps\Annee +
                                   GetGadgetState(#Spn_Mois_0) * Temps\Annee / Temps\Mois +
                                   GetGadgetState(#Spn_Semaine_0) * Temps\Annee / Temps\Semaine +
                                   GetGadgetState(#Spn_Jour_0) * Temps\Annee / Temps\Jour +
                                   GetGadgetState(#Spn_Heure_0) * Temps\Annee / Temps\Heure +
                                   GetGadgetState(#Spn_Minute_0) * Temps\Annee / Temps\Minute +
                                   GetGadgetState ( #Spn_Seconde_0) * Temps\Annee / Temps\Seconde, 3))
EndProcedure

Procedure _Mois_()
  SetGadgetText(#Str_Mois_1, StrF(GetGadgetState(#Spn_Annee_0) * Temps\Mois * Temps\Annee +
                                  GetGadgetState(#Spn_Mois_0) * Temps\Mois / Temps\Mois +
                                  GetGadgetState(#Spn_Semaine_0) * Temps\Mois / Temps\Semaine +
                                  GetGadgetState(#Spn_Jour_0) * Temps\Mois / Temps\Jour +
                                  GetGadgetState(#Spn_Heure_0) * Temps\Mois / Temps\Heure +
                                  GetGadgetState(#Spn_Minute_0) * Temps\Mois / Temps\Minute +
                                  GetGadgetState(#Spn_Seconde_0) * Temps\Mois / Temps\Seconde, 2))
EndProcedure

Procedure _Semaine_()
  SetGadgetText(#Str_Semaine_1, StrF(GetGadgetState(#Spn_Annee_0) * Temps\Semaine * Temps\Annee +
                                     GetGadgetState(#Spn_Mois_0) * Temps\Semaine / Temps\Mois +
                                     GetGadgetState(#Spn_Semaine_0) * Temps\Semaine / Temps\Semaine +
                                     GetGadgetState(#Spn_Jour_0) * Temps\Semaine / Temps\Jour +
                                     GetGadgetState(#Spn_Heure_0) * Temps\Semaine / Temps\Heure +
                                     GetGadgetState(#Spn_Minute_0) * Temps\Semaine / Temps\Minute +
                                     GetGadgetState(#Spn_Seconde_0) * Temps\Semaine / Temps\Seconde, 2))
EndProcedure

Procedure _Jour_()
  SetGadgetText(#Str_Jour_1, StrF(GetGadgetState(#Spn_Annee_0) * Temps\Jour * Temps\Annee +
                                  GetGadgetState(#Spn_Mois_0) * Temps\Jour / Temps\Mois +
                                  GetGadgetState(#Spn_Semaine_0) * Temps\Jour / Temps\Semaine +
                                  GetGadgetState(#Spn_Jour_0) * Temps\Jour / Temps\Jour +
                                  GetGadgetState(#Spn_Heure_0) * Temps\Jour / Temps\Heure +
                                  GetGadgetState(#Spn_Minute_0) * Temps\Jour / Temps\Minute +
                                  GetGadgetState(#Spn_Seconde_0) * Temps\Jour / Temps\Seconde, 2))
EndProcedure

Procedure _Heure_()
  SetGadgetText(#Str_Heure_1, StrF(GetGadgetState(#Spn_Annee_0) * Temps\Heure +
                                   GetGadgetState(#Spn_Mois_0) * Temps\Heure / Temps\Mois +
                                   GetGadgetState(#Spn_Semaine_0) * Temps\Heure / Temps\Semaine +
                                   GetGadgetState(#Spn_Jour_0) * Temps\Heure / Temps\Jour +
                                   GetGadgetState(#Spn_Heure_0) * Temps\Heure / Temps\Heure +
                                   GetGadgetState(#Spn_Minute_0) * Temps\Heure / Temps\Minute +
                                   GetGadgetState(#Spn_Seconde_0) * Temps\Heure / Temps\Seconde, 0))
EndProcedure

Procedure _Minute_()
  SetGadgetText(#Str_Minute_1, StrF(GetGadgetState(#Spn_Annee_0) * Temps\Minute +
                                    GetGadgetState(#Spn_Mois_0) * Temps\Minute / Temps\Mois +
                                    GetGadgetState(#Spn_Semaine_0) * Temps\Minute / Temps\Semaine +
                                    GetGadgetState(#Spn_Jour_0) * Temps\Minute / Temps\Jour +
                                    GetGadgetState(#Spn_Heure_0) * Temps\Minute / Temps\Heure +
                                    GetGadgetState(#Spn_Minute_0) * Temps\Minute / Temps\Minute +
                                    GetGadgetState(#Spn_Seconde_0) * Temps\Minute / Temps\Seconde, 0))
EndProcedure

Procedure _Seconde_()
  SetGadgetText(#Str_Seconde_1, StrF(GetGadgetState(#Spn_Annee_0) * Temps\Seconde +
                                     GetGadgetState(#Spn_Mois_0) * Temps\Seconde / Temps\Mois +
                                     GetGadgetState(#Spn_Semaine_0) * Temps\Seconde / Temps\Semaine +
                                     GetGadgetState(#Spn_Jour_0) * Temps\Seconde / Temps\Jour +
                                     GetGadgetState(#Spn_Heure_0) * Temps\Seconde / Temps\Heure +
                                     GetGadgetState(#Spn_Minute_0) * Temps\Seconde / Temps\Minute +
                                     GetGadgetState(#Spn_Seconde_0 ) * Temps\Seconde / Temps\Seconde, 0))
EndProcedure

Procedure Minimum(a, b, c) ; Retourne la valeur minimum parmi 3.
  Protected mi = a
  If b < mi
    mi = b
  EndIf
  If c < mi
    mi = c
  EndIf
  ProcedureReturn mi
EndProcedure

Procedure CalculerNbJDS()
  ClearList(Jat())
  i = JDSdateAvant
  AddElement(Jat())
  While i < JDSdateApres
    Select JourDeSemaineF(i) %7
      Case 0
        Jat()\Dimanche + 1
      Case 1
        Jat()\Lundi + 1
      Case 2
        Jat()\Mardi + 1
      Case 3
        Jat()\Mercredi + 1
      Case 4
        Jat()\Jeudi + 1
      Case 5
        Jat()\Vendredi + 1
      Case 6
        Jat()\Samedi + 1
    EndSelect
    i + 86400
  Wend
  ProcedureReturn Resultat
EndProcedure

Procedure Calculer_Jours_JDS()
  If GetGadgetState(#Spn_M_de_JDS)
    Jm = JoursDansMoisF(GetGadgetState(#Spn_A_de_JDS),GetGadgetState(#Spn_M_de_JDS))
   
    If GetGadgetState(#Spn_J_de_JDS) > Jm
      SetGadgetState(#Spn_J_de_JDS,1)
    ElseIf GetGadgetState(#Spn_J_de_JDS) < 1
      SetGadgetState(#Spn_J_de_JDS,Jm)
    EndIf
   
  EndIf
  If GetGadgetState(#Spn_M_a_JDS)
    Jm = JoursDansMoisF(GetGadgetState(#Spn_A_a_JDS),GetGadgetState(#Spn_M_a_JDS))
   
    If GetGadgetState(#Spn_J_a_JDS) > Jm
      SetGadgetState(#Spn_J_a_JDS,1)
    ElseIf GetGadgetState(#Spn_J_a_JDS) < 1
      SetGadgetState(#Spn_J_a_JDS,Jm)
    EndIf
   
  EndIf
EndProcedure

Procedure Calculer_Mois_JDS()
  If GetGadgetState(#Spn_M_de_JDS) > 12
    SetGadgetState(#Spn_M_de_JDS,1)
  ElseIf GetGadgetState(#Spn_M_de_JDS) < 1
    SetGadgetState(#Spn_M_de_JDS,12)
  EndIf
  If GetGadgetState(#Spn_M_a_JDS) > 12
    SetGadgetState(#Spn_M_a_JDS,1)
  ElseIf GetGadgetState(#Spn_M_a_JDS) < 1
    SetGadgetState(#Spn_M_a_JDS,12)
  EndIf
EndProcedure

DataSection
  Image:
  IncludeBinary #PB_Compiler_FilePath + "Images\Icone.png"
  Fin:


_________________
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce GT 640 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.45 LTS, 5.62
Un homme doit être poli, mais il doit aussi être libre !


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Calculateur de dates avancé
MessagePosté: Mer 15/Nov/2017 18:05 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 02/Oct/2011 16:17
Messages: 1900
Localisation: 50200 Coutances
Calendrier_F.pbi

Partie 1
Code:
;- Constantes et variables globales
#SecsParJourF = 86400 ; Secondes par jour
#AnneeEpoqueF = 1601 ; Première année valable pour la plupart des routines date
#JoursDepuis1970 = 134774 ; Jours à compter de la première journée de l'année époque (01-Jan-1601) au 01-Jan-1970
#Date_Annee   = #PB_Date_Year
#Date_Mois    = #PB_Date_Month
#Date_Semaine = #PB_Date_Week
#Date_Jour    = #PB_Date_Day
#Date_Heure   = #PB_Date_Hour
#Date_Minute  = #PB_Date_Minute
#Date_Seconde = #PB_Date_Second
Global dimanche = 0, lundi = 1, mardi = 2, mercredi = 3, jeudi = 4, vendredi = 5, samedi = 6
Global UniteDateF.q = 10000000 ; Unité de granularité, initialement 1 seconde pour la compatibilité avec les routines date de PB 4.xx
Global UniteJourF.q = 10000000*#SecsParJourF/UniteDateF ; Nombre de granularité unités par jour
Global Dim JS.s(6), Dim NomMois.s(11)

JS(0) = "dimanche" : JS(1) = "lundi" : JS(2) = "mardi" : JS(3) = "mercredi" : JS(4) = "jeudi" : JS(5) = "vendredi" : JS(6) = "samedi"
NomMois(0) = "janvier" : NomMois(1) = "février" : NomMois(2) = "mars" : NomMois(3) = "avril" : NomMois(4) = "mai" : NomMois(5) = "juin"
NomMois(6) = "juillet" : NomMois(7) = "août" : NomMois(8) = "septembre" : NomMois(9) = "octobre" : NomMois(10) = "novembre" : NomMois(11) = "décembre"

DeclareDLL.q AjouterDateF(date.q=-1, Unite=#Date_Jour, Valeur.q=1)
DeclareDLL AmjF(date.q, *Annee, *Mois, *Jour, *Heure=0, *Minute=0, *Seconde=0)
DeclareDLL.q AnalyserDateF(masque$, chaine$, coupure=0, ignore=#False)
DeclareDLL.i AnneeF(date.q=-1)
DeclareDLL.q Aujourd_huiF()
DeclareDLL.q DateDePbF(date.q)
DeclareDLL.q DateDeUtcF(date.q=-1)
DeclareDLL.q DateEntreeRepF(Repertoire, DateType)
DeclareDLL.q DateF(Annee=0, Mois=0, Jour=0, Heure=0, Minute=0, Seconde=0)
DeclareDLL.q DatePaquesF(Annee.q=0)
DeclareDLL.i DateSemaine1(Annee=-1, Premier_Jour=0)
DeclareDLL.q DateVersPbF(date.q)
DeclareDLL.q DateVersUtcF(date.q=-1)
DeclareDLL.q DebutAnneeF(Annee=-1, Jour=0)
DeclareDLL.i DecalageHoraireF(type)
DeclareDLL DefinirDateFichierF(Filename$, DateType, Date.q)
DeclareDLL.q DiffDatesF(datedebut.q, datefin.q=-1, Unite=#Date_Jour, multiple.q=1)
DeclareDLL.b EstBissextileF(Annee=-1)
DeclareDLL.s FormatDateF(masque$, date.q=-1)
DeclareDLL.i HeureF(date.q=-1)
DeclareDLL.i JourDAnneeF(date.q=-1)
DeclareDLL.i JourDeSemaineF(date.q=-1)
DeclareDLL.i JourF(date.q=-1)
DeclareDLL.i JoursDansMoisF(Annee=-1, Mois=-1)
DeclareDLL.q JoursDepuis1970(Annee=0, Mois=1, Jour=1)
DeclareDLL.i MaxLongAnneeF()
DeclareDLL.i MinuteF(date.q=-1)
DeclareDLL.i ModeDateF(Unite.q=0)
DeclareDLL.i MoisF(date.q=-1)
DeclareDLL.q ObtenirDateFichierF(Filename$, DateType)
DeclareDLL.i SecondeF(date.q=-1)
DeclareDLL.i SemaineDAnneeF(date.q=-1, Premier_Jour=0)
DeclareDLL.s ZoneFuseauF()


ProcedureDLL.q AjouterDateF(date.q=-1, Unite=#Date_Jour, Valeur.q=1)
   ; Augmenter une date par des unités de «valeur» dont la valeur peut être négative
   ; Si la date est absente, Aujourd_huiF est utilisé
   ; Unité est une de:
   ;   #PB_Date_Year   = 0
   ;   #PB_Date_Month  = 1
   ;   #PB_Date_Week   = 2
   ;   #PB_Date_Day    = 3
   ;   #PB_Date_Hour   = 4
   ;   #PB_Date_Minute = 5
   ;   #PB_Date_Second = 6
   ; Pour une calculatrice en ligne date (années 1 .. 3999) Voir:
   ;   www.timeanddate.com/date/dateadd.html
   Protected a, m, j, h, i, s, Dernier
   If date<0
      date = DateF()
   EndIf ; Aujourd_huiF
   Select Unite
      Case #Date_Annee
         AmjF(date, @a, @m, @j, @h, @i, @s)
         a + Valeur
         Dernier = JoursDansMoisF(a, m)
         If m>Dernier
            m = Dernier
         EndIf
         date = DateF(a, m, j, h, i, s)
      Case #Date_Mois
         AmjF(date, @a, @m, @j, @h, @i, @s)
         m + Valeur
         If m<=0
            a+m/12-1
            m%12+12
         ElseIf m>12
            m-1
            a+m/12
            m%12+1
         EndIf
         Dernier = JoursDansMoisF(a, m)
         If m>Dernier
            m = Dernier
         EndIf
         date = DateF(a, m, j, h, i, s)
      Case #Date_Semaine
         date + Valeur*UniteJourF*7
      Case #Date_Jour
         date + Valeur*UniteJourF
      Case #Date_Heure
         date + (Valeur*UniteJourF+12)/24 ; Heures par jour
      Case #Date_Minute
         date + (Valeur*UniteJourF+720)/1440 ; Minutes par jour
      Case #Date_Seconde
         date + (Valeur*UniteJourF+#SecsParJourF/2)/#SecsParJourF ; Secondes par jour
   EndSelect
   ProcedureReturn date
EndProcedure

ProcedureDLL AmjF(date.q, *Annee, *Mois, *Jour, *Heure=0, *Minute=0, *Seconde=0)
   ; Retourne (dans les arguments) une date du calendrier grégorien donnée, en une date julienne
   ; Si la date est négative, la date/heure locale pour Aujourd_huiF est retournée
   ; si la date est trop grande, le dernier instant de l'année 9999 est retourné
   ; L'inverse de la routine DateF()
   Protected datemax.q=2650467743999999999
   Protected hs.SYSTEMTIME
   If date<0 ; Suposons maintenant
      GetLocalTime_(@hs)
   Else
      date * UniteDateF
      If date>datemax
         date=datemax
      EndIf
      FileTimeToSystemTime_(@date, @hs)
   EndIf
   With hs
      PokeI(*Annee, \wYear)
      PokeI(*Mois, \wMonth)
      PokeI(*Jour, \wDay)
      If *Heure
         PokeI(*Heure, \wHour)
      EndIf
      If *Minute
         PokeI(*Minute, \wMinute)
      EndIf
      If *Seconde
         PokeI(*Seconde, \wSecond)
      EndIf
   EndWith
EndProcedure

ProcedureDLL.q AnalyserDateF(masque$, chaine$, coupure=0, ignore=#False)
   ; Convertit une date et/ou heure contenue dans une chaîne en une date/heure Julienne
   ; Retourne -1 en cas d'erreur (par exemple, mois > 12)
   ; La chaîne de date doit contenir au moins un séparateur (par exemple slash)
   ;   entre chaque partie numérique de la date (sauf %ymd)
   ; Les séparateurs dans le masque ne doivent pas correspondre aux séparateurs
   ;   dans la chaîne (et donc plus tolérant que PB ParseDate)
   ; Le masque décrit comment la chaîne de date d 'entrée est formatée:
   ; %amj    >=6 chiffres a.. ammjj (si moins de 7 chiffres, la coupure est utilisée)
   ; %aaaa   >=4 chiffres de l'année
   ; %aa     >=1 chiffre année (si 0 .. 99, coupure est utilisée)
   ; %mm     1..2 chiffres mois
   ; %mois   >=1 caractère [mois ou] nom du mois (par exemple avr ou avril)
   ; %jj     1..2 chiffres  date
   ; %hh     1..2 chiffres  heure
   ; %ii     1..2 chiffres  minute
   ; %ss     1..2 chiffres  seconde
   ; %%      Ignorer le reste du masque (peut-être utilisé comme un commentaire)
   ;
   ; Le paramètre 'coupure' décide de l'interprétation d'années à 2 chiffres
   ;   et est utilisé uniquement par des champs masque %ymd et %yy
   ;  Supposons que la valeur coupure est xx alors les années à 2 chiffres de 00 .. xx sont
   ;   interprété comme 2000 .. 20xx et xx+1..99 comme 19xx+1..1999
   ;   Exemples:
   ;   Si coupure=29, 00..29 -> 2000..2029 et 30..99 -> 1930..1999
   ;   Si coupure=99, 00..99 -> 2000..2999
   ;   Cas particulier: coupure 00 (par défaut) est considérée comme 99
   ;
   ; Le paramètre 'ignore':
   ;   Si le masque a plus de champs '%' que la chaîne ne dispose de nombres
   ;   une erreur sera relevée, sauf si l'argument 'ignore' est vrai
   ;   ou si %% est utilisé pour terminer l'analyse (Voir les exemples)
   ;
   Protected a, m, j, h, i, s ; Champs Date/heure
   Protected p, index=2, Champ$, date.q, Chiffre$="0123456789"
   Protected Nombre, trouves = 0 ; Nombre de champs trouvés
   Protected Mois$, pMois, c$, q ; Pour résoudre %mois
   masque$ = LCase(masque$)
   ; Prévisualisation pour chaque nom de mois et le remplacer par le numéro du mois
   If FindString(masque$, "%mois", 1)
      Mois$ = "-jan-fév-mar-avr-mai-juin-juil-août-sep-oct-nov-déc-"
      ReplaceString(Mois$, "-", Chr(1), #PB_String_InPlace)
      chaine$=LCase(chaine$)
      For p=1 To Len(chaine$)-3
         ; Est-ce que le nom du mois commence à la position p dans chaîne$?
         pMois = FindString(Mois$, Mid(chaine$, p, 3), 1)
         If pMois ; Position du début de nom de mois dans Mois$
            ; Est-ce que le nom est précédé d'un caractère non-alpha?
            c$ = Mid(chaine$, p-1, 1)
            If p=1 Or c$<"a" Or c$>"z"
               ; Trouver la fin du nom du mois
               q = p+3
               c$ = Mid(chaine$, q, 1)
               While c$>="a" And c$<="z"
                  q + 1
                  c$ = Mid(chaine$, q, 1)
               Wend
               ; Remplacez le nom du mois par son numéro de mois
               chaine$ = Left(chaine$,p-1)+" "+Str((pMois+3)/4)+" "+Mid(chaine$,q)
               Break ; Ne cherchez pas plus loin %mois
            EndIf
         EndIf ; pMois
      Next p
   EndIf ; %mois
   ; Résoudre les champs du masque
   If coupure<=0 Or coupure>99
      coupure=99
   EndIf
   Champ$=StringField(masque$, index, "%")
   While Champ$ And chaine$
      ; Recherche pour le premier/suivant nombre décimal
      While chaine$ And FindString(Chiffre$, Left(chaine$, 1), 1)=0
         chaine$ = Mid(chaine$, 2) ; Retirer premier non-chiffres
      Wend
      If Len(chaine$)=0
         Break
      EndIf ; plus de nombre restant
      ; Récupérer le nombre
      For p=1 To Len(chaine$)+1
         If FindString(Chiffre$, Mid(chaine$, p, 1), 1)=0
            Break
         EndIf ; Si ce n'est pas un chiffre
      Next p
      trouves + 1
      Nombre = Val(Left(chaine$, p-1)) ; >=0
      chaine$ = Mid(chaine$, p) ; Retirer le nombre
      ; correspondant au champ du masque en cours avec le nombre actuel
      If Left(Champ$,3)="amj"
         a=Nombre/10000
         m=(Nombre/100)%100
         j=Nombre%100
         If a<=coupure
            a + 2000
         ElseIf a<=99
            a + 1900
         EndIf
      ElseIf Left(Champ$,4)="aaaa"
         a = Nombre
      ElseIf Left(Champ$,2)="aa"
         a = Nombre
         If a<=coupure
            a + 2000
         ElseIf a<=99
            a + 1900
         EndIf
      ElseIf Left(Champ$,2)="mm"
         m = Nombre
      ElseIf Left(Champ$,3)="mois"
         m = Nombre
      ElseIf Left(Champ$,2)="jj"
         j = Nombre
      ElseIf Left(Champ$,2)="hh"
         h = Nombre
      ElseIf Left(Champ$,2)="ii"
         i = Nombre
      ElseIf Left(Champ$,2)="ss"
         s = Nombre
      Else
         ProcedureReturn -1
      EndIf ; Erreur (mauvais masque)
      index + 1
      Champ$=StringField(masque$, index, "%")
   Wend
   ; Vérifier les erreurs
   If trouves=0
      ProcedureReturn -1
   EndIf
   If Champ$ And Not ignore
      ProcedureReturn -1
   EndIf
   If a Or m Or j
      If a And (a<#AnneeEpoqueF Or a>9999)
         ProcedureReturn -1
      EndIf
      If a And m=0
         m = 1
      EndIf
      If a And j=0
         j = 1
      EndIf
      If m>12 Or j>31
         ProcedureReturn -1
      EndIf
   EndIf
   If h>59 Or i>59
      ProcedureReturn -1
   EndIf
   ProcedureReturn DateF(a, m, j, h, i, s) ; date/heure Julienne
EndProcedure

ProcedureDLL.i AnneeF(date.q=-1)
   ; Retourne la valeur de l'année (#AnneeEpoqueF..9999) de la date donnée
   ; S'il n'y a aucun argument, l'année en cours est retournée
   Protected a, m, j
   AmjF(date, @a, @m, @j)
   ProcedureReturn a
EndProcedure

ProcedureDLL.q Aujourd_huiF()
   ; Retourne la date julienne pour minuit au début d'aujourd'hui
   ProcedureReturn DateF()/UniteJourF*UniteJourF
EndProcedure

ProcedureDLL.q DateDePbF(date.q)
   ; Convertit une date et heure PureBasic en équivalent FILETIME
   ; Retourne -1 en cas d'erreur
   Protected correction.q = #JoursDepuis1970*UniteJourF
   If UniteDateF=1 ; Pour éviter les débordements quad
      date*10000000 + correction
   Else
      date = (date*UniteJourF+#SecsParJourF/2)/#SecsParJourF + correction
   EndIf
   If date<0
      date = -1
   EndIf
   ProcedureReturn date
EndProcedure


ProcedureDLL.q DateDeUtcF(date.q=-1)
   ; Convertit une date/heure UTC (GMT) en son équivalent local
   ; Si la date est absente, la date/heure locale pour Aujourd_huiF est retournée
   Protected datelocale.q, hs.SYSTEMTIME
   If date<0
      GetLocalTime_(@hs) ; Heure Système
      SystemTimeToFileTime_(@hs, @datelocale) ; Aujourd_huiF -> locale
   Else
      date * UniteDateF ; Convertir en unités de 100 nanosecondes
      FileTimeToLocalFileTime_(@date, @datelocale) ; UTC -> local
   EndIf
   ProcedureReturn (datelocale+UniteDateF/2)/UniteDateF
EndProcedure

ProcedureDLL.q DateEntreeRepF(Repertoire, DateType)
   ; Renvoie la date de l'entrée actuelle dans le répertoire en cours d'examen
   ProcedureReturn DateDePbF(DirectoryEntryDate(Repertoire, DateType))
EndProcedure

ProcedureDLL.q DateF(Annee=0, Mois=0, Jour=0, Heure=0, Minute=0, Seconde=0)
   ; Retourne une date/heure du calendrier julien donnée à une date/heure du calendrier grégorien
   ; Retourne la date Julienne local / heure pour Aujourd_huiF, si aucun argument n'est donné
   ; Retourne -1 si l'année est hors de portée
   Protected date.q, hs.SYSTEMTIME
   If Annee | Mois | Jour | Heure | Minute | Seconde = 0
      GetLocalTime_(@hs) ; Heure locale
   Else
      If Annee=0 ; Si seulement l'heure est spécifiée
         Annee = #AnneeEpoqueF
         Mois = 1
         Jour = 1
      ElseIf Annee<#AnneeEpoqueF Or Annee>9999
         ProcedureReturn -1
      Else
         If Mois=0
            Mois = 1
         EndIf
         If Jour=0
            Jour = 1
         EndIf
      EndIf
      With hs
         \wYear = Annee
         \wMonth = Mois
         \wDay = Jour
         \wHour = Heure
         \wMinute = Minute
         \wSecond = Seconde
      EndWith
   EndIf
   SystemTimeToFileTime_(@hs, @date) ; Heure locale
   ProcedureReturn (date+UniteDateF/2)/UniteDateF
EndProcedure

_________________
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce GT 640 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.45 LTS, 5.62
Un homme doit être poli, mais il doit aussi être libre !


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Calculateur de dates avancé
MessagePosté: Mer 15/Nov/2017 18:06 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 02/Oct/2011 16:17
Messages: 1900
Localisation: 50200 Coutances
Partie 2

Code:
ProcedureDLL.q DatePaquesF(Annee.q=0)
   ; Retourne la date du dimanche de Pâques pour l'année donnée (valable jusqu'à 4099)
   ; S'il n'y a aucun argument, l'année en cours est utilisée
   ; Si l'argument est > 9999, c'est supposé être une date, pas une année
   ; Définition:
   ;   www.merlyn.demon.co.uk/estrdate.htm
   ;   Dimanche Pâques est le premier dimanche après la date de la
   ;   pleine lune estimée se produisant le 21 Mars ou après.
   ;   Les dates possibles vont donc, du 22 Mars au 25 avril
   ; Utilise la méthode 3 à:
   ;   users.sa.chariot.net.au/~gmarts/eastalg.htm
   Protected FirstDig, Remain19, temp, d ; résultats intermediaires
   Protected tA, tB, tC, tD, tE          ; Résultats table A à E
   If Annee<=0
      Annee = AnneeF() ; Cette année
   ElseIf Annee>9999
      Annee = AnneeF(Annee) ; Convertir date à l'année
   EndIf
   FirstDig = Annee / 100 ; Siècle
   Remain19 = Annee%19 ; Nombre d'or de l'année dans le cycle métonique
   ; Calculer Paschal Full Moon Day-of-March date (PFM)
   temp = (FirstDig - 15) / 2 + 202 - 11 * Remain19
   Select FirstDig
      Case 21, 24, 25, 27 To 32, 34, 35, 38
         temp = temp - 1
      Case 33, 36, 37, 39, 40
         temp - 2
   EndSelect
   temp = Mod(temp, 30)
   tA = temp + 21
   If temp=29
      tA - 1
   EndIf
   If (temp=28 And Remain19>10)
      tA - 1
   EndIf
   ; Trouver le dimanche suivant
   tB = (tA - 19)%7
   tC = (40 - FirstDig)%4
   If tC=3
      tC + 1
   EndIf
   If tC>1
      tC + 1
   EndIf
   temp = Annee%100
   tD = (temp + temp / 4)%7
   tE = ((20 - tB - tC - tD)%7) + 1
   d = tA + tE ; Jours après le 0 Mars
   ProcedureReturn AjouterDateF(DateF(Annee, 3, 1), #Date_Jour, d-1)
EndProcedure

ProcedureDLL.i DateSemaine1(Annee=-1, Premier_Jour=0)
   ; Renvoie la première date de janvier de la semaine 1 de l'année donnée
   ;   Une date de retour <= 0 implique le mois de décembre précédent à la place:
   ;   -2=Dec29  -1=Dec30  0=Dec31
   ; La semaine 1 est la première semaine comportant au moins 4 jours dans l'année
   ;   Cela signifie que la première semaine comportera toujours le 4 janvier
   ;   qui est conforme à la norme ISO 8601 (& CalendarGadget)
   ;   mais peut-être pas avec le calendrier de la barre d'état du système Windows
   ;   comme (sous Windows ME au moins) le décalage est de 3 au lieu de 4
   ; L'argument 'Premier_Jour' identifie le "premier jour de chaque semaine"
   ;   Dimanche=0 .. Samedi=6
   ; Si l'année est absente, l'année en cours est utilisée
   Protected Decalage=4 ; La date de Janvier qui tombe toujours dans la semaine 1
   Protected Jourjan ; Jour de la semaine de Janvier du décalage de date
   Protected jandate ; Date de décembre/janvier du début de la semaine 1
   If Annee<=0
      Annee = AnneeF()
   EndIf ; Cette année
   Jourjan = (DateF(Annee, 1, Decalage)/UniteJourF+1)%7 ; Jour de la semaine
   jandate = Decalage+Premier_Jour-Jourjan
   If Premier_Jour>Jourjan
      jandate - 7
   EndIf
   ProcedureReturn jandate
EndProcedure

ProcedureDLL.q DateVersPbF(date.q)
   ; Convertit une date et heure FILETIME en équivalent PureBasic
   ; Retourne -1 en cas d'erreur
   Protected correction.q = #JoursDepuis1970*#SecsParJourF
   If UniteDateF=1 ; Pour éviter les débordements quad
      date = (date+5000000)/10000000 - correction
   Else
      date = (date*#SecsParJourF+UniteJourF/2)/UniteJourF - correction
   EndIf
   If date<0
      date = -1
   EndIf
   ProcedureReturn date
EndProcedure

ProcedureDLL.q DateVersUtcF(date.q=-1)
   ; Convertit une date / heure locale en son UTC (GMT) équivalent
   ; Si la date est négative, l'UTC (GMT) la date / l'heure de Aujourd_huiF est retournée
   Protected dateUTC.q, hs.SYSTEMTIME
   If date<0
      GetSystemTime_(@hs)
      SystemTimeToFileTime_(@hs, @dateUTC) ; Aujourd_huiF -> UTC
   Else
      date * UniteDateF ; Convertir en unités de 100 nanosecondes
      LocalFileTimeToFileTime_(@date, @dateUTC) ; Locale -> UTC
   EndIf
   ProcedureReturn (dateUTC+UniteDateF/2)/UniteDateF
EndProcedure

ProcedureDLL.q DebutAnneeF(Annee=-1, Jour=0)
   ; Retourne la première date [Julienne] de l'année donnée qui tombe au jour de la semaine donnée
   ; Si l'année est absente ou 0, l'année en cours est utilisée
   ; L'argument 'Jour' identifie un jour de la semaine:
   ;   Dimanche=0 .. Samedi=6
   ; Par exemple, DebutAnneeF(2008, 6) renvoie la date du
   ;   premier samedi (Jour=6) en 2008 p.e. 5-Jan-08
   ; Voir:  www.cpearson.com/excel/weeknum.htm
   Protected jandate ; Date en décembre/janvier au début de la semaine 1
   If Annee<=0
      Annee = AnneeF()
   EndIf ; Cette année
   If jandate<0
      jandate+7
   EndIf
   ProcedureReturn DateF(Annee, 1, jandate)
EndProcedure

ProcedureDLL.i DecalageHoraireF(type)
   ; Retourne l'heure de la zone d'information de polarisation en quelques minutes
   ; Decalage=1 retourne (localtime-UTCTime) excluant l'heure d'été
   ; Decalage=2 retourne (localtime-UTCTime), y compris l'heure d'été
   ; Decalage=3 retourne la polarisation d'été locale qui est
   ;   en vigueur à ce moment et sera de 0 en hiver
   ; Decalage=4 retourne la polarisation d'été locale fixe (généralement 60)
   ; N.B. DecalageHoraireF(2)=DecalageHoraireF(1)+DecalageHoraireF(3)
   ; L'heure UTC utilisée est appelée GMT
   ; www.purebasic.fr/english/viewtopic.php?t=17158
   Protected zoneid, tz.TIME_ZONE_INFORMATION, daylight
   zoneid = GetTimeZoneInformation_(tz)
   With tz
      If zoneid=#TIME_ZONE_ID_DAYLIGHT
         daylight = tz\DaylightBias
      Else
         daylight = 0
      EndIf
      Select type
         Case 1
            ProcedureReturn -tz\Bias
         Case 2
            ProcedureReturn -tz\Bias-daylight
         Case 3
            ProcedureReturn -daylight
         Case 4
            ProcedureReturn -tz\DaylightBias
      EndSelect
      ProcedureReturn 0
   EndWith
EndProcedure

ProcedureDLL DefinirDateFichierF(Filename$, DateType, Date.q)
   ; Changer la date du fichier spécifié
   SetFileDate(Filename$, DateType, DateVersPbF(Date))
EndProcedure

ProcedureDLL.q DiffDatesF(datedebut.q, datefin.q=-1, Unite=#Date_Jour, multiple.q=1)
   ; Différence entre deux dates
   ; Calcule datefin-datedebut le résultat est retourné dans l'unité donnée [ou de son multiple]
   ; Si datefin est absente ou négatif, Aujourd_huiF est utilisé
   ; Retourne 0 en cas d'erreur
   ; Unité est une de:
   ;   #PB_Date_Year   = #Date_Annee   = 0
   ;   #PB_Date_Month  = #Date_Mois    = 1
   ;   #PB_Date_Week   = #Date_Semaine = 2
   ;   #PB_Date_Day    = #Date_Jour    = 3
   ;   #PB_Date_Hour   = #Date_Heure   = 4
   ;   #PB_Date_Minute = #Date_Minute  = 5
   ;   #PB_Date_Second = #Date_Seconde = 6
   ; Les exemples de l'utilisation de l'argument de multiples (>0) sont:-
   ;   La différence de date (qui peut être négative) est retournée dans:
   ;     Semaines si l'unité   = #PB_Date_Week  ou #Date_Semaine et multiple = 1 (par défaut)
   ;     Quinzaines si l'unité = #PB_Date_Week  ou #Date_Semaine et multiple = 2
   ;     Trimestres si l'unité = #PB_Date_Month ou #Date_Mois et multiple    = 3
   Protected signe=1, Secondes, diff.q, date.q
   If multiple <= 0
      ProcedureReturn 0
   EndIf ; Erreur
   If datefin<0
      datefin = DateF()
   EndIf ; Aujourd_huiF
   If datedebut>datefin
      signe = -1
      Swap datedebut, datefin
   EndIf
   ; Obtenir la différence de date en secondes
   diff = datefin-datedebut
   If UniteDateF=1 ; Pour éviter les débordements quad
      diff = (diff+5000000)/10000000
   Else
      diff = (diff*#SecsParJourF+UniteJourF/2)/UniteJourF
   EndIf
   Select Unite
      Case #Date_Annee
         Secondes = 366*#SecsParJourF
      Case #Date_Mois
         Secondes = 31*#SecsParJourF
      Case #Date_Semaine
         Secondes = 7*#SecsParJourF
      Case #Date_Jour
         Secondes = 1*#SecsParJourF
      Case #Date_Heure
         Secondes = 3600
      Case #Date_Minute
         Secondes = 60
      Case #Date_Seconde
         Secondes = 1
      Default
         ProcedureReturn 0 ; Erreur
   EndSelect
   ; Obtenir une réponse approximative
   diff / (multiple * Secondes)
   ; Améliorer l'approximation
   date = AjouterDateF(datedebut, Unite, multiple * diff)
   While date<datefin
      date = AjouterDateF(date, Unite, multiple)
      diff + 1
   Wend
   ProcedureReturn signe*diff
EndProcedure

ProcedureDLL.b EstBissextileF(Annee=-1)
   ; Retourne Vrai si l'année est une année bissextile (366 jours)
   ; S'il n'y a aucun argument, l'année en cours est utilisée
   ;   Dans le calendrier grégorien, l'année bissextile est
   ;   toute année divisible par 4, sauf
   ;   année du centenaire non divisible par 400
   ; L'année équinoxe de printemps est d'environ 365.242374 jours longs (et croissants)
   ; Le calendrier iranien est basée sur 8 jours bissextiles tous les 33 ans (365,242424 jours)
   ; dictionary.die.net/leap%20year
   ; en.wikipedia.org/wiki/Leap_year
   If Annee<=0
      Annee = AnneeF()
   EndIf ; Cette année
   If (Mod(Annee,4)=0 And Mod(Annee,100)<>0) Or (Mod(Annee,400)=0)
      ProcedureReturn #True
   EndIf
   ProcedureReturn #False
EndProcedure

ProcedureDLL.s FormatDateF(masque$, date.q=-1)
   ; Retourne une chaîne représentant la date
   ;   en accord avec le masque$ spécifié lequel peut contenir:
   ;   %aaaa ou %yyyy  Année à 4 chiffres
   ;   %aa ou %yy   Année à 2-chiffres
   ;   %mm    Mois à 2 chiffres
   ;   %jj ou %dd   date à 2 chiffres
   ;   %hh    heure à 2 chiffres
   ;   %ii    minute à 2 chiffres
   ;   %ss    seconde à 2 chiffres
   ;   %mois ou %mon   3-caractère pour le nom du mois par exemple Avr
   ;   %jour ou %day   3-caractère pour le nom du jour par exemple Mer
   ; Si la date est absente, Aujourd_huiF est utilisé
   Protected a, m, j, h, i, s
   Protected Mois$ = "JanFevMarAvrMaiJunJulAouSepOctNovDec"
  Protected Jour$ = "DimLunMarMerJeuVenSam"
   ;Protected Mois$ = "Janvier  Février  Mars     Avril    Mai      Juin     Juillet  Août     SeptembreOctobre  Novembre Décembre "
   ;Protected Jours$ = "dimanche   lundi   mardimercredi   jeudivendredi  samedi"
   AmjF(date, @a, @m, @j, @h, @i, @s)
   masque$ = ReplaceString(masque$, "%aaaa", RSet(Str(a),4,"0"))
   masque$ = ReplaceString(masque$, "%yyyy", RSet(Str(a), 4, "0"))
   masque$ = ReplaceString(masque$, "%aa", RSet(Right(Str(a),2),2,"0"))
   masque$ = ReplaceString(masque$, "%yy", RSet(Right(Str(a), 2), 2, "0"))
   masque$ = ReplaceString(masque$, "%mm", RSet(Str(m),2,"0"))
   masque$ = ReplaceString(masque$, "%jj", RSet(Str(j),2,"0"))
   masque$ = ReplaceString(masque$, "%dd", RSet(Str(j), 2, "0"))
   masque$ = ReplaceString(masque$, "%hh", RSet(Str(h),2,"0"))
   masque$ = ReplaceString(masque$, "%ii", RSet(Str(i),2,"0"))
   masque$ = ReplaceString(masque$, "%ss", RSet(Str(s),2,"0"))
   masque$ = ReplaceString(masque$, "%mois", Mid(Mois$, m*3-2, 3))
   masque$ = ReplaceString(masque$, "%mon", Mid(Mois$, m*3-2, 3))
   ;masque$ = ReplaceString(masque$, "%mois", Mid(Mois$, m*9-8, 9))
   ;masque$ = ReplaceString(masque$, "%mon", Mid(Mois$, m*9-8, 9))
   masque$ = ReplaceString(masque$, "%jour", Mid(Jour$, ((date/UniteJourF+1)%7)*3+1, 3)) ; Jour de la semaine
  masque$ = ReplaceString(masque$, "%day", Mid(Jour$, ((date/UniteJourF+1)%7)*3+1, 3)) ; Jour de la semaine
   ;masque$ = ReplaceString(masque$, "%jour", Mid(Jours$, ((date/UniteJourF+1)%7)*8+1, 8))
   ;masque$ = ReplaceString(masque$, "%day", Mid(Jours$, ((date/UniteJourF+1)%7)*8+1, 8))
   
   ProcedureReturn masque$
EndProcedure

ProcedureDLL.i HeureF(date.q=-1)
   ; Renvoie la valeur de l'heure (0 .. 23) de la date donnée
   ; S'il n'y a aucun argument, l'heure en cours est retournée
   Protected a, m, j, h
   AmjF(date, @a, @m, @j, @h)
   ProcedureReturn h
EndProcedure

ProcedureDLL.i JourDAnneeF(date.q=-1)
   ; Retourne le nombre de jours (1 .. 366) écoulés depuis le
   ;   début de l'année pour la date donnée
   ; S'il n'y a pas d'argument, le numéro du jour d'aujourd'hui est retourné
   Protected a, m, j
   If date<0
      date = DateF()
   EndIf
   AmjF(date, @a, @m, @j)
   ProcedureReturn (date-DateF(a, 1, 1))/UniteJourF+1
EndProcedure

ProcedureDLL.i JourDeSemaineF(date.q=-1)
   ; Retourne le jour de la semaine en nombre:
   ; 0=Dim  1=Lun  2=Mar  3=Mer  4=Jeu  5=Ven  6=Sam
   ; S'il n'y a pas d'argument, le jour courant est renvoyé
   If date<0
      date = DateF()
   EndIf ; Aujourd_huiF
   ProcedureReturn Mod((date/UniteJourF+1),7) ; Comme 01-Jan-1601 C'était un lundi
EndProcedure

ProcedureDLL.i JourF(date.q=-1)
   ; Renvoie le jour (1 .. 31) dans le mois pour la date donnée
   ; S'il n'y a aucun argument, le jour en cours est retourné
   Protected a, m, j
   AmjF(date, @a, @m, @j)
   ProcedureReturn j
EndProcedure

ProcedureDLL.i JoursDansMoisF(Annee=-1, Mois=-1)
   ; Retourne le nombre de jours dans le mois donné (28 .. 31)
   ; Si l'année est absente, l'année en cours est utilisée
   ; Si l'année est présente, mais le mois absent, février est utilisé
   ; Si l'année et le mois sont tous deux absents, le mois courant de l'année en cours est utilisé
   Protected Jours
   If Annee<=0
      Annee = AnneeF()
      If Mois<=0
         Mois = MoisF()
      EndIf
   Else
      If Mois<=0
         Mois = 2
      EndIf
   EndIf
   If Mois=2
      Jours = 28+EstBissextileF(Annee)
   Else
      Jours = 31-$A55>>Mois&1
   EndIf
   ProcedureReturn Jours
EndProcedure

ProcedureDLL.q JoursDepuis1970(Annee=0, Mois=1, Jour=1)
  ; Retourne le nombre de jours de la date donnée depuis le 1-Jan-1970
  ; (à savoir renvoie la valeur appropriée pour #JoursDepuis1970)
  ; S'il n'y a pas d'arguments (ou année = 0), la date d'aujourd'hui est utilisée,
  ; en retournant un résultat négatif
  ; Cette routine est conçue comme une aide à chaque fois qu'une date d'une
  ; autre époque que le 1-Jan-1601 est examinée
   If Annee=0
      Annee = AnneeF()
      Mois = MoisF()
      Jour = JourF()
   EndIf ; Aujourd'hui
   ProcedureReturn (DateF(1970) - DateF(Annee, Mois, Jour))/UniteJourF
EndProcedure

ProcedureDLL.i MaxLongAnneeF()
   ; Retourne l'année complète maximale supportée par des variables (non quad)
   ; (Supposons que la limite pour les variables quad est l'année 9999)
   ; Une valeur retournée de -1 signifie que les quads sont nécessaires pour les paramètres actuels
   ; Le résultat dépendra de la valeur de #AnneeEpoqueF et l'unité de granularité
   Protected date.q, a, m, j
   Protected limite=2147483647 ; 2^31-1
   date = DateF(9999, 12, 31, 23, 59, 59)
   If date<0
      ProcedureReturn -1
   EndIf
   If date<=limite
      ProcedureReturn 9999
   EndIf
   AmjF(limite, @a, @m, @j)
   If a<=AnneeF()
      a=0
   EndIf ; Supposons que les années à venir devront être prises en charge
   ProcedureReturn a-1
EndProcedure

_________________
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce GT 640 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.45 LTS, 5.62
Un homme doit être poli, mais il doit aussi être libre !


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Calculateur de dates avancé
MessagePosté: Mer 15/Nov/2017 18:08 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 02/Oct/2011 16:17
Messages: 1900
Localisation: 50200 Coutances
Dernière partie

Code:
ProcedureDLL.i MinuteF(date.q=-1)
   ; Retourne la valeur des minutes (0 .. 59) de la date indiquée
   ; S'il n'y a aucun argument, la minute en cours est retournée
   Protected a, m, j, h, i
   AmjF(date, @a, @m, @j, @h, @i)
   ProcedureReturn i
EndProcedure

ProcedureDLL.i ModeDateF(Unite.q=0)
   ; Etablit l'unité de date Julienne/granularité heure (intervalle de temps minimum pris en charge)
   ; Aucune autre routine de date ne peut modifier cette granularité
   ; L'argument unité de granularité est soit l'un des mots réservés voir ci-dessous ou
   ;   est donné en millisecondes (>=10)
   ; Une unité est considérée comme invalide 100 nanosecondes qui est la valeur par défaut FILETIME de Windows
   ; Retourne la granularité en millisecondes (à l'exception 0 -> 100 nanosecondes)
   If Unite >= 10
      UniteDateF = Unite*10000
      UniteJourF = #SecsParJourF*1000/Unite
      ProcedureReturn Unite ; Millisecondes
   EndIf
   Select Unite
      Case #PB_Date_Minimum ; 1 granularité minimum qui prend en charge les Longs - au delà de l'année en cours
         UniteDateF = 10000
         UniteJourF = #SecsParJourF*1000 ; granularité temporaire milliseconde
         Unite = DateF(AnneeF()+1) ; Millisecondes de l'époque au début de l'année suivante
         Unite / 2147483647 + 1 ; Arrondi supérieur
         UniteDateF = Unite*10000
         UniteJourF = #SecsParJourF*1000/Unite
         ProcedureReturn Unite ; Millisecondes
      Case #PB_Date_Maximum ; 2 granularité minimum qui prend en charge Longs jusqu'à l'année 9998
         UniteDateF = 10000
         UniteJourF = #SecsParJourF*1000 ; granularité temporaire milliseconde
         Unite = DateF(9999, 12, 31, 23, 59, 59) ; Millisecondes de l'époque jusqu'à la fin de 9999
         Unite / 2147483647 + 1 ; Arrondi supérieur
         UniteDateF = Unite*10000
         UniteJourF = #SecsParJourF*1000/Unite
         ProcedureReturn Unite ; Millisecondes
      Case #Date_Jour ; 3
         UniteDateF = 10000000*#SecsParJourF
         UniteJourF = 1
         ProcedureReturn 1000*#SecsParJourF
      Case #Date_Heure ; 4
         UniteDateF = 10000000*3600
         UniteJourF = 24
         ProcedureReturn 1000*3600
      Case #Date_Minute ; 5
         UniteDateF = 10000000*60
         UniteJourF = 1440
         ProcedureReturn 1000*60
      Case #Date_Seconde ; 6
         UniteDateF = 10000000*1
         UniteJourF = #SecsParJourF
         ProcedureReturn 1000*1
      Default ; 100 nanoseconds
         UniteDateF = 1
         UniteJourF = 10000000*#SecsParJourF
         ProcedureReturn 0
   EndSelect
EndProcedure

ProcedureDLL.i MoisF(date.q=-1)
   ; Renvoie le mois (1 .. 12) dans l'année pour la date donnée
   ; S'il n'y a aucun argument, le mois en cours est retourné
   Protected a, m, j
   AmjF(date, @a, @m, @j)
   ProcedureReturn m
EndProcedure

ProcedureDLL.q ObtenirDateFichierF(Filename$, DateType)
   ; Renvoie la date du fichier spécifié
   ProcedureReturn DateDePbF(GetFileDate(Filename$, DateType))
EndProcedure

ProcedureDLL.i SecondeF(date.q=-1)
   ; Retourne la valeur des secondes (0 .. 59) de la date indiquée
   ; S'il n'y a aucun argument, la seconde en cours est retournée
   Protected a, m, j, h, i, s
   AmjF(date, @a, @m, @j, @h, @i, @s)
   ProcedureReturn s
EndProcedure

ProcedureDLL.i SemaineDAnneeF(date.q=-1, Premier_Jour=0)
   ; Retourne le nombre de semaines (1 .. 53) écoulées depuis le
   ;   début de l'année pour la date donnée
   ; Si la date est absente, la date d'aujourd'hui est utilisée
   ; L'argument 'Premier_Jour' identifie la "premier jour de chaque semaine"
   ;   Dimanche=0 .. Samedi=6
   Protected jandate ; Date en janvier au début de la semaine 1
   If date<0
      date = DateF()
   EndIf ; Maintenant
   jandate = DateSemaine1(AnneeF(date), Premier_Jour)
   ProcedureReturn (JourDAnneeF(date)-jandate)/7+1
EndProcedure

ProcedureDLL.s ZoneFuseauF()
   ; Retourne le nom du fuseau horaire
   ; www.purebasic.fr/english/viewtopic.php?p=181541
   Protected TimeZoneInfo.TIME_ZONE_INFORMATION
   Protected i=0, NomStandard$=""
   GetTimeZoneInformation_(TimeZoneInfo)
   While TimeZoneInfo\StandardName[i]<>0 And i<=32
      NomStandard$ + Chr(TimeZoneInfo\StandardName[i])
      i + 1
   Wend
   ProcedureReturn NomStandard$
EndProcedure



Conversion d'un entier en chiffres romains



Code:
;- Conversion d'un entier en chiffres romains

Procedure.s RomVal(nr.l)
 
  roms.s = "1000,M;900,CM;500,D;400,CD;100,C;90,XC;50,L;40,XL;10,X;9,IX;5,V;4,IV;1,I"
 
  i = 1
  While i <= 13
   
    ar.s = StringField(roms,i,";")
    br.l = Val(StringField(ar,1,","))
   
    While nr >= br
      res.s + StringField(ar,2,",")
      nr - br
    Wend
   
    i + 1
  Wend 
 
  ProcedureReturn res
 
EndProcedure

CompilerIf #PB_Compiler_IsMainFile
  ;- Exemples d'utilisation
 
  Debug RomVal(1999)
  Debug RomVal(2005)
 
  For i = 1 To 1200
    Debug RomVal(i)
  Next
CompilerEndIf

_________________
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce GT 640 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.45 LTS, 5.62
Un homme doit être poli, mais il doit aussi être libre !


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Calculateur de dates avancé
MessagePosté: Mer 15/Nov/2017 18:15 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 02/Oct/2011 16:17
Messages: 1900
Localisation: 50200 Coutances
Fonctions DateF.pbi

Code:
;Fonctions DateF.pbi
XIncludeFile "Calendrier_F.pbi"

Structure DiffTemps
  TotalJours.q
  Annees.q
  Mois.q
  JoursRestants.q
  Heures.q
  Minutes.q
  Secondes.q
EndStructure

;- déclarations diverses
Global.q Annee
Global.b NumSem, NbJMR, Semaine
Global.s JourCourant, MoisCourant, DateCourante
Global.q NumJS, date
Global.q a, m, j, h, i, s
Global.s Masque = "%dddd %dd %mmm %yyyy"
Global.s NomJours = "dimanche,lundi,mardi,mercredi,jeudi,vendredi,samedi"
Global.s NomJoursAbr = "dim,lun,mar,mer,jeu,ven,sam"
Global.s NomMois = "janvier,février,mars,avril,mai,juin,juillet,août,septembre,octobre,novembre,décembre"
Global.s NomMoisAbr = "jan.,fév.,mars,avr.,mai,juin,juil.,août,sept.,oct.,nov.,déc."

; --- Liste des Déclarations Procédures, générée par Filtre Declare  ---

Declare.s ChaineDateF(Masque.s, Date.q) 
Declare.b SiBissextileF(Annee=-1)
Declare.s DDAF(Annee=-1)
Declare.s FDAF(Annee=-1)
Declare.s DDMF(Annee=-1,Mois=-1)
Declare.s FDMF(Annee=-1, Mois=-1)
Declare.w  JDAF(Annee=-1)
Declare.w JourRestantAnneeF() ;
Declare.b DonneSemaineF(PAnnee.w,PMois.b,PJour.b)
Declare.b  NumSemaineF()
Declare.b   NbSemRestantF()     
Declare.s JDSF()
Declare.b Jour(_Jour_ = -1) ;
Declare.s NomMoisF() ;
Declare Mois(_Mois_ = -1)
Declare.w JourRestantMoisF() ;
Declare EstDateValide(Jour,Mois,Annee) ;
Declare.s CToD(Chaine.s) ;
Declare.s DToC(Chaine.s) ;
Declare DToN(Chaine.s) ;
Declare.s NToD(Nombre.i) ;
Declare.q DateDiff(dateAvant.q, dateApres.q, *diff.DiffTemps)
Declare.q AnalyserDate(Date$)
Declare.b ComparerDates(Date1$, Date2$)
Declare$ SigneAstroF(Jour,Mois) ;
Declare$ SaisonF(Jour, Mois) ;

Procedure.s ChaineDateF(Masque.s, Date.q) 
  Masque = ReplaceString (Masque, "%dddd" , StringField ( NomJours , JourDAnneeF(Date) + 1, "," ))
  Masque = ReplaceString (Masque, "%ddd" , StringField ( NomJoursAbr , JourDAnneeF(Date) + 1, "," ))
  Masque = ReplaceString (Masque, "%mmmm" , StringField ( NomMois , MoisF (Date), "," ))
  Masque = ReplaceString (Masque, "%mmm" , StringField ( NomMoisAbr , MoisF (Date), "," )) 
  ProcedureReturn FormatDateF(Masque, Date)   
EndProcedure

Procedure.b SiBissextileF(Annee=-1)
  ; Retourne Vrai si l'année est une année bissextile (366 jours)
  ; S'il n'y a aucun argument, l'année en cours est utilisée
  ;   Dans le calendrier grégorien, l'année bissextile est
  ;   toute année divisible par 4, sauf
  ;   année du centenaire non divisible par 400
  ; L'année équinoxe de printemps est d'environ 365.242374 jours longs (et croissants)
  ; Le calendrier iranien est basée sur 8 jours bissextiles tous les 33 ans (365,242424 jours)
 
  If Annee<=0: Annee = AnneeF(): EndIf ; Cette année
  If (Mod(Annee,4)=0 And Mod(Annee,100)<>0) Or (Mod(Annee,400)=0)
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure

Procedure.s DDAF(Annee=-1) ;Retourne la date de début de l'année donnée, si l'année = -1 ou n'est pas indiquée, alors l'année en cours sera prise en compte.
  DateCourante = FormatDateF("%jour %jj %mois %aaaa", DateF(AnneeF(), 1, 1))
  ProcedureReturn DateCourante
EndProcedure

Procedure.s FDAF(Annee=-1) ;Retourne la date de fin d'année, si l'année n'est pas indiquée, alors la l'année courante sera prise en compte.
  DateCourante = FormatDateF("%jour %jj %mois %aaaa", DateF(AnneeF(), 12, 31))
  ProcedureReturn DateCourante
EndProcedure

Procedure.s DDMF(Annee=-1,Mois=-1) ;Retourne le début du mois donné, si le mois = -1 ou non indiqué, alors le mois courant sera pris en compte.
  DateCourante = FormatDateF("%jour %jj %mois %aaaa", DateF(AnneeF(), MoisF(), 1))
  ProcedureReturn DateCourante
EndProcedure

Procedure.s FDMF(Annee=-1, Mois=-1) ;Retourne la fin du mois, si le mois n'est pas indiqué, alors le mois en cours pris en compte.
  DateCourante = FormatDateF("%jour %jj %mois %aaaa", DateF(AnneeF(), MoisF(), JoursDansMoisF()))
  ProcedureReturn DateCourante
EndProcedure

Procedure.w  JDAF(Annee=-1) ;Retourne le nombre de jours (1 .. 366) écoulés depuis le début de l'année pour la date donnée
;S'il n'y a pas d'argument, le numéro du jour actuel est retourné.
  If Annee < 0
    ProcedureReturn JourDAnneeF()
  Else
    ProcedureReturn JourDAnneeF(Annee)
  EndIf
EndProcedure

Procedure.w JourRestantAnneeF() ;Nombre de jours pour finir l'année
  Protected reste = 365 + SiBissextileF(Annee)   
  ProcedureReturn reste-Int(JourDAnneeF())
EndProcedure

Procedure.b DonneSemaineF(PAnnee.w,PMois.b,PJour.b) ;Donne le numéro de semaine correspondant au jour, mois et année courants.
  PAnnee=Int(AnneeF())
  PMois=Int(MoisF())
  PJour=Int(JourF())
 
  Protected Semaine4J.b = JourDeSemaineF(DateF(PAnnee.w,1,4,0,0,0))
  If Semaine4J.b = 0 : Semaine4J.b = 7 : EndIf
  Protected LunSemaine1.b = 4-Semaine4J.b
  Protected SemaineGD.b = JourDeSemaineF(DateF(PAnnee.w,PMois.b,PJour.b,0,0,0))
  ; Lundi = 1 Dimanche = 7.
  If SemaineGD.b = 0 : SemaineGD.b = 7 : EndIf
  Protected LunGD.w = JourDAnneeF(DateF(PAnnee.w,PMois.b,PJour.b,0,0,0))-SemaineGD.b
  Semaine.b = Int((LunGD.w-LunSemaine1.b)/7)+1
  If PMois.b = 12
    Protected NumSem1Q.w = JourDAnneeF(DateF(PAnnee.w,PMois.b,PJour.b,0,0,0))
    Protected Semaine4JNA.b = JourDAnneeF(DateF(PAnnee.w+1,1,4,0,0,0))
    ; Lundi = 1 Dimanche = 7.
    If Semaine4JNA.b = 0 : Semaine4JNA.b = 7 : EndIf
    Protected DernierJourAnnee.w = JourDAnneeF(DateF(PAnnee.w,12,31,0,0,0))
    If DernierJourAnnee.w - NumSem1Q.w < Semaine4JNA.b -4
      Semaine.b = 1
    EndIf
  EndIf
 
  If PMois.b = 1 And PJour.b < 4
    If Semaine4J.b < SemaineGD.b
      Semaine.b = DonneSemaineF(PAnnee.w-1,12,31)
    EndIf
  EndIf
  ProcedureReturn Semaine
EndProcedure

Procedure.b  NumSemaineF() ;Donne le numéro de semaine actuelle.
  Protected date.b, NumSem.i
  NumSem=DonneSemaineF(AnneeF(date),MoisF(date),JourF(date))
  ProcedureReturn NumSem
EndProcedure

Procedure.b   NbSemRestantF() ;Donne le nombre de semaines nécessaires pour finir l'année en cours.
  ProcedureReturn 52 - NumSemaineF()
EndProcedure

Procedure.s JDSF() ;Donne le nom du jour actuel.
  NumJS = JourDeSemaineF()
  JourCourant = StringField(NomJours,NumJS+1,",")
  ProcedureReturn JourCourant
EndProcedure

Procedure.b Jour(_Jour_ = -1) ;Jour quantième actuel
  If _Jour_ <= 0
    _Jour_ = JourF()
  EndIf 
  ProcedureReturn _Jour_
EndProcedure

Procedure.s NomMoisF() ; Nom du mois actuel
  MoisCourant = StringField(NomMois,MoisF(),",")
  ProcedureReturn MoisCourant
EndProcedure

Procedure Mois(_Mois_ = -1) ;Donne le numéro du mois actuel
  If _Mois_ <= 0
    _Mois_ = MoisF() ;Ce mois-ci
  EndIf
  ProcedureReturn _Mois_
EndProcedure

Procedure.w JourRestantMoisF() ;Nombre de jours pour finir le mois
  NbJMR =JoursDansMoisF(AnneeF(), MoisF()) - JourF()
  ProcedureReturn NbJMR
EndProcedure

Procedure EstDateValide(Jour,Mois,Annee) ; - Indique si la date proposée est valide
  Protected Validite = 1 , Jour1 = 1 , Mois1 = 1 , Annee1 = 1 ; 1 = Valide, 0 = non valide.
  If Jour < 1 Or Jour > 31
    Jour1 = 0 ; Jour doit être 1-31.
  ElseIf Mois < 1 Or Mois > 12
    Mois1 = 0 ; Mois doit être 1-12.
  ElseIf Mois = 2 And Jour > 28
    If Jour   >   29
      Jour1=0 ; Février n'a Jamais plus de 29 Jours.
    Else
      ; Vérifie si février de l'année "Annee" est une année bissextile.  Notez que l'année
      ; 3600 est un cas spécial unique (www.google.com/search?q=leap+year+faq).
      Jour1 = Bool(Mod(Annee, 4) = 0 And
                   (Mod(Annee, 100) <> 0 Or
                    Mod(Annee, 400) = 0) And
                   Annee <> 3600)
    EndIf
  ElseIf (Mois = 4 Or Mois = 6 Or Mois = 9 Or Mois = 11) And Jour = 31
    Jour1=0 ; Ces mois ont seulement 30 jours.
  ElseIf Annee < 1 Or Annee > 9999
    Annee1 = 0 ; limite l'année à une gamme de 9999 ans
  EndIf
  If Jour1 = 0
    Validite = 0
  ElseIf Mois1 = 0
    Validite = 0
  ElseIf Annee1 = 0
    Validite = 0
  EndIf 
  ProcedureReturn Validite
EndProcedure

Procedure.s CToD(Chaine.s) ; - Transforme une chaine en Date
  Protected Jour.s, Mois.s, Annee.s, Resultat.s
 
  Jour = Left(Chaine, 2) : Mois = Mid(Chaine, 3, 2)
  Jour = RSet(Jour, 2, "00")
  Mois = RSet(Mois, 2, "00")
  Annee = RSet(Annee, 4, "0000")
 
  If Len(Chaine) = 6
    Annee = Right(Chaine, 2)
  ElseIf Len(Chaine) = 8
    Annee = Right(Chaine, 4)
  EndIf
 
  If   Val(Jour) > 31 Or Val(Mois) > 12
    Resultat = "Le format est : CToD(JJ/MM/AA) ou CToD(JJ/MM/AAAA)"
  EndIf      
 
  If Not EstDateValide(Val(Jour), Val(Mois), Val(Annee))
    Resultat = "Date non valide"
  Else
    Resultat = Jour+"/"+Mois+"/"+Annee
  EndIf
  ProcedureReturn resultat
EndProcedure

Procedure.s DToC(Chaine.s) ; - Transforme une Date en chaîne
  Protected Jour.s, Mois.s, Annee.s, Resultat.s
 
  Jour = StringField(Chaine, 1, "/") : Mois = StringField(Chaine, 2, "/") : Annee = StringField(Chaine, 3, "/")
 
  Jour = RSet(Jour, 2, "00")
  Mois = RSet(Mois, 2, "00")
  Annee = RSet(Annee, 4, "0000")
 
  If Len(Chaine) < 8 Or Len(Chaine) > 10
    Resultat = "Le format est : DToC(JJMMAA) ou DToC(JJMMAAAA)"
  EndIf
 
  If Not EstDateValide(Val(Jour), Val(Mois), Val(Annee))
    Resultat = "Date non valide"
  Else
    Resultat = Jour + Mois + Annee
  EndIf
  ProcedureReturn Chr(34) + Resultat + Chr(34)
EndProcedure

Procedure DToN(Chaine.s) ; Convertit une date "JJ/MM/AAAA" en nombre entier
  Protected Jour.s,Mois.s,Annee.s,Resultat
 
  Jour = StringField(Chaine,1,"/") : Mois = StringField(Chaine,2,"/") : Annee = StringField(Chaine,3,"/")
 
  Jour = RSet(Jour,2,"00")
  Mois = RSet(Mois,2,"00")
  Annee = RSet(Annee,4,"0000")
 
  If Val(Mois)
    Resultat = Val(Jour)*1000000+Val(Mois)*10000+Val(Annee)
  EndIf
 
  Select Mois
    Case "02"
      If Val(Jour) <= 28 + SiBissextileF(Val(Annee))
        ProcedureReturn Resultat
      EndIf
    Case "01","03","05","07","08","10","12"
      If Val(Jour) <= 31
        ProcedureReturn Resultat
      EndIf
    Case "04","06","09","11"
      If Val(Jour) <= 30
        ProcedureReturn Resultat
      EndIf
  EndSelect
 
  If Resultat <= 31129999
    ProcedureReturn 0
  EndIf
 
EndProcedure

Procedure.s NToD(Nombre.i) ; Convertit un nombre >= 01011001 <= 31129999 en date
  Protected sJour.s, sMois.s, sAnnee.s, Resultat.s, valide, Jour, Mois, Annee
  Resultat = RSet(Str(Nombre),8,"0")
 
  Jour = Val(Left(Resultat,2))
  Mois = Val(Mid(Resultat,3,2))
  Annee = Val(Right(Resultat,4))
  valide = #True
  Select Annee
    Case 1 To 9999
      Select Mois
        Case 2
          If Jour < 1 Or Jour > 28 + SiBissextileF(Annee)
            valide = #False
          EndIf
        Case 1,3,5,7,8,10,12
          If Jour < 1 Or Jour > 31
            valide = #False
          EndIf
        Case 4,6,9,11
          If Jour < 1 Or Jour > 30
            valide = #False
          EndIf
        Default
          valide = #False
      EndSelect
    Default
      valide = #False
  EndSelect
 
  If valide
    sJour = RSet(Str(Jour),2,"0")+"/"
    sMois = RSet(Str(Mois),2,"0")+"/"
    sAnnee = RSet(Str(Annee),4,"0")
   
    Resultat = sJour+sMois+sAnnee
    ProcedureReturn Resultat
  Else
    ProcedureReturn "Erreur"
  EndIf
EndProcedure

Procedure.q DateDiff(dateAvant.q, dateApres.q, *diff.DiffTemps) ;Permet de calculer la différence de temps en années, mois, jours entre 2 dates données.
 
  Protected.q TotalJours,DiffAnnees,DiffMois,DiffJoursRestants,DiffHeures,DiffMinutes,DiffSecondes,DiffDateCourante, DiffDateTest, DiffJourDebut
 
  If dateAvant > dateApres
    Swap dateAvant, dateApres
  EndIf
 
  DiffDateCourante = dateAvant
  DiffDateTest = dateAvant
  DiffJourDebut = JourF(dateAvant)
  TotalJours = 0
  DiffJoursRestants = 0
 
  While DiffDateTest <= dateApres
    DiffDateTest = AjouterDateF(DiffDateCourante, #Date_Jour, 1)
    If DiffDateTest <= dateApres
      DiffDateCourante = DiffDateTest
      TotalJours+1
      DiffJoursRestants+1
      If JourF(DiffDateCourante) = DiffJourDebut
        DiffMois+1
        DiffJoursRestants=0
      EndIf
    EndIf
  Wend
 
  DiffDateTest = DiffDateCourante
  DiffHeures = 0
  While DiffDateTest<dateApres
    DiffDateTest = AjouterDateF(DiffDateCourante, #Date_Heure, 1)
    If DiffDateTest <= dateApres
      DiffDateCourante = DiffDateTest
      DiffHeures+1
    EndIf
  Wend
 
  DiffDateTest = DiffDateCourante
  DiffMinutes = 0
  While DiffDateTest<dateApres
    DiffDateTest = AjouterDateF(DiffDateCourante, #Date_Minute, 1)
    If DiffDateTest <= dateApres
      DiffDateCourante = DiffDateTest
      DiffMinutes+1
    EndIf
  Wend
 
  DiffDateTest = DiffDateCourante
  DiffSecondes = 0
  While DiffDateTest<dateApres
    DiffDateTest = AjouterDateF(DiffDateCourante, #Date_Seconde, 1)
    If DiffDateTest <= dateApres
      DiffDateCourante = DiffDateTest
      DiffSecondes+1
    EndIf
  Wend
 
  DiffAnnees = DiffMois/12
  If DiffAnnees
    DiffMois % 12
  EndIf
 
  *diff\TotalJours = TotalJours
  *diff\Annees = DiffAnnees
  *diff\Mois = DiffMois
  *diff\JoursRestants = DiffJoursRestants
  *diff\Heures = DiffHeures
  *diff\Minutes = DiffMinutes
  *diff\Secondes = DiffSecondes
 
EndProcedure

Procedure.q AnalyserDate(Date$) ;Convertit une date et/ou heure contenue dans une chaîne à une date/heure Julienne.
  Protected Resultat.q
  Resultat = AnalyserDateF("%jj/%mm/%aaaa", Date$)
  ProcedureReturn Resultat
EndProcedure

Procedure.b ComparerDates(Date1$, Date2$) ;Compare 2 dates
  If AnalyserDateF("%jj/%mm/%aaaa", Date1$) > AnalyserDateF("%jj/%mm/%aaaa", Date2$)
    ProcedureReturn #True
  ElseIf AnalyserDateF("%jj/%mm/%aaaa", Date1$) < AnalyserDateF("%jj/%mm/%aaaa", Date2$)
    ProcedureReturn #False
  ElseIf  AnalyserDateF("%jj/%mm/%aaaa", Date1$) = AnalyserDateF("%jj/%mm/%aaaa", Date2$)
    ProcedureReturn -1
  EndIf
EndProcedure

Procedure$ SigneAstroF(Jour,Mois) ;Permet de déterminer le signe astrologique correspondant au jour et au mois donnés
  Protected$ Resultat
  If (Jour >= 22 And Mois = 12) Or (Jour <= 20 And Mois = 1)
    Resultat = "Capricorne"
  ElseIf (Jour >= 21 And Mois = 1) Or (jour <= 19 And Mois = 2)
    Resultat = "Verseau"
  ElseIf (Jour >= 20 And Mois = 2) Or (jour <= 20 And Mois = 3)
    Resultat = "Poissons"
  ElseIf (Jour >= 21 And Mois = 3) Or (Jour <= 20 And Mois = 4)
    Resultat = "Bélier"
  ElseIf (Jour >= 21 And Mois = 4) Or (Jour <= 21 And Mois = 5)
    Resultat = "Taureau"
  ElseIf (Jour >= 22 And mois = 5) Or (Jour <= 21 And Mois = 6)
    Resultat = "Gémeaux"
  ElseIf (Jour >= 22 And Mois = 6) Or (Jour <= 22 And Mois = 7)
    Resultat = "Cancer"
  ElseIf (Jour >= 23 And Mois = 7) Or (Jour <= 22 And Mois = 8)
    Resultat = "Lion"
  ElseIf (Jour >= 23 And Mois = 8) Or (Jour <= 22 And Mois = 9)
    Resultat = "Vierge"
  ElseIf (Jour >= 23 And Mois = 9) Or (Jour <= 22 And Mois = 10)
    Resultat = "Balance"
  ElseIf (Jour >= 23 And Mois = 10) Or (Jour <= 22 And Mois = 11)
    Resultat = "Scorpion"
  ElseIf (Jour >= 23 And Mois = 11) Or (Jour <= 21 And Mois = 12)
    Resultat = "Sagittaire"
  EndIf
 
  ProcedureReturn Resultat
EndProcedure

Procedure$ Element(Jour, Mois)
  Select SigneAstroF(Jour, Mois)
    Case "Bélier", "Lion", "Sagittaire"
      ProcedureReturn "le feu"
    Case "Taureau", "Vierge", "Capricorne"
      ProcedureReturn "la terre"
    Case "Gémeaux", "Balance", "Verseau"
      ProcedureReturn "l'air"
    Case "Cancer", "Scorpion", "Poissons"
      ProcedureReturn "l'eau"
  EndSelect   
EndProcedure

Procedure$ SaisonF(Jour, Mois) ;Permet de déterminer la saison correspondant au jour et au mois donnés
  Protected$ Resultat
  If (jour >= 21 And Mois = 3) Or Mois = 4 Or Mois = 5 Or (Jour <= 21 And Mois = 6)
    Resultat = "Printemps"
  ElseIf (Jour >= 22 And Mois = 6) Or Mois = 7 Or Mois = 8 Or (Jour <= 22 And Mois = 9)
    Resultat = "Eté"
  ElseIf (Jour >= 23 And Mois = 9) Or Mois = 10 Or Mois = 11 Or (Jour <= 21 And Mois = 12)
    Resultat = "Automne"
  ElseIf (Jour >= 22 And mois = 12) Or Mois = 1 Or Mois = 2 Or (Jour <= 20 And Mois = 3)
    Resultat = "Hiver"
  EndIf
  ProcedureReturn Resultat
EndProcedure


_________________
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce GT 640 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.45 LTS, 5.62
Un homme doit être poli, mais il doit aussi être libre !


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Calculateur de dates avancé
MessagePosté: Mer 15/Nov/2017 18:16 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 22/Aoû/2010 15:24
Messages: 6549
Localisation: IDF (Yvelines)
@Micoute : Dans ta dropbox pourrais tu ajouter le dossier image ? merci.

_________________

➽ Config PureBasic : i3, RAM 4Go, NVidia (1024 Mo), Windows 10 - PB 5.45 LTS & PB 5.62
➽ Je papote aussi sur http://purebasic.chat & http://purebasic.chat/forum

➽ Restez informé Image Pure Basic Francophone Community

➽ Sites personnels http://falsam.com & EasySprite.js

➽ Je ne répond pas aux mp


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Calculateur de dates avancé
MessagePosté: Mer 15/Nov/2017 18:22 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 02/Oct/2011 16:17
Messages: 1900
Localisation: 50200 Coutances
Ok

https://www.dropbox.com/sh/gojsbcdy7t38i3d/AACDI5imTryf68LLSrKUKYeNa?dl=0#

voilà qui est fait.

Cette petite icône sert à remettre à zéro le spin.

_________________
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce GT 640 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.45 LTS, 5.62
Un homme doit être poli, mais il doit aussi être libre !


Dernière édition par Micoute le Mer 15/Nov/2017 18:26, édité 1 fois.

Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Calculateur de dates avancé
MessagePosté: Mer 15/Nov/2017 18:26 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 22/Aoû/2010 15:24
Messages: 6549
Localisation: IDF (Yvelines)
La solution DropBox, Google Drive et Github sont de bonnes solutions quand on a des gros codes et des fichiers connexes.

Dire que DropBox n'est pas de confiance est une ... bêtise et signe de méconnaissance. Je ne débaterais pas plus sur ce sujet car ce n'est pas l'objectif de ce topic.

_________________

➽ Config PureBasic : i3, RAM 4Go, NVidia (1024 Mo), Windows 10 - PB 5.45 LTS & PB 5.62
➽ Je papote aussi sur http://purebasic.chat & http://purebasic.chat/forum

➽ Restez informé Image Pure Basic Francophone Community

➽ Sites personnels http://falsam.com & EasySprite.js

➽ Je ne répond pas aux mp


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Calculateur de dates avancé
MessagePosté: Mer 15/Nov/2017 18:29 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 22/Aoû/2010 15:24
Messages: 6549
Localisation: IDF (Yvelines)
@Micoute : A partir du moment ou tu as déjà un lien de partage pour ton dossier principale, il est inutile de faire des liens de partages pour les autres fichiers ou dossiers inclus dans ce même dossier.

je vais corrigé tes liens précédents et supprimerais ce message quand tu l'auras lu.

_________________

➽ Config PureBasic : i3, RAM 4Go, NVidia (1024 Mo), Windows 10 - PB 5.45 LTS & PB 5.62
➽ Je papote aussi sur http://purebasic.chat & http://purebasic.chat/forum

➽ Restez informé Image Pure Basic Francophone Community

➽ Sites personnels http://falsam.com & EasySprite.js

➽ Je ne répond pas aux mp


Haut
 Profil  
Répondre en citant le message  
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 20 messages ]  Aller à la page 1, 2  Suivante

Heures au format UTC + 1 heure


Qui est en ligne

Utilisateurs parcourant ce forum: Google [Bot] et 1 invité


Vous ne pouvez pas poster de nouveaux sujets
Vous ne pouvez pas répondre aux sujets
Vous ne pouvez pas éditer vos messages
Vous ne pouvez pas supprimer vos messages

Rechercher:
Aller à:  

 


Powered by phpBB © 2008 phpBB Group | Traduction par: phpBB-fr.com
subSilver+ theme by Canver Software, sponsor Sanal Modifiye