'=========================================================================== ' Subject: DATE MODIFYING PROCEDURES Date: 11-11-97 (11:43) ' Author: Hauke Daempfling Code: QB, QBasic, PDS ' Origin: hcd@berlin.snafu.de Packet: DATETIME.ABC '=========================================================================== TYPE DateType Day AS INTEGER Month AS INTEGER Year AS INTEGER END TYPE ' by Hauke Daempfling ' hcd@berlin.snafu.de ' '(c)1996 Hauke Daempfling ' ' Give me credit if used!... thanx! :) ' ' Date-modifiying procedures: ' ValidDate: returns -1 if the Date (of DateType) is valid ' DateString: convert DateType back to string format ' DaysPerMonth: returns the number of days in a certain month ' AddDays: adds days to a DateType, keeps months & years "in mind" ' ReadDate: convert a date string (QB DATE$ variable!) to a DateType DEFINT A-Z SUB AddDays (Date AS DateType, Days AS INTEGER) Date.Day = Date.Day + Days AddDaysCheckThis: IF Date.Day > DaysPerMonth(Date.Month) THEN Date.Day = Date.Day - DaysPerMonth(Date.Month) Date.Month = Date.Month + 1 GOTO AddDaysCheckThis END IF IF Date.Month > 12 THEN Date.Month = Date.Month - 12 Date.Year = Date.Year + 1 GOTO AddDaysCheckThis END IF END SUB FUNCTION DateString$ (Date AS DateType) x$ = LTRIM$(RTRIM$(STR$(Date.Month))) m$ = "00" MID$(m$, 3 - LEN(x$)) = x$ x$ = LTRIM$(RTRIM$(STR$(Date.Day))) d$ = "00" MID$(d$, 3 - LEN(x$)) = x$ x$ = LTRIM$(RTRIM$(STR$(Date.Year))) y$ = "0000" MID$(y$, 5 - LEN(x$)) = x$ DateString$ = m$ + "-" + d$ + "-" + y$ END FUNCTION FUNCTION DaysPerMonth (Month AS INTEGER) SELECT CASE Month CASE 1, 3, 5, 7, 8, 10, 12 d = 31 CASE 4, 6, 9, 11 d = 30 CASE 2 d = 28 CASE ELSE d = 30 END SELECT DaysPerMonth = d END FUNCTION SUB ReadDate (DateStr$, Date AS DateType) Date.Month = VAL(MID$(DateStr$, 1, 2)) Date.Day = VAL(MID$(DateStr$, 4, 2)) Date.Year = VAL(MID$(DateStr$, 7, 4)) END SUB FUNCTION ValidDate (Date AS DateType) IF Date.Month < 1 OR Date.Month > 12 THEN EXIT FUNCTION IF Date.Day < 1 OR Date.Day > DaysPerMonth(Date.Month) THEN EXIT FUNCTION IF Date.Year < 1 OR Date.Year > 9999 THEN EXIT FUNCTION ValidDate = -1 END FUNCTION