Petites fonctions utiles CToD, DToC, DToN et NToD

Programmation d'applications complexes
Répondre
Avatar de l’utilisateur
Micoute
Messages : 2522
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Petites fonctions utiles CToD, DToC, DToN et NToD

Message 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
Dernière modification par Micoute le ven. 31/oct./2014 17:53, modifié 3 fois.
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.73 PB 6.00 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Haut
Avatar de l’utilisateur
Ar-S
Messages : 9477
Inscription : dim. 09/oct./2005 16:51
Contact :
Contacter Ar-S

Re: Petites fonctions utiles

Message 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:
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Haut
Avatar de l’utilisateur
Micoute
Messages : 2522
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: Petites fonctions utiles

Message 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.
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.73 PB 6.00 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Haut
Avatar de l’utilisateur
Ar-S
Messages : 9477
Inscription : dim. 09/oct./2005 16:51
Contact :
Contacter Ar-S

Re: Petites fonctions utiles

Message 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:
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Haut
Avatar de l’utilisateur
Micoute
Messages : 2522
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: Petites fonctions utiles CToD, DToC et DToN

Message par Micoute »

Voila, c'est fait ! Merci du conseil.
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.73 PB 6.00 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Haut
Avatar de l’utilisateur
graph100
Messages : 1318
Inscription : sam. 21/mai/2005 17:50

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

Message 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.
_________________________________________________
Mon site : CeriseCode (Attention Chantier perpétuel ;))
Haut
Répondre

Revenir à « Applications »