$INCLUDE "RAPIDQ.INC"
$ESCAPECHARS ON
CONST AW_CENTER = &H10
CONST AW_HIDE = &H10000
DECLARE FUNCTION AnimateWindow LIB "user32" ALIAS "AnimateWindow"(BYVAL hwnd AS LONG, BYVAL dwTime AS LONG, BYVAL dwFlags AS LONG) AS INTEGER
DECLARE FUNCTION SetFocus LIB "USER32" ALIAS "SetFocus" (HWnd AS LONG) AS LONG
DECLARE FUNCTION PaintDesktop LIB "USER32" ALIAS "PaintDesktop" (HDC AS INTEGER) AS INTEGER
DECLARE FUNCTION GetDC LIB "USER32" ALIAS "GetDC" (HWND AS INTEGER) AS INTEGER
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 SUB PseudoMini
DECLARE SUB Animate(Handle AS INTEGER)
DECLARE SUB Deanimate(Handle AS INTEGER)
DECLARE SUB CloseNoteProductForm
DECLARE SUB CloseDays
DECLARE SUB ShowNotes
DECLARE SUB NotesShow
DECLARE SUB EMailMe
DECLARE SUB SendMe
DECLARE SUB TopMost
DECLARE SUB GetMonth(monthtocheck AS STRING)
DECLARE SUB GetDay(daytocheck AS STRING)
DECLARE SUB NewD
DECLARE SUB preNew_Date
DECLARE SUB New_Date(key AS BYTE)
DECLARE SUB DaysDifference(key AS BYTE)
DECLARE SUB preDaysDifference
DECLARE FUNCTION GetAOdays AS INTEGER
DECLARE FUNCTION GetOdays AS INTEGER
DECLARE SUB TransDaysLeft
DECLARE SUB TransDaysRight
DECLARE SUB TransDateUp
DECLARE SUB TransDateDn
DECLARE SUB DayTodayRt
DECLARE SUB DayTodayLt
DECLARE SUB Initialize
DECLARE SUB YearsMonths
DECLARE SUB Time
DECLARE SUB Nights
DECLARE SUB Noisemaker
DECLARE SUB Today
DECLARE SUB Calendar
DECLARE SUB CloseCalendar
DECLARE SUB PopMonths
DECLARE SUB MonthChanged(Sender AS QMENUITEM)
DECLARE SUB YearChanged(key AS BYTE)
DECLARE SUB DayChanged(Sender AS QCOOLBTN)
DECLARE SUB Blink
DECLARE SUB LoopColor
DECLARE SUB CalendarColor
DECLARE SUB UpDownYear
DECLARE SUB PaintForm
DECLARE SUB PanelColors
DECLARE SUB ButtonColor
DECLARE SUB ImageFiles
DEFWORD buttcolor,monthnow, monththen, monthchecked, yearnow, yearthen, betyears
DEFBYTE ccolorcount,blinking,soundoff,juston,colorcount,countyrsmos,leapnow, leapthen, bleap, circa, weekday, fmonth, emonth, pmonth, todate, always
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
CONST HWND_TOPMOST = -1
CONST HWND_NOTOPMOST = -2
CONST SWP_NOSIZE = &H1
CONST SWP_NOMOVE = &H2
CONST WM_SYSCOMMAND = &H0112
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 TimeFont AS QFONT
Name = "Univers"
COLOR = clGreen
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 DaysDates AS QFORM
Width = 497
Height = 260
Center
WndProc = PaintForm
OnClose = CloseDays
CREATE NewDForm AS QPANEL
CAPTION = "New Date"
Top = 20
Left = 10
Width = 230
Height = 195
Cursor = -21
ShowHint = 1
Hint = "Click to change the backdrop."
OnClick = PanelColors
CREATE Month AS QEDIT
Text = LEFT$(DATE$,2)
Left = 10
Top = 5
Width = 65
TabOrder = 1
OnKeyPress = New_Date
END CREATE
CREATE Day AS QEDIT
Text = MID$(DATE$,4,2)
Left = 82
Top = 5
Width = 65
TabOrder = 2
OnKeyPress = New_Date
END CREATE
CREATE Year AS QEDIT
Text = RIGHT$(DATE$,4)
Left = 154
Top = 5
Width = 65
TabOrder = 3
OnKeyPress = New_Date
END CREATE
CREATE DayThence AS QEDIT
Text = "Days past"
Left = 10
Top = 30
Width = 65
TabOrder = 4
OnKeyPress = New_Date
END CREATE
CREATE SNotes AS QLABEL
Alignment = taCenter
Layout = tlCenter
LabelStyle = 1
CAPTION = "NOTES"
Left = 82
Top = 31
Width = 65
Height = 19
COLOR = clWhite
Hint = "Click to know more about Days"
ShowHint = 1
OnClick = ShowNotes
END CREATE
CREATE DayHence AS QEDIT
Text = "Days hence"
Left = 154
Top = 30
Width = 65
TabOrder = 5
OnKeyPress = New_Date
END CREATE
CREATE DateButt AS QBUTTON
Font = Arial9B
CAPTION = "New Date"
Left = 10
Top = 65
Width = 210
Height = 25
Cursor = -21
Hint = "Click to get new date"
ShowHint = 1
OnClick = preNew_Date
END CREATE
CREATE DatePanel AS QPANEL
Left = 10
Top = 90
Width = 210
COLOR = Black
Font = TimeFont
CAPTION = "The new date"
Hint = "Click to send date to the Clipboard\nand the Days Difference lower row.\nDouble-click to send to upper row."
ShowHint = 1
Cursor = -21
OnClick = TransDateDn
OnDblClick = TransDateUp
END CREATE
CREATE WeekdayPanel AS QPANEL
Left = 10
Top = 130
Width = 210
COLOR = Black
Font = TimeFont
CAPTION = "Day of the week"
Hint = "Click to post today's date on the upper row."
ShowHint = 1
Cursor = -21
OnClick = DayTodayLt
END CREATE
CREATE Cal AS QOVALBTN
Left = 105
Top = 172
Height = 20
Width = 20
Flat = 1
Down = 1
Hint = "Click to bring up the calendar."
ShowHint = 1
Cursor = -12
OnClick = Calendar
END CREATE
END CREATE
CREATE DaysDForm AS QPANEL
CAPTION = "Days Difference"
Top = 20
Left = 250
Width = 230
Height = 195
Cursor = -21
Hint = "Click to change the backdrop."
ShowHint = 1
OnClick = TopMost
CREATE Month1 AS QEDIT
Text = LEFT$(DATE$,2)
Left = 10
Top = 5
Width = 65
TabOrder = 1
OnKeyPress = DaysDifference
END CREATE
CREATE Day1 AS QEDIT
Text = MID$(DATE$,4,2)
Left = 82
Top = 5
Width = 65
TabOrder = 2
OnKeyPress = DaysDifference
END CREATE
CREATE Year1 AS QEDIT
Text = RIGHT$(DATE$,4)
Left = 154
Top = 5
Width = 65
TabOrder = 3
OnKeyPress = DaysDifference
END CREATE
CREATE Month2 AS QEDIT
Text = "End month"
Left = 10
Top = 30
Width = 65
TabOrder = 4
OnKeyPress = DaysDifference
END CREATE
CREATE Day2 AS QEDIT
Text = "End day"
Left = 82
Top = 30
Width = 65
TabOrder = 5
OnKeyPress = DaysDifference
END CREATE
CREATE Year2 AS QEDIT
Text = "End year"
Left = 154
Top = 30
Width = 65
TabOrder = 6
OnKeyPress = DaysDifference
END CREATE
CREATE DaysButt AS QBUTTON
Font = Arial9B
CAPTION = "Days Difference"
Left = 10
Top = 65
Width = 210
Height = 25
Cursor = -21
Hint = "Click to get the difference in days between the dates"
ShowHint = 1
OnClick = preDaysDifference
END CREATE
CREATE DaysPanel AS QPANEL
Left = 10
Top = 90
Width = 210
COLOR = Black
Font = TimeFont
CAPTION = "Difference in days"
Hint = "Click to send result to the Clipboard \nand to Days-past on the left.\nDouble-click to send to Days-hence,\nalso on the left."
ShowHint = 1
Cursor = -21
OnClick = TransDaysLeft
OnDblClick = TransDaysRight
END CREATE
CREATE WeeksPanel AS QPANEL
Left = 10
Top = 130
Width = 210
COLOR = Black
Font = TimeFont
CAPTION = "Difference in weeks"
Hint = "Click to cycle through weeks, months and years."
ShowHint = 1
Cursor = -21
OnClick = YearsMonths
END CREATE
CREATE Noise AS QOVALBTN
Left = 105
Top = 172
Height = 20
Width = 20
Flat = 1
Down = 1
Hint = "Click to turn on/off sound effects."
ShowHint = 1
Cursor = -12
OnClick = Noisemaker
END CREATE
END CREATE
CREATE NoteProductForm AS QFORM
Top = Screen.Height/2 + 25
Left = Screen.Width/2 - 170
Width = 340
Height = 205
COLOR = &HCC000
BorderStyle = 1
DelBorderIcons(biMaximize)
DelBorderIcons(biMinimize)
BorderStyle = bsSingle
FormStyle = fsStayOnTop
CAPTION = "Notes on Days"
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 " » Days 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 " » Days is an easy-to-use date "
AddItems " calculator and calendar that can"
AddItems " easily calculate the difference"
AddItems " in days, weeks, months or years "
AddItems " between two dates or get the date "
AddItems " in the future or past given the "
AddItems " number of days from any specified "
AddItems " date."
AddItems ""
AddItems " » To use Days, just follow the hints"
AddItems " attached to each button, panel or"
AddItems " display. Days doesn't use menus."
AddItems ""
AddItems " » Days has two panels: the left one"
AddItems " calculates new dates; the right "
AddItems " one, days difference."
AddItems ""
AddItems " » To get a new date in the past from,"
AddItems " say, today, enter the number "
AddItems " of days in the Days-past (left)"
AddItems " field. Conversely, to get a future"
AddItems " date, enter the number of days"
AddItems " in the Days-hence (right) field."
AddItems ""
AddItems " » To get the day of the week of any"
AddItems " date, just input the date in the "
AddItems " upper row of the left panel and "
AddItems " press Enter or click New Date."
AddItems ""
AddItems " » If both Days-past and Days-hence "
AddItems " are filled, Days calculates for "
AddItems " days past."
AddItems ""
AddItems " » To calculate the difference between"
AddItems " two dates, you must fill in six "
AddItems " fields, three to each row. The first "
AddItems " field on either row is for the month; "
AddItems " the second, for the day; the third, "
AddItems " for the year."
AddItems ""
AddItems " » You can use either numbers or words"
AddItems " (e.g. 01, 1, Jan, jan., january), "
AddItems " the calculator will know what to do. "
AddItems " The year, however, must be written "
AddItems " in full and in numbers."
AddItems ""
AddItems " » Press Enter while in any of the "
AddItems " fields or click on the appropriate "
AddItems " button to get the answer."
AddItems ""
AddItems " » Click The-new-date panel to send the "
AddItems " new date to the lower-row fields of "
AddItems " Days Difference and the Clipboard. "
AddItems " Double-click to send the new date "
AddItems " to the upper row. "
AddItems ""
AddItems " » Click the Difference-in-days panel "
AddItems " to send the result to the Days-past"
AddItems " field and also to the Clipboard. "
AddItems " Double-click to send it to the "
AddItems " Days-hence field. "
AddItems ""
AddItems " » Clicking on the Day-of-the-week "
AddItems " posts the current date on the left "
AddItems " upper-row field. Clicking on the "
AddItems " Weeks panel cycles through the "
AddItems " number of weeks, months and years."
AddItems ""
AddItems " » Theoretically, Days can calculate "
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's "
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 " » You can put Days always on top "
AddItems " by clicking on the green backdrop "
AddItems " on the right."
AddItems ""
AddItems " » Days remembers your preferences--"
AddItems " no need to readjust your settings "
AddItems " each time you use it."
AddItems ""
AddItems " » Click the round depression at the"
AddItems " bottom of the left panel to access"
AddItems " Days' perpetual calendar."
AddItems ""
AddItems " » Using the calendar 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 "Programming"
AddItems " » Days was written in Rapid-Q, a"
AddItems " computer language developed by "
AddItems " William Yu. It's also freeware at"
AddItems " www.basicguru.com/abc/rapidq."
END CREATE
CREATE NotesP0 AS QLABEL
Top = 3
Left = 255
Width = 84
Font = Arial10B
CAPTION = "Days 2.61"
Alignment = taCenter
Layout = -1
LabelStyle = 1
OnClick = SendMe
Hint = "Click to go to website"
ShowHint = 1
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
CREATE CalendarForm AS QFORM
Visible = 0
CAPTION = "Days"
Width = 216
Height = 224
Center
BorderStyle = 1
FormStyle = fsStayOnTop
DelBorderIcons(biMaximize)
DelBorderIcons(biMinimize)
Hint = "Click background to look for a new backdrop image file."
ShowHint = 1
OnClose = CloseCalendar
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 BackdropButt AS QOVALBTN
CAPTION = "B"
Left = 175
Top = 169
Height = 25
Width = 27
Flat = 1
Layout = -1
Font = Arial8B
Hint = "Click to change the backdrop."
ShowHint = 1
OnClick = CalendarColor
END CREATE
CREATE ColorButt AS QOVALBTN
CAPTION = "C"
Left = 147
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 DayButt AS QOVALBTN
Left = 147
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 = 101
Width = 24
Height = 24
Hint = "Click left or right to change years."
ShowHint = 1
Min = 0
Max = 65000
Position = VAL(Year.Text)
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
OnKeyPress = YearChanged
END CREATE
END CREATE
CREATE One AS QPANEL
Left = 7
Top = 42
CAPTION = "Sun"
Width = 27
Height = 25
BevelOuter = 1
Hint = "Click to show 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 to show 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 to show 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 to show 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 to show 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 to show 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 to show today's date"
Showhint = 1
OnClick = Today
END CREATE
END CREATE
END CREATE
SUB Initialize
RANDOMIZE
IF FILEEXISTS("days.ini") <> 0 THEN
DIM File AS QFILESTREAM
File.OPEN("days.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))
ccolorcount = VAL(MID$(inifile,5,1))
buttcolor = 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"
IF soundoff = 0 THEN PLAYWAV(clocktow,1)
Application.HintShortPause = 25
Application.HintPause = 25
Application.HintHidePause = 12000
PanelColors
ButtonColor
CalendarColor
juston = 1
New_Date(13)
dayname$ = "(" + wday$ - "!" + ")"
thedate$ = month$ + " " + STR$(fday) + ", " + STR$(fyear) + " " + dayname$ + " "
Time
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
IF military = 1 THEN
DaysDates.CAPTION = thedate$ + STR$(milhour) + ":0" + STR$(min) + RIGHT$(TIME$,3)
ELSE
thetime$ = STR$(hour) + ":0" + STR$(min) + RIGHT$(TIME$,3) + ampm$
spaceCap$ = SPACE$((64 - LEN("Days" + thedate$ + thetime$))*.875)
DaysDates.CAPTION = "Days" + spaceCap$ + thedate$ + thetime$
END IF
ELSE
IF military = 1 THEN
DaysDates.CAPTION = thedate$ + TIME$
ELSE
thetime$ = STR$(hour) + ":" + STR$(min) + RIGHT$(TIME$,3) + ampm$
spaceCap$ = SPACE$((64 - LEN("Days" + thedate$ + thetime$))*.875)
DaysDates.CAPTION = "Days" + spaceCap$ + thedate$ + thetime$
END IF
END IF
END SUB
SUB preNew_Date
New_Date(13)
END SUB
SUB New_Date(key AS BYTE)
IF key <> 13 THEN EXIT SUB
IF soundoff = 0 THEN PLAYWAV(whoosh,1)
byear = VAL(REPLACESUBSTR$(Year.Text,",",""))
GetMonth(Month.Text)
bmonth = monthchecked
bday = VAL(Day.Text)
dayshence = VAL(REPLACESUBSTR$(DayHence.Text,",",""))
daysthence = VAL(REPLACESUBSTR$(DayThence.Text,",",""))
IF daysthence = 0 THEN
eday = bday
eyear = byear
emonth = bmonth
SELECT CASE emonth
CASE 1,3,5,7,8,10,12
monthdays = 31
CASE 4,6,9,11
monthdays = 30
CASE 2
IF eyear MOD 4 = 0 THEN
leapday = 1
IF eyear MOD 100 = 0 AND eyear MOD 400 <> 0 THEN leapday = 0
ELSE
leapday = 0
END IF
monthdays = 28 + leapday
END SELECT
totdays = eday + dayshence
IF monthdays >= totdays THEN
fday = totdays
ELSE
neweday = monthdays
DO
INC emonth
IF emonth = 13 THEN
emonth = 1
INC eyear
END IF
SELECT CASE emonth
CASE 1,3,5,7,8,10,12
monthdays = 31
CASE 4,6,9,11
monthdays = 30
CASE 2
IF eyear MOD 4 = 0 THEN
leapday = 1
IF eyear MOD 100 = 0 AND eyear MOD 400 <> 0 THEN leapday = 0
ELSE
leapday = 0
END IF
monthdays = 28 + leapday
END SELECT
neweday = neweday + monthdays
LOOP UNTIL neweday > totdays
DEC neweday,monthdays
fday = totdays - neweday
END IF
fmonth = emonth
fyear = eyear
ELSE
pday = bday
pyear = byear
pmonth = bmonth
IF daysthence < pday THEN
fday = pday - daysthence
ELSE
monthdays = 0
newpday = pday
DO
DEC pmonth
IF pmonth = 0 THEN
pmonth = 12
DEC pyear
END IF
SELECT CASE pmonth
CASE 1,3,5,7,8,10,12
monthdays = 31
CASE 4,6,9,11
monthdays = 30
CASE 2
IF pyear MOD 4 = 0 THEN
leapday = 1
IF pyear MOD 100 = 0 AND pyear MOD 400 <> 0 THEN leapday = 0
ELSE
leapday = 0
END IF
monthdays = 28 + leapday
END SELECT
newpday = newpday + monthdays
LOOP UNTIL newpday > daysthence
fday = newpday - daysthence
END IF
fmonth = pmonth
fyear = pyear
END IF
IF fday = 0 THEN
SELECT CASE fmonth
CASE 5,7,8,10,12
fday = 30
DEC fmonth
CASE 1
fday = 31
fmonth = 12
CASE 2,4,6,9,11
fday = 31
DEC fmonth
CASE 3
fmonth = 2
fday = 28
IF fyear MOD 4 = 0 THEN
fday = 29
IF fyear MOD 100 = 0 AND fyear MOD 400 <> 0 THEN fday = 28
END IF
END SELECT
END IF
SELECT CASE fmonth
CASE 1
month$ = "January"
CASE 2
month$ = "February"
CASE 3
month$ = "March"
CASE 4
month$ = "April"
CASE 5
month$ = "May"
CASE 6
month$ = "June"
CASE 7
month$ = "July"
CASE 8
month$ = "August"
CASE 9
month$ = "September"
CASE 10
month$ = "October"
CASE 11
month$ = "November"
CASE 12
month$ = "December"
END SELECT
IF fyear = 0 THEN
fyear = 1
DatePanel.CAPTION = STR$(fyear) + " BC"
ELSEIF fyear < 0 THEN
fyear = ABS(fyear) + 1
DatePanel.CAPTION = STR$(fyear) + " BC"
ELSE
IF month$ = "December" AND fday = 31 THEN
IF daysthence = 0 AND dayshence <> 0 THEN DEC fyear
END IF
IF thedate$ <> "" THEN DatePanel.CAPTION = month$ + " " + STR$(fday) + ", " + STR$(fyear)
circa = 1
DaysDifference(13)
END IF
END SUB
SUB preDaysDifference
DaysDifference(13)
END SUB
SUB DaysDifference(key AS BYTE)
IF key <> 13 THEN EXIT SUB
IF circa = 0 THEN
IF soundoff = 0 THEN PLAYWAV(whoosh,1)
GetMonth(Month2.text)
monthnow = monthchecked
daynow = VAL(Day2.text)
yearnow = VAL(Year2.text)
GetMonth(Month1.text)
monththen = monthchecked
daythen = VAL(Day1.text)
yearthen = VAL(Year1.text)
ELSEIF circa = 1 THEN
monthnow = fmonth
yearnow = fyear
daynow = fday
monththen = 1
yearthen = 1900
daythen = 1
END IF
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
IF circa = 1 THEN
circa = 0
IF fday = 0 OR fmonth = 0 OR fyear = 0 THEN
todate = 8
ELSE
todate = diffdays MOD 7
END IF
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!"
IF daysthence = 0 AND past = 0 THEN
weekday$ = "It's a Monday!"
ELSEIF daysthence <> 0 OR past = 1 THEN
past = 0
weekday$ = "It was a Monday!"
END IF
CASE 1
IF fyear < 1900 THEN
wday$ = "Sunday!"
ELSE
wday$ = "Tuesday!"
END IF
IF daysthence = 0 AND past = 0 THEN
weekday$ = "It's a " + wday$
ELSEIF daysthence <> 0 OR past = 1 THEN
past = 0
weekday$ = "It was a " + wday$
END IF
CASE 2
IF fyear < 1900 THEN
wday$ = "Saturday!"
ELSE
wday$ = "Wednesday!"
END IF
IF daysthence = 0 AND past = 0 THEN
weekday$ = "It's a " + wday$
ELSEIF daysthence <> 0 OR past = 1 THEN
past = 0
weekday$ = "It was a " + wday$
END IF
CASE 3
IF fyear < 1900 THEN
wday$ = "Friday!"
ELSE
wday$ = "Thursday!"
END IF
IF daysthence = 0 AND past = 0 THEN
weekday$ = "It's a " + wday$
ELSEIF daysthence <> 0 OR past = 1 THEN
past = 0
weekday$ = "It was a " + wday$
END IF
CASE 4
IF fyear < 1900 THEN
wday$ = "Thursday!"
ELSE
wday$ = "Friday!"
END IF
IF daysthence = 0 AND past = 0 THEN
weekday$ = "It's a " + wday$
ELSEIF daysthence <> 0 OR past = 1 THEN
past = 0
weekday$ = "It was a " + wday$
END IF
CASE 5
IF fyear < 1900 THEN
wday$ = "Wednesday!"
ELSE
wday$ = "Saturday!"
END IF
IF daysthence = 0 AND past = 0 THEN
weekday$ = "It's a " + wday$
ELSEIF daysthence <> 0 OR past = 1 THEN
past = 0
weekday$ = "It was a " + wday$
END IF
CASE 6
IF fyear < 1900 THEN
wday$ = "Tuesday!"
ELSE
wday$ = "Sunday!"
END IF
IF daysthence = 0 AND past = 0 THEN
weekday$ = "It's a " + wday$
ELSEIF daysthence <> 0 OR past = 1 THEN
past = 0
weekday$ = "It was a " + wday$
END IF
CASE ELSE
weekday$ = "Error. Check date entry."
END SELECT
IF thedate$ <> "" THEN WeekDayPanel.CAPTION = weekday$
ELSE
IF ABS(diffdays) = 1 THEN
days$ = " day"
ELSE
days$ = " days"
END IF
DaysPanel.CAPTION = FORMAT$("%.0n",diffdays) + days$
diffdays = ABS(diffdays)
remaindays = diffdays MOD 7
IF remaindays = 1 THEN
remaindays$ = " " + STR$(remaindays) + " day)"
ELSEIF remaindays > 1 THEN
remaindays$ = " " + STR$(remaindays) + " days)"
ELSEIF remaindays = 0 THEN
remaindays$ = ")"
ELSE
diffdays = 0
remaindays$ = ")"
END IF
IF ABS(diffdays\7) = 1 THEN
weeks$ = " week"
ELSE
weeks$ = " weeks"
END IF
WeeksPanel.CAPTION = "(" + STR$(diffdays\7) + weeks$ + remaindays$
PreWeeksPanel$ = WeeksPanel.CAPTION
END IF
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 GetMonth
validmonth = VAL(monthtocheck)
IF validmonth > 12 THEN monthtocheck = STR$(validmonth MOD 12)
SELECT CASE LCASE$(monthtocheck)
CASE "1","01","jan","jan.","january"
monthchecked = 1
CASE "2","02","feb","feb.","february"
monthchecked = 2
CASE "3","03","mar","mar.","march"
monthchecked = 3
CASE "4","04","apr","apr.","april"
monthchecked = 4
CASE "5","05","may.","may"
monthchecked = 5
CASE "6","06","jun","jun.","june"
monthchecked = 6
CASE "7","07","jul","jul.","july"
monthchecked = 7
CASE "8","08","aug","aug.","august"
monthchecked = 8
CASE "9","09","sep","sep.","sept","sept.","september"
monthchecked = 9
CASE "10","oct","oct.","october"
monthchecked = 10
CASE "11","nov","nov.","november"
monthchecked = 11
CASE "12","dec","dec.","december"
monthchecked = 12
END SELECT
END SUB
SUB TopMost
IF always = 0 THEN
always = 1
ELSEIF always = 1 THEN
always = 0
END IF
END SUB
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=Attention_Days_croaks",0)
IF dummy = 0 THEN
SHOWMESSAGE "Can't find your Start program. Please do manual email instead."
END IF
END IF
END SUB
SUB TransDaysLeft
DayThence.Text = LEFT$(DaysPanel.CAPTION,INSTR(DaysPanel.CAPTION," ")-1)
Clipboard.Text = DayThence.Text
END SUB
SUB TransDaysRight
DayHence.Text = LEFT$(DaysPanel.CAPTION,INSTR(DaysPanel.CAPTION," ")-1)
END SUB
SUB TransDateUp
Day1.Text = STR$(fday)
Month1.Text = STR$(fmonth)
Year1.Text = STR$(fyear)
END SUB
SUB TransDateDn
Day2.Text = STR$(fday)
Month2.Text = STR$(fmonth)
Year2.Text = STR$(fyear)
Clipboard.Text = DatePanel.CAPTION
END SUB
SUB DayTodayLt
Day.Text = MID$(DATE$,4,2)
Month.Text = LEFT$(DATE$,2)
Year.Text = RIGHT$(DATE$,4)
END SUB
SUB YearsMonths
totweeks = INT(diffdays/7)
inttotyears = (diffdays - 366*betleaps)/365 + 366*betleaps/366
totyears = FIX(inttotyears)
totmonths = 12*FIX(inttotyears) + CEIL(12*FRAC(inttotyears))
INC countyrsmos
IF countyrsmos = 5 THEN countyrsmos = 1
SELECT CASE countyrsmos
CASE 1
yrsmos$ = STR$(totmonths)
unit$ = " months"
CASE 2
yrsmos$ = STR$(totyears)
unit$ = " years"
CASE 3
yrsmos$ = STR$(totweeks)
unit$ = " weeks"
END SELECT
IF countyrsmos = 4 THEN
WeeksPanel.CAPTION = PreWeeksPanel$
ELSE
IF VAL(yrsmos$) <= 1 THEN unit$ = unit$ - "s"
WeeksPanel.CAPTION = "(" + yrsmos$ + unit$ + ")"
END IF
END SUB
SUB CloseNoteProductForm
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$ = "days.ini"
ELSE
where$ = iDir + "\\" + "days.ini"
END IF
File.OPEN(where$,fmCreate)
inifile = STR$(colorcount) + STR$(always) + STR$(soundoff)_
+ STR$(blinking) + STR$(ccolorcount) + STR$(buttcolor)_
+ 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
END SUB
SUB Noisemaker
IF soundoff = 0 THEN
Noise.Hint = "Click to turn on sound effects."
soundoff = 1
ELSE
PLAYWAV(handbell,1)
Noise.Hint = "Click to turn off sound effects."
soundoff = 0
END IF
END SUB
SUB MonthChanged(Sender AS QMENUITEM)
Month.Text = Sender.CAPTION
New_Date(13)
Calendar
END SUB
SUB YearChanged(key AS BYTE)
IF key <> 13 THEN EXIT SUB
Year.Text = CYear.Text
DayThence.Text = "0"
DayHence.Text = "0"
New_Date(13)
UpDownYr.Position = fyear
Calendar
END SUB
SUB DayChanged(Sender AS QCOOLBTN)
Day.Text = Sender.CAPTION
Daythence.Text = ""
Dayhence.Text = ""
New_Date(13)
Calendar
END SUB
SUB Calendar
CalendarForm.Visible = 1
IF soundoff = 0 THEN PLAYWAV(handbell,1)
CYear.Text = STR$(fyear)
CMonth.CAPTION = month$
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 LoopColor
IF blinking = 0 THEN DayButt.COLOR = 15661818*(1+RND*(5))
END SUB
SUB PanelColors
IF DaysDates.Visible = 1 THEN INC colorcount
IF colorcount = 6 THEN colorcount = 0
SELECT CASE colorcount
CASE 0
NewDForm.COLOR = &HBCCAAA
CASE 1
NewDForm.COLOR = &HEEFAFA
CASE 2
NewDForm.COLOR = &HCCC000
CASE 3
NewDForm.COLOR = &HGCCC
CASE 4
NewDForm.COLOR = &HA000
CASE 5
NewDForm.COLOR = &HEFFF
END SELECT
DaysDForm.COLOR = NewDForm.COLOR
END SUB
SUB CalendarColor
IF juston = 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
PanelColors
END SUB
SUB UpdownYear
CYear.Text = STR$(UpDownYr.Position)
Year.Text = CYear.Text
New_Date(13)
Calendar
END SUB
SUB CloseCalendar
IF soundoff = 0 THEN PLAYWAV(whoosh,1)
Deanimate(CalendarForm.Handle)
CalendarForm.Visible = 0
END SUB
SUB PaintForm
PaintDesktop GetDC(DaysDates.Handle)
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
SetFocus(CalendarForm.Handle)
END SELECT
END SUB
SUB Deanimate(Handle AS INTEGER)
AnimateWindow Handle, 300, AW_CENTER OR AW_HIDE
END SUB
SUB Today
Day.Text = MID$(DATE$,4,2)
Month.Text = LEFT$(DATE$,2)
Year.Text = "20" + RIGHT$(DATE$,2)
Daythence.Text = ""
Dayhence.Text = ""
New_Date(13)
UpDownYr.Position = fyear
Calendar
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 CloseDays
IF soundoff = 0 THEN PLAYWAV(whoosh,1)
Deanimate(DaysDates.Handle)
END SUB
Initialize
DaysDates.SHOWMODAL
Nights
Application.Terminate
|
|
搜索
论坛
Home
回顶部
g.yi.org Hits:0 Last modified:2002-09-21 20:53:08
