home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / basic / baswiz19 / examples / bcddiv.bas < prev    next >
Encoding:
BASIC Source File  |  1993-01-29  |  2.1 KB  |  61 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        BASWIZ  Copyright (c) 1990-1993  Thomas G. Hanlin III         |
  4. '   |                                                                      |
  5. '   |                      The BASIC Wizard's Library                      |
  6. '   |                                                                      |
  7. '   +----------------------------------------------------------------------+
  8.  
  9.    DECLARE FUNCTION BCDAbs$ (Nr AS STRING)
  10.    DECLARE FUNCTION BCDAdd$ (Nr1 AS STRING, Nr2 AS STRING)
  11.    DECLARE FUNCTION BCDCompare% (Nr1 AS STRING, Nr2 AS STRING)
  12.    DECLARE FUNCTION BCDSet$ (NumSt$)
  13.    DECLARE FUNCTION BCDSgn% (Nr AS STRING)
  14.    DECLARE FUNCTION BCDSub$ (Nr1 AS STRING, Nr2 AS STRING)
  15.  
  16.    DECLARE SUB BCDDiv1L (Nr AS STRING)
  17.    DECLARE SUB BCDDiv1R (Nr AS STRING)
  18.  
  19.    DEFINT A-Z
  20.  
  21. FUNCTION BCDDiv$ (Nr1 AS STRING, Nr2 AS STRING)
  22.    IF BCDSgn(Nr2) = 0 THEN
  23.       BCDDiv$ = ""
  24.    ELSEIF BCDSgn(Nr1) = 0 THEN
  25.       BCDDiv$ = Nr1
  26.    ELSE
  27.       Sign1$ = LEFT$(Nr1, 1)
  28.       Sign2$ = LEFT$(Nr2, 1)
  29.       N1$ = BCDAbs$(Nr1)
  30.       N2$ = BCDAbs$(Nr2)
  31.       Result$ = BCDSet$("0")
  32.       ShiftTrack$ = BCDSet$("1")
  33.       DO
  34.          Flip = 0
  35.          Ready = 0
  36.          DO
  37.             SELECT CASE BCDCompare(N2$, N1$)
  38.                CASE -1
  39.                   BCDDiv1L N2$
  40.                   BCDDiv1L ShiftTrack$
  41.                   Flip = -1
  42.                CASE 0
  43.                   Ready = -1
  44.                CASE 1
  45.                   BCDDiv1R N2$
  46.                   BCDDiv1R ShiftTrack$
  47.                   Ready = Flip
  48.             END SELECT
  49.             IF BCDSgn(ShiftTrack$) = 0 THEN Ready = -1
  50.          LOOP UNTIL Ready
  51.          Result$ = BCDAdd$(Result$, ShiftTrack$)
  52.          N1$ = BCDSub$(N1$, N2$)
  53.       LOOP WHILE BCDSgn(ShiftTrack$) AND BCDSgn(N1$)
  54.       IF Sign1$ = Sign2$ THEN
  55.          BCDDiv$ = Sign1$ + MID$(Result$, 2)
  56.       ELSE
  57.          BCDDiv$ = "-" + MID$(Result$, 2)
  58.       END IF
  59.    END IF
  60. END FUNCTION
  61.