' Calendar popup.bas
'   by ShirleyMSmith
 
'   modified by cassiope01
'
'   Released as Public Domain
'
    nomainwin
 
    Mois$ = "Janvier Février Mars Avril Mai Juin Juillet Août Septembre Octobre Novembre Décembre"
   ' Mois$ = "January February March April May June July August September October November December"
    aDay$ = Date$("mm/dd/yyyy")
    YearLimitDown = 1904
    nYearLimitUp = 180
    dim nDay(42)
    dim mon$(12)
    dim year$(nYearLimitUp)
    for m = 1 to 12 :mon$(m) = word$(Mois$,m) :next  'list for months
    for y = 1 to nYearLimitUp :year$(y) = str$(YearLimitDown+y) :next  'list for years
    Xref = 29
    Yref = 16
      ' make a small calendar
    WindowWidth = 238
    WindowHeight = 210
    UpperLeftX = 70: UpperLeftY = 70
    Graphicbox #cal.g, 7, 7, 219, 170
    combobox #cal.month, mon$(), [MonthYear], 38, 15, 96, 20
    combobox #cal.year, year$(), [MonthYear], 130, 15, 60, 20
    Open "Calendrier" for Dialog_modal as #cal
    #cal, "trapclose [quit]"
    #cal.g, "down"
    #cal.g, "backcolor white"
    #cal.g, "rule xor"
    #cal.month "font courier_new bold 10"
    #cal.year "font courier_new bold 10"
    #cal.g "backcolor white"
    #cal.g "font courier_new bold 10"'; cls"
    #cal.g "Place 10 20"
    #cal.g "\<<                    >>"
    #cal.g "Place 15 161"
   ' #cal.g "\   Today: ";aDay$
    #cal.g "\Aujourd'hui: ";word$(aDay$,2,"/");"/";word$(aDay$,1,"/");"/";word$(aDay$,3,"/")
    #cal.g "font ms_sans_serif bold 9"
    #cal.g "Place 7 47"
   ' #cal.g "\Mon  Tue  Wed Thu  Fri   Sat  Sun"
    #cal.g "\Lun  Mar  Mer  Jeu  Ven  Sam  Dim"
    #cal.g "font ms_sans_serif bold 10"
 
[CalendarRePrint]
 
    firstDay = Date$(Left$(aDay$,3);1;Right$(aDay$,5))
    lastDay$ = Date$(Date$(Left$(Date$(firstDay+31),3);1;Right$(Date$(firstDay+31),5))-1)
    dow = (firstDay+1) Mod 7 + 1
    If dow < 1 Then dow= (dow+13) Mod 7 + 1
    MonthName$ = Word$(Mois$,Val(Word$(lastDay$,1,"/")))
    Yr$        = Right$(lastDay$,4)
    #cal.month, "select ";MonthName$
    #cal.year, "select ";Yr$
    #cal.g "setfocus"
    ldow = dow :d = 0 :da = 0 :dd = 0
    for nd = 1 to 42
        lig = int(nd/7)
        col = nd - (lig*7)
        if nd mod 7 = 0 then col = 7 :lig = lig - 1  'case of must col = 7
        select case
        case ldow-1 > 0
            d = d + 1
            i = val(Mid$(date$(firstDay - d),4,2))
            ldow = ldow - 1
            nDay(nd) = i - ldow + d
            #cal.g "color lightgray"
 
        case dd < Val(Mid$(lastDay$,4,2))
            dd = dd + 1
            nDay(nd) = dd
            #cal.g "color black"
            if dd = val(word$(aDay$,2,"/")) then  'the day of aDay$
                rcx1 = col
                rcy1 = 4 + lig
            end if
 
        case else
            da = da + 1
            nDay(nd) = da
            #cal.g "color lightgray"
 
        end select
        #cal.g "place ";(col-1)*Xref+6;" ";1+(4+lig)*Yref
        #cal.g "\";Space$(7)
        #cal.g "place ";(col-1)*Xref+12;" ";1+(4+lig)*Yref
        #cal.g "\"; Using("##",nDay(nd))
    next
    #cal.g "color black"
    #cal.g "Place ";(rcx1-1)*Xref+6;" ";(rcy1-1)*Yref+4    ' show specific date w/box around date
    #cal.g "box ";rcx1*Xref+6;" ";rcy1*Yref+4
    #cal.g "flush calg"
    #cal.g "When leftButtonDown [calgButtonSingle]"
    #cal.g "When leftButtonDouble [calgButtonDouble]"
    double=0
    Wait
 
[calgButtonSingle]
    double=0
    Goto [calgButton]
    Wait
 
[calgButtonDouble]
    double=1
    Goto [calgButton]
    Wait
 
[MonthYear]
    #cal.month "contents? MonthName$"
    #cal.year "contents? Yr$"
    #cal.month "selectionindex? mo"
    aDay$ = right$(str$(100+mo),2);"/";word$(aDay$,2,"/");"/";Yr$
    goto [CalendarRePrint]
wait
 
[calgButton]
 ' rcy
  ' |   1  2  3  4  5  6  7   <-- rcx
  ' | +--+--+--+--+--+--+--+
  ' 1 |                    |
  '   + << month   year >> +
  ' 2 |                    |
  '   +--+--+--+--+--+--+--+
  ' 3 | L M  M  J  V  S  D |
  '   +--+--+--+--+--+--+--+
  ' 4 |  |  |  |  |  |  |  |         Xref = 29,  Yref = 16  ---> dim. of a cell
  '   +--+--+--+--+--+--+--+
  ' 5 |  |  |  |  |  |  |  |         so we have height = 10 x 16   ->  rcy x Yref
  '   +--+--+--+--+--+--+--+                    width =  7 x 29    ->  rcx x Xref
  ' 6 |  |  |  |  |  |  |  |
  '   +--+--+--+--+--+--+--+    so we can calculate rcx,rcy with MouseX,MouseY
  ' 7 |  |  |  |  |  |  |  |
  '   +--+--+--+--+--+--+--+
  ' 8 |  |  |  |  |  |  |  |
  '   +--+--+--+--+--+--+--+    so we have 7x6 = 42 cells for days of month
  ' 9 |  |  |  |  |  |  |  |
  '   +--+--+--+--+--+--+--+
  '10 |    T o d a y       |
  '   +--+--+--+--+--+--+--+
 
    rcx = int((MouseX-6)/Xref)+1     ' check mouse positions
    rcy = int((MouseY-4)/Yref)+1
    dom$ = Mid$(aDay$,4,2)
    numD = date$(aDay$)
    firstDay = Date$(Left$(aDay$,3);1;Right$(aDay$,5))
    lastDay = Date$(Left$(Date$(firstDay+31),3);1;Right$(Date$(firstDay+31),5))-1
    select case
    case rcy < 3 and rcx = 1 and numD > date$("01/31/";YearLimitDown + 1)
        aDate$=Date$(firstDay-1)
        lastdom$=Mid$(aDate$,4,2)
        If Val(dom$) > Val(lastdom$) Then dom$=lastdom$
        aDay$=Left$(aDate$,2);"/";dom$;Mid$(aDate$,6)
 
    case rcy < 3 and rcx = 7 and numD < date$("12/01/";YearLimitDown + nYearLimitUp)
        aDate$=Date$(lastDay+1)
        nxmo$=Date$(Date$(aDate$)+31)
        lastdom$=Date$(Date$(Left$(nxmo$,3);1;Right$(nxmo$,5))-1)
        lastdom$=Mid$(lastdom$,4,2)
        If Val(dom$) > Val(lastdom$) Then dom$ = lastdom$
        aDay$=Left$(aDate$,2);"/";dom$;Mid$(aDate$,6)
 
    case rcy > 3 and rcy < 10
        if rcy = 4 then i = rcx - dow + 1 else i = 8 - dow + ((rcy-5) * 7) + rcx
        dat$ = word$(aDay$,1,"/");"/";right$(str$(100+i),2);"/";word$(aDay$,3,"/")
        if date$(dat$) then
            #cal.g, "Place ";(rcx1-1)*Xref+6;" ";(rcy1-1)*Yref+4    ' hide last specific date w/box around date
            #cal.g, "box ";rcx1*Xref+6;" ";rcy1*Yref+4
            #cal.g, "Place ";(rcx-1)*Xref+6;" ";(rcy-1)*Yref+4    ' show specific date w/box around date
            #cal.g, "box ";rcx*Xref+6;" ";rcy*Yref+4
            aDay$ = dat$
            rcx1 = rcx
            rcy1 = rcy
            if double = 1 then Notice "Date selected is "+aDay$
        else
            select case
            case rcy = 4
                 dat$ = date$(firstDay - 1)  'change month (-1)
            case rcy > 7
                 dat$ = date$(lastDay + 1)  'change month (+1)
            end select
            n = nDay(7*(rcy-4)+rcx)
            aDay$ = word$(dat$,1,"/");"/";right$(str$(100+n),2);"/";word$(dat$,3,"/")
        end if
 
    case rcy = 10
        aDay$ = Date$("mm/dd/yyyy")   ' reprint calendar for 'today'
 
    end select
    double = 0
    Goto [CalendarRePrint]
Wait
 
[quit]
    Close #cal
End