Nth Day of Month

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