Support Forum / Форум поддержки

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

Code: Select all

graphics
fill color 0,0,0
s=1 ! ch$="0" ! min$="00" ! sec$="0" 
for i=0 to 9
sprite  i begin 20,20
draw text i at 0,0
sprite end
if i>0 then sprite 0 add i
next i
draw text "0"&ch$&":"&min$&":"&sec$  at 0,0
sprite 0 at 85,0
sprite 0 show
pause 1
sprite 0 delay 1
sprite 0 show
sprite 0 loop
loop:
if sprite_frame ("0")<>0 then kl=0
if s=6 then ! s=0 ! m$+=1 ! sec$=-1 ! if val(m$)<10 then min$="0"&m$ else min$=m$ ! endif
if val(m$)=60 then ! m$=0 ! min$="0"&m$ ! ch$+=1 !  endif
if kl=0 and SPRITE_FRAME ("0")=0 then ! fill rect 0,0 to 90,20 ! s+=1 ! sec$+=1 ! draw text "0"&ch$&":"&min$&":"&sec$  at 0,0 ! kl=1 ! endif
goto loop

Code: Select all

graphics
OPTION BASE 1
OPTION TEXT POS CENTRAL
OPTION IMAGE POS CENTRAL
fill color 0,0,0
rem Масштаб
maxx=screen_width()
maxy=screen_height()
if FILE_EXISTS ("..")=0 then papki$="." else papki$=".."
draw color .1,.1,.9
draw text "Ведётся поиск изображений..." at maxx/2,maxy/2+100
draw color 1,1,1
draw text "Просмотрено папок:" at maxx/2,maxy/2-180
draw text "Просмотрено файлов:" at maxx/2,maxy/2-100
draw text "Обнаружено изображений:" at maxx/2,maxy/2-20
if FILE_EXISTS ("System")=0 then dir "System" create
if FILE_EXISTS ("System/Папки")=0 then file "System/Папки" print
if FILE_EXISTS ("System/Картинки")=0 then file "System/Картинки" print
file "System/Картинки" trim 0
file "System/Папки" trim 0
file "System/Папки" print papki$
file "System/Папки" setpos 0
p=1
while file_end ("System/Папки")=0
file "System/Папки" readline papki$
dir papki$ list files c$,c
if c>0 then
          for ii=1 to c
          f+=1 ! f$=f ! fill rect maxx/2,maxy/2-60 size text_width(f$)/2,text_height(f$)/2 ! draw text f at maxx/2,maxy/2-60
          str$=papki$&"/"&c$(ii)
          if INSTR (STR$,".png")>-1 or INSTR (STR$,".jpg")>-1 or INSTR (STR$,".gif")>-1 then ! file "System/Картинки" print str$ ! n+=1 ! n$=n ! fill rect maxx/2,maxy/2+20 size text_width(n$)/2,text_height(n$)/2 ! draw text n at maxx/2,maxy/2+20 ! endif
           next ii
endif
dir papki$ list dirs b$,b
if b>0 then
for ii=1 to b
p+=1 ! p$=p ! fill rect maxx/2,maxy/2-140 size text_width(p$)/2,text_height(p$)/2 ! draw text p at maxx/2,maxy/2-140
file "System/Папки" print papki$&"/"&b$(ii)
next ii
endif
end while

if n=0 then !  graphics clear 0,0,0 ! draw color .9,.1,.1 ! draw text "В выбранной директории изображений не обнаружено" at maxx/2,maxy/2 ! end ! endif
dim images$(n)
for i=1 to n
file "System/Картинки" readline kar$
images$(i)=kar$
next i
sort images$
graphics clear 0,0,0
draw text "Обнаружено изображений: "&n$ at maxx/2,maxy/2-20
draw text "Просмотрено папок: "&p$ at maxx/2,maxy/2-100
draw text "Просмотрено файлов: "&f$ at maxx/2,maxy/2-60
draw color .1,.1,.9
draw text "Нажмите для начала просмотра" at maxx/2,maxy/2+100
draw color .5,.5,.5
lo:
get touch 0 as x,y
if x>-1 then 6
goto lo
6 nazh
sled

loop:
get touch 0 as x,y
if x>-1 and x<maxx/2 and k>1 then ! l=1 ! sled ! endif
if x>maxx/2 and k<n then ! l=0 ! sled ! endif
goto loop

def nazh
loop:
get touch 0 as x,y
if x=-1 then return
goto loop
end def

def sled
nazh
graphics clear .9,.9,.8
if .l=0 then .k+=1 else .k-=1
refresh off
draw image .images$(.k) at .maxx/2,.maxy/2
draw text .k at 50,30
.l=0
refresh on
end def

Code: Select all

graphics
graphics clear 1,0.9,0.9
draw color 0.6,0.4,0.5
w=SCREEN_HEIGHT ()
x=30
y=30


data "AcademyEngravedLetPlain","AmericanTypewriter","AmericanTypewriter-Bold","AmericanTypewriter-Condensed","AmericanTypewriter-CondensedBold","AmericanTypewriter-CondensedLight","AmericanTypewriter-Light","AppleColorEmoji","AppleSDGothicNeo-Bold","AppleSDGothicNeo-Medium","Arial-BoldItalicMT","Arial-BoldMT","Arial-ItalicMT","ArialHebrew","ArialHebrew-Bold","ArialMT","ArialRoundedMTBold","BanglaSangamMN","BanglaSangamMN-Bold","Baskerville","Baskerville-Bold","Baskerville-BoldItalic","Baskerville-Italic","Baskerville-SemiBold","Baskerville-SemiBoldItalic","BodoniOrnamentsITCTT","BodoniSvtyTwoITCTT-Bold","BodoniSvtyTwoITCTT-Book","BodoniSvtyTwoITCTT-BookIta","BodoniSvtyTwoOSITCTT-Bold","BodoniSvtyTwoOSITCTT-Book","BodoniSvtyTwoOSITCTT-BookIt","BodoniSvtyTwoSCITCTT-Book","BradleyHandITCTT-Bold","ChalkboardSE-Bold","ChalkboardSE-Light","ChalkboardSE-Regular","Chalkduster","Cochin","Cochin-Bold","Cochin-BoldItalic","Cochin-Italic","Copperplate","Copperplate-Bold","Copperplate-Light","Courier","Courier-Bold","Courier-BoldOblique","Courier-Oblique","CourierNewPS-BoldItalicMT","CourierNewPS-BoldMT","CourierNewPS-ItalicMT","CourierNewPSMT","DBLCDTempBlack","DevanagariSangamMN","DevanagariSangamMN-Bold","Didot","Didot-Bold","Didot-Italic","EuphemiaUCAS","EuphemiaUCAS-Bold","EuphemiaUCAS-Italic","Futura-CondensedExtraBold","Futura-CondensedMedium","Futura-Medium","Futura-MediumItalic","GeezaPro","GeezaPro-Bold","Georgia","Georgia-Bold","Georgia-BoldItalic","Georgia-Italic","GillSans","GillSans-Bold","GillSans-BoldItalic","GillSans-Italic","GillSans-Light","GillSans-LightItalic","GujaratiSangamMN","GujaratiSangamMN-Bold","GurmukhiMN","GurmukhiMN-Bold","Helvetica","Helvetica-Bold","Helvetica-BoldOblique","Helvetica-Light","Helvetica-LightOblique","Helvetica-Oblique","HelveticaNeue","HelveticaNeue-Bold","HelveticaNeue-BoldItalic","HelveticaNeue-CondensedBlack","HelveticaNeue-CondensedBold","HelveticaNeue-Italic","HelveticaNeue-Light","HelveticaNeue-LightItalic","HelveticaNeue-Medium","HelveticaNeue-UltraLight","HelveticaNeue-UltraLightItalic","HiraKakuProN-W3","HiraKakuProN-W6","HiraMinProN-W3","HiraMinProN-W6","HoeflerText-Black","HoeflerText-BlackItalic","HoeflerText-Italic","HoeflerText-Regular","Kailasa","Kailasa-Bold","KannadaSangamMN","KannadaSangamMN-Bold","MalayalamSangamMN","MalayalamSangamMN-Bold","Marion-Bold","Marion-Italic",",Marion-Regular","MarkerFelt-Thin","MarkerFelt-Wide","Noteworthy-Bold","Noteworthy-Light","Optima-Bold","Optima-BoldItalic","Optima-ExtraBlack","Optima-Italic","Optima-Regular","OriyaSangamMN","OriyaSangamMN-Bold","Palatino-Bold","Palatino-BoldItalic","Palatino-Italic","Palatino-Roman","Papyrus","Papyrus-Condensed","PartyLetPlain","STHeitiSC-Light","STHeitiSC-Medium","STHeitiTC-Light","STHeitiTC-Medium","SinhalaSangamMN","SinhalaSangamMN-Bold","SnellRoundhand","SnellRoundhand-Black","SnellRoundhand-Bold","TamilSangamMN","TamilSangamMN-Bold","TeluguSangamMN","TeluguSangamMN-Bold","Thonburi","Thonburi-Bold","TimesNewRomanPS-BoldItalicMT","TimesNewRomanPS-BoldMT","TimesNewRomanPS-ItalicMT","TimesNewRomanPSMT","Trebuchet-BoldItalic","TrebuchetMS",",TrebuchetMS-Bold","TrebuchetMS-Italic","Verdana","Verdana-Bold","Verdana-BoldItalic","Verdana-Italic","ZapfDingbatsITC","Zapfino"
draw text "колличество шрифтов= " & 163 at x,y
f=0
for i=1 to 163
f+=1
y+=20
read q$
DRAW FONT NAME q$

draw text f & "--" & q$ at x,y
if y>w-40 then  
do 
get touch 0 as a1,a2
until a1>30
a1=0
y=30
GRAPHICS CLEAR 1,0.9,0.9
endif
next i
a1=0
do 
get touch 0 as a1,a2
until a1>30
FIELD 1 SELECT
RUN "dop"

Code: Select all

input "номер шрифта":a
data "AcademyEngravedLetPlain","AmericanTypewriter","AmericanTypewriter-Bold","AmericanTypewriter-Condensed","AmericanTypewriter-CondensedBold","AmericanTypewriter-CondensedLight","AmericanTypewriter-Light","AppleColorEmoji","AppleSDGothicNeo-Bold","AppleSDGothicNeo-Medium","Arial-BoldItalicMT","Arial-BoldMT","Arial-ItalicMT","ArialHebrew","ArialHebrew-Bold","ArialMT","ArialRoundedMTBold","BanglaSangamMN","BanglaSangamMN-Bold","Baskerville","Baskerville-Bold","Baskerville-BoldItalic","Baskerville-Italic","Baskerville-SemiBold","Baskerville-SemiBoldItalic","BodoniOrnamentsITCTT","BodoniSvtyTwoITCTT-Bold","BodoniSvtyTwoITCTT-Book","BodoniSvtyTwoITCTT-BookIta","BodoniSvtyTwoOSITCTT-Bold","BodoniSvtyTwoOSITCTT-Book","BodoniSvtyTwoOSITCTT-BookIt","BodoniSvtyTwoSCITCTT-Book","BradleyHandITCTT-Bold","ChalkboardSE-Bold","ChalkboardSE-Light","ChalkboardSE-Regular","Chalkduster","Cochin","Cochin-Bold","Cochin-BoldItalic","Cochin-Italic","Copperplate","Copperplate-Bold","Copperplate-Light","Courier","Courier-Bold","Courier-BoldOblique","Courier-Oblique","CourierNewPS-BoldItalicMT","CourierNewPS-BoldMT","CourierNewPS-ItalicMT","CourierNewPSMT","DBLCDTempBlack","DevanagariSangamMN","DevanagariSangamMN-Bold","Didot","Didot-Bold","Didot-Italic","EuphemiaUCAS","EuphemiaUCAS-Bold","EuphemiaUCAS-Italic","Futura-CondensedExtraBold","Futura-CondensedMedium","Futura-Medium","Futura-MediumItalic","GeezaPro","GeezaPro-Bold","Georgia","Georgia-Bold","Georgia-BoldItalic","Georgia-Italic","GillSans","GillSans-Bold","GillSans-BoldItalic","GillSans-Italic","GillSans-Light","GillSans-LightItalic","GujaratiSangamMN","GujaratiSangamMN-Bold","GurmukhiMN","GurmukhiMN-Bold","Helvetica","Helvetica-Bold","Helvetica-BoldOblique","Helvetica-Light","Helvetica-LightOblique","Helvetica-Oblique","HelveticaNeue","HelveticaNeue-Bold","HelveticaNeue-BoldItalic","HelveticaNeue-CondensedBlack","HelveticaNeue-CondensedBold","HelveticaNeue-Italic","HelveticaNeue-Light","HelveticaNeue-LightItalic","HelveticaNeue-Medium","HelveticaNeue-UltraLight","HelveticaNeue-UltraLightItalic","HiraKakuProN-W3","HiraKakuProN-W6","HiraMinProN-W3","HiraMinProN-W6","HoeflerText-Black","HoeflerText-BlackItalic","HoeflerText-Italic","HoeflerText-Regular","Kailasa","Kailasa-Bold","KannadaSangamMN","KannadaSangamMN-Bold","MalayalamSangamMN","MalayalamSangamMN-Bold","Marion-Bold","Marion-Italic",",Marion-Regular","MarkerFelt-Thin","MarkerFelt-Wide","Noteworthy-Bold","Noteworthy-Light","Optima-Bold","Optima-BoldItalic","Optima-ExtraBlack","Optima-Italic","Optima-Regular","OriyaSangamMN","OriyaSangamMN-Bold","Palatino-Bold","Palatino-BoldItalic","Palatino-Italic","Palatino-Roman","Papyrus","Papyrus-Condensed","PartyLetPlain","STHeitiSC-Light","STHeitiSC-Medium","STHeitiTC-Light","STHeitiTC-Medium","SinhalaSangamMN","SinhalaSangamMN-Bold","SnellRoundhand","SnellRoundhand-Black","SnellRoundhand-Bold","TamilSangamMN","TamilSangamMN-Bold","TeluguSangamMN","TeluguSangamMN-Bold","Thonburi","Thonburi-Bold","TimesNewRomanPS-BoldItalicMT","TimesNewRomanPS-BoldMT","TimesNewRomanPS-ItalicMT","TimesNewRomanPSMT","Trebuchet-BoldItalic","TrebuchetMS",",TrebuchetMS-Bold","TrebuchetMS-Italic","Verdana","Verdana-Bold","Verdana-BoldItalic","Verdana-Italic","ZapfDingbatsITC","Zapfino"
draw text "колличество шрифтов= " & 163 at x,y
f=0
do
f+=1
y+=20
read q$
until f=a
print "DRAW FONT NAME " & q$