Mac
Professional Member
Joined: 08 Jul 2000
Posts: 1585
Location: Oklahoma USA
|
 Posted: Tue Nov 19, 2002 11:17 am Post subject: Perpetual Calendar... |
 |
|
This is an old one, so the code could prolly be optimized.
I adjusted it to allow for tooltips in VDS4 (hopefully...).
You can seek to any 4 digit year (0001 or greater)
and month with the small button beneath the arrows.
__________________________________________________________________________________________________________________________
| Code: |
rem -- VDS3 and VDS4 compatible --
OPTION SCALE, 96
OPTION DECIMALSEP, "."
TITLE By Mac
DIALOG CREATE, Perpetual Calendar,-1,-1,212,227,ONTOP
DIALOG ADD,STYLE,BoldText,MS Sans Serif,9,B
DIALOG ADD,STYLE,BoldText2,MS Sans Serif,10,B
DIALOG ADD,STYLE,TodayText,MS Sans Serif,10,B,,LTBLUE
DIALOG ADD,STYLE,Black,,,,BLACK
DIALOG ADD,BUTTON,Left,0,1,22,14,"<",,BoldText2
DIALOG ADD,BUTTON,Right,0,24,22,14,">",,BoldText2
DIALOG ADD,BUTTON,Input,14,1,45,9," "
DIALOG ADD,Text,Monthlabel,5,70,,,@datetime(mmmm),,BoldText
DIALOG ADD,Text,Yearlabel,5,170,,,@datetime(yyyy),,BoldText
DIALOG ADD,Text,Daylabel1,30,10,,,"S",,BoldText
DIALOG ADD,Text,Daylabel2,30,40,,,"M",,BoldText
DIALOG ADD,Text,Daylabel3,30,70,,,"T",,BoldText
DIALOG ADD,Text,Daylabel4,30,99,,,"W",,BoldText
DIALOG ADD,Text,Daylabel5,30,130,,,"T",,BoldText
DIALOG ADD,Text,Daylabel6,30,160,,,"F",,BoldText
DIALOG ADD,Text,Daylabel7,30,190,,,"S",,BoldText
rem -- Vertical lines --
DIALOG ADD,TEXT,VertLineLeft,25,0,2,200,"",,Black
DIALOG ADD,TEXT,VertLineRight,25,210,2,200,"",,Black
%x = 30
REPEAT
DIALOG ADD,TEXT,VertLine%x,45,%x,2,180,"",,Black
%x = @sum(%x,30)
UNTIL @greater(%x, 180)
rem -- Horizontal lines --
DIALOG ADD,TEXT,HorzLineTop,24,0,212,2,"",,Black
%y = 45
REPEAT
DIALOG ADD,TEXT,HorzLine%y,%y,0,212,2,"",,Black
%y = @sum(%y,30)
UNTIL @greater(%y, 240)
%p = 1
%x = 8
%y = 53
%z = LoadNumbers
:LoadNumbers
REPEAT
DIALOG ADD,Text,Today%p,%y,%x,,," ",,TRANSPARENT,TodayText
DIALOG ADD,Text,Place%p,%y,%x,,,"",,TRANSPARENT,BoldText2
%x = @sum(%x, 30)
%p = @succ(%p)
UNTIL @greater(%x, 210)
%x = 8
%y = @sum(%y, 30)
if @greater(%y, 220)
%z = LoadNumbersEND
end
goto %z
:LoadNumbersEND
DIALOG SHOW
OPTION FIELDSEP, ","
rem -- Month Names --
LIST CREATE, 1
LIST LOADTEXT, 1,
"0
"January
"February
"March
"April
"May
"June
"July
"August
"September
"October
"November
"December
rem -- Max days in months (must allow for leap year) --
LIST CREATE, 2
LIST LOADTEXT, 2,
"0
"31
"28
"31
"30
"31
"30
"31
"31
"30
"31
"30
"31
%%month = @datetime(m)
%%day = @datetime(d)
%%year = @datetime(yyyy)
%%weekday = 0
GOSUB Draw
:EVLOOP
DIALOG FOCUS, Input
WAIT EVENT
goto @event()
:RightBUTTON
%%month = @succ(%%month)
if @greater(%%month, 12)
%%month = 1
%%year = @succ(%%year)
end
GOSUB Draw
goto EVLOOP
:LeftBUTTON
%%month = @pred(%%month)
if @greater(1,%%month)
%%month = 12
%%year = @pred(%%year)
end
GOSUB Draw
goto EVLOOP
:InputBUTTON
%i = @input("Year or year,month such as 1950 or 1950, January")
if %i
PARSE "%a;%b", %i
if @equal(@len(%a),4)
if @numeric(%a)
if @greater(%a, 0)
if %b
LIST SEEK, 1, 1
if @match(1, %b)
%%month = @index(1)
%%year = %a
GOSUB Draw
else
INFO You must enter the full name of the month.@tab()
end
else
%%year = %a
GOSUB Draw
end
else
INFO You must enter a 4 digit year@tab()@cr()greater than zero.
end
else
INFO You must enter a 4 digit year@tab()@cr()greater than zero.
end
else
INFO You must enter a 4 digit year@tab()@cr()greater than zero.
end
end
goto EVLOOP
:CLOSE
EXIT
STOP
rem -- GOSUB ROUTNES ------------
:Draw
DIALOG SET, Monthlabel, @item(1, %%month)
DIALOG SET, Yearlabel, %%year
%%numdays = @item(2, %%month)
GOSUB GetWeekDay
rem -- Empty calendar --
%x = 1
REPEAT
DIALOG SET, Place%x, ""
DIALOG SET, Today%x, ""
%x = @succ(%x)
UNTIL @greater(%x, 42)
%x = 1
REPEAT
%p = @sum(%x, %%weekday)
DIALOG SET, Place%p, %x
DIALOG SET, Today%p, %x
if @equal(%%month, @datetime(mm))
if @equal(%%year, @datetime(yyyy))
if @equal(%x, @datetime(d))
DIALOG SET, Place%p, ""
end
end
end
%x = @succ(%x)
UNTIL @greater(%x, %%numdays)
if @greater(%p, 35)
WINDOW POSITION, "Perpetual Calendar",,,218,252
else
WINDOW POSITION, "Perpetual Calendar",,,218,222
end
exit
:GetWeekDay
%y = %%year
%m = %%month
%d = 1
if @greater(3, %m)
%m = @sum(%m, 10)
%y = @pred(%y)
else
%m = @diff(%m, 2)
end
%%century = @div(%y, 100)
%y = @mod(%y, 100)
%a = @prod(26, %m)
%a = @diff(%a, 2)
%a = @div(%a, 10)
%a = @sum(%a, %d, %y, @div(%y, 4), @diff(@div(%%century, 4), @prod(2, %%century)))
%%dw = @mod(%a, 7)
if @greater(0, %%dw)
%%weekday = @fadd(%%dw, 7)
else
%%weekday = %%dw
end
exit
|
Cheers, Mac
_________________
VDSug.dll does file IO, check/disable menu items,
non-VDS dlls, draw functions and more...
Free download (30k dll size) at:
http://www.vdsworld.com/download.php?id=361
 |
|
FAQ
Search
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
@vdsworld