ATOUTFOX
COMMUNAUTÉ FRANCOPHONE DES PROFESSIONNELS FOXPRO
Visual FoxPro : le développement durable

cDateOrder() - Renvoie l'ordre d'une date quel que soit son format   


L'auteur

FoxInCloud (Th. Nivelet)
France France
Membre Simple
# 0000000014
enregistré le 13/10/2004

http://www.foxincloud.com/
Nivelet Thierry
75016 Paris
de la société Abaque
Fiche personnelle

Note des membres
pas de note

Contributions > 01 - PRG : Programmation > Temps - heures - Dates - Calendriers

cDateOrder() - Renvoie l'ordre d'une date quel que soit son format
# 0000000035
ajouté le 01/11/2004 13:58:39 et modifié le 30/03/2005
consulté 9310 fois
Niveau débutant

Version(s) Foxpro :
VFP 9.0
VFP 8.0
VFP 7.0
Description
Si vous clients vous livrent des tables avec des dates mal foutues (genre saisies n'importe comment ), ...

cDateOrder() peut vous aider à y voir plus clair.

Trois fonctions annexes dans le paquet :

  • nRAtSep() Position du premier séparateur en partant de la droite
  • nLRAtSep () Position du premier séparateur en partant de la gauche ou de la droite
  • nYearCent () Année avec le siècle
Code source :
FUNCTION cDateOrder && Ordre d'une date
 LPARAMETERS ;
  tcDate && Date sous la forme [JJ][MM]AA[AA], séparée par '.', '/', ou '-'
 LOCAL lcResult
 m.lcResult = Space(8)

 * Si une date valide a été passée
 IF Vartype(m.tcDate) == 'C' ;
  AND Val(Chrtran(m.tcDate, DATE_SEP, Space(0))) > 0

  * Localiser les éventuels séparateurs d'an et de mois
  LOCAL lnSepAn, lnSepMois
  m.lnSepAn = nRatSep(m.tcDate, DATE_SEP, 1)
  m.lnSepMois = nRatSep(m.tcDate, DATE_SEP, 2)

  * Calculer l'an (avec le siècle), le mois et le jour en numérique
  LOCAL lnAn, lnMois, lnJour
  m.lnAn = nYearCent(Val(Substr(m.tcDate, m.lnSepAn + 1)))
  m.lnMois = Val(Substr(m.tcDate, m.lnSepMois + 1, m.lnSepAn - 1))
  m.lnMois = Iif(m.lnMois < 1 or m.lnMois > 12, 1, m.lnMois)
  m.lnJour = Val(Substr(m.tcDate, 1, m.lnSepMois - 1))
  m.lnJour = Iif(m.lnJour < 1 or m.lnJour > 31, 1, m.lnJour)

  * Calculer le résultat
  m.lcResult = Dtoc(Date(m.lnAn, m.lnMois, m.lnJour), 1) && 1 Returns the date in a format suitable for indexing
 ENDIF

 RETURN m.lcResult

* -----------
 FUNCTION nRAtSep && Position du premier séparateur en partant de la droite
 LPARAMETER ;
  tcChain,; && Chaîne à analyser
  tcSeps,; && [".,:;|/\-_*#!$§£&"] Séparateurs recherchés
  tnOcc && [1] Numéro d'occurrence de séparateur recherchée
 LOCAL lnResult && Position du séparateur dans la chaîne (= 0 si aucun)
 m.lnResult = nLRAtSep ('R', m.tcChain, m.tcSeps, m.tnOcc)

 RETURN m.lnResult

* -----------
FUNCTION nLRAtSep && Position du premier séparateur en partant de la gauche ou de la droite
 LPARAMETER  ;
  tcSens,; && ['L'] indique s'il faut chercher en partant de la gauche (L) ou de la droite (R)
  tcChain,; && Chaîne à analyser
  tcSeps,; && [".,:;|/\-_*#!$§£&"] Séparateurs recherchés
  tnOcc && [1] Numéro d'occurrence de séparateur recherchée
 LOCAL lnResult && Position du séparateur dans la chaîne (= 0 si aucun)
 m.lnResult = 0
 #DEFINE DEFAULT_SEP  ".,:;|/\-_*#!$§£&"

 * Si une chaîne non vide a été passée
 IF Vartype(m.tcChain) == 'C' ;
  AND NOT Empty(m.tcChain)

  * Régler les valeurs par défaut des paramètres optionnels
  LOCAL lcSens, lcSeps, lnOcc
  m.lcSens = Iif(Vartype(m.tcSens) = 'C', Upper(Left(Ltrim(m.tcSens),1)), 'L')
  m.lcSens = Iif(m.lcSens $ 'LR', m.lcSens, 'L')
  m.lcSeps = Iif(Vartype(m.tcSeps)='C' AND ! Empty(m.tcSeps), m.tcSeps, DEFAULT_SEP)
  m.lnOcc = Iif(Vartype(m.tnOcc)='N' and m.tnOcc > 0, m.tnOcc, 1)

  * Pour chaque séparateur
  LOCAL lnSep, lcSep
  For m.lnSep = 1 to Len(m.lcSeps)
   m.lcSep = Substr(m.lcSeps, m.lnSep, 1)

   * Si le séparateurs est dans le chaine, arrêter
   m.lnResult = Iif(m.lcSens = 'L', ;
            AT (m.lcSep, m.tcChain, m.lnOcc), ;
            RAT (m.lcSep, m.tcChain, m.lnOcc))
   IF m.lnResult > 0
    EXIT
   ENDIF
  ENDFOR
 ENDIF

 RETURN m.lnResult

* -----------
 FUNCTION nYearCent && Année avec le siècle
 LPARAMETERS ;
  tnYear && Année avec ou sans le siècle
 LOCAL lnResult
 m.lnResult = 0
 IF Vartype(m.tnYear)=='N'
  IF m.tnYear > 99
   m.lnResult = m.tnYear
  ELSE
   #DEFINE CENT_CURRENT Int(Year(Date())/100)*100
   #DEFINE CENT_ROLLOVER Year(Date()) - CENT_CURRENT + 30
   m.lnResult = CENT_CURRENT - Iif(m.tnYear > CENT_ROLLOVER, 100, 0) + m.tnYear
  ENDIF
 ENDIF

 RETURN m.lnResult
Commentaires
Aucun commentaire enregistré ...
www.atoutfox.org - Site de la Communauté Francophone des Professionnels FoxPro - v3.4.0 - © 2004-2024.
Cette page est générée par un composant COM+ développé en Visual FoxPro 9.0-SP2-HF3