Sver
Full Member
Posts: 145
|
Post by Sver on Sept 20, 2020 3:48:05 GMT -5
' 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 "Calender" 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
'volgende record
[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
|
|
|
|
Post by alincon on Sept 20, 2020 10:18:06 GMT -5
[CalendarRePrint] - duplicate label in your calendar program
r.m.
|
|
Sver
Full Member
Posts: 145
|
Post by Sver on Sept 20, 2020 10:33:15 GMT -5
Alincon,
' 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 "Calender" 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
print aDay$
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
|
|
