First [Monday] of the month, Second [Thursday] of the month, etc. Delphi - delphi

Using Delphi, I need a function to evaluate the current date and see if it's, for example, the Third Sunday of the month, etc.
In pseudocode:
function IsFirst(const CurrentDateTime: TDateTime; const Day: Word): Boolean;
/// Day can be 1-7 (monday to sunday)
begin
Result:= ??
end;
Another function would be needed to calculate the Second, Third, Forth and Last of the month. DateUtils seems to have nothing like that. Any ideas?

This function is what you need:
function IsFirst(const DateTime: TDateTime; const Day: Word): Boolean;
begin
Result := (DayOfTheWeek(DateTime)=Day) and
InRange(DayOfTheMonth(DateTime), 1, 7);
end;
The equivalent function for the second occurrence is:
function IsSecond(const DateTime: TDateTime; const Day: Word): Boolean;
begin
Result := (DayOfTheWeek(DateTime)=Day) and
InRange(DayOfTheMonth(DateTime), 8, 14);
end;
I'm sure you can fill out the details for third, fourth and fifth. You may prefer to write a single general function like this:
function IsNth(const DateTime: TDateTime; const Day: Word;
const N: Integer): Boolean;
var
FirstDayOfWeek, LastDayOfWeek: Integer;
begin
LastDayOfWeek := N*7;
FirstDayOfWeek = LastDayOfWeek-6;
Result := (DayOfTheWeek(DateTime)=Day) and
InRange(DayOfTheMonth(DateTime), FirstDayOfWeek, LastDayOfWeek);
end;

This can be done using simple math.
Get the DayOfTheWeek and divide the DayOf by seven.

Related

Counting down to a time?

I'm trying to count down to a time of the day (24-hour clock format). This is my solution so far:
function TimeDiffStr(const s1, s2: string): string;
var
t1, t2: TDateTime;
secs: Int64;
begin
t1 := StrToDateTime(s1);
t2 := StrToDateTime(s2);
secs := SecondsBetween(t1, t2);
Result := Format('%2.2d:%2.2d:%2.2d', [secs div 3600, (secs div 60) mod 60, secs mod 60]);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
TargetTime: TTime;
s: string;
begin
s := TimeDiffStr(TimeToStr(Now), TimeToStr(TargetTime));
end;
If Now is, for example, 15:35:02 and the target time is 21:44:59, the output is correct (06:09:57). However, if Now is 15:35:02 and the target time is 01:32:23, instead of counting down from 09:57:21, it will count upwards, because the function does not know that the target time is on a different day.
How can I work out the difference between two times when the times are on different days?
First off, there is no need to pass strings around. If you start with TTime and convert to TTime, then simply pass TTime around.
Second, since you are dealing with just time values, if the target time is meant to be on the next day, you need to add 24 hours so that you have a TDateTime that actually represents the next day.
Try this:
uses
..., DateUtils;
function TimeDiffStr(const t1, t2: TTime): string;
var
d1, d2: TDateTime;
secs: Int64;
begin
d1 := t1;
if t2 < t1 then
d2 := IncDay(t2) // or IncHour(t2, 24)
else
d2 := t2;
secs := SecondsBetween(d1, d2);
Result := Format('%2.2d:%2.2d:%2.2d', [secs div 3600, (secs div 60) mod 60, secs mod 60]);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
TargetTime: TTime;
s: string;
begin
TargetTime := ...;
s := TimeDiffStr(Time(), TargetTime);
end;

How to get the year when bolding month days in a TMonthCalendar?

I have a log that use the Calendar and I want to bold the days that have recorded info. I have them in an 3D array TDiaryLog = array[1900..2399] of array[1..12] of array[1..31] of POneDay;. But in the OnGetMonthInfo, when I must build the list with the bold days, it gives me only the Month, and not the Year. How should I know for what month I must pass the day if I don't have the year ? When December is displayed as the current month in the Calendar, there are a few days shown from the January next year !
procedure TMainForm.CalendarGetMonthInfo(Sender: TObject; Month: Cardinal;
var MonthBoldInfo: Cardinal);
begin
end;
I made a new component where I intercepted the MCN_GETDAYSTATE message and I extracted the year too from the message info... It was there all the time, but Delphi decided that year is not useful.
TOnGetMonthInfoExEvent = procedure(Sender: TObject; Year, Month: Word;
var MonthBoldInfo: LongWord) of object;
TNewMonthCalendar = class(TMonthCalendar)
private
FOnGetMonthInfoEx: TOnGetMonthInfoExEvent;
procedure CNNotify(var Msg: TWMNotifyMC); message CN_NOTIFY;
published
property OnGetMonthInfoEx: TOnGetMonthInfoExEvent read FOnGetMonthInfoEx write FOnGetMonthInfoEx;
end;
procedure TNewMonthCalendar.CNNotify(var Msg: TWMNotifyMC);
var
I: Integer;
Month, Year: Word;
DS: PNMDayState;
CurState: PMonthDayState;
begin
if (Msg.NMHdr.code = MCN_GETDAYSTATE) and Assigned(FOnGetMonthInfoEx) then begin
DS:= Msg.NMDayState;
FillChar(DS.prgDayState^, DS.cDayState * SizeOf(TMonthDayState), 0);
CurState:= DS.prgDayState;
for I:= 0 to DS.cDayState - 1 do begin
Year:= DS.stStart.wYear;
Month:= DS.stStart.wMonth + I;
if Month > 12 then begin Inc(Year); Dec(Month, 12); end;
FOnGetMonthInfoEx(Self, Year, Month, CurState^);
Inc(CurState);
end;
end
else inherited;
end;
BONUS
And, as a bonus, you need this to update the changes you made to the bold info of the current month view... because it doesn't work with Invalidate.
procedure TNewMonthCalendar.RefreshDayState;
var N: Cardinal;
Range: array[0..1] of TSystemTime;
Year, Month: Word;
States: array of TMonthDayState;
I: Integer;
begin
if not Assigned(FOnGetMonthInfoEx) then Exit;
N:= SendMessage(Handle, MCM_GETMONTHRANGE, GMR_DAYSTATE, LPARAM(#Range));
Year:= Range[0].wYear;
Month:= Range[0].wMonth;
SetLength(States, N);
FillChar(States[0], N * SizeOf(TMonthDayState), 0);
for I:= 0 to N-1 do begin
FOnGetMonthInfoEx(Self, Year, Month, States[I]);
Inc(Month);
if Month > 12 then
begin Dec(Month, 12); Inc(Year); end;
end;
SendMessage(Handle, MCM_SETDAYSTATE, N, LPARAM(#States[0]));
end;

Calculate Days Between Two Dates

Please help me find days between two dates.
I have two objects TDBDateEdit date1 and date2.
procedure Torder_form.date2Click(Sender: TObject);
var d3: TDateTime;
begin
d3:=date2.date - date1.date;
showmessage(datetostr(d3));
end.
I put to date1 = 07.10.2015
to date2 - 15.11.2015
Result must be: 39
But program gives me result: 07.02.1900
I found DaysBetween function. and I changed my codes like that
procedure Torder_form.date2Click(Sender: TObject);
var d3: TDateTime;
begin
d3:=DaysBetween(date2.date,date1.date);
showmessage(datetostr(d3));
end.
But programs says Result: 07.02.1900
You're trying to store a non-date value (the number of days between two dates) in a TDateTime value. Since you don't want a date, use a double instead, and interpret it as a double:
var
DaysDiff: Double;
begin
DaysDiff := Date2.Date - Date1.Date;
ShowMessage(FloatToStr(DaysDiff));
end;
Better yet, use the functions in DateUtils to do the work for you. If you need just whole days, use DaysBetween:
var
DaysDiff: Integer;
begin
DaysDiff := DaysBetween(Date2.Date, Date1.Date);
ShowMessage(IntToStr(DaysDiff));
end;
If you need fractional (partial) days, use DaySpan:
var
DaysDiff: Double;
begin
DaysDiff := DaySpan(Date2.Date, Date1.Date);
ShowMessage(FloatToStr(DaysDiff));
end;
I had the same problem in one of my projects. but after a little search in Delphi help, I find out Delphi has a rich set of functions on dates. Anyway you can use from 'DaysBetween' function to solve your problem. My code was something like this:
procedure TForm1.btnResultClick(Sender: TObject);
var
FirstDate, SecondDate: TDateTime;
format:TFormatSettings;
intDays: Integer;
begin
format:= TFormatSettings.Create();
format.ShortDateFormat := 'yyyy/mm/dd';
FirstDate := StrToDate(eFirstDate.Text,format);
SecondDate := StrToDate(eSecondDate.Text,format);
intDays:= DaysBetween(FirstDate,SecondDate);
eFinalDate.Text:= intToStr(intDays);
end;

Is there a Delphi RTL function that can convert the ISO 8601 basic date format to a TDate?

ISO 8601 describes a so called basic date format that does not use the dashes:
20140507 is a valid representation of the more readable 2014-05-07.
Is there a Delphi RTL function that can interpret that basic format and convert it to a TDateTime value?
I tried
function TryIso2Date(const _s: string; out _Date: TDateTime): Boolean;
var
Settings: TFormatSettings;
begin
Settings := GetUserDefaultLocaleSettings;
Settings.DateSeparator := #0;
Settings.ShortDateFormat := 'yyyymmdd';
Result := TryStrToDate(_s, Date, Settings);
end;
TryIso2Date('20140507', dt);
but it did not work because the DateSeparator could not be found in the string.
The only solution I so far came up with (other than writing the parsing code myself) is adding the missing dashes before calling TryStrToDate:
function TryIso2Date(const _s: string; out _Date: TDateTime): Boolean;
var
Settings: TFormatSettings;
s: string;
begin
Settings := GetUserDefaultLocaleSettings;
Settings.DateSeparator := #0;
Settings.ShortDateFormat := 'yyyy-mm-dd';
s := Copy(_s,1,4) + '-' + Copy(_s, 5,2) + '-' + Copy(_s, 7);
Result := TryStrToDate(_s, Date, Settings);
end;
TryIso2Date('20140507', dt);
This works, but it feels rather clumsy.
This is Delphi XE6, so it should have the most recent RTL possible.
You can use Copy to pull out the values as you already do. And then you just need to encode the date:
function TryIso8601BasicToDate(const Str: string; out Date: TDateTime): Boolean;
var
Year, Month, Day: Integer;
begin
Assert(Length(Str)=8);
Result := TryStrToInt(Copy(Str, 1, 4), Year);
if not Result then
exit;
Result := TryStrToInt(Copy(Str, 5, 2), Month);
if not Result then
exit;
Result := TryStrToInt(Copy(Str, 7, 2), Day);
if not Result then
exit;
Result := TryEncodeDate(Year, Month, Day, Date);
end;

DateTimeToUnix in UTC?

I need UTC variants of the functions DateTimeToUnix and UnixToDateTime, so a Chinese customer is able to interact with the server in Germany. Both sides should be able to exchange Unix timestamps (in UTC, without DST) and be able to communicate through this way.
In a bugreport of HeidiSQL , users discussed that DateTimeToUnix and UnixToDateTime do not care about the time zone, and there I have found following code:
function DateTimeToUTC(dt: TDateTime): Int64;
var
tzi: TTimeZoneInformation;
begin
Result := DateTimeToUnix(dt);
GetTimeZoneInformation(tzi);
Result := Result + tzi.Bias * 60;
end;
MSDN explains twi.Bias as follows:
All translations between UTC time and local time are based on the following formula:
UTC = local time + bias
The bias is the difference, in minutes, between UTC time and local time.
This sounds logical, but since I was unsure if the code above was correct, I made following program to check it:
// A date in summer time (DST)
Memo1.Lines.add('1401494400'); // 31 May 2014 00:00:00 GMT according to http://www.epochconverter.com/
Memo1.Lines.add(inttostr(DateTimeToUnixUTC(StrToDate('31.05.2014'))));
// A date in winter time
Memo1.Lines.add('567302400'); // 24 Dec 1987 00:00:00 GMT according to http://www.epochconverter.com/
Memo1.Lines.add(inttostr(DateTimeToUnixUTC(StrToDate('24.12.1987'))));
The output in Germany (GMT+1+DST) is currently:
1401494400
1401490800
567302400
567298800
I expected the output being:
1401494400
1401494400
567302400
567302400
What am I doing wrong?
PS: For this project I am bound to Delphi 6.
You have already found DateTimeToUnix and UnixToDateTime. So that part of the conversion is taken care of.
All you need to do now is convert between local and UTC time. You can do that using DateUtils.TTimeZone class. Specifically DateUtils.TTimeZone.ToUniversalTime and DateUtils.TTimeZone.ToLocalTime.
These four functions give you all that you need.
I think I have found some solutions for my question. All 3 solutions gave the same output, but I will try to find out which one is best and I will test it on several machines with different locales.
Solution #1 using TzSpecificLocalTimeToSystemTime and SystemTimeToTzSpecificLocalTime works fine, but requires Windows XP and above:
(Source: https://stackoverflow.com/a/15567777/3544341 , modified)
// Statically binds Windows API functions instead of calling them dynamically.
// Requires Windows XP for the compiled application to run.
{.$DEFINE USE_NEW_WINDOWS_API}
{$IFDEF USE_NEW_WINDOWS_API}
function SystemTimeToTzSpecificLocalTime(lpTimeZoneInformation: PTimeZoneInformation; var lpUniversalTime,lpLocalTime: TSystemTime): BOOL; stdcall; external kernel32 name 'SystemTimeToTzSpecificLocalTime';
{$ELSE}
function SystemTimeToTzSpecificLocalTime(lpTimeZoneInformation: PTimeZoneInformation; var lpUniversalTime,lpLocalTime: TSystemTime): BOOL; stdcall;
var
h: HModule;
f: function(lpTimeZoneInformation: PTimeZoneInformation; var lpUniversalTime,lpLocalTime: TSystemTime): BOOL; stdcall;
begin
h := LoadLibrary(kernel32);
if h = 0 then RaiseLastOSError;
#f := GetProcAddress(h, 'SystemTimeToTzSpecificLocalTime');
if #f = nil then RaiseLastOSError;
result := f(lpTimeZoneInformation, lpUniversalTime, lpLocalTime);
end;
{$ENDIF}
{$IFDEF USE_NEW_WINDOWS_API}
function TzSpecificLocalTimeToSystemTime(lpTimeZoneInformation: PTimeZoneInformation; var lpLocalTime, lpUniversalTime: TSystemTime): BOOL; stdcall; external kernel32 name 'TzSpecificLocalTimeToSystemTime';
{$ELSE}
function TzSpecificLocalTimeToSystemTime(lpTimeZoneInformation: PTimeZoneInformation; var lpLocalTime, lpUniversalTime: TSystemTime): BOOL; stdcall;
var
h: HModule;
f: function(lpTimeZoneInformation: PTimeZoneInformation; var lpLocalTime, lpUniversalTime: TSystemTime): BOOL; stdcall;
begin
h := LoadLibrary(kernel32);
if h = 0 then RaiseLastOSError;
#f := GetProcAddress(h, 'TzSpecificLocalTimeToSystemTime');
if #f = nil then RaiseLastOSError;
result := f(lpTimeZoneInformation, lpLocalTime, lpUniversalTime);
end;
{$ENDIF}
function UTCToLocalDateTime_WinXP(d: TDateTime): TDateTime;
var
TZI: TTimeZoneInformation;
LocalTime, UniversalTime: TSystemTime;
begin
GetTimeZoneInformation(tzi);
DateTimeToSystemTime(d,UniversalTime);
SystemTimeToTzSpecificLocalTime(#tzi,UniversalTime,LocalTime);
Result := SystemTimeToDateTime(LocalTime);
end;
function LocalDateTimeToUTC_WinXP(d: TDateTime): TDateTime;
var
TZI: TTimeZoneInformation;
LocalTime, UniversalTime: TSystemTime;
begin
GetTimeZoneInformation(tzi);
DateTimeToSystemTime(d,LocalTime);
TzSpecificLocalTimeToSystemTime(#tzi,LocalTime,UniversalTime);
Result := SystemTimeToDateTime(UniversalTime);
end;
Solution #2 as workaround for older operating systems does also work fine:
(Source: http://www.delphipraxis.net/299286-post4.html )
uses DateUtils;
function GetDateTimeForBiasSystemTime(GivenDateTime: TSystemTime; GivenYear: integer): TDateTime;
var
Year, Month, Day: word;
Hour, Minute, Second, MilliSecond: word;
begin
GivenDateTime.wYear := GivenYear;
while not TryEncodeDayOfWeekInMonth(GivenDateTime.wYear, GivenDateTime.wMonth, GivenDateTime.wDay, GivenDateTime.wDayOfWeek, Result) do
Dec(GivenDateTime.wDay);
DecodeDateTime(Result, Year, Month, Day, Hour, Minute, Second, MilliSecond);
Result := EncodeDateTime(Year, Month, Day, GivenDateTime.wHour, GivenDateTime.wMinute, GivenDateTime.wSecond, GivenDateTime.wMilliseconds);
end;
function GetBiasForDate(GivenDateTime: TDateTime): integer;
var
tzi: TIME_ZONE_INFORMATION;
begin
GetTimeZoneInformation(tzi);
if (GivenDateTime < GetDateTimeForBiasSystemTime(tzi.StandardDate, YearOf(GivenDateTime))) and
(GivenDateTime >= GetDateTimeForBiasSystemTime(tzi.DaylightDate, YearOf(GivenDateTime))) then
Result := (tzi.Bias + tzi.DaylightBias) * -1
else
Result := (tzi.Bias + tzi.StandardBias) * -1;
end;
function UTCToLocalDateTime_OldWin(aUTC: TDateTime): TDateTime;
begin
Result := IncMinute(aUTC, GetBiasForDate(aUTC));
end;
function LocalDateTimeToUTC_OldWin(aLocal: TDateTime): TDateTime;
begin
Result := IncMinute(aLocal, GetBiasForDate(aLocal) * -1);
end;
Solution #3 using TTimeZone for users of newer versions of Delphi, does give the same results as the codes above:
(Solution by David Heffernan, alas not possible in my current project, because I am bound to Delphi 6)
uses DateUtils;
{$IF Declared(TTimeZone)}
function UTCToLocalDateTime_XE(aUTC: TDateTime): TDateTime;
begin
result := TTimeZone.Local.ToLocalTime(aUTC);
end;
function LocalDateTimeToUTC_XE(aLocal: TDateTime): TDateTime;
begin
result := TTimeZone.Local.ToUniversalTime(aLocal);
end;
{$IFEND}
Now we can put all 3 solutions together! :-)
function UTCToLocalDateTime(aUTC: TDateTime): TDateTime;
begin
{$IF Declared(UTCToLocalDateTime_XE)}
result := UTCToLocalDateTime_XE(aUTC);
{$ELSE}
{$IFDEF USE_NEW_WINDOWS_API}
result := UTCToLocalDateTime_WinXP(aUTC);
{$ELSE}
try
result := UTCToLocalDateTime_WinXP(aUTC);
except
on E: EOSError do
begin
// Workaround for Windows versions older than Windows XP
result := UTCToLocalDateTime_OldWin(aUTC);
end
else raise;
end;
{$ENDIF}
{$IFEND}
end;
function LocalDateTimeToUTC(aLocal: TDateTime): TDateTime;
begin
{$IF Declared(LocalDateTimeToUTC_XE)}
result := LocalDateTimeToUTC_XE(aLocal);
{$ELSE}
{$IFDEF USE_NEW_WINDOWS_API}
result := LocalDateTimeToUTC_WinXP(aLocal);
{$ELSE}
try
result := LocalDateTimeToUTC_WinXP(aLocal);
except
on E: EOSError do
begin
// Workaround for Windows versions older than Windows XP
result := LocalDateTimeToUTC_OldWin(aLocal);
end
else raise;
end;
{$ENDIF}
{$IFEND}
end;
An easy method to get the current UTC unix timestamp is
function NowUTC: TDateTime;
var
st: TSystemTime;
begin
GetSystemTime(st);
result := EncodeDateTime(st.wYear, st.wMonth, st.wDay, st.wHour, st.wMinute, st.wSecond, st.wMilliseconds);
end;
function CurrentUnixUTCTimestamp: int64;
begin
result := DateTimeToUnix(NowUTC);
end;
DateTimeToUnix and UnixToDateTime have got a second argument now:
function DateTimeToUnix(const AValue: TDateTime; AInputIsUTC: Boolean): Int64;
function UnixToDateTime(const AValue: Int64; AReturnUTC: Boolean): TDateTime;
So, you can easily choose between UTC and local time.
Using kbmMW's TkbmMWDateTime class it is very easy as it is always timezone aware:
var
dt:TkbmMWDateTime;
unix:int64;
begin
dt:=TkbmMWDateTime.Now;
unix:=dt.UTCSinceEpoch;
end;
And it also goes the other way around. In fact there are many such epoch variations and time formats supported in TkbmMWDateTime.
I would recommend, if you any place need to exchange a string with date/time info in it, to use ISO8601 format. In kbmMW you do like this:
var
s:string;
begin
s:=TkbmMWDateTime.Now.ISO8601String;
...
end;
It also goes two ways.
You can read a bit more about kbmMW's DateTime handling here:
https://components4developers.blog/2018/05/25/kbmmw-features-3-datetime/
kbmMW is a toolbox that fully supports Delphi including all platforms.

Resources