Date formatée vers Date (StrToDate "amélioré")

**SergioMaster** · 02/07/2018, 08h58

Bonjour,

je tente peut être de réinventer la roue , dans ce cas merci de me le signaler.

Je voudrai à partir d'une date formatée (par exemple sous la forme ddd dd mmm yyyy soit Lun. 2 Juil. 2018) récupéré la dite date

j'ai donc écrit cette fonction

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
function FormatedDateToDate(Format,FormatedDate : String) : TDate;
   var i : Word;
   begin
//   try
     for I := 1 to 7 do
     begin
      S:=StringReplace(S,FormatSettings.ShortDayNames[i],'',[rfReplaceAll,rfIgnoreCase]);
      S:=StringReplace(S,FormatSettings.LongDayNames[i],'',[rfReplaceAll,rfIgnoreCase]);
     end;
     for I := 1 to 12 do
       begin
         S:=StringReplace(S,FormatSettings.ShortMonthNames[i],FormatSettings.DateSeparator+i.ToString+FormatSettings.DateSeparator,[rfReplaceAll,rfIgnoreCase]);
         S:=StringReplace(S,FormatSettings.LongMonthNames[i],FormatSettings.DateSeparator+i.ToString+FormatSettings.DateSeparator,[rfReplaceAll,rfIgnoreCase]);
       end;
 
     Result:=StrToDateDef(S,-1);
//    except
//    end;
   end;

si elle fonctionne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
procedure TForm15.Button1Click(Sender: TObject);
var S,Format : String;
    ADate : TDate;
begin
 Format:='ddd dd mmm yyyy';
 S:=FormatDateTime(Format,Date);
 Showmessage(s);
 ADate:=FormatedDateToDate(Format,S);
 if ADate>=0 then Label1.Text:=FormatDateTime(FormatSettings.ShortDateFormat,ADate);
end;

je voudrai quand même l'étendre à plus de possibilités
quelques tests avec d'autres format fonctionnent aussi 'dd mmm yy','dd/mm/yy','dddd dd mmmm e','dd/mm' ...
et certains formats comme 'ddd dd mmm' non (celui là c'est normal, j'ai un / en trop à la fin)

mais elles ont toutes l'obligation d'être sous la forme jour mois <an>
J'ai fait quelques tentatives avec StrToDate(string,TFormatSettings) mais sans succès (si quelqu'un peut m'expliquer

)

en gros j'ai testé ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
AFormatSettings : TFormatSettings;
ADate : TDate;
...
AFormatSettings:=TFormatSettings.Create();
AFormatSettings.LongDateFormat:='ddd dd mmm yyyy'; 
ADate:=StrToDate(FormatDateTime(AFormatSettings.LongDateFormat,Date);

**ShaiLeTroll** · 02/07/2018, 11h22

C'est con mais l'espace ne pourra jamais être un séparateur, tout espace est retiré durant l'analyse ce qui rend le découpage impossible

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
 
function SimplifyFormatedDate(const ADate: string; var AFormat: string): string;
var
  I: Integer;
begin
  Result := ADate;
  for I := 1 to 7 do
  begin
    Result := StringReplace(Result, FormatSettings.ShortDayNames[I], '', [rfReplaceAll, rfIgnoreCase]);
    Result := StringReplace(Result, FormatSettings.LongDayNames[I], '', [rfReplaceAll, rfIgnoreCase]);
  end;
  Result := StringReplace(Result, '  ', ' ', [rfReplaceAll, rfIgnoreCase]);
  for I := 1 to 12 do
  begin
    Result := StringReplace(Result, FormatSettings.ShortMonthNames[I], Format('%.2d', [I]), [rfReplaceAll, rfIgnoreCase]);
    Result := StringReplace(Result, FormatSettings.LongMonthNames[I], Format('%.2d', [I]), [rfReplaceAll, rfIgnoreCase]);
  end;
  Result := StringReplace(Trim(Result), ' ', FormatSettings.DateSeparator, [rfReplaceAll]);
 
  AFormat := StringReplace(AFormat, 'dddd', '', [rfReplaceAll, rfIgnoreCase]);
  AFormat := StringReplace(AFormat, 'ddd', '', [rfReplaceAll, rfIgnoreCase]);
  AFormat := StringReplace(AFormat, '  ', ' ', [rfReplaceAll, rfIgnoreCase]);
  AFormat := StringReplace(AFormat, 'mmmm', 'mm', [rfReplaceAll, rfIgnoreCase]);
  AFormat := StringReplace(AFormat, 'mmm', 'mm', [rfReplaceAll, rfIgnoreCase]);
  AFormat := StringReplace(Trim(AFormat), ' ', FormatSettings.DateSeparator, [rfReplaceAll]);
  AFormat := Trim(AFormat);
end;

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
 
procedure TZooXXXVCLMainForm.Button1Click(Sender: TObject);
const
  _FORMATS: array[0..5] of string = ('dd mmm yy', 'dd/mm/yy', 'dddd dd mmmm e', 'dd/mm', 'ddd dd mmm', 'yyyy mmmm dddd dd');
var
  S, Format, FormatS: String;
  lDate : TDate;
  lFormatSettings : TFormatSettings;
  I: Integer;
begin
  for I := Low(_FORMATS)to High(_FORMATS) do
  begin
     Format := _FORMATS[I];
     S := FormatDateTime(Format, Date);
     MemoPing.Lines.Add(Format + ' : ' + S);
 
     FormatS := Format;
     S := SimplifyFormatedDate(S, FormatS);
     MemoPing.Lines.Add(Format + ' -> ' + FormatS + ' : ' + S);
 
     try
       lFormatSettings := TFormatSettings.Create();
       lFormatSettings.ShortDateFormat := FormatS[1]; // 'dd mm yyyy';
       // lFormatSettings.DateSeparator := ' '; n'a aucun effet car les espaces sont ignorész par ScanDate\ScanNumber\ScanChar
       lDate := StrToDate(S, lFormatSettings);
       MemoPing.Lines.Add(Format + ' -> ' + FormatS + ' : ' + DateToStr(lDate)) + ' & ' + FormatDateTime(Format, lDate));
     except
       on E: Exception do
       MemoPing.Lines.Add(Format + ' -> ' + FormatS + ' : ' + E.Message);
     end;
  end;
end;

Code result :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
MemoPing
dd mmm yy : 02 juil. 18
dd mmm yy -> dd/mm/yy : 02/07/18
dd mmm yy -> dd/mm/yy : 02/07/2018 & 02 juil. 18
dd/mm/yy : 02/07/18
dd/mm/yy -> dd/mm/yy : 02/07/18
dd/mm/yy -> dd/mm/yy : 02/07/2018 & 02/07/18
dddd dd mmmm e : lundi 02 juillet 18
dddd dd mmmm e -> dd/mm/e : 02/07/18
dddd dd mmmm e -> dd/mm/e : 02/07/2018 & lundi 02 juillet 18
dd/mm : 02/07
dd/mm -> dd/mm : 02/07
dd/mm -> dd/mm : 02/07/2018 & 02/07
ddd dd mmm : lun. 02 juil.
ddd dd mmm -> dd/mm : 02/07
ddd dd mmm -> dd/mm : 02/07/2018 & lun. 02 juil.
yyyy mmmm dddd dd : 2018 juillet lundi 02
yyyy mmmm dddd dd -> yyyy/mm/dd : 2018/07/02
yyyy mmmm dddd dd -> yyyy/mm/dd : 02/07/2018 & 2018 juillet lundi 02