LB Booster
Programming >> BASIC code examples >> Nth Day of Month
http://lbb.conforums.com/index.cgi?board=code&action=display&num=1472831139
Nth Day of Month
Post by Jack Kelly on Sep 2nd, 2016, 3:45pm

This program provides a function definition that returns the date of any occurrence of a day in any given month and year. For example, the first Monday in August or the fourth Thursday in November, etc. It should be useful for developing calendar programs. Those who have taken a look at my Remember-It program in the Showcase Section will know just exactly where I'm going with this function.

Code:
NoMainWin
WindowWidth = 800 : WindowHeight = 600
statictext #win.Title, "Find the nth day of any month...", 135, 150, 287, 31
stylebits #win.textbox4, _ES_NUMBER, 0, 0, 0
textbox #win.textbox4, 50, 198, 85, 30
statictext #win.caption, "1901 to 2099", 54, 230, 85, 30
combobox #win.combobox6, MonthArray$(), click, 180, 200, 120, 210
combobox #win.combobox7, WeekArray$(), click, 340, 200, 120, 210
combobox #win.combobox8, DayArray$(), click, 500, 200, 120, 210
button #win.button7, "Find", [find], ul, 650, 200, 100, 30
button #win.button8, "Quit", [quit], ul, 650, 300, 100, 30
statictext #win.Date, "", 350, 350, 97, 75
open "Nth Day of Month" for dialog_nf as #win
#win "TrapClose [quit]"
#win "Font Ariel 12"
#win.caption, "!Font Arial 10"
#win.Title "!Font Arial 14 bold"
#win.Date "!Font Arial 24 bold"
call SetTextLimit hwnd(#win.textbox4), 4
#win.textbox4 "Year (yyyy)"
#win.textbox4 "!SetFocus"
#win.textbox4 "!SelectAll"
call SetUpArrays
wait

[find]
#win.textbox4 "!Contents? Year$": Year=val(Year$)
#win.combobox6 "Selection? Month$": Month=Month(Month$)
#win.combobox7 "Selection? Week$" 
#win.combobox8 "Selection? Day$": nDa$=nDa$(Week$, Day$)
x=NthDayOfMonth(Year, Month, nDa$)
if x>0 then #win.Date x else #win.Date ""
wait

[quit]
close #win
end

function NthDayOfMonth(yyyy, mm, nda$)
' nda$ is a two part code. The first character is the occurance in the 
' month -- first, second, third, fourth, or last -- denoted by 1, 2, 3, 4 or 5.
' The last two characters is the day of the week denoted by Su, Mo, Tu, We, Th,
' Fr, or Sa.
    if yyyy<1901 or yyyy>2099 or mm<1 or mm>12 then
        NthDayOfMonth=0: exit function
    end if
    nda$=lower$(trim$(nda$))
    if len(nda$)<>3 then NthDayOfMonth=0: exit function
    n$=left$(nda$,1)
    nC$="1234l"
    da$=right$(nda$,2)
    daC$="tuwethfrsasumotuwethfrsasumo"
    if not(instr(nC$,n$)) or not(instr(daC$,da$)) then
        NthDayOfMonth=0
        exit function
    end if
    NthDayOfMonth=1
    mm$=str$(mm): if mm<10 then mm$="0"+mm$ 
    db$=DayOfDate$(str$(yyyy)+mm$+"01")
    if da$<>db$ then
        x=instr(daC$,db$): y=instr(daC$,da$,x): NthDayOfMonth=1+(y-x)/2
    end if
    dim MD(12)
    MD(1)=31: MD(2)=28: MD(3)=31: MD(4)=30: MD(5)=31: MD(6)=30 
    MD(7)=31: MD(8)=31: MD(9)=30: MD(10)=31: MD(11)=30: MD(12)=31 
    if yyyy mod 4 = 0 then MD(2)=29
    if n$<>"1" then
        if n$<>"l" then
            NthDayOfMonth=NthDayOfMonth+((val(n$)-1)*7)
        else
            if NthDayOfMonth+28<MD(mm)+1 then
                NthDayOfMonth=NthDayOfMonth+28
            else
                NthDayOfMonth=NthDayOfMonth+21
            end if
        end if
    end if
end function

function DayOfDate$(ObjectDate$) 'yyyymmdd format
    if ObjectDate$="" then 'today
        DaysSince1900 = date$("days")
    else
        DaysSince1900 = date$(mid$(ObjectDate$,5,2)+"/"+right$(ObjectDate$,2)_
                +"/"+left$(ObjectDate$,4))
    end if
    DayOfWeek = DaysSince1900 mod 7
    select case DayOfWeek
        case 0: DayOfDate$="tu"
        case 1: DayOfDate$="we"
        case 2: DayOfDate$="th"
        case 3: DayOfDate$="fr"
        case 4: DayOfDate$="sa"
        case 5: DayOfDate$="su"
        case 6: DayOfDate$="mo"
    end select
end function

sub SetUpArrays
dim MonthArray$(12)
MonthArray$(1)="January"
MonthArray$(2)="February"
MonthArray$(3)="March"
MonthArray$(4)="April"
MonthArray$(5)="May"
MonthArray$(6)="June"
MonthArray$(7)="July"
MonthArray$(8)="August"
MonthArray$(9)="September"
MonthArray$(10)="October"
MonthArray$(11)="November"
MonthArray$(12)="December"

WeekArray$(1)="First"
WeekArray$(2)="Second"
WeekArray$(3)="Third"
WeekArray$(4)="Fourth"
WeekArray$(5)="Last"

DayArray$(1)="Sunday"
DayArray$(2)="Monday"
DayArray$(3)="Tuesday"
DayArray$(4)="Wednesday"
DayArray$(5)="Thursday"
DayArray$(6)="Friday"
DayArray$(7)="Saturday"

#win.combobox6 "Reload"
#win.combobox6 "!month"
#win.combobox7 "Reload"
#win.combobox7 "!Occurance"
#win.combobox8 "Reload"
#win.combobox8 "!Day"
end sub

function Month(Month$)
    select case Month$
        case "January": Month=1
        case "February": Month=2
        case "March": Month=3
        case "April": Month=4
        case "May": Month=5
        case "June": Month=6
        case "July": Month=7
        case "August": Month=8
        case "September": Month=9
        case "October": Month=10
        case "November": Month=11
        case "December": Month=12
    end select
end function

function nDa$(Week$, Day$)
    select case Week$
        case "First": n$="1"
        case "Second": n$="2"
        case "Third": n$="3"
        case "Fourth": n$="4"
        case "Last": n$="L"
    end select
    select case Day$
        case "Sunday": Da$="Su"
        case "Monday": Da$="Mo"
        case "Tuesday": Da$="Tu"
        case "Wednesday": Da$="We"
        case "Thursday": Da$="Th"
        case "Friday": Da$="Fr"
        case "Saturday": Da$="Sa"
    end select
    nDa$=n$+Da$
end function

sub SetTextLimit TextBoxHwnd, Limit
    CallDll #user32, "SendMessageA",_
                     TextBoxHwnd as ulong,_
                     _EM_SETLIMITTEXT as long,_
                     Limit as long,_
                     0 as long,_
                     SetTextLimit as long
end sub

sub click handle$
end sub
Re: Nth Day of Month
Post by tsh73 on Sep 5th, 2016, 07:48am

Hello Jack
your program have some issues
1) wikipedia says 2000 is leap year
Quote:
Every year that is exactly divisible by four is a leap year, except for years that are exactly divisible by 100, but these centurial years are leap years if they are exactly divisible by 400. For example, the years 1700, 1800, and 1900 are not leap years, but the years 1600 and 2000 are.[5]

Windows calendar agrees (your program says last Tue of February 2000 is 22nd, should be 29th).

2) Last parameter in combobox is "high".
LB help says
Quote:
wide & high

These parameters determine the width and height (in pixels) of the combobox. "Height" in this case refers to the length of the selection list when the combobox's button is clicked, not to the size of the initial selection window, which is dependant upon the size of the font.

so apparently 21 is too small - in LB list just don't drop down at all
(it looks like LBB ignores it, so it works?)

3) Also your program sets handle for comboboxes to be sub "click", but there no such sub in code.
So it makes LB to die silently after selecting from combobox (after any second select in my test)
You really might not care but adding
Code:
sub click handle$
end sub

fixes this.
Re: Nth Day of Month
Post by Richard Russell on Sep 5th, 2016, 08:47am

on Sep 5th, 2016, 07:48am, tsh73 wrote:
LB help says '"Height" in this case refers to the length of the selection list when the combobox's button is clicked'.

The LB Help is wrong - or at least very out-of-date. Before Common Controls version 6.0 (so called 'Windows XP Visual Styles') what it says was true, but since then the height parameter of a combobox has been ignored.

So as long as you are targeting your program to Windows XP or later, and Common Controls v6 are enabled by the program's manifest (which they are in LBB), it is not necessary to set the height parameter to the size of the drop-down box. The comboboxes in Jack's program work fine here in LB 4.04 and LB 4.5.0 (Windows 10).

But the Year 2000 bug is shocking, well spotted. wink

Richard.
Re: Nth Day of Month
Post by joker on Sep 5th, 2016, 09:47am

on Sep 5th, 2016, 08:47am, Richard Russell wrote:
... But the Year 2000 bug is shocking, well spotted. wink


Too funny, Richard! Wasn't that the year that we were all supposed to be slung off the Earth never to be heard from again? Perhaps I exaggerate a bit? cheesy
Re: Nth Day of Month
Post by Jack Kelly on Sep 5th, 2016, 11:37am

I have corrected the issues in the original post, code section. Sorry about the Y2K leap year error. Endless confusion is my normal state-of-mind. Thank you for your feedback. It's always appreciated!
Re: Nth Day of Month
Post by Richard Russell on Sep 5th, 2016, 12:02pm

on Sep 5th, 2016, 09:47am, pnlawrence wrote:
Wasn't that the year that we were all supposed to be slung off the Earth never to be heard from again?

In all seriousness this conditional test in Jack's program is surprising:

Code:
if yyyy mod 4 = 0 and yyyy<>2000 then

It was/is quite fortuitous that 2000 (being a multiple-of-400 year) fitted in with the simple leap-year rule because it meant that programs written carelessly, or with an expectation that they wouldn't still be in use by then, nevertheless worked correctly. But there's no accounting for somebody inserting a special test for 2000, when it wasn't special!

If the test had said year<>2100 it would have been correct, and we would have been congratulating Jack for his optimism!

Richard.