| 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; |
|
|