Convertion d'une chaine en tdate

Commenter

Contenu du snippet

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...

Source / Exemple : 


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;

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_barbichette)