Code: Select all
const SCRW = 800
const SCRH = 500
const WINX = 50
const WINY = 10
screenres SCRW,SCRH,32
color rgb(0,0,0),rgb(255,255,255):cls
dim shared as integer mx,my,mb
DIM shared v (6,7) AS STRING 'calendar month layout
dim shared as integer m,y 'month and year
dim shared as integer selectedTab
type TAB_LABEL
as integer x,y,w,h,s
as string title
end type
dim shared as TAB_LABEL tabs(0 to 11)
type BUTTON
as integer x,y,w,h
as string t
end type
dim shared as BUTTON btn1,btn2
btn1.x = 12*8
btn1.y = 40
btn1.w = 8*4
btn1.h = 16
btn1.t = " <- "
btn2.x = 23*8
btn2.y = 40
btn2.w = 8*4
btn2.h = 16
btn2.t = " -> "
sub initialize()
dim as integer position
for i as integer = 0 to 11
tabs(i).x = position
tabs(i).y = 0
tabs(i).s = 0
read tabs(i).title
tabs(i).h = 16
tabs(i).w = len(tabs(i).title)*8+8
position = position + tabs(i).w + 1
next i
tabs(0).s = 1
end sub
tabTitles:
data "JAN","FEB","MAR","APR","MAY","JUN","JUL","AUG","SEP","OCT","NOV","DEC"
sub drawTabs()
line (WINX,WINY+16)-(SCRW-WINX,SCRH-WINY),rgb(0,0,0),b
for i as integer = 0 to 11
line (tabs(i).x + WINX,tabs(i).y+ WINY)-(tabs(i).x + WINX+tabs(i).w,tabs(i).y+ WINY+tabs(i).h),rgb(0,0,0),b
if selectedTab = i then
line (tabs(i).x + WINX+1,tabs(i).y+ WINY+1)-(tabs(i).x + WINX+tabs(i).w-1,tabs(i).y+ WINY+tabs(i).h),rgb(255,255,255),bf
else
line (tabs(i).x + WINX+1,tabs(i).y+ WINY+1)-(tabs(i).x + WINX+tabs(i).w-1,tabs(i).y+ WINY+tabs(i).h-1),rgb(200,200,200),bf
end if
draw string (tabs(i).x + WINX+4,tabs(i).y+ WINY+4),tabs(i).title,rgb(0,0,0)
pset (tabs(i).x + WINX+tabs(i).w,tabs(i).y+ WINY),rgb(255,255,255)
pset (tabs(i).x + WINX+tabs(i).w-1,tabs(i).y+ WINY),rgb(0,0,0)
pset (tabs(i).x + WINX+tabs(i).w-2,tabs(i).y+ WINY),rgb(0,0,0)
pset (tabs(i).x + WINX+tabs(i).w,tabs(i).y+ WINY+1),rgb(0,0,0)
pset (tabs(i).x + WINX,tabs(i).y+ WINY),rgb(255,255,255)
pset (tabs(i).x + WINX+1,tabs(i).y+ WINY),rgb(0,0,0)
pset (tabs(i).x + WINX+2,tabs(i).y+ WINY),rgb(0,0,0)
pset (tabs(i).x + WINX,tabs(i).y+ WINY+1),rgb(0,0,0)
next i
'draw buttons
line (btn1.x+WINX,btn1.y+WINY)-(btn1.x+btn1.w+WINX,btn1.y+btn1.h+WINY),rgb(0,0,0),b
draw string (btn1.x+2+WINX,btn1.y+4+WINY),btn1.t
line (btn2.x+WINX,btn2.y+WINY)-(btn2.x+btn2.w+WINX,btn2.y+btn2.h+WINY),rgb(0,0,0),b
draw string (btn2.x+2+WINX,btn2.y+4+WINY),btn2.t
end sub
sub drawPage()
Select Case As Const selectedTab
Case 0
draw string (WINX+10,SCRH+WINY-32),"January brings the snow, Makes our feet and fingers glow."
Case 1
draw string (WINX+10,SCRH+WINY-32),"February brings the rain, Thaws the frozen lake again."
Case 2
draw string (WINX+10,SCRH+WINY-32),"March brings breezes loud and shrill, Stirs the golden daffodil."
Case 3
draw string (WINX+10,SCRH+WINY-32),"April brings the primrose sweet, Scatters daisies at our feet."
Case 4
draw string (WINX+10,SCRH+WINY-32),"May brings flocks of pretty lambs, Skipping by their fleecy dams."
Case 5
draw string (WINX+10,SCRH+WINY-32),"June brings tulips, lillies, roses, Fills the children's hands with posies."
Case 6
draw string (WINX+10,SCRH+WINY-32),"Hot July brings cooling showers, Apricots and gillyflowers."
Case 7
draw string (WINX+10,SCRH+WINY-32),"August brings the sheaves of corn, Then the harvest home is borne."
Case 8
draw string (WINX+10,SCRH+WINY-32),"Warm September brings the fruit, Sportsmen then begin to shoot."
Case 9
draw string (WINX+10,SCRH+WINY-32),"Fresh October brings the pheasant, Then to gather nuts is pleasant."
Case 10
draw string (WINX+10,SCRH+WINY-32),"Dull November brings the blast, Then the leaves are falling past."
Case Else
draw string (WINX+10,SCRH+WINY-32),"Chill December brings the sleet, Blazing fire and Christmas treat."
End Select
end sub
sub showCalendarMonth()
draw string (WINX+16*8+12,WINY+46), str( y )
draw string (WINX+64,WINY+72), "Mo Tu We Th Fr Sa Su"
FOR j as integer = 1 TO 6
FOR k as integer = 1 TO 7
draw string (WINX + (k-1) * 32 + 64,(j-1)*32+WINY+96), v(j, k)
NEXT k
PRINT
NEXT j
end sub
sub upDate()
screenlock
cls
drawTabs()
drawPage()
showCalendarMonth()
screenunlock()
end sub
sub makeCalendarMonth(y as integer, m as integer)
DIM AS INTEGER a,c,d,dm,ds,f, Z
DIM as string u(49)
d = 1
IF m = 2 THEN dm = 28
If m = 2 And (y Mod 400 = 0) And (y Mod 4 = 0) or (y Mod 100 <> 0) And (y Mod 4 = 0) Then dm = 29
IF m = 1 OR m = 3 OR m = 5 OR m = 7 OR m = 8 OR m = 10 OR m = 12 THEN dm = 31
IF m = 4 OR m = 6 OR m = 9 OR m = 11 THEN dm = 30
a = INT((14 - m) / 12)
y = y - a
m = m + (12 * a) - 2
ds =((d + y + INT(y / 4) - INT(y / 100) + INT(y / 400) + INT((31 * m) / 12)) MOD 7)
IF ds = 0 THEN ds = ds +7
IF ds > 0 THEN ds = ds -1
FOR n as integer = 1 TO 49
u(n) = " "
NEXT n
FOR n as integer = 1 TO dm
f = LEN(LTRIM(STR(n)))
IF f =1 THEN
u(n+ds) = " " + LTRIM(STR(n))
ELSE
u(n+ds) = LTRIM(STR(n))
END IF
NEXT n
c = 1
FOR j as integer = 1 TO 6
FOR k as integer = 1 TO 7
v(j,k) = MID(u(c),1,3)
c = c + 1
NEXT k
NEXT j
end sub
initialize()
y = 2017
do
getmouse mx,my,,mb
if mb=1 then
'is it over tab
for i as integer = 0 to 11
if mx>tabs(i).x+WINX and mx<tabs(i).x + tabs(i).w + WINX and _
my>tabs(i).y+WINY and my<tabs(i).y + tabs(i).h + WINY then
selectedTab = i
end if
next i
'is it over button
if mx>btn1.x+WINX and mx<btn1.x + btn1.w + WINX and _
my>btn1.y+WINY and my<btn1.y + btn1.h + WINY then
y = y - 1
end if
if mx>btn2.x+WINX and mx<btn2.x + btn2.w + WINX and _
my>btn2.y+WINY and my<btn2.y + btn2.h + WINY then
y = y + 1
end if
end if
m = selectedTab+1
makeCalendarMonth(y,m)
showCalendarMonth()
upDate()
while mb=1:getmouse mx,my,,mb:wend
sleep 2
loop until multikey(&H01)