Trouver une ressource (Nouvelle version du moteur, plus rapide & pertinent, essayez le !)
Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum.
Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !
CONVERTION D'UNE CHAINE EN TDATE
Information sur la source
Description
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
- 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;
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;
Historique
- 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...
Sources de la même categorie
Commentaires
Discussions en rapport avec ce code source
|
Téléchargements
Logiciels à télécharger sur le même thème :
|