Str2Date Routines |
Unit
QESBPCSDateTime
Overloaded Variants |
Function Str2Date(const DateStr: string): TDateTime; |
Function Str2Date(const DateStr: string; const Year, StartMonth: Integer): TDateTime; |
Declaration
Function Str2Date(const DateStr: string): TDateTime;
Description
If the Item has no month and/or year then the current month and year will be assumed.
The following are all exceptable separators for entry: [' ', ',', '.', '/', '-', '\'] though the current DateSeparator will be used for display.
Dates can be entered without Separators but Leading Zeroes must then be used. Date parsing is highly dependant upon the current ShortDateFormat. ESB2DigitYr contols the different ways in which 2 Digit Years are handled in Str2Date.
edyNone - Nothing is done, left to Delphi to handle.
edyCutOff - the ESB2DigitCutOff is used to decide which century the date lies in. If 1900 + Yr less than ESB2DigitCutOff then it is assumed that 2000 + Yr is wanted, otherwise 1900 + Yr is used.
edyHistoric - asssumes that the yr is this year or earlier.
Parameters |
DateStr | The String to convert. |
Year | If Year and StartMonth are entered then if the Month is at least StartMonth, then this Year is implied. If it is less then the StartMonth then Year + 1 is implied. Only has meaning if the Year is omitted in the String. |
StartMonth | If Year and StartMonth are entered then if the Month is at least StartMonth, then this Year is implied. If it is less then the StartMonth then Year + 1 is implied. Only has meaning if the Year is omitted in the String. |
Category
Date/Time Conversion RoutinesImplementation
function Str2Date (const DateStr: string): TDateTime; var P1, P2, I: Integer; Yr: Word; DateOrder: TESBDateOrder; Hold: Boolean; S: string; Found: Boolean; begin S := UpperCase (Trim (DateStr)); if S = '' then begin Result := 0.0; Exit; end; if S [1] = '+' then begin Result := ESBToday + Str2Float (RightAfterStr (S, 1)); Exit; end else if S [1] = '-' then begin Result := ESBToday - Str2Float (RightAfterStr (S, 1)); Exit; end; DateOrder := GetESBDateOrder (ShortDateFormat); Hold := ESBBlankWhenZero; ESBBlankWhenZero := False; try if IsDigitStr (S) then begin case Length (S) of 4: S := LeftStr (S, 2) + DateSeparator + RightStr (S, 2); 6: S := LeftStr (S, 2) + DateSeparator + Copy (S, 3, 2) + DateSeparator + Copy (S, 5, 2); 8: begin if DateOrder = edoYMD then S := LeftStr (S, 4) + DateSeparator + Copy (S, 5, 2) + DateSeparator + Copy (S, 7, 2) else S := LeftStr (S, 2) + DateSeparator + Copy (S, 3, 2) + DateSeparator + Copy (S, 5, 4); end; end; end else begin Found := False; for I := 1 to 12 do begin P1 := Pos (UpperCase (LongMonthNames [I]), S); if P1 > 0 then begin S := LeftStr (S, P1 - 1) + Int2EStr (I) + RightAfterStr (S, P1 + Length (LongMonthNames [I]) - 1); Found := True; Break; end; end; if not Found then begin for I := 1 to 12 do begin P1 := Pos (UpperCase (ShortMonthNames [I]), S); if P1 > 0 then begin S := LeftStr (S, P1 - 1) + Int2EStr (I) + RightAfterStr (S, P1 + Length (ShortMonthNames [I]) - 1); Break; end; end; end; end; try // Allow '-' and '/' as valid alternatives for DateSeparator S := ReplaceChStr (S, '-', DateSeparator); S := ReplaceChStr (S, '/', DateSeparator); S := ReplaceChStr (S, '\', DateSeparator); S := ReplaceChStr (S, ' ', DateSeparator); S := ReplaceChStr (S, '.', DateSeparator); S := ReplaceChStr (S, ',', DateSeparator); // Remove trailing Separator if any if S [Length (S)] = DateSeparator then begin S := LeftStr (S, Length (S) - 1); if S = '' then begin Result := 0.0; Exit; end; end; // Remove Duplicate Separators repeat P1 := Pos (DateSeparator + DateSeparator, S); if P1 <> 0 then Delete (S, P1, 1); until P1 = 0; P1 := ESBPosCh (DateSeparator, S); if P1 > 0 then // If at least one Date Separator begin P2 := ESBPosCh (DateSeparator, Copy (S, P1 + 1, Length (S) - P1)); if P2 > 0 then // If 2 Date Separators begin // Get Components case DateOrder of edoDMY, edoMDY: begin Yr := Str2Word (Copy (S, P1 + P2 + 1, Length (S) - (P1 + P2))); end; else begin Yr := Str2Word (LeftStr (S, P1 - 1)); end; end; if Yr < 100 then // If 2 Digit begin case ESB2DigitYr of // edyNone - Nothing has to be done edyCutOff: // Process using ESB2DigitCutOff begin if 1900 + Yr < ESB2DigitCutOff then Yr := 2000 + Yr else Yr := 1900 + Yr end; edyHistoric: // Take Yr as this year or earlier begin if 2000 + Yr <= ThisYear then Yr := 2000 + Yr else Yr := 1900 + Yr; end; end; end; // Rebuild String case DateOrder of edoDMY, edoMDY: begin S := LeftStr (S, P1 + P2) + Int2EStr (Yr); end; edoYMD: begin S := Int2EStr (Yr) + RightAfterStr (S, P1 - 1); end; end; end else begin // Assume This Year is implied case DateOrder of edoDMY, edoMDY: begin S := S + DateSeparator + Int2EStr (ThisYear) end; edoYMD: begin S := Int2EStr (ThisYear) + DateSeparator + S; end; end; end; end else begin // Assume This Month and Year are implied case DateOrder of edoDMY: begin S := S + DateSeparator + Int2EStr (ThisMonth) + DateSeparator + Int2EStr (ThisYear); end; edoMDY: begin S := Int2EStr (ThisMonth) + DateSeparator + S + DateSeparator + Int2EStr (ThisYear); end; edoYMD: begin S := Int2EStr (ThisYear) + DateSeparator + Int2EStr (ThisMonth) + DateSeparator + S; end; end; end; //Int ensures the fractional Component is 0 Result := Int (StrToDate (S)); except Result := 0.0; if ESBRaiseDateError then raise EConvertError.Create (rsInvalidDate + ' - ' + DateStr); end; finally ESBBlankWhenZero := Hold; end; End; |
Declaration
Function Str2Date(const DateStr: string; const Year, StartMonth: Integer): TDateTime;Implementation
function Str2Date (const DateStr: string; const Year, StartMonth: Integer): TDateTime; var P1, P2, I: Integer; Yr, Mnth: Integer; DateOrder: TESBDateOrder; Hold: Boolean; S: string; Found: Boolean; begin if (StartMonth < 1) or (StartMonth > 12) then raise EConvertError.Create (rsInvalidMonth); S := UpperCase (Trim (DateStr)); if S = '' then begin Result := 0.0; Exit; end; if S [1] = '+' then begin Result := ESBToday + Str2Float (RightAfterStr (S, 1)); Exit; end else if S [1] = '-' then begin Result := ESBToday - Str2Float (RightAfterStr (S, 1)); Exit; end; DateOrder := GetESBDateOrder (ShortDateFormat); Hold := ESBBlankWhenZero; ESBBlankWhenZero := False; try if IsDigitStr (S) then begin case Length (S) of 4: S := LeftStr (S, 2) + DateSeparator + RightStr (S, 2); 6: S := LeftStr (S, 2) + DateSeparator + Copy (S, 3, 2) + DateSeparator + Copy (S, 5, 2); 8: begin if DateOrder = edoYMD then S := LeftStr (S, 4) + DateSeparator + Copy (S, 5, 2) + DateSeparator + Copy (S, 7, 2) else S := LeftStr (S, 2) + DateSeparator + Copy (S, 3, 2) + DateSeparator + Copy (S, 5, 4); end; end; end else begin Found := False; for I := 1 to 12 do begin P1 := Pos (UpperCase (LongMonthNames [I]), S); if P1 > 0 then begin S := LeftStr (S, P1 - 1) + Int2EStr (I) + RightAfterStr (S, P1 + Length (LongMonthNames [I]) - 1); Found := True; Break; end; end; if not Found then begin for I := 1 to 12 do begin P1 := Pos (UpperCase (ShortMonthNames [I]), S); if P1 > 0 then begin S := LeftStr (S, P1 - 1) + Int2EStr (I) + RightAfterStr (S, P1 + Length (ShortMonthNames [I]) - 1); Break; end; end; end; end; try // Allow '-' and '/' as valid alternatives for DateSeparator S := ReplaceChStr (S, '-', DateSeparator); S := ReplaceChStr (S, '/', DateSeparator); S := ReplaceChStr (S, '\', DateSeparator); S := ReplaceChStr (S, ' ', DateSeparator); S := ReplaceChStr (S, '.', DateSeparator); S := ReplaceChStr (S, ',', DateSeparator); // Remove trailing Separator if any if S [Length (S)] = DateSeparator then begin S := LeftStr (S, Length (S) - 1); if S = '' then begin Result := 0.0; Exit; end; end; // Remove Duplicate Separators repeat P1 := Pos (DateSeparator + DateSeparator, S); if P1 <> 0 then Delete (S, P1, 1); until P1 = 0; P1 := ESBPosCh (DateSeparator, S); if P1 > 0 then // If at least one Date Separator begin P2 := ESBPosCh (DateSeparator, Copy (S, P1 + 1, Length (S) - P1)); if P2 > 0 then // If 2 Date Separators begin // Get Components case DateOrder of edoDMY, edoMDY: begin Yr := Str2Word (Copy (S, P1 + P2 + 1, Length (S) - (P1 + P2))); end; else begin Yr := Str2Word (LeftStr (S, P1 - 1)); end; end; if Yr < 100 then // If 2 Digit begin case ESB2DigitYr of // edyNone - Nothing has to be done edyCutOff: // Process using ESB2DigitCutOff begin if 1900 + Yr < ESB2DigitCutOff then Yr := 2000 + Yr else Yr := 1900 + Yr end; edyHistoric: // Take Yr as this year or earlier begin if 2000 + Yr <= Year + 1 then Yr := 2000 + Yr else Yr := 1900 + Yr; end; end; end; // Rebuild String case DateOrder of edoDMY, edoMDY: begin S := LeftStr (S, P1 + P2) + Int2EStr (Yr); end; edoYMD: begin S := Int2EStr (Yr) + RightAfterStr (S, P1 - 1); end; end; end else begin // Assume This Year is implied case DateOrder of edoDMY: begin Mnth := Str2Int (RightAfterChStr (S, DateSeparator)); end; else Mnth := Str2Int (LeftTillChStr (S, DateSeparator)); end; if Mnth < StartMonth then Yr := Year + 1 else Yr := Year; case DateOrder of edoDMY, edoMDY: begin S := S + DateSeparator + Int2EStr (Yr) end; edoYMD: begin S := Int2EStr (Yr) + DateSeparator + S; end; end; end; end else begin Mnth := ThisMonth; if Mnth < StartMonth then Yr := Year + 1 else Yr := Year; // Assume This Month and Year are implied case DateOrder of edoDMY: begin S := S + DateSeparator + Int2EStr (Mnth) + DateSeparator + Int2EStr (Yr); end; edoMDY: begin S := Int2EStr (Mnth) + DateSeparator + S + DateSeparator + Int2EStr (Yr); end; edoYMD: begin S := Int2EStr (Yr) + DateSeparator + Int2EStr (Mnth) + DateSeparator + S; end; end; end; //Int ensures the fractional Component is 0 Result := Int (StrToDate (S)); except Result := 0.0; if ESBRaiseDateError then raise EConvertError.Create (rsInvalidDate + ' - ' + DateStr); end; finally ESBBlankWhenZero := Hold; end; End; |
|