home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / QBAS / PBC22B.ZIP / PBC$BAS.ZIP / FORMDATE.BAS < prev    next >
BASIC Source File  |  1993-01-01  |  3KB  |  88 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        PBClone  Copyright (c) 1990-1993  Thomas G. Hanlin III        |
  4. '   |                                                                      |
  5. '   +----------------------------------------------------------------------+
  6.  
  7.    DECLARE SUB CheckDate (BYVAL MonthNr%, BYVAL DayNr%, BYVAL YearNr%, ErrCode%)
  8.    DECLARE SUB TInstr (St$, BYVAL ChrType%, Place%)
  9.  
  10. SUB FormatDate (DateSt$, FormatSt$, Result$, ErrCode%)
  11.    ErrCode% = -1
  12.  
  13.    IF LEN(DateSt$) THEN
  14.       Dt$ = DateSt$
  15.    ELSE
  16.       Dt$ = DATE$
  17.    END IF
  18.  
  19.    IF LEN(FormatSt$) THEN
  20.       DateFormat$ = UCASE$(FormatSt$)
  21.    ELSE
  22.       DateFormat$ = "MM/DD/YY"
  23.    END IF
  24.  
  25.    MonthNr% = CINT(VAL(Dt$))
  26.    TInstr Dt$, NOT 2, Place%
  27.    IF Place% = 0 THEN EXIT SUB
  28.    Dt$ = MID$(Dt$, Place% + 1)
  29.    DayNr% = CINT(VAL(Dt$))
  30.    TInstr Dt$, NOT 2, Place%
  31.    IF Place% = 0 THEN EXIT SUB
  32.    Dt$ = MID$(Dt$, Place% + 1)
  33.    YearNr% = CINT(VAL(Dt$))
  34.    IF YearNr% < 100 THEN YearNr% = YearNr% + 1900
  35.  
  36.    CheckDate MonthNr%, DayNr%, YearNr%, ErrCode%
  37.    IF ErrCode% THEN EXIT SUB
  38.  
  39.    tmp$ = DateFormat$
  40.    DO
  41.       ch$ = LEFT$(tmp$, 1)
  42.       IF INSTR("MDY#", ch$) = 0 THEN Delim$ = ch$
  43.       tmp$ = MID$(tmp$, 2)
  44.    LOOP UNTIL LEN(Delim$) > 0 OR LEN(tmp$) = 0
  45.  
  46.    IF LEN(Delim$) = 0 AND INSTR(DateFormat$, "#") > 0 THEN
  47.       IF LEN(DateFormat$) = 6 THEN
  48.          DateFormat$ = "MMDDYY"
  49.       ELSE
  50.          DateFormat$ = "MMDDYYYY"
  51.       END IF
  52.    END IF
  53.  
  54.    IF INSTR(DateFormat$, "####") OR INSTR(DateFormat$, "YYYY") THEN
  55.       YearLen% = 4
  56.    ELSE
  57.       YearLen% = 2
  58.    END IF
  59.  
  60.    M% = INSTR(DateFormat$, "M")
  61.    D% = INSTR(DateFormat$, "D")
  62.    Y% = INSTR(DateFormat$, "Y")
  63.    IF M% > 0 AND D% > 0 AND Y% > 0 THEN
  64.       MM% = 1 - ((M% > D%) + (M% > Y%))
  65.       DD% = 1 - ((D% > M%) + (D% > Y%))
  66.       YY% = 1 - ((Y% > M%) + (Y% > D%))
  67.       Order$ = "xxx"
  68.       MID$(Order$, MM%, 1) = "M"
  69.       MID$(Order$, DD%, 1) = "D"
  70.       MID$(Order$, YY%, 1) = "Y"
  71.    ELSE
  72.       Order$ = "MDY"
  73.    END IF
  74.  
  75.    Result$ = ""
  76.    FOR tmp% = 1 TO 3
  77.       SELECT CASE MID$(Order$, tmp%, 1)
  78.          CASE "M"
  79.             Result$ = Result$ + Delim$ + RIGHT$("0" + MID$(STR$(MonthNr%), 2), 2)
  80.          CASE "D"
  81.             Result$ = Result$ + Delim$ + RIGHT$("0" + MID$(STR$(DayNr%), 2), 2)
  82.          CASE "Y"
  83.             Result$ = Result$ + Delim$ + RIGHT$("000" + MID$(STR$(YearNr%), 2), YearLen%)
  84.       END SELECT
  85.    NEXT
  86.    IF LEN(Delim$) THEN Result$ = MID$(Result$, 2)
  87. END SUB
  88.