POINT Software Programming/PPROG1.ISO/basic/qbasic/function.bas

BASIC Source File | 1993-10-14 | 23.5 KB | 843 lines

  ' DISCLAIMER/WARRANTY INFORMATION
  ' ─────────────────────────────────────────────────────────────────
  ' Users of these Routines must accept this disclaimer of warranty:
  '
  ' These Routines are supplied as is. The author disclaims all
  ' warranties, expressed or implied, including, without limitation,
  ' the warranties of merchantability and of fitness for any purpose.
  ' The author assumes no liability for damages, direct or
  ' consequential, which may result from the use of these routines.
  '


  ' Placed in the public domain October 1993
  '
  ' by David Cantrell  CIS# 73730,2741
  '                    Fax# [phone]
  '
  '         ***** USE THESE ROUTINES AT YOUR OWN RISK *****
  '



  DEFINT A-Z        ' These Lines are required in your program
  %True = -1        ' for some of the routines to
  %False = 0        ' operate properly



  ' FUNCTION DaysApart(STRING, STRING)
  '
  '          Returns the number of days between the two dates, Leap Year aware
  '
  ' FUNCTION DaysInMonth(INTEGER, INTEGER)
  '
  '          Returns the number of Days in the Month, Leap Year aware
  '
  ' FUNCTION DosVer!
  '
  '          Returns DOS Version Number
  '
  ' FUNCTION EVEN(INTEGER)
  '
  '          Returns True if even number, False if not
  '
  ' FUNCTION FileExists(STRING)
  '
  '          Returns True if file exists along with Date, Time, Size & Atrib
  '
  ' FUNCTION FormatMoney$(STRING)
  '
  '          Returns string in dollars and cents, ie. two decimal places
  '
  ' FUNCTION GetProgPath$
  '
  '          Returns the Full Path of the current Program now executing
  '
  ' FUNCTION GetUserInput$(STRING, INTEGER, INTEGER)
  '
  '          Returns User Input from keyboard with Editing & Window Scrolling
  '
  ' FUNCTION INCRDate$(STRING, INTEGER)
  '
  '          Increments date by a specified number of days, Leap Year aware
  '
  ' FUNCTION INCRSeries$(STRING)
  '
  '          Increments an alfa/numeric String Series
  '
  ' FUNCTION NameOfDay$(STRING)
  '
  '          Returns the Name of the day of the week
  '
  ' FUNCTION ODD(INTEGER)
  '
  '          Returns True if odd number, False if not
  '
  ' FUNCTION ShiftedKeys
  '
  '          Returns True if Shift, Control or Alternate & which one
  '
  ' FUNCTION TodaysDate$
  '
  '          Returns System Date in the "YYYYMMDD" (Year,Month,Day) Format
  '
  ' FUNCTION TRIM$(STRING)
  '
  '          Trims off Leading and Trailing spaces from a string
  '
  ' FUNCTION ValidDate(STRING)
  '
  '          Returns True if Valid Date, False if not, Leap Year aware
  '


FUNCTION DaysApart(BYVAL DateFrom$, BYVAL DateTo$)

  ' Returns the number of days between the two dates
  ' This function is aware of leap years
  ' No modifications are made to either Date

  ' Requires Dates to be in "YYYYMMDD" (Year,Month,Day) Format
  ' Requires FUNCTION ValidDate
  ' Requires FUNCTION DaysInMonth

  ' Example: Print DaysApart("19930101","19940101") prints to the screen 365
  ' Example: Print DaysApart("19920101","19930101") prints to the screen 366
  '                                                      1992 was a Leap Year

  LOCAL FD, FM, FY, TD, TM, TY, Days

  DaysApart = 0
  Days = 0

  IF NOT(ValidDate(DateFrom$)) OR _
     NOT(ValidDate(DateTo$))   OR _
     VAL(DateFrom$) => VAL(DateTo$) THEN EXIT FUNCTION

  FY = VAL(LEFT$(DateFrom$, 4))                'From Year
  FM = VAL(MID$(DateFrom$,5,2))                '     Month
  FD = VAL(RIGHT$(DateFrom$,2))                '     Day

  TY = VAL(LEFT$(DateTo$,   4))                'To   Year
  TM = VAL(MID$(DateTo$,  5,2))                '     Month
  TD = VAL(RIGHT$(DateTo$,  2))                '     Day

  DO
    INCR FD
    INCR Days
    IF FD > DaysInMonth(FY,FM) THEN
      INCR FM
      FD = 1
      IF FM > 12 THEN
        INCR FY
        FM = 1
      END IF
    END IF
  LOOP UNTIL FY = TY AND FM = TM AND FD = TD

  DaysApart = Days

 END FUNCTION

FUNCTION DaysInMonth(BYVAL Year, BYVAL Month)

  ' Returns the number of Days in the Month
  ' No modifications are made to Year or Month
  ' Year info must be in full ie. 1993 NOT 93
  ' This function is aware of leap years

  ' Example PRINT DaysInMonth(1993,2) prints to the screen 28
  ' Example PRINT DaysInMonth(1992,2) prints to the screen 29
  '                                            1992 was a Leap Year

  DaysInMonth = 0

  IF Year < 1000 THEN EXIT FUNCTION

  SELECT CASE Month
    CASE 2
      IF (Year / 4) - FIX(Year / 4) = 0 THEN      'Leap Year
        DaysInMonth = 29
      ELSE                                        'Non-Leap Year
        DaysInMonth = 28
      END IF
    CASE 4, 6, 9, 11
      DaysInMonth = 30
    CASE ELSE
      DaysInMonth = 31
  END SELECT

 END FUNCTION

FUNCTION DosVer!

  ' Returns DOS Version Number
  ' i.e.  3.3  4.01  5.0 etc.

  REG 1, &H3000
  CALL INTERRUPT &H21
  DosVer! = REG(1) MOD 256 + (REG(1) \ 256) / 100

 END FUNCTION

FUNCTION EVEN(BYVAL Number)

  ' Returns True if even number, False if not
  ' No modifications are made to Number

  IF (Number / 2) - FIX(Number / 2) = 0 THEN
    EVEN = %True
  ELSE
    EVEN = %False
  END IF

 END FUNCTION

FUNCTION FileExists(BYVAL FileSpec$)

  ' Returns True if file exists based on setting of FileAttribute% (see below)
  ' No modifications are made to FileSpec$
  ' If True then this function also returns as shared variables:
  '    FileTime$ - "HH:MM:SS"
  '    FileDate$ - "MM/DD/YYYY"
  '    FileSize$ - "12345" - "12345678" etc.
  '    FileAttb$ - "∙∙∙∙∙" - "SHRAD"  or combination of the two where:
  '                           S = System
  '                           H = Hidden
  '                           R = Read Only
  '                           A = Archive
  '                           D = Directory
  '
  ' The Current Disk Transfer Area (DTA) is preserved!
  ' Requires FUNCTION TRIM$

  SHARED FileTime$, FileDate$, FileSize$, FileAttb$

  LOCAL FileSpec1$, FileAttribute%
  LOCAL OrigDTASeg??, OrigDTAOff??, TempDTA$, DTASeg??, DTAOff??
  LOCAL DTAAttr??, DTADate??, DTASize??, DTATime??, FDate%, FTime%, FileAtt%
  LOCAL Hours, Hours$, Minutes, Minutes$, Seconds, Seconds$
  LOCAL Month, Month$, Day, Day$, Year, Year$

  TempDTA$  = STRING$(43,0)                    ' Create a temporary DTA
  FileDate$ = ""
  FileTime$ = ""
  FileSize$ = ""
  FileAttb$ = ""

  REG 1,&H2F00                                 ' Save original DTA address
  CALL INTERRUPT &H21                          ' so that it is not altered
  OrigDTASeg?? = REG(9)
  OrigDTAOff?? = REG(2)

  DTASeg?? = STRSEG(TempDTA$)
  DTAOff?? = STRPTR(TempDTA$)
  DTAAttr?? = DTAOff?? + &H15
  DTATime?? = DTAOff?? + &H16
  DTADate?? = DTAOff?? + &H18
  DTASize?? = DTAOff?? + &H1A

  REG 1, &H1A00                                ' Set New DTA address
  REG 4, DTAOff??
  REG 8, DTASeg??
  CALL INTERRUPT &H21

  FileSpec1$ = FileSpec$ + CHR$(0)             ' Does file exist?

    ' File Attribute to search for: `FileAttribute%'
    ' 0  = Normal
    ' 2  = Normal & Hidden
    ' 4  = Normal & System
    ' 6  = Normal & Hidden & System
    ' 8  = Volume Labels
    ' 16 = Directories

    FileAttribute% = 6

  REG 1, &H4E00
  REG 3, FileAttribute%
  REG 4, STRPTR(FileSpec1$)
  REG 8, STRSEG(FileSpec1$)
  CALL INTERRUPT &H21
  IF (REG(0) AND 1) = 0 THEN

    FileExists = %True

    DEF SEG = DTASeg??
      FileAtt%  = PEEK(DTAAttr??)                   ' Read Temp DTA
      FileSize$ = TRIM$(STR$(PEEKL(DTASize??)))     ' for File Attributes
      FDate%    = PEEKI(DTADate??)                  ' Size, Date and Time
      FTime%    = PEEKI(DTATime??)                  '
    DEF SEG

    FileAttb$ = "∙∙∙∙∙"
    IF (FileAtt% AND &H20) THEN MID$(FileAttb$, 4, 1) = "A"     ' Attributes
    IF (FileAtt% AND &H10) THEN MID$(FileAttb$, 5, 1) = "D"
    IF (FileAtt% AND &H04) THEN MID$(FileAttb$, 1, 1) = "S"
    IF (FileAtt% AND &H02) THEN MID$(FileAttb$, 2, 1) = "H"
    IF (FileAtt% AND &H01) THEN MID$(FileAttb$, 3, 1) = "R"

    Hours = FTime% AND &HF800                                   ' Hours
    SHIFT RIGHT Hours, 11
    Hours$ = TRIM$(STR$(Hours))
    IF LEN(Hours$) = 1 THEN Hours$ = "0" + Hours$
    Minutes = FTime% AND &H07E0                                 ' Minutes
    SHIFT RIGHT Minutes, 5
    Minutes$ = TRIM$(STR$(Minutes))
    IF LEN(Minutes$) = 1 THEN Minutes$ = "0" + Minutes$
    Seconds = FTime% AND &H001F                                 ' Seconds
    Seconds$  = TRIM$(STR$(Seconds * 2))
    IF LEN(Seconds$) = 1 THEN Seconds$  = "0" + Seconds$

    FileTime$ = Hours$ + ":" + Minutes$ + ":" + Seconds$

    Month = FDate% AND &H01E0                                   ' Month
    SHIFT RIGHT Month, 5
    Month$ = TRIM$(STR$(Month))
    IF LEN(Month$) = 1 THEN Month$ = "0" + Month$
    Day = FDate% AND &H001F                                     ' Day
    Day$ = TRIM$(STR$(Day))
    IF LEN(Day$) = 1 THEN Day$ = "0" + Day$
    Year = FDate% AND &HFE00                                    ' Year
    SHIFT RIGHT Year, 9
    Year$ = TRIM$(STR$(Year + 1980))

    FileDate$ = Month$ + "/" + Day$ + "/" + Year$
  ELSE
    FileExists = %False
  END IF

  REG 1,&H1A00                                 ' Restore the original DTA
  REG 8,OrigDTASeg??
  REG 4,OrigDTAOff??
  CALL INTERRUPT &H21

 END FUNCTION

FUNCTION FormatMoney$(BYVAL MoneyVal$)

  ' Returns string formated in dollars and cents, ie. two decimal places
  ' No modifications are made to MoneyVal$
  ' Requires FUNCTION TRIM$

  ' Example PRINT FormatMoney$("25") prints to the screen 25.00
  ' Example PRINT FormatMoney$("5.2") prints to the screen 5.20
  ' Example PRINT FormatMoney$(" 5 ") prints to the screen 5.00

  LOCAL MVal$

  FormatMoney$ = ""

  MVal$ = TRIM$(MoneyVal$)

  IF VAL(MVal$) <> 0 THEN

    IF INSTR(MVal$, ".") = 0 THEN MVal$ = MVal$ + ".00"

    IF INSTR(MVal$, ".") > 0 AND _
       MID$(MVal$, LEN(MVal$) -1, 1) = "." THEN _
                                   MVal$ = MVal$ + "0"

    IF RIGHT$(MVal$, 1) = "." THEN MVal$ = MVal$ + "00"

    FormatMoney$ = MVal$

  END IF

 END FUNCTION

FUNCTION GetProgPath$

  ' Returns the Path of the current Program now executing
  ' This function can only be used with DOS 3.0 & up
  ' Requires FUNCTION DosVer!

  LOCAL EnvSeg??, LastBackSlash, Offset??, Path$, X

  GetProgPath$ = ""

  IF DosVer! < 3.0 THEN EXIT FUNCTION    ' This function is only available
                                         ' in DOS 3.0 & up

  REG 1, &H6200                          '
  CALL INTERRUPT &H21                    ' Get PSP Segment Address
  DEF SEG = REG(2)                       '

  EnvSeg?? = PEEKI(&H2C)                 ' Get the Segment Address of the DOS
  DEF SEG = EnvSeg??                     ' Environment from the PSP.

  Offset?? = 0
  DO                                     ' Find the end of the DOS environment
    INCR Offset??                        ' i.e. Two CHR$(0)'s in a row
  LOOP UNTIL PEEKI(Offset??) = 0         '

  INCR Offset??, 4                       ' Skip the CHR$(0)'s + two bytes

  DO                                     ' Load the ASCIIZ string containing
    Path$ = Path$ + CHR$(PEEK(Offset??)) ' the complete Drive, Path and Name
    INCR Offset??                        ' of the Parent Program
  LOOP UNTIL PEEK(Offset??) = 0          '

  DEF SEG

  LastBackSlash = 0                      ' find last occurance of "\"
  DO
    X = INSTR(MID$(Path$,LastBackSlash + 1), "\")
    IF X = 0 THEN
      EXIT LOOP
    ELSE
      LastBackSlash = LastBackSlash + X
    END IF
  LOOP

  GetProgPath$ = LEFT$(Path$,LastBackSlash)       'Return just the Path

 END FUNCTION

FUNCTION GetUserInput$(BYVAL OrigText$, BYVAL TextLength, BYVAL WindowLength)

  ' Returns User Input from keyboard
  ' No modifications are made to OrigText$, TextLength or WindowLength
  ' Programable Text and Window Length
  ' Automatic Scrolling within a Window
  ' Allows for editing of input: Insert, Overwrite, Backspace, Delete
  '                              Home, End, Left Arrow, Right Arrow & Escape
  ' Defaults to Overwrite mode (Insert Off)

  ' Text Length passed to Function or 0 = Unlimited
  ' Window Length passed to Function or 0 = Starting column to end of Row
  ' Escape Key returns the Original String
  ' ExitKey$ holds value of exiting key stroke - CR or ESC
  ' Changed is set to true if the original string <> exiting string

  ' Example  UserText$ = GetUserInput$("What ever", 10, 5)

  SHARED ExitKey$, Changed

  LOCAL CurrentPosInText, CurrentPosInWindow, InsertKey, KBD$
  LOCAL ScrollingMode, SpecialKey, StartCol, StartRow, Text$, X

  StartRow = CSRLIN
  StartCol = POS

  Text$ = OrigText$

  IF WindowLength = 0 THEN _            'Set WindowLength to whats left of the
     WindowLength = 81 - StartCol       'screen width and scroll within it

  PRINT SPACE$(WindowLength);

  LOCATE StartRow, StartCol

  IF Text$ > SPACE$(TextLength) THEN
    IF LEN(Text$) >= WindowLength THEN
      PRINT LEFT$(Text$, WindowLength);
      CurrentPosInWindow = WindowLength
      CurrentPosInText = WindowLength
    ELSE
      PRINT Text$;
      CurrentPosInWindow = LEN(Text$) + 1
      CurrentPosInText = LEN(Text$) + 1
    END IF
  ELSE
    CurrentPosInText = 1
    CurrentPosInWindow = 1
  END IF

  InsertKey = %False                    'Start in Overwrite mode
  ScrollingMode = %False
  SpecialKey = %True
  KBD$ = ""

  DO

    IF InsertKey THEN
      LOCATE ,,1,0,7                    'Insert Cursor On
    ELSE
      LOCATE ,,1,6,7                    'Overwrite Cursor On
    END IF

    IF KBD$ > "" THEN
      IF CurrentPosInText > LEN(Text$) THEN
        Text$ = Text$ + KBD$
      ELSE
        IF InsertKey THEN
          Text$ = LEFT$(Text$,CurrentPosInText - 1) + _
                  KBD$ + MID$(Text$,CurrentPosInText)
        ELSE
          Text$ = LEFT$(Text$,CurrentPosInText - 1) + _
                  KBD$ + MID$(Text$,CurrentPosInText + 1)
        END IF
        IF CurrentPosInWindow < WindowLength THEN SpecialKey = %True
      END IF
    END IF
    IF LEN(Text$) + 1 >= WindowLength THEN
      ScrollingMode = %True
      LOCATE StartRow, StartCol
      X = (CurrentPosInText + 1) - WindowLength
      IF X < 1 THEN X = 1
      IF NOT(SpecialKey) AND LEN(Text$) >= WindowLength THEN INCR X
      PRINT MID$(Text$,X,WindowLength); " ";
    ELSE
      ScrollingMode = %False
      LOCATE StartRow, StartCol
      PRINT Text$; " ";
    END IF

    IF KBD$ > "" THEN
      INCR CurrentPosInText
      IF CurrentPosInWindow < WindowLength THEN INCR CurrentPosInWindow
    END IF

    LOCATE StartRow, StartCol + CurrentPosInWindow - 1

    SpecialKey = %False

    WHILE NOT INSTAT : WEND
    KBD$ = INKEY$

    IF ASCII(KBD$) = 27 THEN                                   'Escape Key
      Text$ = OrigText$
    END IF

    IF ASCII(KBD$) = 8 THEN                                    'BackSpace Key

      IF CurrentPosInText > 1 THEN
        DECR CurrentPosInText
        Text$ = LEFT$(Text$,CurrentPosInText - 1) + _
                MID$(Text$,CurrentPosInText + 1)
        IF ScrollingMode THEN
          IF LEN(Text$) < WindowLength - 1 THEN
            LOCATE StartRow,StartCol
            PRINT Text$;
          END IF
          IF CurrentPosInText < WindowLength THEN DECR CurrentPosInWindow
        ELSE
          LOCATE StartRow,StartCol
          PRINT Text$;
          IF CurrentPosInWindow > 1 THEN DECR CurrentPosInWindow
        END IF
        IF CurrentPosInWindow <= WindowLength THEN PRINT " ";
      END IF

      KBD$ = ""
      SpecialKey = %True

    END IF

    IF LEN(KBD$) > 1 THEN                   'If Extended Key has been pressed

      IF ASC(RIGHT$(KBD$,1)) = 82 THEN InsertKey = NOT(InsertKey)

      IF ASC(RIGHT$(KBD$,1)) = 83 THEN                            'Delete Key
        Text$ = LEFT$(Text$,CurrentPosInText - 1) + _
                MID$(Text$,CurrentPosInText + 1)
      END IF

      IF ASC(RIGHT$(KBD$,1)) = 75 AND CurrentPosInText > 1 THEN   'Left Arrow
        DECR CurrentPosInText
        IF CurrentPosInWindow > 1 AND CurrentPosInText <= WindowLength THEN
          IF CurrentPosInText = WindowLength THEN
          ELSE
            DECR CurrentPosInWindow
          END IF
        END IF
      END IF

      IF ASC(RIGHT$(KBD$,1)) = 77 AND _                           'Right Arrow
         CurrentPosInText <= LEN(Text$) THEN
        INCR CurrentPosInText
        IF CurrentPosInWindow < WindowLength THEN INCR CurrentPosInWindow
      END IF

      IF ASC(RIGHT$(KBD$,1)) = 71 THEN                            'Home Key
        CurrentPosInText = 1
        CurrentPosInWindow = 1
      END IF

      IF ASC(RIGHT$(KBD$,1)) = 79 THEN                            'End Key
        CurrentPosInText = LEN(Text$) + 1
        IF LEN(Text$) >= WindowLength THEN
          CurrentPosInWindow = WindowLength
        ELSE
          CurrentPosInWindow = LEN(Text$) + 1
        END IF
      END IF

      KBD$ = ""
      SpecialKey = %True

    END IF

    IF TextLength > 0 AND _
       LEN(Text$) = TextLength AND KBD$ <> CHR$(13) _
       AND KBD$ <> CHR$(27) AND KBD$ > "" THEN       'Don't Allow Another Key
      KBD$ = ""
      SOUND 54, 1
      SpecialKey = %True
    END IF

  LOOP UNTIL (KBD$ = CHR$(13) OR KBD$ = CHR$(27))

  LOCATE ,,0,0,7                                     'Turn Cursor Off

  GetUserInput$ = Text$

  IF Text$ <> OrigText$ THEN
    Changed = %True
  ELSE
    Changed = %False
  END IF

  ExitKey$ = KBD$

 END FUNCTION

FUNCTION INCRDate$(BYVAL StartDate$, BYVAL Days)

  ' Increments the date by a specified number of days
  ' This function is aware of leap years
  ' No modifications are made to StartDate$ or Days

  ' Requires StartDate$ to be in "YYYYMMDD" (Year,Month,Day) Format
  ' Requires FUNCTION DaysInMonth

  ' Example: Print INCRDate$("19920227",3) prints to the screen 19920301
  '                                                    1992 was a Leap Year

  LOCAL Day, Day$, Month, Month$, X, Year, Year$

  Month = VAL(MID$(StartDate$,5,2))
  Day   = VAL(RIGHT$(StartDate$,2))
  Year  = VAL(LEFT$(StartDate$,4))

  FOR X = 1 TO Days
   INCR Day
   IF Day > DaysInMonth(Year,Month) THEN
     INCR Month
     Day = 1
   END IF
   IF Month > 12 THEN
     INCR Year
     Month = 1
   END IF
  NEXT X

  Year$  = TRIM$(STR$(Year))
  Month$ = TRIM$(STR$(Month))
  Day$   = TRIM$(STR$(Day))

  IF LEN(Month$) = 1 THEN Month$ = "0" + Month$
  IF LEN(Day$) = 1 THEN Day$ = "0" + Day$

  INCRDate$ = Year$ + Month$ + Day$

 END FUNCTION


FUNCTION INCRSeries$(BYVAL TheString$)

  ' Increments an alfa/numeric String Series
  ' No modifications are made to TheString$
  ' Acceptable values in the string are A-Z and 0-9
  ' Anything else returns a Null String
  ' Requires FUNCTION TRIM$

  ' Example PRINT INCRSeries$("SC97") prints to the screen SC98
  ' Example PRINT INCRSeries$("SC99") prints to the screen SD00
  ' Example PRINT INCRSeries$("AZ99") prints to the screen BA00

  ' Note: INCRSeries$("999") returns "000" not "1000", unlike PB's INCR X

  LOCAL NextTimeThruINCR, Series$, X, Y

  X = LEN(TRIM$(TheString$))
  Series$ = SPACE$(X)

  NextTimeThruINCR = %True

  DO WHILE X > 0                        'Search the series to be incremented
                                        'from right to left
    Y = ASC(MID$(TRIM$(TheString$),X,1))

    IF NextTimeThruINCR THEN INCR Y

    IF Y < 59 AND Y > 47 THEN           'If 0-9
      IF Y = 58 THEN
        Y = 48
      ELSE
          NextTimeThruINCR = %False
      END IF
    ELSEIF Y < 92 AND Y > 64 THEN       'If A-Z
      IF Y = 91 THEN
        Y = 65
      ELSE
          NextTimeThruINCR = %False
      END IF
    ELSE                                'Otherwise Abort Function
      Series$ = ""                      'not alfa/numeric
      EXIT LOOP
    END IF

    MID$(Series$,X,1) = CHR$(Y)
    DECR X

  LOOP

  INCRSeries$ = Series$

 END FUNCTION

FUNCTION NameOfDay$(BYVAL DateCheck$)

  ' Returns the name of the day of the week
  ' No modifications are made to DateCheck$
  ' This function is based on The Zeller Congruence

  ' Requires DateCheck$ to be in "YYYYMMDD" (Year,Month,Day) Format
  ' Requires FUNCTION ValidDate

  LOCAL Day%, Month%, WeekDay&, Year%

  NameOfDay$ = ""

  IF NOT(ValidDate(DateCheck$)) THEN EXIT FUNCTION

  Month%    = VAL(MID$(DateCheck$,5,2))
  Day%      = VAL(RIGHT$(DateCheck$,2))
  Year%     = VAL(LEFT$(DateCheck$,4))

  IF Month% < 3 THEN
    INCR Month%,12                      'Jan and Feb = months 13 and 14
    DECR Year%                          'of the previous year!
  END IF

  WeekDay& = (Day% + ((26 * (Month% + 1)) \ 10)) + ((125 * Year%) \ 100)
  WeekDay& = (WeekDay& - (Year% \ 100) + (Year% \ 400)) MOD 7

  SELECT CASE WeekDay&
    CASE 0
      NameOfDay$ = "Sat"
    CASE 1
      NameOfDay$ = "Sun"
    CASE 2
      NameOfDay$ = "Mon"
    CASE 3
      NameOfDay$ = "Tue"
    CASE 4
      NameOfDay$ = "Wed"
    CASE 5
      NameOfDay$ = "Thu"
    CASE 6
      NameOfDay$ = "Fri"
  END SELECT

 END FUNCTION

FUNCTION ODD(BYVAL Number)

  ' Returns True if odd number, False if not
  ' No modifications are made to Number

  IF (Number / 2) - FIX(Number / 2) = 0 THEN
    ODD = %False
  ELSE
    ODD = %True
  END IF

 END FUNCTION

FUNCTION ShiftedKeys

  ' Returns True if Shift, Control or Alternate
  ' keys are held down
  ' ShiftKey, CtrlKey and AltKey variables are
  ' set to True or False accordingly

  SHARED ShiftKey, CtrlKey, AltKey

  REG 1, &H0200
  CALL INTERRUPT &H16

  IF (REG(1) AND &H3)  > 0 THEN
    ShiftKey = %True
  ELSE
    ShiftKey = %False
  END IF

  IF (REG(1) AND &H4)  > 0 THEN
    CtrlKey = %True
  ELSE
    CtrlKey = %False
  END IF

  IF (REG(1) AND &H8)  > 0 THEN
    AltKey = %True
  ELSE
    AltKey = %False
  END IF

  IF (ShiftKey OR CtrlKey OR AltKey) THEN
    ShiftedKeys = %True
  ELSE
    ShiftedKeys = %False
  END IF

 END FUNCTION

FUNCTION TodaysDate$

  ' Returns System Date in the "YYYYMMDD" (Year,Month,Day) Format

  TodaysDate$ = RIGHT$(DATE$,4) + LEFT$(DATE$,2) + MID$(DATE$,4,2)

 END FUNCTION

FUNCTION TRIM$(BYVAL TheString$)

  ' Trims off leading and trailing spaces from a string
  ' No modifications are made to TheString$

  ' Example A$ = TRIM$("  Test  ")  Sets A$ equal to "Test"

  TRIM$ = LTRIM$(RTRIM$(TheString$))

 END FUNCTION

FUNCTION ValidDate(BYVAL DateCheck$)

  ' Returns True if Valid Date, False if not
  ' No modifications are made to DateCheck$
  ' This function is aware of leap years

  ' Requires DateCheck$ to be in "YYYYMMDD" (Year,Month,Day) Format
  ' Requires FUNCTION DaysInMonth

  ValidDate = %False

  IF LEN(DateCheck$) <> 8 THEN EXIT FUNCTION                'Check full date

  IF VAL(LEFT$(DateCheck$,4)) > 999 AND    _                'If valid Year
     VAL(LEFT$(DateCheck$,4)) < 10000 THEN

    IF VAL(MID$(DateCheck$,5,2)) > 0 AND   _                'If valid Month
       VAL(MID$(DateCheck$,5,2)) < 13 THEN

      IF VAL(RIGHT$(DateCheck$,2)) > 0 AND _                'If valid Day
           VAL(RIGHT$(DateCheck$,2)) <=        _            'for the above
           DaysInMonth(VAL(LEFT$(DateCheck$,4)),   _        'month & year
           VAL(MID$(DateCheck$,5,2))) THEN

        ValidDate = %True

      END IF
    END IF
  END IF

 END FUNCTION