Category : BASIC Source Code
Archive   : PBC30B.ZIP
Filename : FORMDATE.BAS

' +----------------------------------------------------------------------+
' | |
' | PBClone Copyright (c) 1990-1994 Thomas G. Hanlin III |
' | |
' +----------------------------------------------------------------------+

DECLARE SUB CheckDate (BYVAL MonthNr%, BYVAL DayNr%, BYVAL YearNr%, ErrCode%)
DECLARE SUB TInstr (St$, BYVAL ChrType%, Place%)

SUB FormatDate (DateSt$, FormatSt$, Result$, ErrCode%)
ErrCode% = -1

IF LEN(DateSt$) THEN
Dt$ = DateSt$
ELSE
Dt$ = DATE$
END IF

IF LEN(FormatSt$) THEN
DateFormat$ = UCASE$(FormatSt$)
ELSE
DateFormat$ = "MM/DD/YY"
END IF

MonthNr% = CINT(VAL(Dt$))
TInstr Dt$, NOT 2, Place%
IF Place% = 0 THEN EXIT SUB
Dt$ = MID$(Dt$, Place% + 1)
DayNr% = CINT(VAL(Dt$))
TInstr Dt$, NOT 2, Place%
IF Place% = 0 THEN EXIT SUB
Dt$ = MID$(Dt$, Place% + 1)
YearNr% = CINT(VAL(Dt$))
IF YearNr% < 100 THEN YearNr% = YearNr% + 1900

CheckDate MonthNr%, DayNr%, YearNr%, ErrCode%
IF ErrCode% THEN EXIT SUB

tmp$ = DateFormat$
DO
ch$ = LEFT$(tmp$, 1)
IF INSTR("MDY#", ch$) = 0 THEN Delim$ = ch$
tmp$ = MID$(tmp$, 2)
LOOP UNTIL LEN(Delim$) > 0 OR LEN(tmp$) = 0

IF LEN(Delim$) = 0 AND INSTR(DateFormat$, "#") > 0 THEN
IF LEN(DateFormat$) = 6 THEN
DateFormat$ = "MMDDYY"
ELSE
DateFormat$ = "MMDDYYYY"
END IF
END IF

IF INSTR(DateFormat$, "####") OR INSTR(DateFormat$, "YYYY") THEN
YearLen% = 4
ELSE
YearLen% = 2
END IF

M% = INSTR(DateFormat$, "M")
D% = INSTR(DateFormat$, "D")
Y% = INSTR(DateFormat$, "Y")
IF M% > 0 AND D% > 0 AND Y% > 0 THEN
MM% = 1 - ((M% > D%) + (M% > Y%))
DD% = 1 - ((D% > M%) + (D% > Y%))
YY% = 1 - ((Y% > M%) + (Y% > D%))
Order$ = "xxx"
MID$(Order$, MM%, 1) = "M"
MID$(Order$, DD%, 1) = "D"
MID$(Order$, YY%, 1) = "Y"
ELSE
Order$ = "MDY"
END IF

Result$ = ""
FOR tmp% = 1 TO 3
SELECT CASE MID$(Order$, tmp%, 1)
CASE "M"
Result$ = Result$ + Delim$ + RIGHT$("0" + MID$(STR$(MonthNr%), 2), 2)
CASE "D"
Result$ = Result$ + Delim$ + RIGHT$("0" + MID$(STR$(DayNr%), 2), 2)
CASE "Y"
Result$ = Result$ + Delim$ + RIGHT$("000" + MID$(STR$(YearNr%), 2), YearLen%)
END SELECT
NEXT
IF LEN(Delim$) THEN Result$ = MID$(Result$, 2)
END SUB