home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / tools / numadd / addnum.bas next >
BASIC Source File  |  1994-04-03  |  15KB  |  658 lines
  1. '**********************************ADDNUM.BAS**************************
  2. 'JRD NOTE:
  3. '
  4. 'For adding numbers to QuickBASIC programs that need to be debugged
  5. 'Not sure if when you compile using the "/d" switch with BC.EXE
  6. 'that the line number that it reports is the same one that this program
  7. 'puts in.
  8. '
  9. 'Because I was not happy having to manually remove the line numbers from
  10. 'TYPE..... END TYPE, and SELECT CASE..... END SELECT,
  11. 'I added the SUB SkipKeyWord$ (a$, KeyWordFlag%) which parses those words
  12. 'and sets "Flags" so that the line count continues but the line number
  13. 'is not added. It's not great code, but it works.
  14. '
  15. '
  16. '
  17. '                       Mon  04-04-1994  00:22:47
  18. '
  19. 'John De Palma on CompuServe 76076,571
  20. '
  21. DEFINT A-Z
  22. '$INCLUDE: 'qb.bi'
  23. DECLARE SUB LocateIt (Row%, text$)
  24. DECLARE SUB Splash (BackGround%)
  25. DECLARE SUB TextBoxShadow (Row%, Col%, Message$, Outline%, Shadow%, Length%)
  26. DECLARE SUB Waitkey ()
  27. DECLARE SUB CursorOff ()
  28. DECLARE SUB CursorOn ()
  29. DECLARE SUB ParseFileName (FileName$, Drive$, File$, Ext$)
  30. DECLARE FUNCTION Center% (text$)
  31. DECLARE FUNCTION BufferedKeyInput$ (n%)
  32. DECLARE FUNCTION Exist% (Spec$)
  33. DECLARE SUB ErrorBox (Row%)
  34. DECLARE SUB SetBorder (ColrByte%)
  35. DECLARE SUB TwoColrs (Fgd%, Bkg%, Colr%)
  36. DECLARE SUB ColorIt (Fgd%, Bkg%)
  37. DECLARE SUB SkipKeyWord (a$, KeyWordFlag%)
  38. DECLARE SUB FileProgress (Counter&, LineNum&, Row%, Col%)
  39. COMMON SHARED KeyWordFlag%
  40.  
  41. DIM Count AS LONG
  42. DIM SHARED Regs AS RegType
  43. REDIM SHARED Box$(1 TO 56)
  44. Copyright$ = "■Copyright (c) 1994 LearnWare (c) ■ John De Palma■"
  45.  
  46. Again:
  47.     KeyWordFlag% = False
  48.     COLOR 7, 1
  49.     SCREEN 0
  50.     WIDTH 80, 25
  51.     CLS
  52.     CALL Splash(179)
  53.     CALL SetBorder(2)
  54.    
  55.     Col% = 0
  56.     Length% = 0
  57.    
  58.     COLOR 15, 1
  59.     Message$ = "Program to Add Line Numbers to *.BAS Code"
  60.     COLOR 15, 7
  61.     CALL TextBoxShadow(1, Col%, Message$, 4, 1, Length%)
  62.     COLOR 15, 1
  63.     text$ = " File Name "
  64.     Message$ = SPACE$(LEN(text$))
  65.     CALL TextBoxShadow(6, Col%, Message$, 6, 1, Length%)
  66.     CALL LocateIt(6, text$)
  67.     LOCATE 7, 41 - 6
  68.     CursorOn
  69.     FileName$ = BufferedKeyInput(12)
  70.     FileName$ = RTRIM$(LTRIM$(FileName$))
  71.     CursorOff
  72.    
  73.     IF NOT Exist%(FileName$) THEN
  74.         CALL ErrorBox(11)
  75.         BEEP
  76.         PRINT
  77.         PRINT
  78.         Message$ = "Whoa... Can't Find: " + UCASE$(FileName$)
  79.         COLOR 12, 4
  80.         CALL TextBoxShadow(16, Col%, Message$, 3, 0, Length%)
  81.         Message$ = "PRESS {Enter} to try Again... <Esc> to EXIT!"
  82.         COLOR 11, 2
  83.         CALL TextBoxShadow(20, Col%, Message$, 1, 1, Length%)
  84.         Waitkey
  85.         GOTO Again
  86.     END IF
  87.  
  88.     CALL ParseFileName(FileName$, Drive$, File$, Ext$)
  89.     CursorOff
  90.     NewFile$ = File$ + ".LIN"
  91.   
  92.   
  93.       
  94.     text$ = " What START Number (1, 10...) "
  95.     LOCATE 10, 2: PRINT text$
  96.     Message$ = SPACE$(3)
  97.     COLOR 14, 1
  98.     CALL TextBoxShadow(11, 20, Message$, 5, 1, Length%)
  99.     LOCATE 12, 22
  100.     CursorOn
  101.     Start$ = BufferedKeyInput(3)
  102.     IF Start$ = "" THEN Start$ = "1"
  103.     Start% = VAL(Start$)
  104.     CursorOff
  105.    
  106.     COLOR 15, 1
  107.     text$ = " What Number INTERVAL (1, 5, 10....) "
  108.     LOCATE 10, 42: PRINT text$
  109.     Message$ = SPACE$(2)
  110.     COLOR 13, 1
  111.     CALL TextBoxShadow(11, 50, Message$, 5, 1, Length%)
  112.     LOCATE 12, 52
  113.     CursorOn
  114.     Interval$ = BufferedKeyInput(2)
  115.     IF Interval$ = "" THEN Interval$ = "1"
  116.     Interval% = VAL(Interval$)
  117.     CursorOff
  118.    
  119.     FileNumber1 = FREEFILE
  120.     OPEN FileName$ FOR INPUT AS #FileNumber1
  121.         WHILE NOT EOF(FileNumber1)
  122.             LINE INPUT #FileNumber1, a$
  123.             Counter& = Counter& + 1
  124.         WEND
  125.         CLOSE FileNumber1
  126.  
  127.     FileNumber1 = FREEFILE
  128.     OPEN FileName$ FOR INPUT AS #FileNumber1
  129.    
  130.     FileNumber2 = FREEFILE
  131.     OPEN NewFile$ FOR OUTPUT AS #FileNumber2
  132.    
  133.     Count& = Start%
  134.     LineNum& = 0
  135.    
  136.     Message$ = SPACE$(44)
  137.     COLOR 14, 6
  138.     CALL TextBoxShadow(15, 0, Message$, 4, 1, Length%)
  139.     COLOR 15, 1
  140.    
  141.     WHILE NOT EOF(FileNumber1)
  142.            
  143.         LINE INPUT #FileNumber1, a$
  144.         CALL SkipKeyWord(a$, KeyWordFlag%)
  145.         IF KeyWordFlag% THEN
  146.             PRINT #FileNumber2, SPACE$(LEN(Count&)); "  "; a$
  147.         ELSE
  148.             PRINT #FileNumber2, LTRIM$(STR$(Count&)); "  "; a$
  149.         END IF
  150.         Count& = Count& + Interval%
  151.         LineNum& = LineNum& + 1
  152.         text$ = "Processing line " + STR$(LineNum&)
  153.         LOCATE 16, 19: PRINT text$
  154.         CALL FileProgress(Counter&, LineNum&, 16, 43)
  155.     WEND
  156.     CLOSE
  157.     BEEP
  158.     Message$ = "The New File - " + UCASE$(NewFile$) + " - is DONE!"
  159.     COLOR 15, 2
  160.     CALL TextBoxShadow(20, 0, Message$, 1, 1, Length%)
  161.     Waitkey
  162.     COLOR 7, 0
  163.     END
  164.  
  165. FUNCTION BufferedKeyInput$ (n%) STATIC
  166.  
  167.      'DIM Regs AS RegType
  168.      b$ = CHR$(n% + 1) + SPACE$(n% + 1) + CHR$(13)   'see EXPLANATION
  169.   
  170.      Regs.ax = &HA00                     'BufferkeyInput MS-DOS Function
  171.      Regs.ds = VARSEG(b$)                'segment of string b$
  172.      Regs.dx = SADD(b$)                  'offset of string b$
  173.      'using qb.bi INCLUDE file
  174.      CALL INTERRUPTX(&H21, Regs, Regs)
  175.      Count% = ASC(MID$(b$, 2, 1))        'length of the string b$
  176.  
  177.      'EXPLANATION of b$ command
  178.      'byte one of b$ contains the working -size- of the string.
  179.      'byte two is the -actual size- of the string that MS-DOS uses.
  180.      'last byte is a carriage return which is needed to prevent
  181.      'a STRING SPACE CORRUPT Run Time error when you use this
  182.      'so the return string starts at byte three (3), and does NOT
  183.      'include the carriage return
  184.      'see below
  185.      BufferedKeyInput$ = MID$(b$, 3, Count%)
  186.  
  187. END FUNCTION
  188.  
  189. FUNCTION Center% (text$)
  190.     Center% = 41 - LEN(text$) \ 2
  191. END FUNCTION
  192.  
  193. SUB ColorIt (Fgd, Bkg)
  194.     COLOR Fgd, Bkg
  195. END SUB
  196.  
  197. SUB CursorOff
  198.     LOCATE , , 0
  199. END SUB
  200.  
  201. SUB CursorOn
  202.     LOCATE , , 1, 4, 7
  203. END SUB
  204.  
  205. SUB ErrorBox (Row%)
  206.  
  207. CALL ColorIt(14, 4)
  208. OldRow% = CSRLIN
  209. OldCol% = POS(0)
  210. text$ = "█▀▀▀▀▀▀▀▀▀▀▀▀▀█"
  211. CALL LocateIt(Row%, text$)
  212. text$ = "█             █"
  213. CALL LocateIt(Row% + 1, text$)
  214. text$ = "█▄▄▄▄▄▄▄▄▄▄▄▄▄█"
  215. CALL LocateIt(Row% + 2, text$)
  216. text$ = "ERROR"
  217. CALL ColorIt(15 + 16, 4)
  218. CALL LocateIt(Row% + 1, text$)
  219. LOCATE OldRow%, OldCol%
  220. END SUB
  221.  
  222. FUNCTION Exist% (Spec$) STATIC           'reports if a file exists
  223.  
  224.   'From Ethan's 1992 Book, shorter than 1991 code
  225.  
  226.   DIM DTA AS STRING * 44                'This is DOS' work area
  227.   'DIM Regs AS RegType                   'Used by CALL Interrupt
  228.   DIM LocalSpec AS STRING * 80          'Using a fixed-length string
  229.                                         '  supports both QB and PDS
  230.   LocalSpec$ = Spec$ + CHR$(0)          'Add a CHR$(0) for DOS
  231.  
  232.   Exist% = True                         'Assume the file is present
  233.                                     
  234.  
  235.   Regs.ax = &H1A00                      'Assign DTA service
  236.   Regs.dx = VARPTR(DTA)                 'Show DOS where to place it
  237.   CALL INTERRUPT(&H21, Regs, Regs)
  238.  
  239.   Regs.ax = &H4E00                      'Find first matching file
  240.   Regs.cx = 39                          'Any file attribute okay
  241.   Regs.dx = VARPTR(LocalSpec)
  242.   CALL INTERRUPT(&H21, Regs, Regs)      'See if there's a match
  243.  
  244.     IF Regs.flags AND 1 THEN              'If the Carry flag is set
  245.         Exist% = False                    ' there were no matches
  246.  
  247.     ELSEIF Regs.ax <> 0 THEN              'or if AX contains an Error
  248.         Exist% = 0                         'number (usually &H12)
  249.  
  250.     ELSEIF Regs.ax = 0 THEN               'else file exists
  251.         Exist% = True
  252.  
  253.   ELSE
  254.  
  255.   END IF
  256.  
  257. END FUNCTION
  258.  
  259. SUB FileProgress (Counter&, LineNum&, Row%, Col%)
  260. STATIC Fraction&, Flag%, Num%, PerCent&
  261.    
  262.     SaveRow% = CSRLIN
  263.     SaveCol% = POS(0)
  264.     
  265.     LOCATE Row%, Col%
  266.     IF Flag% = True THEN GOTO Around
  267.     BackGround$ = STRING$(20, 176)
  268.     PRINT BackGround$
  269.     Fraction& = (Counter& \ 20)
  270.     PerCent& = Fraction&
  271.     Num% = 1
  272.     Flag% = True
  273. Around: 
  274.     'Fraction& = 5
  275.     IF Fraction& = LineNum& THEN
  276.         LOCATE Row, Col%
  277.         LOCATE Row, Col%
  278.         PRINT STRING$(Num%, 219)
  279.         Num% = Num% + 1
  280.         Fraction& = Fraction& + PerCent&
  281.     END IF
  282.        
  283.     LOCATE SaveRow%, SaveCol%
  284.  
  285. 'single line box
  286. '    Box$(1) = "┌"
  287. '    Box$(2) = "─"
  288. '    Box$(3) = "┐"
  289. '    Box$(4) = "│"
  290. '    Box$(5) = "│"
  291. '    Box$(6) = "└"
  292. '    Box$(7) = "─"
  293. '    Box$(8) = "┘"
  294.  
  295.  
  296. END SUB
  297.  
  298. SUB LocateIt (Row%, text$)
  299.      LOCATE Row%, Center(text$)
  300.      PRINT text$;
  301. END SUB
  302.  
  303. SUB ParseFileName (FileName$, Drive$, File$, Ext$) STATIC
  304.  
  305. Length% = LEN(FileName$)
  306.  
  307. ' first get the drive
  308.  
  309. colon = INSTR(FileName$, ":")
  310. IF colon THEN
  311.         Drive$ = LEFT$(FileName$, colon)
  312. END IF
  313.  
  314. ' next erase a final backslash if it exists
  315.  
  316. IF RIGHT$(FileName$, 1) = "\" THEN
  317.         temp$ = LEFT$(FileName$, Length% - 1)
  318.         Length% = Length% - 1
  319.         ELSE
  320.         temp$ = FileName$
  321. END IF
  322.  
  323. ' third get the Extension
  324.  
  325. FOR Num% = Length% TO 1 STEP -1
  326.  
  327.         Ext$ = MID$(temp$, Num%)
  328.         IF INSTR(Ext$, ".") THEN
  329.         Ext$ = LTRIM$(LEFT$(Ext$, 4))
  330.         temp$ = LEFT$(temp$, Num% - 1)
  331.         k = Num%
  332.         EXIT FOR
  333.         ELSE
  334.         Ext$ = ""
  335.         k = Length%           'if there is no extension
  336.         END IF
  337. NEXT Num%
  338.  
  339. 'fourth get the file name but not more than 8 letters...
  340.  
  341. FOR Num% = k TO 1 STEP -1
  342.          File$ = MID$(temp$, Num%)
  343.          IF INSTR(File$, "\") THEN
  344.                  EXIT FOR
  345.          ELSE
  346.                 File$ = MID$(temp$, Num%)
  347.                 'IF LEN(File$) >= 8 THEN EXIT FOR
  348.          END IF
  349. NEXT Num%
  350. File$ = LEFT$(File$, 8)
  351.  
  352. 'fifth add a backslash to the file name
  353. 'use for full path, only, not now....
  354. 'IF INSTR(File$, "\") = 0 THEN
  355. '    File$ = "\" + File$
  356. 'END IF
  357.  
  358. END SUB
  359.  
  360. SUB SetBorder (ColrByte%) STATIC
  361.  
  362.     'DIM Regs AS RegType
  363.     Regs.ax = &H1001
  364.     Regs.bx = ColrByte% * &H100
  365.     CALL INTERRUPT(&H10, Regs, Regs)
  366.  
  367. END SUB
  368.  
  369. SUB SkipKeyWord (a$, KeyWordFlag%)
  370. STATIC TypeFlagTrue%, b$
  371.        
  372.         b$ = UCASE$(a$)
  373.        
  374.         FOR i% = 1 TO LEN(b$)
  375.              IF MID$(b$, i%, 1) = "'" THEN
  376.                 KeyWordFlag% = False
  377.                 EXIT FOR
  378.              ELSEIF MID$(b$, i%, 1) = CHR$(13) THEN
  379.                 KeyWordFlag% = False
  380.                 EXIT FOR
  381.              ELSEIF MID$(b$, i%, 1) = "R" THEN
  382.                 j% = i%
  383.                 FOR j% = j% TO j% + 2
  384.                     Word$ = Word$ + MID$(b$, j%, 1)
  385.                 NEXT
  386.                 IF Word$ = "REM" THEN
  387.                     KeyWordFlag% = False
  388.                 END IF
  389.                 EXIT FOR
  390.              ELSEIF MID$(b$, i%, 1) = "T" THEN
  391.                 j% = i%
  392.                 FOR j% = j% TO j% + 3
  393.                     Word$ = Word$ + MID$(b$, j%, 1)
  394.                 NEXT
  395.                 IF Word$ = "TYPE" THEN
  396.                     KeyWordFlag% = True
  397.                     TypeFlagTrue% = True
  398.                 END IF
  399.                 EXIT FOR
  400.              ELSEIF MID$(b$, i%, 1) = "S" THEN
  401.                 j% = i%
  402.                 FOR j% = j% TO j% + 10
  403.                     Word$ = Word$ + MID$(b$, j%, 1)
  404.                 NEXT
  405.                 IF Word$ = "SELECT CASE" THEN
  406.                     KeyWordFlag% = True
  407.                     TypeFlagTrue% = True
  408.                 END IF
  409.                 EXIT FOR
  410.              ELSEIF MID$(b$, i%, 1) = "E" THEN
  411.                 j% = i%
  412.                 FOR j% = j% TO j% + 9
  413.                     Word$ = Word$ + MID$(b$, j%, 1)
  414.                 NEXT
  415.                 IF LTRIM$(Word$) = "END TYPE" OR LTRIM$(Word$) = "END SELECT" THEN
  416.                     KeyWordFlag% = True
  417.                     TypeFlagTrue% = False
  418.                 END IF
  419.                 EXIT FOR
  420.              ELSE
  421.                 IF TypeFlagTrue% THEN
  422.                     KeyWordFlag% = True
  423.                 ELSE
  424.                     KeyWordFlag% = False
  425.                 END IF
  426.              END IF
  427.         NEXT
  428. END SUB
  429.  
  430. SUB Splash (BackGround%) STATIC
  431.     STATIC ColrFlag%
  432.     RANDOMIZE TIMER
  433.     IF ColrFlag% AND BackGround% THEN
  434.         UpperBound = 254
  435.         LowerBound = 176
  436.         Char = INT((UpperBound - LowerBound + 1) * RND + LowerBound)
  437.     ELSEIF BackGround% THEN
  438.         Char = BackGround%
  439.     ELSE
  440.         Char = 176
  441.     END IF
  442.     CLS
  443.     FOR i = 1 TO 25
  444.         LOCATE i, 1
  445.         PRINT STRING$(80, Char);
  446.     NEXT
  447.     ColrFlag% = True
  448. END SUB
  449.  
  450. SUB TextBoxShadow (Row%, Col%, Message$, Outline%, Shadow%, Length%)
  451.     'Will put a message into a three line box -or-
  452.     'draw a box without a message using Message$=SPACE$(x)
  453.     'where "x" is the width of the box and Length%= number of lines > 3
  454.     'Boxes are centered if Col% = 0; else left side of box = Col%.
  455.     'Boxes display a true shadow if Shadow% <> 0
  456.     'True = -1: False = 0
  457.  
  458.     STATIC BoxReadFlag
  459.     Message$ = LEFT$(Message$, 60)
  460.     BoxWidth% = LEN(Message$) + 4
  461.     SELECT CASE Outline%
  462.         CASE 0
  463.             j = 8 * 6 + 1
  464.         CASE 1
  465.             j = 1
  466.         CASE 2
  467.             j = 8 + 1
  468.         CASE 3
  469.             j = 8 * 2 + 1
  470.         CASE 4
  471.             j = 8 * 3 + 1
  472.         CASE 5
  473.             j = 8 * 4 + 1
  474.         CASE 6
  475.             j = 8 * 5 + 1
  476.         CASE ELSE
  477.             j = 8 * 6 + 1
  478.     END SELECT
  479.  
  480.     IF BoxReadFlag THEN GOTO Skip
  481.     REDIM Box$(1 TO 56)
  482.     BoxReadFlag = True
  483.  
  484. 'single line box
  485.     Box$(1) = "┌"
  486.     Box$(2) = "─"
  487.     Box$(3) = "┐"
  488.     Box$(4) = "│"
  489.     Box$(5) = "│"
  490.     Box$(6) = "└"
  491.     Box$(7) = "─"
  492.     Box$(8) = "┘"
  493.  
  494. 'double top box
  495.     Box$(9) = "╒"
  496.     Box$(10) = "═"
  497.     Box$(11) = "╕"
  498.     Box$(12) = "│"
  499.     Box$(13) = "│"
  500.     Box$(14) = "╘"
  501.     Box$(15) = "═"
  502.     Box$(16) = "╛"
  503.  
  504. 'double side box
  505.     Box$(17) = "╓"
  506.     Box$(18) = "─"
  507.     Box$(19) = "╖"
  508.     Box$(20) = "║"
  509.     Box$(21) = "║"
  510.     Box$(22) = "╙"
  511.     Box$(23) = "─"
  512.     Box$(24) = "╜"
  513.  
  514. 'double box
  515.     Box$(25) = "╔"
  516.     Box$(26) = "═"
  517.     Box$(27) = "╗"
  518.     Box$(28) = "║"
  519.     Box$(29) = "║"
  520.     Box$(30) = "╚"
  521.     Box$(31) = "═"
  522.     Box$(32) = "╝"
  523.  
  524. 'bold box
  525.     Box$(33) = "█"
  526.     Box$(34) = "▀"
  527.     Box$(35) = "█"
  528.     Box$(36) = "█"
  529.     Box$(37) = "█"
  530.     Box$(38) = "█"
  531.     Box$(39) = "▄"
  532.     Box$(40) = "█"
  533.  
  534. 'bold and thick box
  535.     Box$(41) = "█"
  536.     Box$(42) = "█"
  537.     Box$(43) = "█"
  538.     Box$(44) = "█"
  539.     Box$(45) = "█"
  540.     Box$(46) = "█"
  541.     Box$(47) = "█"
  542.     Box$(48) = "█"
  543.  
  544. 'no box
  545.     Box$(49) = " "
  546.     Box$(50) = " "
  547.     Box$(51) = " "
  548.     Box$(52) = " "
  549.     Box$(53) = " "
  550.     Box$(54) = " "
  551.     Box$(55) = " "
  552.     Box$(56) = " "
  553.  
  554. Skip:
  555.  
  556.     IF Col% = 0 THEN
  557.  
  558.             BoxText$ = Box$(j) + STRING$(BoxWidth%, Box$(j + 1)) + Box$(j + 2)
  559.             CALL LocateIt(Row%, BoxText$)
  560.             Row2% = CSRLIN: Col2% = POS(0)
  561.             Colr% = SCREEN(Row2%, Col2% - 1, 1)
  562.             CALL TwoColrs(Fgd%, Bkg%, Colr%)
  563.     
  564.             FOR i = 1 TO Length% + 1
  565.             BoxText$ = Box$(j + 3) + "  " + Message$ + "  " + Box$(j + 4)
  566.             CALL LocateIt(Row% + i, BoxText$)
  567.  
  568.             IF Shadow% THEN
  569.                 COLOR 7, 0
  570.                     FOR k = 1 TO 2
  571.                         PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  572.                     NEXT
  573.                 COLOR Fgd%, Bkg%
  574.             END IF
  575.             NEXT i
  576.  
  577.             BoxText$ = Box$(j + 5) + STRING$(BoxWidth%, Box$(j + 6)) + Box$(j + 7)
  578.             CALL LocateIt(Row% + i, BoxText$)
  579.       
  580.             IF Shadow% THEN
  581.                 COLOR 7, 0
  582.                 FOR k = 1 TO 2
  583.                     PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  584.                 NEXT
  585.             'COLOR Fgd%, Bkg%
  586.     
  587.             COLOR 7, 0
  588.             LOCATE Row% + i + 1, Center(BoxText$) + 2
  589.       
  590.                 FOR k = 1 TO BoxWidth% + 2
  591.                     PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  592.                 NEXT
  593.                 COLOR Fgd%, Bkg%
  594.             END IF
  595.     ELSE
  596.  
  597.             BoxText$ = Box$(j) + STRING$(BoxWidth%, Box$(j + 1)) + Box$(j + 2)
  598.             LOCATE Row%, Col%
  599.             PRINT BoxText$;
  600.             Row2% = CSRLIN: Col2% = POS(0)
  601.             Colr% = SCREEN(Row2%, Col2% - 1, 1)
  602.             CALL TwoColrs(Fgd%, Bkg%, Colr%)
  603.  
  604.             FOR i = 1 TO Length% + 1
  605.             BoxText$ = Box$(j + 3) + "  " + Message$ + "  " + Box$(j + 4)
  606.             LOCATE Row% + i, Col%
  607.             PRINT BoxText$;
  608.       
  609.             IF Shadow% THEN
  610.                 COLOR 7, 0
  611.                 FOR k = 1 TO 2
  612.                     PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  613.                 NEXT
  614.                 COLOR Fgd%, Bkg%
  615.             END IF
  616.       
  617.             NEXT i
  618.  
  619.             BoxText$ = Box$(j + 5) + STRING$(BoxWidth%, Box$(j + 6)) + Box$(j + 7)
  620.             LOCATE Row% + i, Col%
  621.             PRINT BoxText$;
  622.       
  623.             IF Shadow% THEN
  624.                 COLOR 7, 0
  625.                 FOR k = 1 TO 2
  626.                     PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  627.                 NEXT
  628.             'COLOR Fgd%, Bkg%
  629.             'COLOR 7,0
  630.                 LOCATE Row% + i + 1, Col% + 2
  631.                 FOR k = 1 TO BoxWidth% + 2
  632.                     PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  633.                 NEXT
  634.                 COLOR Fgd%, Bkg%
  635.             END IF
  636.  
  637.     END IF
  638.  
  639. END SUB
  640.  
  641. SUB TwoColrs (Fgd%, Bkg%, Colr%)
  642.  
  643.     Fgd% = (Colr% AND 128) \ 8 + (Colr% AND 15)
  644.     Bkg% = (Colr% AND 112) \ 16
  645.  
  646. END SUB
  647.  
  648. SUB Waitkey
  649.  
  650.     WHILE INKEY$ <> "": WEND
  651.     DO
  652.         kee$ = INKEY$
  653.     LOOP UNTIL LEN(kee$)
  654.     IF kee$ = CHR$(27) THEN END
  655.  
  656. END SUB
  657.  
  658.