Convertion d'une chaine en tdate

Soyez le premier à donner votre avis sur cette source.

Snippet vu 7 177 fois - Téléchargée 21 fois

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

Ajouter un commentaire Commentaires
Messages postés
2106
Date d'inscription
mardi 10 décembre 2002
Statut
Modérateur
Dernière intervention
15 décembre 2014
5
Effectivement, je repars me coucher ...
Messages postés
220
Date d'inscription
lundi 30 octobre 2000
Statut
Membre
Dernière intervention
15 juillet 2013

Salut,
Il me semble que FormatDateTime convertis une TDateTime en string et non l'inverse...
Ou alors, je ne connais pas tous ses secrets...

Barbichette
Messages postés
2106
Date d'inscription
mardi 10 décembre 2002
Statut
Modérateur
Dernière intervention
15 décembre 2014
5
Salut FormatDateTime est pas mal dans son genre et permet de personaliser la sortie.
A+
Messages postés
814
Date d'inscription
vendredi 3 novembre 2000
Statut
Membre
Dernière intervention
30 juillet 2009
3
salut,

en ajoutant mon grain de sel : tu peux aussi utiliser le tableau system et enlever les accents (mais dans ce cas pense au autre langue que le FR)

bon code,

Loda
Messages postés
220
Date d'inscription
lundi 30 octobre 2000
Statut
Membre
Dernière intervention
15 juillet 2013

Salut,
Merci pour ces infos, cependant, je vais garder mon tableau pour la raison suivante:
- il contient les mois sans accents...
Mais il est vrai qu'on pourrai utiliser ShortMonthNames ou LongMonthNames, mais dans ce cas, l'utilisateur doit saisir avec accents... Pourquoi pas...

Barbichette
Afficher les 7 commentaires

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.