Solved

Calculate the date of fifth tuesday of the month?

Posted on 2011-03-23
25
607 Views
Last Modified: 2012-06-21
Any suggestions how to calculate fifth tuestay of the month...
There is of course several  methods, but what is the simplest way?
0
Comment
Question by:ejla51
  • 8
  • 7
  • 6
  • +1
25 Comments
 
LVL 32

Expert Comment

by:ewangoya
Comment Utility
try
function FifthTuesday(ADate: TDateTime): TDateTime;
var
  Lastday: TDateTime;
  DOW: Word;
begin
  Result := 0;
  Lastday := EndOfTheMonth(ADate);
  DOW := DayOfTheWeek(Lastday);
  if WeekOfTheMonth(LastDay) = 5 then
  begin
    if DOW = 2 then
      Result := LastDay
    else if DOW > 2 then
    begin
      while DOW > 2 do
      begin
        LastDay := IncDay(LastDay, -1);
        DOW := DayOfTheWeek(Lastday);
      end;
      Result := LastDay;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(DatetimetoStr(FifthTuesday(Date))) //for this month
end;

Open in new window

0
 
LVL 24

Expert Comment

by:jimyX
Comment Utility
Here is a function to get the date of and day as per any specified number:
function FindDate(Dt:TDate;Dy:String;Num:Integer):TDate;
var
  i,j:integer;
  ddte:TDate;
  Dte : String;
begin
  j:=0;
  for i:= 1 to DaysInMonth(MonthOf(dt)) do
    begin
      ddte := EncodeDate(YearOf(dt),MonthOf(dt),i);
      Dte := FormatDateTime('ddd',ddte);
      if Dte = Dy then
        begin
          inc(j);
          if j = Num then
            begin
              Result := ddte;
              exit;
            end;
        end;
    end;
  if J < Num then
    Result := StrToDate('01/01/1700');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  If Datetostr(FindDate(now,'Tue',5)) = StrToDate('01/01/1700') then
    Showmessage('There is no date for that number in this month')
  else
    Showmessage(DateToStr(Datetostr(FindDate(now,'Tue',5))));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ShortDateFormat := 'dd/mm/yyyy';
end;

Open in new window


It can be improved more, this is to show the idea only.
0
 
LVL 45

Expert Comment

by:aikimark
Comment Utility
@ejla51

What do you need to do if there is NO fifth Tuesday in the month?
0
 
LVL 24

Expert Comment

by:jimyX
Comment Utility
small fix in my code:
function FindDate(Dt:TDate;Dy:String;Num:Integer):TDate;
var
  i,j:integer;
  ddte:TDate;
  Dte : String;
begin
  Result := StrToDate('01/01/1700');
  j:=0;
  for i:= 1 to DaysInMonth(MonthOf(dt)) do
    begin
      ddte := EncodeDate(YearOf(dt),MonthOf(dt),i);
      Dte := FormatDateTime('ddd',ddte);
      if Dte = Dy then
        begin
          inc(j);
          if j = Num then
            begin
              Result := ddte;
              exit;
            end;
        end;
    end;
  if J < Num then
    Result := StrToDate('01/01/1700');
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  Dt:TDate;
begin
  Dt := FindDate(now,'Tue',5);  // or FindDate(now,'Thu',5);
  If Dt = StrToDate('01/01/1700') then
    Showmessage('There is no date for that number in this month')
  else
    Showmessage(Datetostr(Dt));
end;

Open in new window

0
 

Author Comment

by:ejla51
Comment Utility
Hi fellows,
Have tested both without succes... I think partly due to national settings (short daynames?/FormatDateTime?)...

ewangoya... please notice that only 5th tuesaday is intrested, not last if there is only 4  tuesdays in the month.

jimyX: My testresult- if there is 5 tuesdays in the month, date was not found, if only 4 tuesdays "Invalid argument to date encode"

aikimark: Usage "Custom calendar" - eg. get dates to  TStringList (5th tuesday dates only) when year is selected with the SpinEdit!
0
 
LVL 24

Expert Comment

by:jimyX
Comment Utility
Can you show the date that you tested this function with please? and also did you set the short date format?
0
 
LVL 32

Expert Comment

by:ewangoya
Comment Utility

First you need to check how if the first day of the week is Monday or Sunday in your LOCALE
If Sunday, then DOW should be 3
Modify my function to
function FifthTuesday(ADate: TDateTime): TDateTime;
var
  Lastday: TDateTime;
  DOW: Word;
begin
  Result := 0;
  Lastday := EndOfTheMonth(ADate);
  DOW := DayOfTheWeek(Lastday);
  if WeekOfTheMonth(LastDay) = 5 then
  begin
    if DOW = 2 then
      Result := LastDay
    else if DOW > 2 then
    begin
      while (WeekOfTheMonth(LastDay) = 5) and (DOW > 2) do
      begin
        LastDay := IncDay(LastDay, -1);
        DOW := DayOfTheWeek(Lastday);
      end;
      if DOW = 2 then
         Result := LastDay;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(DatetimetoStr(FifthTuesday(Date))) //for this month
end;

Open in new window

0
 
LVL 32

Expert Comment

by:ewangoya
Comment Utility
Forget the LOCALE, in Delphi way Monday is always 1 so Tuesday is 2.
My function here should work properly with the extra check

function FifthTuesday(ADate: TDateTime): TDateTime;
var
  Lastday: TDateTime;
  DOW: Word;
begin
  Result := 0;
  Lastday := EndOfTheMonth(ADate);
  DOW := DayOfTheWeek(Lastday);
  if WeekOfTheMonth(LastDay) = 5 then
  begin
    if DOW = 2 then
      Result := LastDay
    else if DOW > 2 then
    begin
      while (WeekOfTheMonth(LastDay) = 5) and (DOW > 2) do
      begin
        LastDay := IncDay(LastDay, -1);
        DOW := DayOfTheWeek(Lastday);
      end;
      if DOW = 2 then
         Result := LastDay;
    end;
  end;
end;
0
 

Author Comment

by:ejla51
Comment Utility
ewangoya:
I'm using Swedish National settings.
ShortDate 2011-03-23
--
procedure TForm1.Button1Click(Sender: TObject);
begin
 ShowMessage(DateToStr(FifthTuesday(MonthCalendar1.Date)));
end;

testresults for year 2011:
Mars -> 2011-03-29 Correct!
April  -> 1899-12-30 (Not found) OK
May  ->  1899-12-30 but would be 2011-05-31
June -> 2011-06-28  This is 4th tuesday
July  -> 1899-12-30 (not found) OK
Aug -> 1899-12-30 but would be 2011-08-30
Sept -> 2011-09-27 This 4th tuesday
Oct -> 1899-12-30 (not found) OK
Nov ->1899-12-30  but would be  2011-11-29
Dec  -> 2011-12-27 is 4th tuesday

0
 

Author Comment

by:ejla51
Comment Utility
@jimyX:
My computer don't allow to set "ShortDateFormat  := 'dd/mm/yyyy'
ERead Error with message "Error reading Form1.Create : Invalid property value"  

My XP uses Swedish settings yyy-mm-dd

Have tested with native settings but date is not found.
0
 
LVL 24

Expert Comment

by:jimyX
Comment Utility
Here is an updated one, can you check it please:
function FindDate(Dt:TDate;Dy,Num:Integer):TDate;
var
  i,j:integer;
  ddte:TDate;
  Dte : String;
begin
  Result := EncodeDate(1700,1,1);
  j:=0;
  for i:= 1 to DaysInMonth(MonthOf(dt)) do
    begin
      ddte := EncodeDate(YearOf(dt),MonthOf(dt),i);
      if DayOfWeek(ddte) = Dy then
        begin
          inc(j);
          if j = Num then
            begin
              Result := ddte;
              exit;
            end;
        end;
    end;
  if J < Num then
    Result := EncodeDate(1700,1,1);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  Dt:TDate;
begin
  Dt := FindDate(now,3,5);
  If Dt = EncodeDate(1700,1,1) then
    Showmessage('There is no date for that number in this month')
  else
    Showmessage(Datetostr(Dt));
end;

Open in new window

0
 

Author Comment

by:ejla51
Comment Utility
@jimyX:
you are very close now :)
Error occured (Invalid argument to date encode) IF there is only 4 tuesdays AND less than 31 days in the month!
All 5th tuesdays are found. Correct result  handling on 31 days months with 4 tuesdays.
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 45

Expert Comment

by:aikimark
Comment Utility
@ejla51

So you want to pass a year value to a function and get all the 5th Tuesday dates in that year?
0
 
LVL 24

Accepted Solution

by:
jimyX earned 250 total points
Comment Utility
Fixed:
function FindDate(Dt:TDate;Dy,Num:Integer):TDate;
var
  i,j:integer;
  ddte:TDate;
begin
  Result := EncodeDate(1700,1,1);
  j:=0;
  for i:= 1 to DaysInAMonth(YearOf(dt),MonthOf(dt)) do
    begin
      ddte := EncodeDate(YearOf(dt),MonthOf(dt),i);
      if DayOfWeek(ddte) = Dy then
        begin
          inc(j);
          if j = Num then
            begin
              Result := ddte;
              exit;
            end;
        end;
    end;
  if J < Num then
    Result := EncodeDate(1700,1,1);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  Dt:TDate;
begin
  Dt := FindDate(now,3,5);
  If Dt = EncodeDate(1700,1,1) then
    Showmessage('There is no date for that number in this month')
  else
    Showmessage(Datetostr(Dt));
end;

Open in new window

0
 

Author Comment

by:ejla51
Comment Utility
@aikimark:
Yes... something like

 for Month := 1 to 12 do
   if FifthTuesday(Year,Month) <> nil then
     MyStringList.Add(DateToStr(FifthTusday(Year,Month)));
0
 
LVL 32

Expert Comment

by:ewangoya
Comment Utility

Interesting, I just found a bug in Delphi

Lastday := EndOfTheMonth(ADate);
When in May, this function is returning 06/01/2011

So the whole function breaks, this is bad, I'll try and get a workaround
0
 
LVL 24

Expert Comment

by:jimyX
Comment Utility
@ ejla51
Any comment on my last code?

@ ewangoya
It works fine in Delphi 7 and 2009. I tried this way:
procedure TForm1.Button1Click(Sender: TObject);
begin
  showmessage(DatetoStr(EndOfTheMonth(EncodeDate(2011,5,3))));
end;

Open in new window

0
 
LVL 32

Expert Comment

by:ewangoya
Comment Utility

Weird stuff, I'm using Delphi 2010
0
 
LVL 32

Expert Comment

by:ewangoya
Comment Utility

My Delphi is behaving really weird, Anyway I tested this with all the months
function FifthTuesday(ADate: TDateTime): TDateTime;
var
  CheckDay: TDateTime;
  Index: Integer;
  WorkMonth: Word;
  DD, MM, YY: WORD;
begin
  Result := 0;
  DecodeDate(ADate, YY, MM, DD);
  CheckDay := EncodeDate(YY, MM, 1);

  //start by getting first tuesday
  while DayOfTheWeek(CheckDay) <> 2 do
    CheckDay := IncDay(CheckDay, 1);

  //now we have first tuesday
  WorkMonth := MM;
  Index := 1;
  while (WorkMonth = MM) and (Index < 5) do
  begin
    CheckDay := IncDay(CheckDay, 7);
    WorkMonth := MonthOf(CheckDay);
    Inc(Index);
  end;
  if (WorkMonth = MM) and (Index = 5) then
    Result := CheckDay
  else
    Result := 0;
end;

procedure TForm3.Button1Click(Sender: TObject);
begin
  ShowMessage(DateToStr(FifthTuesday(MonthCalendar1.Date)));
end;

Open in new window

0
 
LVL 32

Assisted Solution

by:ewangoya
ewangoya earned 250 total points
Comment Utility
Or just pass Month and Year


function FifthTuesday1(MM, YY: Integer): TDateTime;
var
  CheckDay: TDateTime;
  Index: Integer;
  WorkMonth: Word;
begin
  Result := 0;
  CheckDay := EncodeDate(YY, MM, 1);

  //start by getting first tuesday
  while DayOfTheWeek(CheckDay) <> 2 do
    CheckDay := IncDay(CheckDay, 1);

  //now we have first tuesday
  WorkMonth := MM;
  Index := 1;
  while (WorkMonth = MM) and (Index < 5) do
  begin
    CheckDay := IncDay(CheckDay, 7);
    WorkMonth := MonthOf(CheckDay);
    Inc(Index);
  end;
  if (WorkMonth = MM) and (Index = 5) then
    Result := CheckDay
  else
    Result := 0;
end;

//
ShowMessage(DateToStr(FifthTuesday1(8, 2011)))

Open in new window

0
 
LVL 45

Expert Comment

by:aikimark
Comment Utility
My approach is less iterative, as far as the last Tuesday is concerned.

* Any month with less than 29 days can NEVER have a fifth of any day of the week -- I'm looking at you, February (most of the time).
* As long as the day of the week of the last day of the month minus the day-of-the-week value for Tuesday is greater than -1 and also greater than
(DayofTheMonth(LastDayOfTheMonth) - 29) then the
FifthTuesday := LastDayOfTheMonth - (DateOfWeek(LastDayOfTheMonth) - Tuesday)

In my proof-of-concept test, I passed a year to a routine that first calculated the end of January of that passed year and then incremented that date in a loop a month-at-a-time.  Applying the logic above, I either added the fifthTuesday date to a list continued iterating the subsequent 11 months in the passed year.

IncMonth() or IncAMonth() would be the function to use in the iteration.
0
 

Author Comment

by:ejla51
Comment Utility
thanks guys,
I'm very busy right now but I'll be back later!
0
 
LVL 45

Expert Comment

by:aikimark
Comment Utility
@ewangoya & jimyX

My Delphi system is offline, so you are welcome to try your hand at the alternative approach if you wish.  I will not be posting any code.
0
 

Author Comment

by:ejla51
Comment Utility
Hi folks,
great job! Both work exactly...
You should have shared points of course for this impressive lesson!

When I started thinking about the solution, I thought about taking the first Tuesday and add 4 weeks (28 days) and then see if we still are within respective month.

I creamed off and carved the following code.
I don't know if Delphi error ewangoya found, can cause problems there?
procedure TForm1.spinEditYearChange(Sender: TObject);
var i : integer;
    dt,LastDay : TDate;
begin
Memo1.Clear;
 for i := 1 to 12 do
 begin
  dt := EncodeDate(Floor(spinEditYear.Value), i, 1); // Go to 1st day
  Lastday := EndOfTheMonth(dt);
  while DayOfWeek(dt) <> 3 do dt := dt + 1; // Toggle to Fist Tuesday
   dt := dt + 28; // Add 4 weeks to first Tuesday
   if dt <= Lastday then // Check if date still in range
     Memo1.Lines.Add(DateToStr(dt))
 end;
end;

Open in new window

0
 
LVL 32

Expert Comment

by:ewangoya
Comment Utility

That works fine to me
You even saved a few iterations by adding 28 days straight to the first Tuesday
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
Get a first impression of how PRTG looks and learn how it works.   This video is a short introduction to PRTG, as an initial overview or as a quick start for new PRTG users.
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

771 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now