Page 1 sur 1

Petites fonctions utiles CToD, DToC, DToN et NToD

Publié : ven. 31/oct./2014 10:01
par Micoute
Bonjour à tous,
j'ai pensé à faire ces fonctions, car on ne les trouvent pas dans PureBasic, alors je voulais vous en faire profiter, si ça vous intéresse !

CToD est une fonction qui transforme une Chaine en Date.
DToC transforme une Date en Chaine de caractères.
DToN transforme une Date en Nombre.
NToD transforme un nombre entier en date

Évidemment ces fonctions tiennent compte de la validité des entrées.

Code : Tout sélectionner

Procedure DateValide(Jour,Mois,Annee)
  ; Avec PB (sentez-vous libre de l'employer de la façon que vous souhaitez).
  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 (http://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 jusqu'à 9999
  EndIf
  If Jour1=0
    ;    MessageRequester("Erreur","jour non valide dans la date!",0)
    Validite=0
  ElseIf Mois1=0
    ;    MessageRequester("Erreur","mois non valide dans la date!",0)
    Validite=0
  ElseIf Annee1=0
    ;    MessageRequester("Erreur","année non valide dans la date!",0)
    Validite=0
  EndIf  
  ProcedureReturn Validite
EndProcedure

ProcedureDLL.s CToD(Chaine.s)
  Protected Jour.s,Mois.s,Annee.s,Resultat.s
  
  Jour=Left(Chaine,2) : Mois=Mid(Chaine,3,2)
  Jour=RSet(Jour,2,"0")
  Mois=RSet(Mois,2,"0")
  Annee=RSet(Annee,4,"0")
  
  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 DateValide(Val(Jour),Val(Mois),Val(Annee))
    Resultat = "Date non valide"
  Else
    
    
    Resultat=Jour+"/"+Mois+"/"+Annee
  EndIf
  
  ProcedureReturn resultat
EndProcedure

ProcedureDLL.s DToC(Chaine.s)
  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,"0")
  Mois=RSet(Mois,2,"0")
  If FindString(Chaine,"/")=2 
    Annee=RSet(Annee,2,"0")
  EndIf
  
  If Len(Chaine)<8 Or Len(Chaine)>10
    Resultat="Le format est : DToC(JJMMAA) ou DToC(JJMMAAAA)"
  EndIf
  
  If Not DateValide(Val(Jour),Val(Mois),Val(Annee))
    Resultat="Date non valide"
  Else 
    Resultat=Jour+Mois+Annee
  EndIf
  ProcedureReturn Resultat
EndProcedure

ProcedureDLL.i DToN(Chaine.s)
  Protected Jour.s,Mois.s,Annee.s,Resultat.s
  
  Jour=StringField(Chaine,1,"/"):Mois=StringField(Chaine,2,"/"):Annee=StringField(Chaine,3,"/")
  
  Jour=Left(Chaine,2)
  Mois=Mid(Chaine,3,2)
  Annee=Mid(Chaine,5)
  
  If Len(Chaine)<8 Or Len(Chaine)>10
    Resultat="Le format est : DToN(JJMMAA) ou DToN(JJMMAAAA)"
  EndIf
  
  If Not DateValide(Val(Jour),Val(Mois),Val(Annee))
    Resultat="Date non valide"
  Else 
    If Len(Chaine)=6
      Resultat=Str(Val(jour)*10000+Val(Mois)*100+Val(Annee))
    ElseIf Len(Chaine)=8
      Resultat=Str(Val(jour)*1000000+Val(Mois)*10000+Val(Annee))
    EndIf
  EndIf
  ProcedureReturn Val(Resultat)
EndProcedure

ProcedureDLL.s NToD(Nombre.i)
  Protected Jour.s,Mois.s,Annee.s,Resultat.s
  
  
  Jour=Left(Str(Nombre),2)
  Mois=Mid(Str(Nombre),3,2)
  Annee=Mid(Str(Nombre),5)
  
  If Len(Str(Nombre))<8 Or Len(Str(Nombre))>10
    Resultat="Le format est : NToD(JJMMAA) ou NToD(JJMMAAAA)"
  EndIf
  
  If Not DateValide(Val(Jour),Val(Mois),Val(Annee))
    ProcedureReturn"Date non valide"
  Else 
    ProcedureReturn Jour+"/"+Mois+"/"+Annee
  EndIf  
EndProcedure



CompilerIf #PB_Compiler_IsMainFile
  ;Test
  Debug "CToD("+Chr(34)+"18644"+Chr(34)+")      = "+CToD("18644")
  Debug "CToD("+Chr(34)+"180644"+Chr(34)+")     = "+CToD("180644")
  Debug "CToD("+Chr(34)+"18061944"+Chr(34)+")   = "+CToD("18061944")
  Debug ""
  Debug "DToC("+Chr(34)+"06/07/2012"+Chr(34)+") = "+DToC("06/07/2012")
  Debug "DToC("+Chr(34)+"31/11/2014"+Chr(34)+") = "+DToC("31/11/2014")
  Debug "DToC("+Chr(34)+"18/11/2014"+Chr(34)+") = "+DToC("18/11/2014")
  Debug "DToC("+Chr(34)+"18/11/14"+Chr(34)+")   = "+DToC("18/11/14")
  Debug "DToC("+Chr(34)+"18112014"+Chr(34)+")   = "+CToD("18112014")
  Debug "DToC("+Chr(34)+"181114"+Chr(34)+")     = "+CToD("18112014")
  Debug "DToC("+Chr(34)+"06/07/16"+Chr(34)+")   = "+DToC("06/07/16")
  Debug "DToC("+Chr(34)+"06/7/2016"+Chr(34)+")  = "+DToC("06/7/2016")
  Debug "DToC("+Chr(34)+"6/7/8"+Chr(34)+")      = "+DToC("6/7/8")
  Debug "DToC("+Chr(34)+"29/2/2016"+Chr(34)+")  = "+dtoc("29/2/2016")
  Debug "DToC("+Chr(34)+"29/02/2017"+Chr(34)+") = "+DToC("29/02/2017")
  Debug ""
  Debug "CToD("+Chr(34)+"29022012"+Chr(34)+")   = "+CToD("29022012")
  Debug "CToD("+Chr(34)+"29022013"+Chr(34)+")   = "+CToD("29022013")
  Debug ""
  Debug "DToN("+Chr(34)+"18061944"+Chr(34)+")   = "+DToN("18061944")
  Debug ""
  Debug "NToD(18061944)     = "+NToD(18061944)
  Debug "NToD(10102020)     = "+NToD(10102020)
  Debug "NToD(101020)       = "+NToD(101020)
  Debug "NToD(310920)       = "+NToD(310920)
  
  
CompilerEndIf

Re: Petites fonctions utiles

Publié : ven. 31/oct./2014 10:05
par Ar-S
Merci Micoude, j'ai pas essayé mais quand tu proposes des fonctionnes comme ça, ce serait plus attractif de les décrire dans ton sujet ou au pire en commentaire dans ta source. :wink:

Re: Petites fonctions utiles

Publié : ven. 31/oct./2014 10:13
par Micoute
Bonjour Ar-s, en fait c'est tout simple, CToD transforme une chaîne en date, DToC fait l'inverse et DToN transforme une date en nombre, j'ai d'ailleurs mis des exemples dans le fichier source.

Re: Petites fonctions utiles

Publié : ven. 31/oct./2014 11:08
par Ar-S
CToD transforme une chaîne en date, DToC fait l'inverse et DToN transforme une date en nombre
C'est juste un conseil pour gagner en lisibilité et pour d'éventuelles recherches futures sur le fofo.
Tu mets ça en début de ton fil de discussion avant ton code ça suffit. En plus ça permet aux personnes n'ayant pas le temps de le lire ou de lancer pb pour le compiler (comme moi quand j'ai écrit ces lignes ce matin) de savoir en un clin d'oeil si le sujet nous intéresse ou pas.

P.S : Merci pour cette contribution. :mrgreen:

Re: Petites fonctions utiles CToD, DToC et DToN

Publié : ven. 31/oct./2014 15:12
par Micoute
Voila, c'est fait ! Merci du conseil.

Re: Petites fonctions utiles CToD, DToC, DToN et NToD

Publié : ven. 07/nov./2014 23:25
par graph100
Aide PB a écrit : Debug FormatDate("A=%yyyy, M= %mm, J=%dd", Date()) ; Affiche la date sous la forme
; "A=2012, M=12, J=21"

Debug FormatDate("%dd/%mm/%yyyy", Date()) ; Affiche la date sous la forme
; "21/12/2012"

Debug FormatDate("%hh:%ii:%ss", Date()) ; affiche le temps selon un format 00:00:00

Note: Le temps et les dates supportées vont de '1970-01-01, 00:00:00' pour le minimum à '2038-01-19, 03:14:07' pour le maximum.
Donc ca existe dans PB.