CONVERTION D'UNE CHAINE EN TDATE

---

Commentaire sur cette source (7)
Ajouter un commentaire et/ou une note

converti une chaine de caractère en TDate, comme StrToDate, mais fonctionne un peu comme dans Access.
Elle prend en charge les chaines contenants une date au format suivant :
- un jour, un mois et une année séparée par un caractère quelconque (comme un espace ou un slash)
- JJ, JJMM, JJMMAA ou JJMMAAAA sans rien entre
Le mois peut-être écrit en lettre ou en chiffre.
Dans le cas où il manque le mois ou l'année, il prend la date actuelle pour compléter la date
Ainsi on peut saisir :
04/09/07, 040907, 4 9 2007, 04 septembre 07, 4 sep 2007 ou encore 04sep07

J'ai mis 'mars' au lieu de 'mar' pour ne pas avoir de bugs si l'utilisateur tape le jour de la semaine en plus.
Ainsi, 'mardi 05 sep 07' renvois bien 05/09/07 même si en vérité c'est un mercredi.

Il me semble pas y avoir de bug...

Uses DateUtils, StrUtils, SysUtils;

//------------------

function countcar(s:string;c:char):integer;
var
 i:integer;
begin
 result:=0;
 for i:=1 to length(s) do if s[i]=c then inc(result);
end;

//------------------

Function MyStrtoDate(mydate:string):tdate;
const
mois:array[1..12] of string=('jan','fev','mars','avr','mai','juin','juil','aou','sep','oct','nov','dec');
var
 i:integer;
 j,m,a:word;
begin
 result:=-1;
 mydate:=ansilowercase(mydate);
 // récup la date courante
 decodedate(date,a,m,j);
 //retire les accents pour décembre, août, février
 while pos('é',mydate)<>0 do mydate[pos('é',mydate)]:='e';
 while pos('û',mydate)<>0 do mydate[pos('û',mydate)]:='u';
 // remplace les mois en lettres par des mois en chiffres
 for i:=1 to 12 do
  if pos(mois[i],mydate)<>0 then
   begin
    insert(' '+inttostr(i)+' ',mydate,pos(mois[i],mydate));
    delete(mydate,pos(mois[i],mydate),length(mois[i]));
    break;
   end;
 // retire tous ce qui n'est pas des chiffres et remplace par un espace
 i:=1;
 for i:=1 to length(mydate) do  if not (mydate[i] in ['0'..'9',' ']) then mydate[i]:=' ';
 // retire les doubles espaces
 while pos('  ',mydate)<>0 do delete(mydate,pos('  ',mydate),1);
 mydate:=trim(mydate);
 // il n'y a plus rien... on sort
 if mydate='' then exit;
 // si il n'y a pas d'espace, alors c'est la forme JJMMAA
 case countcar(mydate,' ') of
 0:
  case length(mydate) of
   2: mydate:=mydate+'/'+inttostr(m) +'/'+inttostr(a);
   4: begin insert('/',mydate,3); mydate:=mydate+'/'+inttostr(a); end;
   6,8: begin insert('/',mydate,5); insert('/',mydate,3); end;
  end
 1: mydate:=mydate+'/'+inttostr(a);
 end;
 //remplace les espaces par des '/'
 while pos(' ',mydate)<>0 do mydate[pos(' ',mydate)]:='/';
 //verif et renvoi au format TDate
 if not TryStrToDate(mydate,result) then result:=-1;
end;

06 septembre 2007 11:36:04 :

Modification pour tenir compte des remarques de Loda - Rajout de la fonction CountCar que j'avait oublié de mettre...

06 septembre 2007 11:37:00 :

Modification pour tenir compte des remarques de Loda - Rajout de la fonction CountCar que j'avait oublié de mettre...

07 septembre 2007 10:40:02 :

correction d'un petit bug...

• JEU LOGICOLOR
• RACINE CARRÉE ENTIÈRE
• ENTRÉES SORTIES WAVE ET MIDI
• BOIDS DE CRAIG REYNOLDS
• BAC À SABLE

• MODIFIER LES DATES DE CRÉATION, DE MODIFICATION ET DE DERNIER ACCÈS D'UN FICHIER
• UN CHRONOS SIMPLE AVEC UN COMPOSENT LABEL ANIMÉ
• DATE EN ARABE
• LE PROGRAMMATEUR
• POSTITFOREVER

• MODIFIER LES DATES DE CRÉATION, DE MODIFICATION ET DE DERNIER ACCÈS D'UN FICHIER
• DATE EN ARABE
• DELPHI ET ACCESS /DBGRID
• COMPOSANT BOUTON TYPE VA-ET-VIENT POUR DATE ET HEURE AVEC FORMAT ET COULEUR
• GESTION DE CALENDRIER DYNAMIQUE