Page 1 of 2 1 2 LastLast
Results 1 to 15 of 27

Thread: Omgekeerde versie van FormatDateTime

  1. #1

    Omgekeerde versie van FormatDateTime

    Hallo,

    Ik ben opzoek naar een functie die een string omzet naar een TDateTime met een bepaalde mask. Dus precies het tegenovergestelde van FormatDateTime:
    Code:
    DateTime := StrToDateTimeMask('yyyymmdd', '20070228');
    Zit deze standaard in de VCL (StrToDateTime is te beperkt!) of kan iemand mij hier aan helpen?

    Alvast bedankt!

  2. #2
    Uit de Delphi Help :

    function StrToDateTime(const S: string): TDateTime; overload;
    function StrToDateTime(const S: string; const FormatSettings: TFormatSettings): TDateTime; overload;

    Via je FormatSettings moet je toch jouw beperkingen kunnen wegwerken?
    De beste manier om te leren is door fouten te maken.
    80 procent van alle leugens die jij en ik vertellen blijft onopgemerkt

  3. #3
    Dan krijg ik een EConvertError:
    EConvertError with message ''20070228' is not a valid date and time
    Ook als ik dit doe:
    Code:
    var
      FS: TFormatSettings;
    begin
      FS.LongDateFormat := 'yyyymmdd';
      FS.ShortDateFormat := 'yyyymmdd';
      ShowMessage(FormatDateTime('dd/mm/yyyy hh:nn:ss', StrToDateTime('20070228', FS)));

  4. #4
    *+E13818MU01F0F* Norrit's Avatar
    Join Date
    Aug 2001
    Location
    Landgraaf
    Posts
    967
    Je kunt het ook nog zelf maken:
    Code:
        function StrToDateTimeMask(Mask, Date: String): TDate;
        var
          i: Integer;
          Year, Month, Day: Word;
          iYear1, iYear2: Integer;
          iMonth1, iMonth2: Integer;
          iDay1, iDay2: Integer;
        begin
          Mask := UpperCase(Mask);
          iYear1 := 0;
          iYear2 := 0;
          iMonth1 := 0;
          iMonth2 := 0;
          iDay1 := 0;
          iDay2 := 0;
          for i := 1 to Length(Mask) do
          begin
            case mask[i] of
              'Y': begin
                  if iYear1 = 0 then
                  begin
                    iYear1 := i;
                    iYear2 := 1;
                  end
                  else Inc(iYear2);
                end;
              'M': begin
                  if iMonth1 = 0 then
                  begin
                    iMonth1 := i;
                    iMonth2 := 1;
                  end
                  else Inc(iMonth2);
                end;
              'D': begin
                  if iDay1 = 0 then
                  begin
                    iDay1 := i;
                    iDay2 := 1;
                  end
                  else Inc(iDay2);
                end;
            end;
          end;
          Year := StrToInt(Copy(Date, iYear1, iYear2));
          Month := StrToInt(Copy(Date, iMonth1, iMonth2));
          Day := StrToInt(Copy(Date, iDay1, iDay2));
          Result := EncodeDate(Year, Month, Day);
        end;
    Objective reality is a delirium caused by lack of alcohol in blood

  5. #5
    mov rax,marcov; push rax marcov's Avatar
    Join Date
    Apr 2004
    Location
    Ehv, Nl
    Posts
    10,357
    Norrit, dat is maar een deel van wat Jelmer vraagt. Nl alleen zijn voorbeeld datum.

    Ik heb er over na gedacht, en zoiets moet te maken zijn.

  6. #6
    Tuurlijk is het te maken, met reguliere epxressies e.d. kom ik natuurlijk een heel eind.
    FormatDateTime bevat deze code zelfs als helemaal, al is het de verkeerde kant op. Echter gaat het mij natuurlijk (veel) tijd kosten, en ik had wel verwacht dat er een kant-en-klare (of in de VCL of van Internet) oplossing voor zou zijn.

  7. #7
    mov rax,marcov; push rax marcov's Avatar
    Join Date
    Apr 2004
    Location
    Ehv, Nl
    Posts
    10,357
    Ik ken hem niet, en nog niemand anders heeft gereageerd. Beste gok zou JCL zijn, maar die heb ik hier niet bij de hand.

    Ik ben overigens zeer benieuwd hoe je een routine die format parameters begrijpt gaat doen met reguliere expressies.

  8. #8
    mov rax,marcov; push rax marcov's Avatar
    Join Date
    Apr 2004
    Location
    Ehv, Nl
    Posts
    10,357
    Uit de losse pols: (tijd kosten dikke 15min)

    Code:
    program scandatetest;
    
    {$APPTYPE CONSOLE}
    
    uses
      SysUtils,dateutils;
    
    const whitespace  = [' ',#13,#10];
          hrfactor    = 1/(24);
          minfactor   = 1/(24*60);
          secfactor   = 1/(24*60*60);
          mssecfactor = 1/(24*60*60*1000);
    
    function scandate(const pattern:string;s:string;startpos:integer=1) : tdatetime;
    
    var len ,ind  : integer;
        plen,pind : integer;
        i,j,k     : integer;
        pivot,
        yy,mm,dd  : integer;
    
    function scanfixedint:integer;
    var c : char;
    begin
      result:=0;
      c:=pattern[pind];
      while (pind<=plen) and (pattern[pind]=c) and (ind<=len) and (s[ind] IN ['0'..'9']) do
         begin
           result:=result*10+ord(s[ind])-48;
           inc(pind);
           inc(ind);
         end;
      while (pind<=plen) and (pattern[pind]=c) do inc(pind);     
    end;
    
    begin
      yy:=0; mm:=0; dd:=0;
      result:=0.0;
      len:=length(s); ind:=startpos;
    
      while(ind<=len) and (s[ind] in whitespace) do inc(ind);
      plen:=length(pattern); pind:=1;
    
      while (ind<=len) and (pind<=plen) do
         begin
            case pattern[pind] of
               'h':  result:=result+scanfixedint* hrfactor;
               'd':  dd:=scanfixedint;
               'n':  result:=result+scanfixedint* minfactor;
               's':  result:=result+scanfixedint* secfactor;
               'z':  result:=result+scanfixedint* mssecfactor;
               'y':  begin
                       i:=pind;
                       yy:=scanfixedint;
                       i:=pind-i;
                       if i<=2 then
                         begin
                           pivot:=YearOf(now)-TwoDigitYearCenturyWindow;
                           inc(yy, pivot div 100 * 100);
                           if (TwoDigitYearCenturyWindow > 0) and (yy < pivot) then
                              inc(yy, 100);
                         end;
                      end;
               'm':  mm:=scanfixedint;
    
               else
                 begin
                   inc(pind);
                   inc(ind);
                 end;
             end;
         end;
     if (yy>0) and (mm>0) and (dd>0) then  
        result:=result+encodedate(yy,mm,dd);
    end;
    
    procedure dotest(pt,s:string);
    
    var dt : Tdatetime;
    begin
      dt:=scandate(pt,s);
      writeln(pt:20,s:20,' ':5,formatdatetime('yyyy mm dd hh:nn:ss',dt));
    end;
    
    begin
      { TODO -oUser -cConsole Main : Insert code here }
      dotest('hh:nn:ss','10:20:30');
      dotest('yyyy-mm-dd hh:nn:ss','2006-10-06 10:20:30');
      dotest('hhnnss','102030');
      dotest('yyyymmddhhnnss','20061006102030');
      dotest('yymmddhhnnss','061006102030');
      dotest('yy-mm-dd','06-5-3');
      dotest('dd-mm-yy','06-5-3');     
      readln;
    end.
    Overigens; bij gebruik svp functie naam veranderen. Ik wil deze opschonen en aan FPC toevoegen, en dan heb ik liever geen namespace conflicten met oudere versies.

  9. #9
    Silly member NGLN's Avatar
    Join Date
    Aug 2004
    Location
    Werkendam
    Posts
    5,133
    Quote Originally Posted by marcov View Post
    Norrit, dat is maar een deel van wat Jelmer vraagt. Nl alleen zijn voorbeeld datum.
    Huh, volgens mij is het (voor het datumgedeelte) kompleet.
    Code:
    StrToDateTimeMask('mm-yyyy,dd', '02-2007,28')
    geeft bij mij hier keurig netjes "28-2-2007". De uitbreiding voor het tijdgedeelte gaat op dezelfde manier.

    @Norrit: ik zou er nog een check inbouwen of Date en Mask even lang zijn, en de mogelijkheid om een jaartal in twee cijfers op te geven.

    //Edit:
    Beetje late reactie.
    @Marcov: ja, zo kan het ook!
    Last edited by NGLN; 20-Sep-07 at 18:03.
    (Sender as TNLDUser).Signature := 'Groeten van Albert';

  10. #10
    Senior Member Thaddy's Avatar
    Join Date
    Dec 2004
    Location
    Amsterdam
    Posts
    2,211
    unicode versie Marco? Please...?
    Werken aan Ansi support voor Windows is verspilde tijd, behalve voor historici.

  11. #11
    Quote Originally Posted by Jelmer Vos View Post
    (..) een kant-en-klare (of in de VCL of van Internet) oplossing voor zou zijn.
    Bij torry staat er eentje

    FormatDateTime v.1.0 FWS 195 k 07 Jan 2002
    By WinPeak Ufa. Delphi's SysUtils unit have nice function FormatDateTime for conversion from DateTime to a String with format.
    Here is the inverse function: Function FormatStrToDateTime(Format, strDate : string) : TDateTime;

    Fully functional
    Source: Included
    Exe-Demo Included

    http://www.torry.net/vcl/datetime/da...atdatetime.zip

    http://www.torry.net/pages.php?id=297

    Written by Artem Khomenko Russische comments. . Alles zit erin.


    Lx
    Minstens ?®?®n hobby naast programmeerwerk is echt noodzakelijk

  12. #12
    mov rax,marcov; push rax marcov's Avatar
    Join Date
    Apr 2004
    Location
    Ehv, Nl
    Posts
    10,357
    Thaddy: Ik ben nu op pagina 10 van http://www.stack.nl/~marcov/unicode.jpg

    Ik weet niet precies wat hier unicode aan te maken is, (UTF-8 ? UCS2 klassiek of met surrogates?) en heb geen unittests voor unicode. Ik maak eerst deze af. (heb mmm en mmmm zo goed als af, komt morgen)


    LxGoodies: Heb je naar de code gekeken?

    Code:
    		end else if (pFormat^ = 'A') and ((pFormat + 1)^ = '/') and ((pFormat + 2)^ = 'P') then begin
    Brrr. Ziet er uit als eerste Delphi experiment van een beginnende VBer. Maar de routine lijkt wel meer te kunnen, dus ik zal er toch even wat mee testen.

  13. #13
    *+E13818MU01F0F* Norrit's Avatar
    Join Date
    Aug 2001
    Location
    Landgraaf
    Posts
    967
    @NGLN:
    Checks had ik niet ingebouwd, was gewoon om te laten zien hoe het zou kunnen.
    Voor StrToInt kun je ook beter StrToIntDef gebruiken en vallideren voordat je EncodeDate gebruikt.
    Mocht je het nog voor tijd ook willen hebben is het eenvoudig uit te breiden met wat extra lettertjes.
    Objective reality is a delirium caused by lack of alcohol in blood

  14. #14
    mov rax,marcov; push rax marcov's Avatar
    Join Date
    Apr 2004
    Location
    Ehv, Nl
    Posts
    10,357
    Ik heb er nog wat aan gerommeld, en ondersteun nu de niet aziatische format opties.
    Zie requirements voor meer problemen. (verder: geen utf8 of mbcs) Er moet nog zeker meer getest worden. (sommige delen als de recursie en quoting e.d. zijn nog ongetest)

    http://www.stack.nl/~marcov/scandatetest.dpr

    Deze routine is verder bedoeld als een voorbeeld van een redelijk geavanceerde string routine zonder zwaar "copy" gebruik. En vanwege de aanpak in het algemeen (b.v. de recursie).

    Daarmee wil ik niet zeggen dat iets dergelijks niet mag, zeker voor het vlugge dagelijkse werk, maar het is niet aan te raden voor serieuze, voor zwaar hergebruik bedoelde routines.

    Thaddy: ik wacht nog steeds op een verklaring van de unicode requirements. Wat bedoel je, widestring, mbcs, utf-8? En hoe iterereer je voor zo'n string door individuele karakters ?
    LxGoodies: de routine van Torry is minder slecht dan ik initieel dacht. Er zitten minder kanten aan (b.v. voor oudere versie van Delphi, eigen twodaycentury baksel), maar het zou b.v. zelfs kunnen dat deze beter tegen MBCS kan dan de mijne. De code is wel wat groter en lelijker (met name gettoken).

    Zowel die van mij als Torry hebben verder ook #0 teken beperkingen. Die van mij overigens wel minder. (bij mij zijn alleen #0 tekens in de formatsettings constantes niet toegestaan, bij hem ook in hoofd formatstr)
    Last edited by marcov; 22-Sep-07 at 16:57.

  15. #15
    Senior Member Thaddy's Avatar
    Join Date
    Dec 2004
    Location
    Amsterdam
    Posts
    2,211
    @marco:
    Voor mij is utf8 goed genoeg, want dat ondersteunt westers en KOI en meer gebruik ik niet. (hoewel ik vroeger heb moeten omgaan met Japans en Koreaans) <off topic>Zie koffiehoek</off topic>
    Werken aan Ansi support voor Windows is verspilde tijd, behalve voor historici.

Page 1 of 2 1 2 LastLast

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •