$INCLUDE "RAPIDQ.INC"
$ESCAPECHARS ON
CONST AW_CENTER = &H10
CONST AW_HIDE = &H10000
CONST HWND_TOPMOST = -1
CONST HWND_NOTOPMOST = -2
CONST SWP_NOSIZE = &H1
CONST SWP_NOMOVE = &H2
CONST SWP_NOACTIVATE = &H10
CONST SWP_SHOWWINDOW = &H40
DECLARE SUB SetWindowPos LIB "User32" ALIAS "SetWindowPos"(hWnd AS LONG,hWndInsertAfter AS LONG,X AS LONG,Y AS LONG,cx AS LONG,cy AS LONG,wFlags AS LONG)
DECLARE FUNCTION Setfocus LIB "user32" ALIAS "SetFocus"(hwnd AS LONG) AS LONG
DECLARE FUNCTION AnimateWindow LIB "user32" ALIAS "AnimateWindow"(BYVAL hwnd AS LONG, BYVAL dwTime AS LONG, BYVAL dwFlags AS LONG) AS INTEGER
DECLARE SUB Animate(Handle AS INTEGER)
DECLARE SUB Deanimate(Handle AS INTEGER)
DECLARE SUB CloseCalendar
DECLARE SUB CloseNoteProductForm
DECLARE SUB ShowNotes
DECLARE SUB NotesShow
DECLARE SUB EMailMe
DECLARE SUB SendMe
DECLARE SUB New_Date
DECLARE SUB DaysDifference
DECLARE FUNCTION GetAOdays AS INTEGER
DECLARE FUNCTION GetOdays AS INTEGER
DECLARE SUB DayTodayLt
DECLARE SUB Initialize
DECLARE SUB OnTop
DECLARE SUB Time
DECLARE SUB Nights
DECLARE SUB Noisemaker
DECLARE SUB Calendar
DECLARE SUB PopMonths
DECLARE SUB MonthChanged(Sender AS QMENUITEM)
DECLARE SUB YearChanged
DECLARE SUB DayChanged(Sender AS QCOOLBTN)
DECLARE SUB LoopColor
DECLARE SUB UpdownYear(Sender AS QCOOLBTN)
DECLARE SUB Blink
DECLARE SUB CalendarColor
DECLARE SUB ButtonColor
DECLARE SUB Today
DECLARE SUB Minimize
DECLARE SUB ImageFiles
DEFWORD monthnow, monththen, monthchecked, yearnow, yearthen, betyears
DEFBYTE ccolorcount, buttcolor, blinking,always,soundoff,juston,colorcount,countyrsmos,leapnow, leapthen, bleap, circa, weekday, fmonth, emonth, pmonth, todate
DEFINT totyears, totmonths, byear, bmonth, bleapyear, yearhence, AOyears, fyear, eyear, pyear
DEFINT Bdays, rundays, edays, otherdays, totdays, yeardays,Odays, AOdays, diffdays, betleaps, daynow, daythen, Adays
DEFINT lastColor, fday, eday, pday, neweday, newpday, monthdays, daysthence, dayshence, bday, days
DEFSTR PreWeeksPanel$, wday$, month$, thedate$, inifile, iDir, image0, image1, image2, image3, image4, image5
CREATE Arial8B AS QFONT
Name = "Arial"
Size = 8
AddStyles(fsBold)
END CREATE
CREATE Arial10B AS QFONT
Name = "Arial"
Size = 10
AddStyles(fsBold)
END CREATE
CREATE Arial9B AS QFONT
Name = "Arial"
Size = 12
AddStyles(fsBold)
END CREATE
CREATE ArialY10 AS QFONT
Name = "Arial"
Size = 10
COLOR = &HFFFFF
AddStyles = fsBold
END CREATE
CREATE ArialP10 AS QFONT
Name = "Arial"
Size = 10
COLOR = clPurple
AddStyles = fsBold
END CREATE
CREATE ArialB10 AS QFONT
Name = "Arial"
Size = 10
COLOR = clBlue
AddStyles = fsBold
END CREATE
CREATE ArialG10 AS QFONT
Name = "Arial"
Size = 10
COLOR = clGreen
AddStyles = fsBold
END CREATE
CREATE Timer1 AS QTIMER
Enabled = 1
Interval = 1000
OnTimer = Time
END CREATE
CREATE Timer2 AS QTIMER
Enabled = 0
Interval = 1
OnTimer = NotesShow
END CREATE
CREATE Timer3 AS QTIMER
Enabled = 1
Interval = 80
OnTimer = LoopColor
END CREATE
CREATE CalendarForm AS QFORM
CAPTION = "CalendriX"
Width = 215
Height = 225
COLOR = &HEEFAFA
BorderStyle = 1
DelBorderIcons(biMaximize)
Hint = "Click background to look for a new backdrop image file."
ShowHint = 1
Center
Visible = 0
OnClose = CloseCalendar
Wndproc = Minimize
CREATE CDay1 AS QCOOLBTN
CAPTION = "1"
Left = 7
Top = 71
Width = 27
Flat = 1
OnClick = DayChanged
END CREATE
CREATE CDay8 AS QCOOLBTN
CAPTION = "8"
Left = 7
Top = 96
Width = 27
Flat = 1
OnClick = DayChanged
END CREATE
CREATE CDay15 AS QCOOLBTN
CAPTION = "15"
Left = 7
Top = 120
Width = 27
Flat = 1
OnClick = DayChanged
END CREATE
CREATE CDay29 AS QCOOLBTN
CAPTION = "29"
Left = 7
Top = 169
Width = 27
Flat = 1
OnClick = DayChanged
END CREATE
CREATE CDay22 AS QCOOLBTN
CAPTION = "22"
Left = 7
Top = 144
Width = 27
Flat = 1
OnClick = DayChanged
END CREATE
CREATE CDay9 AS QCOOLBTN
CAPTION = "9"
Left = 35
Top = 96
Width = 27
Flat = 1
OnClick = DayChanged
END CREATE
CREATE CDay2 AS QCOOLBTN
CAPTION = "2"
Left = 35
Top = 71
Width = 27
Flat = 1
OnClick = DayChanged
END CREATE
CREATE CDay16 AS QCOOLBTN
CAPTION = "16"
Left = 35
Top = 120
Width = 27
Flat = 1
OnClick = DayChanged
END CREATE
CREATE CDay30 AS QCOOLBTN
CAPTION = "30"
Left = 35
Top = 169
Width = 27
Flat = 1
OnClick = DayChanged
END CREATE
CREATE CDay23 AS QCOOLBTN
CAPTION = "23"
Left = 35
Top = 144
Width = 27
Flat = 1
OnClick = DayChanged
END CREATE
CREATE CDay10 AS QCOOLBTN
CAPTION = "10"
Left = 63
Top = 96
Width = 27
Flat = 1
OnClick = DayChanged
END CREATE
CREATE CDay3 AS QCOOLBTN
CAPTION = "3"
Left = 63
Top = 71
Width = 27
Flat = 1
OnClick = DayChanged
END CREATE
CREATE CDay17 AS QCOOLBTN
CAPTION = "17"
Left = 63
Top = 120
Width = 27
Flat = 1
OnClick = DayChanged
END CREATE
CREATE CDay31 AS QCOOLBTN
CAPTION = "31"
Left = 63
Top = 169
Width = 27
Flat = 1
OnClick = DayChanged
END CREATE
CREATE CDay24 AS QCOOLBTN
CAPTION = "24"
Left = 63
Top = 144
Width = 27
Flat = 1
OnClick = DayChanged
END CREATE
CREATE CDay11 AS QCOOLBTN
CAPTION = "11"
Left = 91
Top = 96
Width = 27
Flat = 1
OnClick = DayChanged
END CREATE
CREATE CDay4 AS QCOOLBTN
CAPTION = "4"
Left = 91
Top = 71
Width = 27
Flat = 1
OnClick = DayChanged
END CREATE
CREATE CDay18 AS QCOOLBTN
CAPTION = "18"
Left = 91
Top = 120
Width = 27
Flat = 1
OnClick = DayChanged
END CREATE
CREATE CDay25 AS QCOOLBTN
CAPTION = "25"
Left = 91
Top = 144
Width = 27
Flat = 1
OnClick = DayChanged
END CREATE
CREATE CDay12 AS QCOOLBTN
CAPTION = "12"
Left = 119
Top = 96
Width = 27
Flat = 1
OnClick = DayChanged
END CREATE
CREATE CDay5 AS QCOOLBTN
CAPTION = "5"
Left = 119
Top = 71
Width = 27
Flat = 1
OnClick = DayChanged
END CREATE
CREATE CDay19 AS QCOOLBTN
CAPTION = "19"
Left = 119
Top = 120
Width = 27
Flat = 1
OnClick = DayChanged
END CREATE
CREATE CDay26 AS QCOOLBTN
CAPTION = "26"
Left = 119
Top = 144
Width = 27
Flat = 1
OnClick = DayChanged
END CREATE
CREATE CDay13 AS QCOOLBTN
CAPTION = "13"
Left = 147
Top = 96
Width = 27
Flat = 1
OnClick = DayChanged
END CREATE
CREATE CDay6 AS QCOOLBTN
CAPTION = "6"
Left = 147
Top = 71
Width = 27
Flat = 1
OnClick = DayChanged
END CREATE
CREATE CDay20 AS QCOOLBTN
CAPTION = "20"
Left = 147
Top = 120
Width = 27
Flat = 1
OnClick = DayChanged
END CREATE
CREATE CDay27 AS QCOOLBTN
CAPTION = "27"
Left = 147
Top = 144
Width = 27
Flat = 1
OnClick = DayChanged
END CREATE
CREATE CDay14 AS QCOOLBTN
CAPTION = "14"
Left = 175
Top = 96
Width = 27
Flat = 1
OnClick = DayChanged
END CREATE
CREATE CDay7 AS QCOOLBTN
CAPTION = "7"
Left = 175
Top = 71
Width = 27
Flat = 1
OnClick = DayChanged
END CREATE
CREATE CDay21 AS QCOOLBTN
CAPTION = "21"
Left = 175
Top = 120
Width = 27
Flat = 1
OnClick = DayChanged
END CREATE
CREATE CDay28 AS QCOOLBTN
CAPTION = "28"
Left = 175
Top = 144
Width = 27
Flat = 1
OnClick = DayChanged
END CREATE
CREATE ColorButt AS QOVALBTN
CAPTION = "C"
Left = 91
Top = 169
Height = 25
Width = 27
Flat = 1
Layout = -1
Font = Arial8B
Hint = "Click to change dates color."
ShowHint = 1
OnClick = ButtonColor
END CREATE
CREATE ImagesButt AS QOVALBTN
CAPTION = "B"
Left = 119
Top = 169
Height = 25
Width = 27
Flat = 1
Layout = -1
Font = Arial8B
Hint = "Click to change backdrop."
ShowHint = 1
OnClick = CalendarColor
END CREATE
CREATE NoiseButt AS QOVALBTN
CAPTION = "S"
Left = 147
Top = 169
Height = 25
Width = 27
Flat = 1
Layout = -1
Font = Arial8B
Hint = "Click to turn off sound effects."
ShowHint = 1
OnClick = NoiseMaker
END CREATE
CREATE NotesButt AS QOVALBTN
CAPTION = "?"
Left = 175
Top = 169
Height = 25
Width = 27
Flat = 1
Layout = -1
Font = Arial8B
Hint = "Click to know more about CalendriX."
ShowHint = 1
OnClick = ShowNotes
END CREATE
CREATE DayButt AS QOVALBTN
Left = 175
Top = 144
Height = 25
Width = 27
COLOR = clGreen
Flat = 1
Layout = -1
Hint = "Click to switch on/off blinking highlight."
ShowHint = 1
OnClick = Blink
END CREATE
CREATE MonthsPop AS QPOPUPMENU
CREATE Jan AS QMENUITEM
CAPTION = "January"
OnClick = MonthChanged
END CREATE
CREATE Feb AS QMENUITEM
CAPTION = "February"
OnClick = MonthChanged
END CREATE
CREATE Mar AS QMENUITEM
CAPTION = "March"
OnClick = MonthChanged
END CREATE
CREATE Apr AS QMENUITEM
CAPTION = "April"
OnClick = MonthChanged
END CREATE
CREATE May AS QMENUITEM
CAPTION = "May"
OnClick = MonthChanged
END CREATE
CREATE Jun AS QMENUITEM
CAPTION = "June"
OnClick = MonthChanged
END CREATE
CREATE Jul AS QMENUITEM
CAPTION = "July"
OnClick = MonthChanged
END CREATE
CREATE Aug AS QMENUITEM
CAPTION = "August"
OnClick = MonthChanged
END CREATE
CREATE Sep AS QMENUITEM
CAPTION = "September"
OnClick = MonthChanged
END CREATE
CREATE Oct AS QMENUITEM
CAPTION = "October"
OnClick = MonthChanged
END CREATE
CREATE Nov AS QMENUITEM
CAPTION = "November"
OnClick = MonthChanged
END CREATE
CREATE Dece AS QMENUITEM
CAPTION = "December"
OnClick = MonthChanged
END CREATE
END CREATE
CREATE MoYe AS QPANEL
Left = 6
Top = 4
Width = 197
Height = 34
BevelInner = 1
BorderStyle = 0
CREATE CMonth AS QPANEL
Top = 5
Left = 4
Height = 24
Width = 95
COLOR = &H00FF00
Font = Arial9B
BevelOuter = bvNone
BevelInner = bvLowered
Alignment = taLeft
Hint = "Click then select month of choice."
ShowHint = 1
OnClick = PopMonths
END CREATE
CREATE UpDownYr AS QSCROLLBAR
Kind = 0
Top = 5
Left = 100
Width = 25
Height = 25
Hint = "Click left or right to change years."
ShowHint = 1
Min = 0
Max = 65000
OnChange = UpDownYear
END CREATE
CREATE CYear AS QEDIT
Top = 5
Left = 126
Height = 24
Width = 66
Autosize = 0
COLOR = &H00FF00
Font = Arial9B
Hint = "Click then type in new year."
ShowHint = 1
OnChange = YearChanged
END CREATE
END CREATE
CREATE One AS QPANEL
Left = 7
Top = 42
CAPTION = "Sun"
Width = 27
Height = 25
BevelOuter = 1
Hint = "Click here to get today's date"
ShowHint = 1
OnClick = Today
END CREATE
CREATE Two AS QPANEL
Left = 35
Top = 42
CAPTION = "Mon"
Width = 27
Height = 25
BevelOuter = 1
Hint = "Click here to get today's date"
ShowHint = 1
OnClick = Today
END CREATE
CREATE Three AS QPANEL
Left = 63
Top = 42
CAPTION = "Tue"
Width = 27
Height = 25
BevelOuter = 1
Hint = "Click here to get today's date"
ShowHint = 1
OnClick = Today
END CREATE
CREATE Four AS QPANEL
Left = 91
Top = 42
CAPTION = "Wed"
Width = 27
Height = 25
BevelOuter = 1
Hint = "Click here to get today's date"
ShowHint = 1
OnClick = Today
END CREATE
CREATE Five AS QPANEL
Left = 119
Top = 42
CAPTION = "Thu"
Width = 27
Height = 25
BevelOuter = 1
Hint = "Click here to get today's date"
ShowHint = 1
OnClick = Today
END CREATE
CREATE Six AS QPANEL
Left = 147
Top = 42
CAPTION = "Fri"
Width = 27
Height = 25
BevelOuter = 1
Hint = "Click here to get today's date"
ShowHint = 1
OnClick = Today
END CREATE
CREATE Seven AS QPANEL
Left = 175
Top = 42
CAPTION = "Sat"
Width = 27
Height = 25
BevelOuter = 1
Hint = "Click here to get today's date"
ShowHint = 1
OnClick = Today
END CREATE
CREATE NoteProductForm AS QFORM
Top = Screen.Height/2 + 25
Left = Screen.Width/2 - 170
Width = 340
Height = 205
COLOR = CalendarForm.COLOR
DelBorderIcons(biMaximize)
DelBorderIcons(biMinimize)
BorderStyle = bsSingle
FormStyle = fsStayOnTop
CAPTION = "Notes on CalendriX"
OnClose = CloseNoteProductForm
CREATE DXNotes AS QCANVAS
Top = 21
Left = 242
Height = 63
Width = 84
COLOR = 0
Cursor = -21
Hint = "Click to email comment or bug report."
Showhint = 1
OnClick = EmailMe
END CREATE
CREATE ProductList AS QLISTBOX
Width = 232
Height = 177
AddItems ""
AddItems "Welcome!
AddItems ""
AddItems " » CalendriX runs best ON Pentium-class
AddItems " machines with Windows 98 or better.
AddItems " (It will RUN ON older 486 PCs
AddItems " on Windows 95 but will show a
AddItems " harmless incompatibility message.
AddItems " Just ignore it.)
AddItems ""
AddItems " » USING CalendriX IS straightforward.
AddItems " To change the month, click on the
AddItems " Month panel, THEN SELECT the month.
AddItems " To change the year, select the Year
AddItems " panel, THEN TYPE in the new year.
AddItems " Or you can use the arrow-left or
AddItems " arrow-right button TO change the
AddItems " year entry one year at a time.
AddItems " TO change the day, simply click ON
AddItems " the appropriate button.
AddItems ""
AddItems " » Theoretically, CalendriX can display
AddItems " dates from Year 0 to Year 65000, a
AddItems " span of over 23 million days. FOR a
AddItems " meaningful result, however, confine
AddItems " dates TO after September 14, 1752--
AddItems " the day our calendar, the Gregorian,
AddItems " was last significantly amended AND
AddItems " the day it was adopted by Britain.
AddItems ""
AddItems " » You can change the calendar
AddItems " backdrop by clicking on the button
AddItems " marked B. You can cycle through
AddItems " six backdrops by repeatedly
AddItems " clicking ON the backdrop. You can
AddItems " even substitute your own images for
AddItems " the supplied backdrops by clicking
AddItems " on the background then selecting
AddItems " an appropriate image file stored
AddItems " in your computer. Remember to use
AddItems " only images that are at least
AddItems " 210 pixels wide x 200 pixels high.
AddItems ""
AddItems " » Nota bene: this prototype uses the
AddItems " date format mm:dd:yyyy. If you have
AddItems " SET your date format differently,
AddItems " CalendriX will display the wrong
AddItems " the dates.
AddItems ""
AddItems " » CalendriX remembers your settings,
AddItems " so there
AddItems " each time you run CalendriX.
AddItems ""
AddItems ""Programming
AddItems " » CalendriX was written in Rapid-Q,"
AddItems " a computer language developed by "
AddItems " William Yu. It
AddItems " www.basicguru.com/abc/rapidq."
END CREATE
CREATE NotesP0 AS QLABEL
Top = 3
Left = 255
Width = 84
Font = Arial10B
CAPTION = "CalendriX"
Alignment = taCenter
Layout = -1
LabelStyle = 1
Hint = "Click to visit website"
ShowHint = 1
OnClick = SendMe
END CREATE
CREATE NotesP1 AS QLABEL
Top = 85
Left = 235
CAPTION = " Copyright (c) 2001\n Achilles B. Mina\n\nThis is FREEWARE.\n Not for commercial\n distribution."
END CREATE
END CREATE
END CREATE
SUB Initialize
RANDOMIZE
IF FILEEXISTS("calendrix.ini") <> 0 THEN
DIM File AS QFILESTREAM
File.OPEN("calendrix.ini",fmOpenReadWrite)
inifile = File.ReadStr(File.Size)
File.CLOSE
END IF
colorcount = VAL(LEFT$(inifile,1))
always = VAL(MID$(inifile,2,1))
soundoff = VAL(MID$(inifile,3,1))
blinking = VAL(MID$(inifile,4,1))
buttcolor = VAL(MID$(inifile,5,1))
ccolorcount = VAL(MID$(inifile,6,1))
whereC = INSTR(7,inifile,CHR$(13))
DayButt.COLOR = VAL(MID$(inifile,7,(whereC-1)-6))
where0 = INSTR(inifile,"0 =")
where0E = INSTR(where0,inifile,CHR$(13))
image0 = MID$(inifile,where0+3,(where0E-1)-(where0+2))
where1 = INSTR(inifile,"1 =")
where1E = INSTR(where1,inifile,CHR$(13))
image1 = MID$(inifile,where1+3,(where1E-1)-(where1+2))
where2 = INSTR(inifile,"2 =")
where2E = INSTR(where2,inifile,CHR$(13))
image2 = MID$(inifile,where2+3,(where2E-1)-(where2+2))
where3 = INSTR(inifile,"3 =")
where3E = INSTR(where3,inifile,CHR$(13))
image3 = MID$(inifile,where3+3,(where3E-1)-(where3+2))
where4 = INSTR(inifile,"4 =")
where4E = INSTR(where4,inifile,CHR$(13))
image4 = MID$(inifile,where4+3,(where4E-1)-(where4+2))
where5 = INSTR(inifile,"5 =")
where5E = INSTR(where5,inifile,CHR$(13))
image5 = MID$(inifile,where5+3,(where5E-1)-(where5+2))
IF RTRIM$(image0) = "" THEN image0 = "00.bmp"
IF RTRIM$(image1) = "" THEN image1 = "10.bmp"
IF RTRIM$(image2) = "" THEN image2 = "20.bmp"
IF RTRIM$(image3) = "" THEN image3 = "30.bmp"
IF RTRIM$(image4) = "" THEN image4 = "40.bmp"
IF RTRIM$(image5) = "" THEN image5 = "50.bmp"
ButtonColor
CalendarColor
IF soundoff = 0 THEN PLAYWAV(clocktow,1)
Application.HintShortPause = 25
Application.HintPause = 25
Application.HintHidePause = 12000
DayTodayLt
New_Date
UpDownYr.Position = fyear
Time
Calendar
END SUB
SUB OnTop
IF soundoff = 0 THEN PLAYWAV(gong,1)
IF always = 0 THEN
always = 1
ELSE
always = 0
END IF
END SUB
SUB Time
DEFINT milhour, hour, min
hour = VAL(LEFT$(TIME$,2))
min = VAL(MID$(TIME$,4,2))
milhour = hour
IF hour >= 12 AND hour < 24 THEN
hour = hour - 12
IF hour = 0 THEN hour = 12
ampm$ = " pm"
ELSEIF hour = 0 THEN
hour = 12
ampm$ = " am"
ELSE
ampm$ = " am"
END IF
IF min < 10 THEN
thetime$ = STR$(hour) + ":0" + STR$(min) + RIGHT$(TIME$,3) + ampm$
ELSE
thetime$ = STR$(hour) + ":" + STR$(min) + RIGHT$(TIME$,3) + ampm$
END IF
CalendarForm.CAPTION = "CalendriX" + " " + thetime$
END SUB
SUB New_Date
IF soundoff = 0 THEN PLAYWAV(whoosh,1)
byear = VAL(REPLACESUBSTR$(CYear.Text,",",""))
fday = bday
fyear = byear
fmonth = bmonth
IF fyear = 0 THEN
fyear = 1
ELSEIF fyear < 0 THEN
fyear = ABS(fyear) + 1
ELSE
DaysDifference
END IF
END SUB
SUB DaysDifference
monthnow = fmonth
yearnow = fyear
daynow = fday
monththen = 1
yearthen = 1900
daythen = 1
IF yearnow < yearthen THEN
SWAP(yearnow,yearthen)
SWAP(monthnow,monththen)
SWAP(daynow,daythen)
END IF
AOyears = yearnow - yearthen
betyears = AOyears - 1
IF AOyears = 0 THEN
IF monthnow = monththen THEN
diffdays = daynow - daythen
ELSE
IF yearthen MOD 4 = 0 THEN
leapthen = 1
IF yearthen MOD 100 = 0 AND yearthen MOD 400 <> 0 THEN leapthen = 0
ELSE
leapthen = 0
END IF
IF yearnow MOD 4 = 0 THEN
leapnow = 1
IF yearnow MOD 100 = 0 AND yearnow MOD 400 <> 0 THEN leapnow = 0
ELSE
leapnow = 0
END IF
SELECT CASE monththen
CASE 1
Adays = daythen
CASE 2
Adays = 31 + daythen
CASE 3
Adays = 59 + daythen + leapthen
CASE 4
Adays = 90 + daythen + leapthen
CASE 5
Adays = 120 + daythen + leapthen
CASE 6
Adays = 151 + daythen + leapthen
CASE 7
Adays = 181 + daythen + leapthen
CASE 8
Adays = 212 + daythen + leapthen
CASE 9
Adays = 243 + daythen + leapthen
CASE 10
Adays = 273 + daythen + leapthen
CASE 11
Adays = 304 + daythen + leapthen
CASE 12
Adays = 334 + daythen + leapthen
END SELECT
diffdays = GetOdays - Adays
END IF
ELSEIF AOyears = 1 THEN
diffdays = GetAOdays
ELSE
betleaps = 0
trialyear = yearthen + 1
DO
IF trialyear MOD 4 = 0 THEN
INC betleaps
IF trialyear MOD 100 = 0 AND trialyear MOD 400 <> 0 THEN DEC betleaps
END IF
INC trialyear
LOOP UNTIL trialyear = yearnow
diffdays = (betyears*365) + GetAOdays + betleaps
END IF
todate = diffdays MOD 7
IF fyear < VAL(RIGHT$(DATE$,4)) THEN
past = 1
ELSEIF fyear = VAL(RIGHT$(DATE$,4)) THEN
IF fmonth < VAL(LEFT$(DATE$,2)) THEN
past = 1
ELSEIF fmonth = VAL(LEFT$(DATE$,2)) THEN
IF fday < VAL(MID$(DATE$,4,2)) THEN past = 1
END IF
END IF
SELECT CASE todate
CASE 0
wday$ = "Monday!"
CASE 1
IF fyear < 1900 THEN
wday$ = "Sunday!"
ELSE
wday$ = "Tuesday!"
END IF
CASE 2
IF fyear < 1900 THEN
wday$ = "Saturday!"
ELSE
wday$ = "Wednesday!"
END IF
CASE 3
IF fyear < 1900 THEN
wday$ = "Friday!"
ELSE
wday$ = "Thursday!"
END IF
CASE 4
IF fyear < 1900 THEN
wday$ = "Thursday!"
ELSE
wday$ = "Friday!"
END IF
CASE 5
IF fyear < 1900 THEN
wday$ = "Wednesday!"
ELSE
wday$ = "Saturday!"
END IF
CASE 6
IF fyear < 1900 THEN
wday$ = "Tuesday!"
ELSE
wday$ = "Sunday!"
END IF
END SELECT
END SUB
FUNCTION GetAOdays
IF yearthen MOD 4 = 0 THEN
leapthen = 1
IF yearthen MOD 100 = 0 AND yearthen MOD 400 <> 0 THEN leapthen = 0
ELSE
leapthen = 0
END IF
SELECT CASE monththen
CASE 1
Adays = 365 - daythen + leapthen
CASE 2
Adays = 334 - daythen + leapthen
CASE 3
Adays = 306 - daythen
CASE 4
Adays = 275 - daythen
CASE 5
Adays = 245 - daythen
CASE 6
Adays = 214 - daythen
CASE 7
Adays = 184 - daythen
CASE 8
Adays = 153 - daythen
CASE 9
Adays = 122 - daythen
CASE 10
Adays = 92 - daythen
CASE 11
Adays = 61 - daythen
CASE 12
Adays = 31 - daythen
END SELECT
GetAOdays = Adays + GetOdays
END FUNCTION
FUNCTION GetOdays
IF yearnow MOD 4 = 0 THEN
leapnow = 1
IF yearnow MOD 100 = 0 AND yearnow MOD 400 <> 0 THEN leapnow = 0
ELSE
leapnow = 0
END IF
SELECT CASE monthnow
CASE 1
Odays = daynow
CASE 2
Odays = 31 + daynow
CASE 3
Odays = 59 + daynow + leapnow
CASE 4
Odays = 90 + daynow + leapnow
CASE 5
Odays = 120 + daynow + leapnow
CASE 6
Odays = 151 + daynow + leapnow
CASE 7
Odays = 181 + daynow + leapnow
CASE 8
Odays = 212 + daynow + leapnow
CASE 9
Odays = 243 + daynow + leapnow
CASE 10
Odays = 273 + daynow + leapnow
CASE 11
Odays = 304 + daynow + leapnow
CASE 12
Odays = 334 + daynow + leapnow
END SELECT
RESULT = Odays
END FUNCTION
SUB ShowNotes
IF soundoff = 0 THEN PLAYWAV(cuckoo,1)
Timer2.Enabled = 1
Animate(NoteProductForm.Handle)
NoteProductForm.Visible = 1
END SUB
SUB NotesShow
DEFSHORT y
DXNotes.FillRect(0,0,84,63,0)
INC y
IF y > 84 THEN y = 1
IF y < 11 THEN b$ = RIGHT$("wasaywasay",y)
IF y < 8 THEN a$ = RIGHT$(".com.ph",y)
DXNotes.TextOut(y,y+2,a$,clGreen,clBlack)
DXNotes.TextOut(y+2,2,b$,clWhite,clBlack)
DXNotes.TextOut(1,y+16,"@i-manila",&HDDCE,clBlack)
END SUB
SUB SendMe
IF soundoff = 0 THEN PLAYWAV(camera,1)
dummy = SHELL ("start http://pages.zdnet.com/wasaywasay/wasaywasay", SW_HIDE)
IF dummy = 0 THEN
dummy = SHELL ("start http://pages.zdnet.com/wasaywasay/wasaywasay", SW_HIDE)
IF dummy = 0 THEN
SHOWMESSAGE "Can't find your Start program. \nPlease go to http://pages.zdnet.com/wasaywasay/wasaywasay manually."
END IF
END IF
END SUB
SUB EMailMe
IF soundoff = 0 THEN PLAYWAV(camera,1)
dummy = SHELL("c:\windows\command\Start mailto:wasaywasay@i-manila.com.ph?Subject=Attention_Days_croaks",0)
IF dummy = 0 THEN
dummy = SHELL("Start mailto:wasaywasay@i-manila.com.ph?Subject=About_CalendriX",0)
IF dummy = 0 THEN
SHOWMESSAGE "Can't find your Start program. Please do manual email instead."
END IF
END IF
END SUB
SUB DayTodayLt
bday = VAL(MID$(DATE$,4,2))
bmonth = VAL(LEFT$(DATE$,2))
CYear.Text = RIGHT$(DATE$,4)
SELECT CASE bmonth
CASE 1
CMonth.CAPTION = "January"
CASE 2
CMonth.CAPTION = "February"
CASE 3
CMonth.CAPTION = "March"
CASE 4
CMonth.CAPTION = "April"
CASE 5
CMonth.CAPTION = "May"
CASE 6
CMonth.CAPTION = "June"
CASE 7
CMonth.CAPTION = "July"
CASE 8
CMonth.CAPTION = "August"
CASE 9
CMonth.CAPTION = "September"
CASE 10
CMonth.CAPTION = "October"
CASE 11
CMonth.CAPTION = "November"
CASE 12
CMonth.CAPTION = "December"
END SELECT
END SUB
SUB CloseNoteProductForm
IF soundoff = 0 THEN PLAYWAV(whoosh,1)
Deanimate(NoteProductForm.Handle)
NoteProductForm.Visible = 0
END SUB
SUB Nights
DIM File AS QFILESTREAM
IF soundoff = 0 THEN PLAYWAV(gong,1)
IF iDir = "" THEN
where$ = "calendrix.ini"
ELSE
where$ = iDir + "\\" + "calendrix.ini"
END IF
File.OPEN(where$,fmCreate)
inifile = STR$(colorcount) + STR$(always) + STR$(soundoff)_
+ STR$(blinking) + STR$(buttcolor) + STR$(ccolorcount)_
+ STR$(DayButt.COLOR) + CHR$(13)_
+ "0 =" + image0 + CHR$(13)_
+ "1 =" + image1 + CHR$(13)_
+ "2 =" + image2 + CHR$(13)_
+ "3 =" + image3 + CHR$(13)_
+ "4 =" + image4 + CHR$(13)_
+ "5 =" + image5 + CHR$(13)
File.WriteStr(inifile,LEN(inifile))
File.CLOSE
CalendarForm.CLOSE
END SUB
SUB Noisemaker
IF soundoff = 0 THEN
NoiseButt.Hint = "Click to turn on sound effects."
soundoff = 1
ELSE
PLAYWAV(handbell,1)
NoiseButt.Hint = "Click to turn off sound effects."
soundoff = 0
END IF
END SUB
SUB DayChanged(Sender AS QCOOLBTN)
bday = VAL(Sender.CAPTION)
New_Date
Calendar
END SUB
SUB MonthChanged(Sender AS QMENUITEM)
CMonth.CAPTION = Sender.CAPTION
SELECT CASE CMonth.CAPTION
CASE "January"
bmonth = 1
CASE "February"
bmonth = 2
CASE "March"
bmonth = 3
CASE "April"
bmonth = 4
CASE "May"
bmonth = 5
CASE "June"
bmonth = 6
CASE "July"
bmonth = 7
CASE "August"
bmonth = 8
CASE "September"
bmonth = 9
CASE "October"
bmonth = 10
CASE "November"
bmonth = 11
CASE "December"
bmonth = 12
END SELECT
New_Date
Calendar
END SUB
SUB YearChanged
New_Date
UpDownYr.Position = VAL(CYear.Text)
Calendar
END SUB
SUB Calendar
IF soundoff = 0 THEN PLAYWAV(handbell,1)
CYear.Text = STR$(fyear)
One.COLOR = -2147483633
Two.COLOR = -2147483633
Three.COLOR = -2147483633
Four.COLOR = -2147483633
Five.COLOR = -2147483633
Six.COLOR = -2147483633
Seven.COLOR = -2147483633
CDay1.Visible = 1
CDay2.Visible = 1
CDay3.Visible = 1
CDay4.Visible = 1
CDay5.Visible = 1
CDay6.Visible = 1
CDay7.Visible = 1
CDay8.Visible = 1
CDay9.Visible = 1
CDay10.Visible = 1
CDay11.Visible = 1
CDay12.Visible = 1
CDay13.Visible = 1
CDay14.Visible = 1
CDay15.Visible = 1
CDay16.Visible = 1
CDay17.Visible = 1
CDay18.Visible = 1
CDay19.Visible = 1
CDay20.Visible = 1
CDay21.Visible = 1
CDay22.Visible = 1
CDay23.Visible = 1
CDay24.Visible = 1
CDay25.Visible = 1
CDay26.Visible = 1
CDay27.Visible = 1
CDay28.Visible = 1
SELECT CASE fmonth
CASE 1,3,5,7,8,10,12
CDay29.Visible = 1
CDay30.Visible = 1
CDay31.Visible = 1
CASE 4,6,9,11
CDay29.Visible = 1
CDay30.Visible = 1
CDay31.Visible = 0
CASE 2
IF leapthen = 1 OR leapnow = 1 THEN
CDay29.Visible = 1
ELSE
CDay29.Visible = 0
END IF
CDay30.Visible = 0
CDay31.Visible = 0
END SELECT
SELECT CASE fday
CASE 1,8,15,22,29
One.COLOR = &HEEFAFA
SELECT CASE wday$
CASE "Sunday!"
One.CAPTION = "Sun"
Two.CAPTION = "Mon"
Three.CAPTION = "Tue"
Four.CAPTION = "Wed"
Five.CAPTION = "Thu"
Six.CAPTION = "Fri"
Seven.CAPTION = "Sat"
CASE "Monday!"
One.CAPTION = "Mon"
Two.CAPTION = "Tue"
Three.CAPTION = "Wed"
Four.CAPTION = "Thu"
Five.CAPTION = "Fri"
Six.CAPTION = "Sat"
Seven.CAPTION = "Sun"
CASE "Tuesday!"
One.CAPTION = "Tue"
Two.CAPTION = "Wed"
Three.CAPTION = "Thu"
Four.CAPTION = "Fri"
Five.CAPTION = "Sat"
Six.CAPTION = "Sun"
Seven.CAPTION = "Mon"
CASE "Wednesday!"
One.CAPTION = "Wed"
Two.CAPTION = "Thu"
Three.CAPTION = "Fri"
Four.CAPTION = "Sat"
Five.CAPTION = "Sun"
Six.CAPTION = "Mon"
Seven.CAPTION = "Tue"
CASE "Thursday!"
One.CAPTION = "Thu"
Two.CAPTION = "Fri"
Three.CAPTION = "Sat"
Four.CAPTION = "Sun"
Five.CAPTION = "Mon"
Six.CAPTION = "Tue"
Seven.CAPTION = "Wed"
CASE "Friday!"
One.CAPTION = "Fri"
Two.CAPTION = "Sat"
Three.CAPTION = "Sun"
Four.CAPTION = "Mon"
Five.CAPTION = "Tue"
Six.CAPTION = "Wed"
Seven.CAPTION = "Thu"
CASE "Saturday!"
One.CAPTION = "Sat"
Two.CAPTION = "Sun"
Three.CAPTION = "Mon"
Four.CAPTION = "Tue"
Five.CAPTION = "Wed"
Six.CAPTION = "Thu"
Seven.CAPTION = "Fri"
END SELECT
CASE 2,9,16,23,30
Two.COLOR = &HEEFAFA
SELECT CASE wday$
CASE "Sunday!"
One.CAPTION = "Sat"
Two.CAPTION = "Sun"
Three.CAPTION = "Mon"
Four.CAPTION = "Tue"
Five.CAPTION = "Wed"
Six.CAPTION = "Thu"
Seven.CAPTION = "Fri"
CASE "Monday!"
One.CAPTION = "Sun"
Two.CAPTION = "Mon"
Three.CAPTION = "Tue"
Four.CAPTION = "Wed"
Five.CAPTION = "Thu"
Six.CAPTION = "Fri"
Seven.CAPTION = "Sat"
CASE "Tuesday!"
One.CAPTION = "Mon"
Two.CAPTION = "Tue"
Three.CAPTION = "Wed"
Four.CAPTION = "Thu"
Five.CAPTION = "Fri"
Six.CAPTION = "Sat"
Seven.CAPTION = "Sun"
CASE "Wednesday!"
One.CAPTION = "Tue"
Two.CAPTION = "Wed"
Three.CAPTION = "Thu"
Four.CAPTION = "Fri"
Five.CAPTION = "Sat"
Six.CAPTION = "Sun"
Seven.CAPTION = "Mon"
CASE "Thursday!"
One.CAPTION = "Wed"
Two.CAPTION = "Thu"
Three.CAPTION = "Fri"
Four.CAPTION = "Sat"
Five.CAPTION = "Sun"
Six.CAPTION = "Mon"
Seven.CAPTION = "Tue"
CASE "Friday!"
One.CAPTION = "Thu"
Two.CAPTION = "Fri"
Three.CAPTION = "Sat"
Four.CAPTION = "Sun"
Five.CAPTION = "Mon"
Six.CAPTION = "Tue"
Seven.CAPTION = "Wed"
CASE "Saturday!"
One.CAPTION = "Fri"
Two.CAPTION = "Sat"
Three.CAPTION = "Sun"
Four.CAPTION = "Mon"
Five.CAPTION = "Tue"
Six.CAPTION = "Wed"
Seven.CAPTION = "Thu"
END SELECT
CASE 3,10,17,24,31
Three.COLOR = &HEEFAFA
SELECT CASE wday$
CASE "Sunday!"
One.CAPTION = "Fri"
Two.CAPTION = "Sat"
Three.CAPTION = "Sun"
Four.CAPTION = "Mon"
Five.CAPTION = "Tue"
Six.CAPTION = "Wed"
Seven.CAPTION = "Thu"
CASE "Monday!"
One.CAPTION = "Sat"
Two.CAPTION = "Sun"
Three.CAPTION = "Mon"
Four.CAPTION = "Tue"
Five.CAPTION = "Wed"
Six.CAPTION = "Thu"
Seven.CAPTION = "Fri"
CASE "Tuesday!"
One.CAPTION = "Sun"
Two.CAPTION = "Mon"
Three.CAPTION = "Tue"
Four.CAPTION = "Wed"
Five.CAPTION = "Thu"
Six.CAPTION = "Fri"
Seven.CAPTION = "Sat"
CASE "Wednesday!"
One.CAPTION = "Mon"
Two.CAPTION = "Tue"
Three.CAPTION = "Wed"
Four.CAPTION = "Thu"
Five.CAPTION = "Fri"
Six.CAPTION = "Sat"
Seven.CAPTION = "Sun"
CASE "Thursday!"
One.CAPTION = "Tue"
Two.CAPTION = "Wed"
Three.CAPTION = "Thu"
Four.CAPTION = "Fri"
Five.CAPTION = "Sat"
Six.CAPTION = "Sun"
Seven.CAPTION = "Mon"
CASE "Friday!"
One.CAPTION = "Wed"
Two.CAPTION = "Thu"
Three.CAPTION = "Fri"
Four.CAPTION = "Sat"
Five.CAPTION = "Sun"
Six.CAPTION = "Mon"
Seven.CAPTION = "Tue"
CASE "Saturday!"
One.CAPTION = "Thu"
Two.CAPTION = "Fri"
Three.CAPTION = "Sat"
Four.CAPTION = "Sun"
Five.CAPTION = "Mon"
Six.CAPTION = "Tue"
Seven.CAPTION = "Wed"
END SELECT
CASE 4,11,18,25
Four.COLOR = &HEEFAFA
SELECT CASE wday$
CASE "Sunday!"
One.CAPTION = "Thu"
Two.CAPTION = "Fri"
Three.CAPTION = "Sat"
Four.CAPTION = "Sun"
Five.CAPTION = "Mon"
Six.CAPTION = "Tue"
Seven.CAPTION = "Wed"
CASE "Monday!"
One.CAPTION = "Fri"
Two.CAPTION = "Sat"
Three.CAPTION = "Sun"
Four.CAPTION = "Mon"
Five.CAPTION = "Tue"
Six.CAPTION = "Wed"
Seven.CAPTION = "Thu"
CASE "Tuesday!"
One.CAPTION = "Sat"
Two.CAPTION = "Sun"
Three.CAPTION = "Mon"
Four.CAPTION = "Tue"
Five.CAPTION = "Wed"
Six.CAPTION = "Thu"
Seven.CAPTION = "Fri"
CASE "Wednesday!"
One.CAPTION = "Sun"
Two.CAPTION = "Mon"
Three.CAPTION = "Tue"
Four.CAPTION = "Wed"
Five.CAPTION = "Thu"
Six.CAPTION = "Fri"
Seven.CAPTION = "Sat"
CASE "Thursday!"
One.CAPTION = "Mon"
Two.CAPTION = "Tue"
Three.CAPTION = "Wed"
Four.CAPTION = "Thu"
Five.CAPTION = "Fri"
Six.CAPTION = "Sat"
Seven.CAPTION = "Sun"
CASE "Friday!"
One.CAPTION = "Tue"
Two.CAPTION = "Wed"
Three.CAPTION = "Thu"
Four.CAPTION = "Fri"
Five.CAPTION = "Sat"
Six.CAPTION = "Sun"
Seven.CAPTION = "Mon"
CASE "Saturday!"
One.CAPTION = "Wed"
Two.CAPTION = "Thu"
Three.CAPTION = "Fri"
Four.CAPTION = "Sat"
Five.CAPTION = "Sun"
Six.CAPTION = "Mon"
Seven.CAPTION = "Tue"
END SELECT
CASE 5,12,19,26
Five.COLOR = &HEEFAFA
SELECT CASE wday$
CASE "Sunday!"
One.CAPTION = "Wed"
Two.CAPTION = "Thu"
Three.CAPTION = "Fri"
Four.CAPTION = "Sat"
Five.CAPTION = "Sun"
Six.CAPTION = "Mon"
Seven.CAPTION = "Tue"
CASE "Monday!"
One.CAPTION = "Thu"
Two.CAPTION = "Fri"
Three.CAPTION = "Sat"
Four.CAPTION = "Sun"
Five.CAPTION = "Mon"
Six.CAPTION = "Tue"
Seven.CAPTION = "Wed"
CASE "Tuesday!"
One.CAPTION = "Fri"
Two.CAPTION = "Sat"
Three.CAPTION = "Sun"
Four.CAPTION = "Mon"
Five.CAPTION = "Tue"
Six.CAPTION = "Wed"
Seven.CAPTION = "Thu"
CASE "Wednesday!"
One.CAPTION = "Sat"
Two.CAPTION = "Sun"
Three.CAPTION = "Mon"
Four.CAPTION = "Tue"
Five.CAPTION = "Wed"
Six.CAPTION = "Thu"
Seven.CAPTION = "Fri"
CASE "Thursday!"
One.CAPTION = "Sun"
Two.CAPTION = "Mon"
Three.CAPTION = "Tue"
Four.CAPTION = "Wed"
Five.CAPTION = "Thu"
Six.CAPTION = "Fri"
Seven.CAPTION = "Sat"
CASE "Friday!"
One.CAPTION = "Mon"
Two.CAPTION = "Tue"
Three.CAPTION = "Wed"
Four.CAPTION = "Thu"
Five.CAPTION = "Fri"
Six.CAPTION = "Sat"
Seven.CAPTION = "Sun"
CASE "Saturday!"
One.CAPTION = "Tue"
Two.CAPTION = "Wed"
Three.CAPTION = "Thu"
Four.CAPTION = "Fri"
Five.CAPTION = "Sat"
Six.CAPTION = "Sun"
Seven.CAPTION = "Mon"
END SELECT
CASE 6,13,20,27
Six.COLOR = &HEEFAFA
SELECT CASE wday$
CASE "Sunday!"
One.CAPTION = "Tue"
Two.CAPTION = "Wed"
Three.CAPTION = "Thu"
Four.CAPTION = "Fri"
Five.CAPTION = "Sat"
Six.CAPTION = "Sun"
Seven.CAPTION = "Mon"
CASE "Monday!"
One.CAPTION = "Wed"
Two.CAPTION = "Thu"
Three.CAPTION = "Fri"
Four.CAPTION = "Sat"
Five.CAPTION = "Sun"
Six.CAPTION = "Mon"
Seven.CAPTION = "Tue"
CASE "Tuesday!"
One.CAPTION = "Thu"
Two.CAPTION = "Fri"
Three.CAPTION = "Sat"
Four.CAPTION = "Sun"
Five.CAPTION = "Mon"
Six.CAPTION = "Tue"
Seven.CAPTION = "Wed"
CASE "Wednesday!"
One.CAPTION = "Fri"
Two.CAPTION = "Sat"
Three.CAPTION = "Sun"
Four.CAPTION = "Mon"
Five.CAPTION = "Tue"
Six.CAPTION = "Wed"
Seven.CAPTION = "Thu"
CASE "Thursday!"
One.CAPTION = "Sat"
Two.CAPTION = "Sun"
Three.CAPTION = "Mon"
Four.CAPTION = "Tue"
Five.CAPTION = "Wed"
Six.CAPTION = "Thu"
Seven.CAPTION = "Fri"
CASE "Friday!"
One.CAPTION = "Sat"
Two.CAPTION = "Mon"
Three.CAPTION = "Tue"
Four.CAPTION = "Wed"
Five.CAPTION = "Thu"
Six.CAPTION = "Fri"
Seven.CAPTION = "Sat"
CASE "Saturday!"
One.CAPTION = "Mon"
Two.CAPTION = "Tue"
Three.CAPTION = "Wed"
Four.CAPTION = "Thu"
Five.CAPTION = "Fri"
Six.CAPTION = "Sat"
Seven.CAPTION = "Sun"
END SELECT
CASE 7,14,21,28
Seven.COLOR = &HEEFAFA
SELECT CASE wday$
CASE "Sunday!"
One.CAPTION = "Mon"
Two.CAPTION = "Tue"
Three.CAPTION = "Wed"
Four.CAPTION = "Thu"
Five.CAPTION = "Fri"
Six.CAPTION = "Sat"
Seven.CAPTION = "Sun"
CASE "Monday!"
One.CAPTION = "Tue"
Two.CAPTION = "Wed"
Three.CAPTION = "Thu"
Four.CAPTION = "Fri"
Five.CAPTION = "Sat"
Six.CAPTION = "Sun"
Seven.CAPTION = "Mon"
CASE "Tuesday!"
One.CAPTION = "Wed"
Two.CAPTION = "Thu"
Three.CAPTION = "Fri"
Four.CAPTION = "Sat"
Five.CAPTION = "Sun"
Six.CAPTION = "Mon"
Seven.CAPTION = "Tue"
CASE "Wednesday!"
One.CAPTION = "Thu"
Two.CAPTION = "Fri"
Three.CAPTION = "Sat"
Four.CAPTION = "Sun"
Five.CAPTION = "Mon"
Six.CAPTION = "Tue"
Seven.CAPTION = "Wed"
CASE "Thursday!"
One.CAPTION = "Fri"
Two.CAPTION = "Sat"
Three.CAPTION = "Sun"
Four.CAPTION = "Mon"
Five.CAPTION = "Tue"
Six.CAPTION = "Wed"
Seven.CAPTION = "Thu"
CASE "Friday!"
One.CAPTION = "Sat"
Two.CAPTION = "Sun"
Three.CAPTION = "Mon"
Four.CAPTION = "Tue"
Five.CAPTION = "Wed"
Six.CAPTION = "Thu"
Seven.CAPTION = "Fri"
CASE "Saturday!"
One.CAPTION = "Sun"
Two.CAPTION = "Mon"
Three.CAPTION = "Tue"
Four.CAPTION = "Wed"
Five.CAPTION = "Thu"
Six.CAPTION = "Fri"
Seven.CAPTION = "Sat"
END SELECT
END SELECT
SELECT CASE fday
CASE 1
CDay1.Visible = 0
DayButt.Top = CDay1.Top
DayButt.Left = CDay1.Left
CASE 2
CDay2.Visible = 0
DayButt.Top = CDay2.Top
DayButt.Left = CDay2.Left
CASE 3
CDay3.Visible = 0
DayButt.Top = CDay3.Top
DayButt.Left = CDay3.Left
CASE 4
CDay4.Visible = 0
DayButt.Top = CDay4.Top
DayButt.Left = CDay4.Left
CASE 5
CDay5.Visible = 0
DayButt.Top = CDay5.Top
DayButt.Left = CDay5.Left
CASE 6
CDay6.Visible = 0
DayButt.Top = CDay6.Top
DayButt.Left = CDay6.Left
CASE 7
CDay7.Visible = 0
DayButt.Top = CDay7.Top
DayButt.Left = CDay7.Left
CASE 8
CDay8.Visible = 0
DayButt.Top = CDay8.Top
DayButt.Left = CDay8.Left
CASE 9
CDay9.Visible = 0
DayButt.Top = CDay9.Top
DayButt.Left = CDay9.Left
CASE 10
CDay10.Visible = 0
DayButt.Top = CDay10.Top
DayButt.Left = CDay10.Left
CASE 11
CDay11.Visible = 0
DayButt.Top = CDay11.Top
DayButt.Left = CDay11.Left
CASE 12
CDay12.Visible = 0
DayButt.Top = CDay12.Top
DayButt.Left = CDay12.Left
CASE 13
CDay13.Visible = 0
DayButt.Top = CDay13.Top
DayButt.Left = CDay13.Left
CASE 14
CDay14.Visible = 0
DayButt.Top = CDay14.Top
DayButt.Left = CDay14.Left
CASE 15
CDay15.Visible = 0
DayButt.Top = CDay15.Top
DayButt.Left = CDay15.Left
CASE 16
CDay16.Visible = 0
DayButt.Top = CDay16.Top
DayButt.Left = CDay16.Left
CASE 17
CDay17.Visible = 0
DayButt.Top = CDay17.Top
DayButt.Left = CDay17.Left
CASE 18
CDay18.Visible = 0
DayButt.Top = CDay18.Top
DayButt.Left = CDay18.Left
CASE 19
CDay19.Visible = 0
DayButt.Top = CDay19.Top
DayButt.Left = CDay19.Left
CASE 20
CDay20.Visible = 0
DayButt.Top = CDay20.Top
DayButt.Left = CDay20.Left
CASE 21
CDay21.Visible = 0
DayButt.Top = CDay21.Top
DayButt.Left = CDay21.Left
CASE 22
CDay22.Visible = 0
DayButt.Top = CDay22.Top
DayButt.Left = CDay22.Left
CASE 23
CDay23.Visible = 0
DayButt.Top = CDay23.Top
DayButt.Left = CDay23.Left
CASE 24
CDay24.Visible = 0
DayButt.Top = CDay24.Top
DayButt.Left = CDay24.Left
CASE 25
CDay25.Visible = 0
DayButt.Top = CDay25.Top
DayButt.Left = CDay25.Left
CASE 26
CDay26.Visible = 0
DayButt.Top = CDay26.Top
DayButt.Left = CDay26.Left
CASE 27
CDay27.Visible = 0
DayButt.Top = CDay27.Top
DayButt.Left = CDay27.Left
CASE 28
CDay28.Visible = 0
DayButt.Top = CDay28.Top
DayButt.Left = CDay28.Left
CASE 29
CDay29.Visible = 0
DayButt.Top = CDay29.Top
DayButt.Left = CDay29.Left
CASE 30
CDay30.Visible = 0
DayButt.Top = CDay30.Top
DayButt.Left = CDay30.Left
CASE 31
CDay31.Visible = 0
DayButt.Top = CDay31.Top
DayButt.Left = CDay31.Left
END SELECT
DayButt.CAPTION = STR$(fday)
END SUB
SUB PopMonths
MonthsPop.PopUp(Screen.MOUSEX,Screen.MOUSEY)
END SUB
SUB Blink
IF blinking = 0 THEN
blinking = 1
ELSE
blinking = 0
END IF
END SUB
SUB Today
DayTodayLt
New_Date
Calendar
END SUB
SUB LoopColor
IF blinking = 0 THEN DayButt.COLOR = 15661818*(1+RND*(5))
END SUB
SUB UpdownYear
CYear.Text = STR$(UpDownYr.Position)
END SUB
SUB CalendarColor
IF CalendarForm.Visible = 1 THEN INC ccolorcount
IF ccolorcount = 6 THEN ccolorcount = 0
SELECT CASE ccolorcount
CASE 0
CalendarForm.COLOR = &HBCCAAA
CASE 1
CalendarForm.COLOR = &HEEFAFA
CASE 2
CalendarForm.COLOR = &HCCC000
CASE 3
CalendarForm.COLOR = &HGCCC
CASE 4
CalendarForm.COLOR = &HA000
CASE 5
CalendarForm.COLOR = &HBCCC
END SELECT
MoYe.COLOR = CalendarForm.COLOR
NoteProductForm.COLOR = CalendarForm.COLOR
END SUB
SUB ButtonColor
IF CalendarForm.Visible = 1 THEN INC buttcolor
IF buttcolor = 4 THEN buttcolor = 0
SELECT CASE buttcolor
CASE 0
DayButt.Font = ArialY10
CDay1.Font = ArialY10
CDay2.Font = ArialY10
CDay3.Font = ArialY10
CDay4.Font = ArialY10
CDay5.Font = ArialY10
CDay6.Font = ArialY10
CDay7.Font = ArialY10
CDay8.Font = ArialY10
CDay9.Font = ArialY10
CDay10.Font = ArialY10
CDay11.Font = ArialY10
CDay12.Font = ArialY10
CDay13.Font = ArialY10
CDay14.Font = ArialY10
CDay15.Font = ArialY10
CDay16.Font = ArialY10
CDay17.Font = ArialY10
CDay18.Font = ArialY10
CDay19.Font = ArialY10
CDay20.Font = ArialY10
CDay21.Font = ArialY10
CDay22.Font = ArialY10
CDay23.Font = ArialY10
CDay24.Font = ArialY10
CDay25.Font = ArialY10
CDay26.Font = ArialY10
CDay27.Font = ArialY10
CDay28.Font = ArialY10
CDay29.Font = ArialY10
CDay30.Font = ArialY10
CDay31.Font = ArialY10
CASE 1
DayButt.Font = ArialB10
CDay1.Font = ArialB10
CDay2.Font = ArialB10
CDay3.Font = ArialB10
CDay4.Font = ArialB10
CDay5.Font = ArialB10
CDay6.Font = ArialB10
CDay7.Font = ArialB10
CDay8.Font = ArialB10
CDay9.Font = ArialB10
CDay10.Font = ArialB10
CDay11.Font = ArialB10
CDay12.Font = ArialB10
CDay13.Font = ArialB10
CDay14.Font = ArialB10
CDay15.Font = ArialB10
CDay16.Font = ArialB10
CDay17.Font = ArialB10
CDay18.Font = ArialB10
CDay19.Font = ArialB10
CDay20.Font = ArialB10
CDay21.Font = ArialB10
CDay22.Font = ArialB10
CDay23.Font = ArialB10
CDay24.Font = ArialB10
CDay25.Font = ArialB10
CDay26.Font = ArialB10
CDay27.Font = ArialB10
CDay28.Font = ArialB10
CDay29.Font = ArialB10
CDay30.Font = ArialB10
CDay31.Font = ArialB10
CASE 2
DayButt.Font = ArialG10
CDay1.Font = ArialG10
CDay2.Font = ArialG10
CDay3.Font = ArialG10
CDay4.Font = ArialG10
CDay5.Font = ArialG10
CDay6.Font = ArialG10
CDay7.Font = ArialG10
CDay8.Font = ArialG10
CDay9.Font = ArialG10
CDay10.Font = ArialG10
CDay11.Font = ArialG10
CDay12.Font = ArialG10
CDay13.Font = ArialG10
CDay14.Font = ArialG10
CDay15.Font = ArialG10
CDay16.Font = ArialG10
CDay17.Font = ArialG10
CDay18.Font = ArialG10
CDay19.Font = ArialG10
CDay20.Font = ArialG10
CDay21.Font = ArialG10
CDay22.Font = ArialG10
CDay23.Font = ArialG10
CDay24.Font = ArialG10
CDay25.Font = ArialG10
CDay26.Font = ArialG10
CDay27.Font = ArialG10
CDay28.Font = ArialG10
CDay29.Font = ArialG10
CDay30.Font = ArialG10
CDay31.Font = ArialG10
CASE 3
DayButt.Font = ArialP10
CDay1.Font = ArialP10
CDay2.Font = ArialP10
CDay3.Font = ArialP10
CDay4.Font = ArialP10
CDay5.Font = ArialP10
CDay6.Font = ArialP10
CDay7.Font = ArialP10
CDay8.Font = ArialP10
CDay9.Font = ArialP10
CDay10.Font = ArialP10
CDay11.Font = ArialP10
CDay12.Font = ArialP10
CDay13.Font = ArialP10
CDay14.Font = ArialP10
CDay15.Font = ArialP10
CDay16.Font = ArialP10
CDay17.Font = ArialP10
CDay18.Font = ArialP10
CDay19.Font = ArialP10
CDay20.Font = ArialP10
CDay21.Font = ArialP10
CDay22.Font = ArialP10
CDay23.Font = ArialP10
CDay24.Font = ArialP10
CDay25.Font = ArialP10
CDay26.Font = ArialP10
CDay27.Font = ArialP10
CDay28.Font = ArialP10
CDay29.Font = ArialP10
CDay30.Font = ArialP10
CDay31.Font = ArialP10
END SELECT
END SUB
SUB ImageFiles
CREATE NewImages AS QOPENDIALOG
InitialDir = CURDIR$
Filter = "Bitmap image files|*.BMP|All Files|*.*
FilterIndex = 1
END CREATE
iDir = NewImages.InitialDir
IF NewImages.Execute THEN
SELECT CASE ccolorcount
CASE 0
image0 = NewImages.FileName
CASE 1
image1 = NewImages.FileName
CASE 2
image2 = NewImages.FileName
CASE 3
image3 = NewImages.FileName
CASE 4
image4 = NewImages.FileName
CASE 5
image5 = NewImages.FileName
END SELECT
DEC ccolorcount
CalendarColor
END IF
END SUB
SUB Animate(Handle AS INTEGER)
AnimateWindow Handle, 300, AW_CENTER
SELECT CASE Handle
CASE NoteProductForm.Handle
NoteProductForm.Repaint
CASE CalendarForm.Handle
CalendarForm.Repaint
END SELECT
END SUB
SUB CloseCalendar
Deanimate(CalendarForm.Handle)
END SUB
SUB Deanimate(Handle AS INTEGER)
AnimateWindow Handle, 300, AW_CENTER OR AW_HIDE
END SUB
Initialize
CalendarForm.ShowModal
'Animate(CalendarForm.Handle)
'CalendarForm.Visible = 1
'DO
' SetWindowPos(CalendarForm.Handle,-1,0,0,0,0,SWP_NOMOVE OR SWP_NOSIZE)
' DOEVENTS
'LOOP UNTIL CalendarForm.Visible = 0
Nights
|
|
搜索
论坛
Home
回顶部
g.yi.org Hits:0 Last modified:2001-10-08 20:21:34
