$INCLUDE "RAPIDQ.INC"
DECLARE SUB GetMonth(monthtocheck AS STRING)
DECLARE SUB GetDay(daytocheck AS STRING)
DECLARE SUB NewD
DECLARE SUB New_Date(key AS BYTE)
DECLARE SUB DaysD
DECLARE SUB DaysDifference(key AS BYTE)
DECLARE FUNCTION GetAOdays AS INTEGER
DECLARE FUNCTION GetOdays AS INTEGER
DEFWORD monthnow, monththen, monthchecked, yearnow, yearthen, betyears
DEFBYTE leapnow, leapthen, bleap, circa, weekday, fmonth, emonth, pmonth, todate, inthepast
DEFWORD byear, bmonth, bleapyear, yearhence, AOyears, fyear, eyear, pyear
DEFINT Bdays, rundays, edays, otherdays, totdays, yeardays,Odays, AOdays, diffdays, betleaps, daynow, daythen, Adays
DEFINT fday, eday, pday, neweday, newpday, monthdays, daysthence, dayshence, bday, days
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 DaysDates AS QFORM
Width = 500
Height = 250
Center
CAPTION = "DaysDates Calculator"
CREATE NewDForm AS QPANEL
COLOR = &HABC111
CAPTION = "New Date"
Top = 10
Left = 5
Width = 237
Height = 205
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 DayHence AS QEDIT
Text = "Days hence"
Left = 154
Top = 30
Width = 65
TabOrder = 5
OnKeyPress = New_Date
END CREATE
CREATE DateButt AS QPANEL
Font = Arial9B
CAPTION = "New Date"
Left = 10
Top = 65
Width = 210
Height = 25
END CREATE
CREATE DatePanel AS QPANEL
Left = 10
Top = 90
Width = 210
COLOR = Black
Font = TimeFont
CAPTION = "The new date"
END CREATE
CREATE WeekdayPanel AS QPANEL
Left = 10
Top = 130
Width = 210
COLOR = Black
Font = TimeFont
CAPTION = "Day of the week"
END CREATE
END CREATE
CREATE DaysDForm AS QPANEL
COLOR = &HABC111
CAPTION = "Days Difference"
Top = 10
Left = 250
Width = 237
Height = 205
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 QPANEL
Font = Arial9B
CAPTION = "Days Difference"
Left = 10
Top = 65
Width = 210
Height = 25
END CREATE
CREATE DaysPanel AS QPANEL
Left = 10
Top = 90
Width = 210
COLOR = Black
Font = TimeFont
CAPTION = "Difference in days"
END CREATE
CREATE WeeksPanel AS QPANEL
Left = 10
Top = 130
Width = 210
COLOR = Black
Font = TimeFont
CAPTION = "Difference in weeks"
END CREATE
END CREATE
END CREATE
DaysDates.SHOWMODAL
SUB New_Date(key AS BYTE)
IF key <> 13 THEN EXIT SUB
IF soundoff = 0 THEN PLAYWAV "whoosh.wav",1
byear = VAL(Year.Text)
GetMonth(Month.Text)
bmonth = monthchecked
bday = VAL(Day.Text)
dayshence = VAL(DayHence.Text)
daysthence = VAL(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
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
DatePanel.CAPTION = month$ + " " + STR$(fday) + ", " + STR$(fyear)
circa = 1
DaysDifference(key AS BYTE)
END SUB
SUB DaysDifference(key AS BYTE)
IF key <> 13 THEN EXIT SUB
IF circa = 0 THEN
IF soundoff = 0 THEN PLAYWAV "whoosh.wav",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
betleaps = betyears \ 4
trialyear = yearthen + 1
stepyear = 1
DO
IF trialyear MOD 100 = 0 THEN
IF trialyear MOD 400 <> 0 THEN DEC betleaps
stepyear = 100
END IF
INC trialyear,stepyear
LOOP UNTIL trialyear >= yearnow
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
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
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 daysthence = 0 AND past = 0 THEN
weekday$ = "It's a Tuesday!"
ELSEIF daysthence <> 0 OR past = 1 THEN
past = 0
weekday$ = "It was a Tuesday!"
END IF
CASE 2
IF daysthence = 0 AND past = 0 THEN
weekday$ = "It's a Wednesday!"
ELSEIF daysthence <> 0 OR past = 1 THEN
past = 0
weekday$ = "It was a Wednesday!"
END IF
CASE 3
IF daysthence = 0 AND past = 0 THEN
weekday$ = "It's a Thursday!"
ELSEIF daysthence <> 0 OR past = 1 THEN
past = 0
weekday$ = "It was a Thursday!"
END IF
CASE 4
IF daysthence = 0 AND past = 0 THEN
weekday$ = "It's a Friday!"
ELSEIF daysthence <> 0 OR past = 1 THEN
past = 0
weekday$ = "It was a Friday!"
END IF
CASE 5
IF daysthence = 0 AND past = 0 THEN
weekday$ = "It's a Saturday!"
ELSEIF daysthence <> 0 OR past = 1 THEN
past = 0
weekday$ = "It was a Saturday!"
END IF
CASE 6
IF daysthence = 0 AND past = 0 THEN
weekday$ = "It's a Sunday!"
ELSEIF daysthence <> 0 OR past = 1 THEN
past = 0
weekday$ = "It was a Sunday!"
END IF
CASE ELSE
weekday$ = "Error. Check date entry."
END SELECT
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$
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
|
|
搜索
论坛
Home
回顶部
g.yi.org Hits:0 Last modified:2000-12-29 19:37:12
