Календарь

[Фант]

Несколько функций для расчётов Григорианского календаря.

Code: Select all

rem [b]Порядковый день в году[/b]
INPUT "Задайте год ":god$
INPUT "Задайте месяц ":mes$
INPUT "Задайте день ":day$
if god$ /400=floor(god$/400) OR (god$ /4=floor(god$/4) AND floor(god$/100)<>god$/100 ) THEN
 Nom$=floor(275*mes$/9)-floor((mes$+9)/12)+day$-30
 else
 Nom$=floor(275*mes$/9)-2*floor((mes$+9)/12)+day$-30
endif
print day$;"." ;mes$;"." ;god$  ;" Порядковый номер дня в году: ";nom$
end


REM [b]Определение количества дней в месяце[/b]
Option base 1
INPUT "Задайте год ":g
INPUT "Задайте месяц ":M
if M=2 and g /400=floor(g /400) OR (g /4=floor(g/4) AND floor(g/100)<>g/100 ) THEN f=29 else f=28
DATA 31,f,31,30,31,30,31,31,30,31,30,31
DIM day$(12)
FOR J=1 TO 12 ! READ day$(J) ! NEXT J
PRINT "Число дней в этом месяце = ";day$(M)
end

REM Определение дня недели
INPUT "Задайте год":g
INPUT "Задайте месяц":m
INPUT "Задайте день":d
a=floor((14-m)/12)
y = g- a
m = m+ 12 * a -2
f1=(7000 + (d + y + floor(y / 4)-floor( y / 100) + floor(y / 400) + floor(31 * m / 12)))
f2=7 ! f=floor(f1/f2)
x=f1-f*f2
PRINT " день недели = ";x
End

REM [b]Восстановление даты по порядковому дню года[/b]
INPUT "Задайте год : ":god$
INPUT "Задайте порядковый номер дня в году : ":nom$
if god$ /400=floor(god$/400) OR (god$ /4=floor(god$/4) AND floor(god$/100)<>god$/100 ) THEN A=1523 else A=1889
B=floor((val(nom$)+A-122.1)/365.25)
C=(val(nom$)+A-floor(365.25*B))
E=floor(C/30.6001)
IF E<13.5 THEN m=E-1 ELSE m=E-13'
D=C-floor(30.6001*E)
PRINT "Ему соответствует месяц = ";m;" и день = ";d

[Фант]

Вариант календаря на месяц

Code: Select all

graphics
graphics clear .9647,.9216,.8118
set buttons custom
draw color 0,0,0
fill color .9,.9,.5
button 41 title "Пн" at 155,195 size 100,35
button 42 title "Вт" at 260,195 size 100,35
button 43 title "Ср" at 365,195 size 100,35
button 44 title "Чт" at 470,195 size 100,35
button 45 title "Пт" at 575,195 size 100,35
fill color .9176,.651,.7137
button 46 title "Сб" at 680,195 size 100,35
button 47 title "Вс" at 785,195 size 100,35

g5=CURRENT_YEAR ()
m5=CURRENT_MONTH () ! d5=1
5 if m5=1 then v3$="ЯНВАРЬ" ! if m5=2 then v3$="ФЕВРАЛЬ"
if m5=3 then v3$="МАРТ" ! if m5=4 then v3$="АПРЕЛЬ"
if m5=5 then v3$="МАЙ" ! if m5=6 then v3$="ИЮНЬ"
if m5=7 then v3$="ИЮЛЬ" ! if m5=8 then v3$="АВГУСТ"
if m5=9 then v3$="СЕНТЯБРЬ" ! if m5=10 then v3$="ОКТЯБРЬ"
if m5=11 then v3$="НОЯБРЬ" ! if m5=12 then v3$="ДЕКАБРЬ"
if g5=CURRENT_YEAR () then fill color .8824,.8118,.6314
button 36 title g5 at 365,90 size 310,35
if g5=CURRENT_YEAR () then fill color .9647,.9216,.8118
if m5=CURRENT_MONTH () and g5=CURRENT_YEAR ()  then fill color .8824,.8118,.6314
button 37 title v3$ at 365,135 size 310,35
if m5=CURRENT_MONTH () and g5=CURRENT_YEAR () then fill color .9647,.9216,.8118
t5=floor((14-m5)/12)
y5 = g5- t5
m7 = m5+ 12 * t5 -2
j=(7000 + (d5+ y5 + floor(y5 / 4)-floor( y5 / 100) + floor(y5 / 400) + floor(31 * m7 / 12)))%7
x5=0 
option base 1
Dim e1(6,7)
if m5=1 or m5=3 or m5=5 or m5=7 or m5 =8 or m5=10 or m5=12 then
if j=0 then e1(1,1)=26 ! if j=1 then e1(1,1)=1 ! if j=2 then e1(1,1)=31 ! if j=3 then e1(1,1)=30 ! if j=4 then e1(1,1)=29 ! if j=5 then e1(1,1)=28 ! if j=6 then e1(1,1)=27 ! m6=31
endif
if m5=4 or m5=6 or m5=9 or m5=11 then
if j=0 then e1(1,1)=25 ! if j=1 then e1(1,1)=1 ! if j=2 then e1(1,1)=30 ! if j=3 then e1(1,1)=29 ! if j=4 then e1(1,1)=28 ! if j=5 then e1(1,1)=27 ! if j=6 then e1(1,1)=26 ! m6=30
endif
if m5=2 then
if g5 /400=floor(g5 /400) OR (g5 /4=floor(g5/4) AND floor(g5/100)<>g5/100 ) THEN 
if j=0 then e1(1,1)=24 ! if j=1 then e1(1,1)=1 ! if j=2 then e1(1,1)=29 ! if j=3 then e1(1,1)=28 ! if j=4 then e1(1,1)=27 ! if j=5 then e1(1,1)=26 ! if j=6 then e1(1,1)=25 ! m6=29
else
if j=0 then e1(1,1)=23 ! if j=1 then e1(1,1)=1 ! if j=2 then e1(1,1)=28 ! if j=3 then e1(1,1)=27 ! if j=4 then e1(1,1)=26 ! if j=5 then e1(1,1)=25 ! if j=6 then e1(1,1)=24 ! m6=28
endif
endif
For k4=1 to 6
For m4=1 to 7
if k4=1 and e1(k4,m4)>m6 then ! e1(k4,m4)=e1(k4,m4)-m6 ! endif
If k4=1 and m4=1 then 7
If m4=1 and k4>1 then e1(k4,m4)=e1(k4-1,7)+1 else e1(k4,m4)=e1(k4,m4-1)+1
if e1(k4,m4)>m6 then e1(k4,m4)=e1(k4,m4)-m6
7 if abs(((k4-1)*7+m4)-e1(k4,m4))>7 then 10
x5=x5+1
if x5=CURRENT_DAte () and g5=CURRENT_YEAR () and m5=CURRENT_MONTH () then fill color .8824,.8118,.6314
button (x5) title (e1(k4,m4)) at 50+105*m4, 160+75*k4 size 100,70
if x5=CURRENT_DAte () and g5=CURRENT_YEAR () and m5=CURRENT_MONTH ()  then fill color .9647,.9216,.8118
10 next m4
Next k4
loop:
get touch 0 as x,y
fill color .8784,.902,.9608
if button_pressed ("37") then 
button 32 title "<" at 155,135 size 100,35
button 33 title ">" at 785,135 size 100,35
endif
if button_pressed ("36") then 
button 34 title "<" at 155,90 size 100,35
button 35 title ">" at 785,90 size 100,35
endif
fill color .9647,.9216,.8118
if m5>0 and m5<12 and button_pressed ("33") then 15
if m5>1 and m5<13 and button_pressed ("32") then 20
if button_pressed ("35") then 23
if button_pressed ("34") then 25
goto loop
15 m5=m5+1
for i=0 to 2
t=x5-i
button (t) delete
next i
goto 5
20 m5=m5-1
for i=0 to 2
t=x5-i
button (t) delete
next i
goto 5
23 g5=g5+1
goto 5
25 g5=g5-1
goto 5

[Mr. Kibernetik]

Интересно. Сделано на кнопках... Хотя там ведь реально кнопочных функций всего листание года и месяца?

В команде BUTTON (T) DELETE необязательно ставить скобки, даже если бы вместо Т стояло выражение.

[Фант]

Да в данном случае кнопки меняют только год и месяц. Я взял этот кусок из своей большой программы-органайзер. Там у меня с помощью кнопок-дней вводиться конкретная дата. А здесь просто для образца может кому-то пригодится-кнопки переделывать на спрайт текст не стал. Ну и что очень не маловажно для меня-просто мне очень нравятся кнопки . Форма закруглённая по углам-супер