home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / dos / unique / tempfile.bas < prev    next >
Encoding:
BASIC Source File  |  1994-03-29  |  21.4 KB  |  838 lines
  1. '******************************TEMPFILE.BAS*******************************
  2. '
  3. 'A program to create a UNIQUE Temporary file that you can use
  4. 'to store stuff and KNOW that there is no temp file that
  5. 'you just destroyed with your TempFile$ = "~TEMP.$$$" variable
  6. '
  7. 'Uses INTERRUPT &H21 Function &H5A in AX to MAKE the Temp file then
  8. 'calls INTERRRUPT &H21 Function &H3E to CLOSE that file as a zero byte
  9. 'file. Now you have to use OPEN it again to use it.
  10. '
  11. 'DS:DX holds the file name so you have to PEEK into a variable
  12. '
  13. 'After a temp file is made, I add the Extension *.TMP to it so there is
  14. 'no question as to what it is
  15. '
  16. 'For some reason that I don't really understand, you can't use the
  17. 'QuickBASIC command NAME to add an Extension, had to SHELL.
  18. '
  19. 'John De Palma on CompuServe 76076,571
  20. '
  21. 'Tues 03-29-1994  23:45:00
  22. '
  23. '
  24. DEFINT A-Z
  25. '$INCLUDE: 'qb.bi'
  26. DECLARE SUB MakeTempFile (TempFile$, NewFile$)
  27. DECLARE SUB ErrorHandler (ErrorCode%)
  28. DECLARE SUB EditLine (a$, exitCode%)
  29. DECLARE SUB LocateIt (Row%, Text$)
  30. DECLARE SUB Splash (BackGround%)
  31. DECLARE SUB TextBoxShadow (Row%, Col%, Message$, Outline%, Shadow%, Length%)
  32. DECLARE SUB TwoColrs (Fgd%, Bkg%, Colr%)
  33. DECLARE SUB CursorOff ()
  34. DECLARE SUB ColorIt (Fgd%, Bkg%)
  35. DECLARE SUB CursorOn ()
  36. DECLARE SUB SetBorder (ColrByte%)
  37. DECLARE SUB ErrorBox (Row%)
  38. DECLARE SUB Squawk (Num%)
  39. DECLARE SUB WaitKey ()
  40. DECLARE SUB SplitClearScreen ()
  41. DECLARE SUB GetColr (Fgd%, Bkg%, Colr%)
  42. DECLARE SUB StarFlag ()
  43. DECLARE SUB Pause2 (Seconds!)
  44.  
  45. DECLARE FUNCTION KeyCode% ()
  46. DECLARE FUNCTION Center% (Text$)
  47. DECLARE FUNCTION GetDirectory$ (Drive$)
  48. DECLARE FUNCTION GetDrive% ()
  49.  
  50. DIM SHARED Regs AS RegType
  51. DIM SHARED NewFile$(1 TO 10)            'this stores the files in an array
  52. DIM SHARED ErrorCode%
  53.  
  54.     Copyright$ = "■Copyright (c) 1994 LearnWare (c) ■ John De Palma■"
  55.  
  56.     CursorOff
  57.     CALL SetBorder(4)
  58.     CALL StarFlag
  59.     Pause2 (2)
  60.     CALL SplitClearScreen
  61.     CALL ColorIt(8, 7)
  62.     CLS
  63.     CALL Splash(0)
  64.   
  65.     CALL ColorIt(15, 4)
  66.   
  67.     Text$ = "Enter a VALID Path to place the files, ie: C:\ "
  68.    
  69.     CALL LocateIt(2, Text$)
  70.     CALL ColorIt(11, 0)
  71.    
  72.     Dir$ = GetDirectory$(Drive$)
  73.     Length% = LEN(Dir$)
  74.     IF Length% < 20 THEN
  75.         Dir$ = Dir$ + SPACE$(20 - Length%)
  76.     END IF
  77.     Message$ = SPACE$(LEN(Dir$))
  78.     CALL TextBoxShadow(4, Col%, Message$, 6, 1, 0)
  79.   
  80.     LOCATE 5, Center(Message$)
  81.     CALL EditLine(Dir$, ErrorCode%)
  82.     Dir$ = RTRIM$(LTRIM$(Dir$))
  83.     CursorOff
  84.   
  85.     CALL ColorIt(14, 1)
  86.  
  87.     LOCATE 10, 8
  88.     PRINT "NewFileName      #                    ArrayFile().TMP"
  89.     LOCATE 11, 8
  90.     PRINT STRING$(55, 205)
  91.     PRINT
  92.     Ext$ = ".TMP"
  93.     FOR i = 1 TO 10
  94.  
  95.     TempFile$ = UCASE$(Dir$)
  96.     CALL MakeTempFile(TempFile$, NewFile$)
  97.     IF ErrorCode% THEN
  98.         CALL ErrorBox(20)
  99.         CALL ErrorHandler(ErrorCode%)
  100.         Squawk (2)
  101.         GOTO CleanUpAndEnd
  102.     END IF
  103.     NewFile$(i) = NewFile$ + Ext$
  104.     'Next QB command doesn't work have to SHELL to add *.TMP extension
  105.     'NAME NewFile$ AS NewFile$(i)
  106.     SHELL "rename " + NewFile$ + " " + RIGHT$(NewFile$(i), 12)
  107.    
  108.     LOCATE 12 + i, 8
  109.     PRINT NewFile$; "   "; i; "  "; NewFile$(i)
  110. NEXT
  111.     WaitKey
  112.     CALL SetBorder(3)
  113.     CALL StarFlag
  114.     Pause2 (2)
  115.     CALL SplitClearScreen
  116. CleanUpAndEnd:
  117.   
  118.     SetBorder (0)
  119.     CursorOff
  120.     COLOR 7, 0
  121.     END
  122.  
  123. FUNCTION Center% (Text$)
  124.     Center% = 41 - LEN(Text$) \ 2
  125. END FUNCTION
  126.  
  127. SUB ColorIt (Fgd%, Bkg%)
  128.     COLOR Fgd%, Bkg%
  129. END SUB
  130.  
  131. SUB CursorOff
  132.     LOCATE , , 0
  133. END SUB
  134.  
  135. SUB CursorOn
  136.     LOCATE , , 1, 4, 7
  137. END SUB
  138.  
  139. SUB EditLine (a$, exitCode%) STATIC
  140.  
  141.       ' Set up some variables
  142.         Row% = CSRLIN
  143.         Col% = POS(0)
  144.         Length% = LEN(a$)
  145.         ptr% = 0
  146.         insert% = True
  147.         quit% = False
  148.         original$ = a$
  149.  
  150.       ' Main processing loop
  151.         DO
  152.     
  153.           ' Display the line
  154.             LOCATE Row%, Col%, 0
  155.             PRINT a$;
  156.     
  157.           ' Show appropriate cursor type
  158.             IF insert% THEN
  159.                 LOCATE Row%, Col% + ptr%, 1, 6, 7
  160.             ELSE
  161.                 LOCATE Row%, Col% + ptr%, 1, 1, 7
  162.             END IF
  163.     
  164.           ' Get next keystroke
  165.             keyNumber% = KeyCode%
  166.     
  167.           ' Process the key
  168.             SELECT CASE keyNumber%
  169.         
  170.             CASE INSERTKEY
  171.                 IF insert% THEN
  172.                     insert% = False
  173.                 ELSE
  174.                     insert% = True
  175.                 END IF
  176.         
  177.             CASE BACKSPACE
  178.                 IF ptr% THEN
  179.                     a$ = a$ + " "
  180.                     a$ = LEFT$(a$, ptr% - 1) + MID$(a$, ptr% + 1)
  181.                     ptr% = ptr% - 1
  182.                 END IF
  183.         
  184.             CASE DELETE
  185.                 a$ = a$ + " "
  186.                 a$ = LEFT$(a$, ptr%) + MID$(a$, ptr% + 2)
  187.         
  188.             CASE UPARROW
  189.                 exitCode% = 1
  190.                 quit% = True
  191.         
  192.             CASE DOWNARROW
  193.                 exitCode% = -1
  194.                 quit% = True
  195.         
  196.             CASE LEFTARROW
  197.                 IF ptr% THEN
  198.                     ptr% = ptr% - 1
  199.                 END IF
  200.         
  201.             CASE RIGHTARROW
  202.                 IF ptr% < Length% - 1 THEN
  203.                     ptr% = ptr% + 1
  204.                 END IF
  205.         
  206.             CASE ENTER
  207.                 exitCode% = 0
  208.                 quit% = True
  209.         
  210.             CASE HOME
  211.                 ptr% = 0
  212.         
  213.             CASE ENDKEY
  214.                 ptr% = Length% - 1
  215.         
  216.         
  217.             CASE ESCAPE
  218.                 a$ = original$
  219.                 ptr% = 0
  220.                 insert% = True
  221.                 exitCode% = -1
  222.             CASE IS > 255
  223.                 CALL Squawk(2)
  224.         
  225.             CASE IS < 32
  226.                 CALL Squawk(2)
  227.         
  228.             CASE ELSE
  229.         
  230.               ' Convert key code to character string
  231.                 kee$ = CHR$(keyNumber%)
  232.         
  233.               ' Insert or overstrike
  234.                 IF insert% THEN
  235.                     a$ = LEFT$(a$, ptr%) + kee$ + MID$(a$, ptr% + 1)
  236.                     a$ = LEFT$(a$, Length%)
  237.                 ELSE
  238.                     IF ptr% < Length% THEN
  239.                         MID$(a$, ptr% + 1, 1) = kee$
  240.                     END IF
  241.                 END IF
  242.         
  243.               ' Are we up against the wall?
  244.                 IF ptr% < Length% THEN
  245.                     ptr% = ptr% + 1
  246.                 ELSE
  247.                     CALL Squawk(2)
  248.                 END IF
  249.        
  250.             END SELECT
  251.     
  252.         LOOP UNTIL quit%
  253.  
  254. END SUB
  255.  
  256. SUB ErrorBox (Row%)
  257.  
  258. CALL ColorIt(14, 4)
  259. OldRow% = CSRLIN
  260. OldCol% = POS(0)
  261. Text$ = "█▀▀▀▀▀▀▀▀▀▀▀▀▀█"
  262. CALL LocateIt(Row%, Text$)
  263. Text$ = "█             █"
  264. CALL LocateIt(Row% + 1, Text$)
  265. Text$ = "█▄▄▄▄▄▄▄▄▄▄▄▄▄█"
  266. CALL LocateIt(Row% + 2, Text$)
  267. Text$ = "ERROR"
  268. CALL ColorIt(15 + 16, 4)
  269. CALL LocateIt(Row% + 1, Text$)
  270. LOCATE OldRow%, OldCol%
  271. END SUB
  272.  
  273. SUB ErrorHandler (ErrorCode%)
  274.   
  275.     'This will trap all INTERRUPT &H21 error codes placed in AX
  276.     'for FUNCTION &H5A and &H3E
  277.     'Well... actually -all- INTERRUPT &H21 Functions use these error codes
  278.     'as defined and trapped in the MakeTempFile SUB
  279.     '
  280.     SELECT CASE ErrorCode%
  281.       
  282.         CASE 0
  283.             PRINT "No ERROR FOUND: "; ErrorCode%;
  284.         CASE 2
  285.             PRINT "File Not Found, ERROR # "; ErrorCode%;
  286.         CASE 3
  287.             PRINT "PATH Not FOUND! ERROR # "; ErrorCode%;
  288.         CASE 1, 4 TO 18
  289.             'are defined, but easier to look up in a book, so...
  290.             PRINT "Undefined Error, Write it Down, ERROR # "; ErrorCode%;
  291.         CASE ELSE
  292.             PRINT "Undefined Error, Write it Down, ERROR # "; ErrorCode%;
  293.     END SELECT
  294.  
  295.         IF ErrorCode% > 0 THEN BEEP
  296.  
  297. END SUB
  298.  
  299. SUB GetColr (Fgd%, Bkg%, Colr%) STATIC
  300.  
  301.     Colr% = SCREEN(1, 1, 1)
  302.  
  303.     Fgd% = (Colr% AND 128) \ 8 + (Colr% AND 15)
  304.     Bkg% = (Colr% AND 112) \ 16
  305.  
  306. END SUB
  307.  
  308. FUNCTION GetDirectory$ (Drive$) STATIC
  309.     'DIM Regs AS RegType
  310.   
  311.         IF Drive$ = "" THEN
  312.             d$ = CHR$(GetDrive%)
  313.         ELSE
  314.             d$ = UCASE$(Drive$)
  315.         END IF
  316.   
  317.         Drive% = ASC(d$) - 64
  318.         Regs.dx = Drive%
  319.         Regs.ax = &H4700
  320.         p$ = SPACE$(64)
  321.         Regs.ds = VARSEG(p$)
  322.         Regs.si = SADD(p$)
  323.   
  324.         CALL INTERRUPTX(&H21, Regs, Regs)
  325.  
  326.         p$ = LEFT$(p$, INSTR(p$, CHR$(0)) - 1)
  327.   
  328.         GetDirectory$ = LEFT$(d$, 1) + ":\" + p$
  329.   
  330.         IF Regs.flags AND 1 THEN
  331.             GetDirectory$ = ""
  332.         END IF
  333.  
  334. END FUNCTION
  335.  
  336. FUNCTION GetDrive% STATIC
  337.   
  338.     'DIM Regs AS RegType
  339.     Regs.ax = &H1900
  340.  
  341.     CALL INTERRUPT(&H21, Regs, Regs)
  342.  
  343.     GetDrive% = (Regs.ax AND &HFF) + 65
  344.  
  345. END FUNCTION
  346.  
  347. FUNCTION KeyCode% STATIC
  348.  
  349.      DO
  350.           k$ = INKEY$
  351.      LOOP UNTIL k$ <> ""
  352.      KeyCode% = CVI(k$ + CHR$(0))
  353.  
  354. END FUNCTION
  355.  
  356. SUB LocateIt (Row%, Text$)
  357.      LOCATE Row%, Center(Text$)
  358.      PRINT Text$;
  359. END SUB
  360.  
  361. SUB MakeTempFile (TempFile$, NewFile$) STATIC
  362.  
  363.     'DIM Regs AS RegType
  364.   
  365.     'JRD NOTE: Place variable equal to the path where you want the TempFile$
  366.     'ie: Path$= "C:\WORD\DOC"
  367.     'TempFile= Path$
  368.     'if you use a subdirectory that doesn't exist you get no tempfile
  369.     'MS-DOS requires the following construct for the TempFile$ variable
  370.     TempFile$ = TempFile$ + CHR$(0) + SPACE$(13)
  371.  
  372.     Segment = VARSEG(TempFile$)    'segment where DOS put this file name
  373.     Offset = SADD(TempFile$)       'offset
  374.  
  375.     Regs.ax = &H5A00               'Function to make a temp file
  376.     Regs.cx = 0                    'file attribute is none
  377.     Regs.ds = Segment              'data segment gets the file name
  378.     Regs.dx = Offset               'data register gets the offset
  379.   
  380.     CALL INTERRUPTX(&H21, Regs, Regs)  'make a temp file
  381.  
  382.     IF (Regs.flags AND 1) = 1 THEN     'if an error set Carry Flag to one
  383.         NewFile$ = STR$(Regs.ax)       'set file name to the ErrorCode as double check
  384.         ErrorCode% = Regs.ax           'Error Code is in AX
  385.         IF ErrorCode% THEN CALL ErrorHandler(ErrorCode%)
  386.         EXIT SUB
  387.     END IF
  388.  
  389.         Segment = Regs.ds                  'redundant
  390.         Offset = Regs.dx                   'redundant
  391.  
  392.     Regs.bx = Regs.ax                   'the file handle
  393.     Regs.ax = &H3E00
  394.     CALL INTERRUPTX(&H21, Regs, Regs)   'closes the file
  395.  
  396.     IF (Regs.flags AND 1) = 1 THEN     'if an error set Carry Flag to one
  397.         NewFile$ = STR$(Regs.ax)       'set file name to the ErrorCode as double check
  398.         ErrorCode% = Regs.ax           'Error Code is in AX
  399.         IF ErrorCode% THEN CALL ErrorHandler(ErrorCode%)
  400.         EXIT SUB
  401.     END IF
  402.  
  403.     DEF SEG = Segment
  404.  
  405.     i = 0
  406.     NewFile$ = ""
  407.  
  408.     DO
  409.         a$ = CHR$(PEEK(Offset + i))
  410.         IF a$ = CHR$(0) THEN EXIT DO
  411.         i = i + 1
  412.         NewFile$ = NewFile$ + a$
  413.     LOOP
  414.  
  415.     DEF SEG
  416.  
  417. END SUB
  418.  
  419. SUB Pause2 (Seconds!)
  420.  
  421.     Synch! = TIMER
  422.     DO                          'looping changes the Start! time to
  423.                 Start! = TIMER      'synchronize to the system timer
  424.     LOOP WHILE Start! = Synch!  'Seconds! must be SINGLE to get fractions
  425.                                     'of a second
  426.     DO
  427.         kee$ = INKEY$
  428.     LOOP UNTIL TIMER > (Start! + Seconds!) OR LEN(kee$)
  429.                           
  430.                                     'put Kee$ in just in case we pass midnight
  431.     WHILE INKEY$ <> "": WEND    'delete that key stroke
  432. END SUB
  433.  
  434. SUB SetBorder (ColrByte%) STATIC
  435.  
  436.     'DIM Regs AS RegType
  437.     Regs.ax = &H1001
  438.     Regs.bx = ColrByte% * &H100
  439.     CALL INTERRUPT(&H10, Regs, Regs)
  440.  
  441. END SUB
  442.  
  443. SUB Splash (BackGround%) STATIC
  444.     STATIC ColrFlag%
  445.     RANDOMIZE TIMER
  446.     IF ColrFlag% OR BackGround% THEN
  447.         UpperBound = 254
  448.         LowerBound = 176
  449.         Char = INT((UpperBound - LowerBound + 1) * RND + LowerBound)
  450.     ELSE
  451.         Char = 176
  452.     END IF
  453.     CLS
  454.     FOR i = 1 TO 25
  455.         LOCATE i, 1
  456.         PRINT STRING$(80, Char);
  457.     NEXT
  458.     ColrFlag% = True
  459. END SUB
  460.  
  461. SUB SplitClearScreen
  462.  
  463.     'DIM Regs AS RegType
  464.     CALL GetColr(Fgd%, Bkg%, Colr%)
  465.  
  466.     'Initialize counter
  467.     Counter = 25
  468.  
  469.     'Scroll down
  470.     'with screen color
  471.     Regs.bx = 256 * Colr%
  472.  
  473.     FOR Index = 0 TO 24
  474.         Regs.ax = &H601
  475.         Regs.cx = 256 * Index
  476.         Regs.dx = (256 * Index) + 39
  477.         CALL INTERRUPT(&H10, Regs, Regs)
  478.         GOSUB DelayIt
  479.  
  480.         'Scroll up
  481.         'with screen color
  482.         Counter = Counter - 1
  483.         Regs.ax = &H701
  484.         Regs.cx = (256 * Counter) + 40
  485.         Regs.dx = (256 * Counter) + 79
  486.         CALL INTERRUPT(&H10, Regs, Regs)
  487.         GOSUB DelayIt
  488.     NEXT
  489.  
  490.     COLOR Fgd%, Bkg%
  491.  
  492. GOTO Around
  493. DelayIt:
  494.  
  495.     DelayTime! = .001
  496.  
  497.     Start! = TIMER
  498.  
  499.     IF Start! + DelayTime! > 86400 THEN
  500.      
  501.         Finish! = Start! + DelayTime! - 86400
  502.         DO WHILE TIMER >= Start! OR TIMER <= Finish!
  503.         LOOP
  504.  
  505.     ELSE
  506.      
  507.         DO WHILE TIMER <= Start! + DelayTime!
  508.         LOOP
  509.  
  510.     END IF
  511.     'GOTO Around
  512.     RETURN
  513. Around:
  514. END SUB
  515.  
  516. SUB Squawk (Num%)
  517. FOR i = 1 TO Num%
  518. SOUND 1000, 1
  519. SOUND 1500, 1
  520. SOUND 500, 1
  521. NEXT
  522. END SUB
  523.  
  524. SUB StarFlag
  525. COLOR 7, 0
  526. CLS
  527. LOCATE 4, 1
  528. PRINT " "; : COLOR 1, 7: PRINT "█"; : COLOR 15, 1: PRINT "";
  529. COLOR 1, 7: PRINT "███"; : COLOR 15, 1: PRINT " ";
  530. COLOR 1, 7: PRINT "█"; : COLOR 15, 1: PRINT "";
  531. COLOR 1, 7: PRINT "█████"; : COLOR 15, 1: PRINT "";
  532. COLOR 1, 7: PRINT "█████"; : COLOR 15, 1: PRINT "";
  533. COLOR 1, 7: PRINT "█████"; : COLOR 15, 1: PRINT "";
  534. COLOR 1, 7: PRINT "█████"; : COLOR 15, 1: PRINT "";
  535. COLOR 1, 7: PRINT "████"; : COLOR 4, 7: PRINT "██████████████████████████████████████████";
  536. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 1, 7: PRINT "███";
  537. COLOR 15, 1: PRINT "  "; : COLOR 1, 7: PRINT "████";
  538. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  539. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  540. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  541. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  542. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█";
  543. COLOR 15, 4: PRINT "▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄";
  544. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 1, 7: PRINT "█";
  545. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█";
  546. COLOR 15, 1: PRINT " "; : COLOR 1, 7: PRINT "█";
  547. COLOR 15, 1: PRINT " "; : COLOR 1, 7: PRINT "█";
  548. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  549. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  550. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  551. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  552. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "████";
  553. COLOR 15, 7: PRINT "██████████████████████████████████████████";
  554. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 1, 7: PRINT "████";
  555. COLOR 15, 1: PRINT " "; : COLOR 1, 7: PRINT "████";
  556. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  557. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  558. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  559. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  560. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█";
  561. COLOR 4, 7: PRINT "██████████████████████████████████████████";
  562. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 1, 7: PRINT "█";
  563. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█";
  564. COLOR 15, 1: PRINT " "; : COLOR 1, 7: PRINT "█";
  565. COLOR 15, 1: PRINT " "; : COLOR 1, 7: PRINT "█";
  566. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  567. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  568. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  569. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  570. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "████";
  571. COLOR 15, 4: PRINT "▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄";
  572. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 1, 7: PRINT "███";
  573. COLOR 15, 1: PRINT "  "; : COLOR 1, 7: PRINT "████";
  574. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  575. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  576. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  577. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  578. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█";
  579. COLOR 15, 7: PRINT "██████████████████████████████████████████";
  580. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 1, 7: PRINT "█";
  581. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█";
  582. COLOR 15, 1: PRINT " "; : COLOR 1, 7: PRINT "█";
  583. COLOR 15, 1: PRINT " "; : COLOR 1, 7: PRINT "█";
  584. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  585. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  586. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  587. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  588. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "████";
  589. COLOR 4, 7: PRINT "██████████████████████████████████████████";
  590. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 1, 7: PRINT "███";
  591. COLOR 15, 1: PRINT "  "; : COLOR 1, 7: PRINT "████";
  592. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  593. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  594. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  595. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  596. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█";
  597. COLOR 15, 4: PRINT "▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄";
  598. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 1, 7: PRINT "█";
  599. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█";
  600. COLOR 15, 1: PRINT " "; : COLOR 1, 7: PRINT "█";
  601. COLOR 15, 1: PRINT " "; : COLOR 1, 7: PRINT "█";
  602. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  603. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  604. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  605. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  606. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "████";
  607. COLOR 15, 7: PRINT "██████████████████████████████████████████";
  608. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 1, 7: PRINT "████";
  609. COLOR 15, 1: PRINT " "; : COLOR 1, 7: PRINT "████";
  610. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  611. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  612. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  613. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  614. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█";
  615. COLOR 4, 7: PRINT "██████████████████████████████████████████";
  616. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 15, 1: PRINT "▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄";
  617. COLOR 15, 4: PRINT "▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄";
  618. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 15, 7: PRINT "██████████████████████████████████████████████████████████████████████████████";
  619. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 4, 7: PRINT "██████████████████████████████████████████████████████████████████████████████";
  620. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 15, 4: PRINT "▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄";
  621. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 15, 7: PRINT "██████████████████████████████████████████████████████████████████████████████";
  622. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 4, 7: PRINT "██████████████████████████████████████████████████████████████████████████████";
  623. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 15, 4: PRINT "▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄";
  624. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 15, 7: PRINT "██████████████████████████████████████████████████████████████████████████████";
  625. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 4, 7: PRINT "██████████████████████████████████████████████████████████████████████████████";
  626. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 4, 0: PRINT "▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀ ";
  627.  
  628. END SUB
  629.  
  630. SUB TextBoxShadow (Row%, Col%, Message$, Outline%, Shadow%, Length%)
  631.     'Will put a message into a three line box -or-
  632.     'draw a box without a message using Message$=SPACE$(x)
  633.     'where "x" is the width of the box and Length%= number of lines > 3
  634.     'Boxes are centered if Col% = 0; else left side of box = Col%.
  635.     'Boxes display a true shadow if Shadow% <> 0
  636.     'True = -1: False = 0
  637.  
  638.     STATIC BoxReadFlag
  639.     Message$ = LEFT$(Message$, 60)
  640.     BoxWidth% = LEN(Message$) + 4
  641.     SELECT CASE Outline%
  642.         CASE 0
  643.             j = 8 * 6 + 1
  644.         CASE 1
  645.             j = 1
  646.         CASE 2
  647.             j = 8 + 1
  648.         CASE 3
  649.             j = 8 * 2 + 1
  650.         CASE 4
  651.             j = 8 * 3 + 1
  652.         CASE 5
  653.             j = 8 * 4 + 1
  654.         CASE 6
  655.             j = 8 * 5 + 1
  656.         CASE ELSE
  657.             j = 8 * 6 + 1
  658.     END SELECT
  659.  
  660.     IF BoxReadFlag THEN GOTO Skip
  661.     REDIM Box$(1 TO 56)
  662.     BoxReadFlag = True
  663.  
  664. 'single line box
  665.     Box$(1) = "┌"
  666.     Box$(2) = "─"
  667.     Box$(3) = "┐"
  668.     Box$(4) = "│"
  669.     Box$(5) = "│"
  670.     Box$(6) = "└"
  671.     Box$(7) = "─"
  672.     Box$(8) = "┘"
  673.  
  674. 'double top box
  675.     Box$(9) = "╒"
  676.     Box$(10) = "═"
  677.     Box$(11) = "╕"
  678.     Box$(12) = "│"
  679.     Box$(13) = "│"
  680.     Box$(14) = "╘"
  681.     Box$(15) = "═"
  682.     Box$(16) = "╛"
  683.  
  684. 'double side box
  685.     Box$(17) = "╓"
  686.     Box$(18) = "─"
  687.     Box$(19) = "╖"
  688.     Box$(20) = "║"
  689.     Box$(21) = "║"
  690.     Box$(22) = "╙"
  691.     Box$(23) = "─"
  692.     Box$(24) = "╜"
  693.  
  694. 'double box
  695.     Box$(25) = "╔"
  696.     Box$(26) = "═"
  697.     Box$(27) = "╗"
  698.     Box$(28) = "║"
  699.     Box$(29) = "║"
  700.     Box$(30) = "╚"
  701.     Box$(31) = "═"
  702.     Box$(32) = "╝"
  703.  
  704. 'bold box
  705.     Box$(33) = "█"
  706.     Box$(34) = "▀"
  707.     Box$(35) = "█"
  708.     Box$(36) = "█"
  709.     Box$(37) = "█"
  710.     Box$(38) = "█"
  711.     Box$(39) = "▄"
  712.     Box$(40) = "█"
  713.  
  714. 'bold and thick box
  715.     Box$(41) = "█"
  716.     Box$(42) = "█"
  717.     Box$(43) = "█"
  718.     Box$(44) = "█"
  719.     Box$(45) = "█"
  720.     Box$(46) = "█"
  721.     Box$(47) = "█"
  722.     Box$(48) = "█"
  723.  
  724. 'no box
  725.     Box$(49) = " "
  726.     Box$(50) = " "
  727.     Box$(51) = " "
  728.     Box$(52) = " "
  729.     Box$(53) = " "
  730.     Box$(54) = " "
  731.     Box$(55) = " "
  732.     Box$(56) = " "
  733.  
  734. Skip:
  735.  
  736.     IF Col% = 0 THEN
  737.  
  738.             BoxText$ = Box$(j) + STRING$(BoxWidth%, Box$(j + 1)) + Box$(j + 2)
  739.             CALL LocateIt(Row%, BoxText$)
  740.             Row2% = CSRLIN: Col2% = POS(0)
  741.             Colr% = SCREEN(Row2%, Col2% - 1, 1)
  742.             CALL TwoColrs(Fgd%, Bkg%, Colr%)
  743.     
  744.             FOR i = 1 TO Length% + 1
  745.             BoxText$ = Box$(j + 3) + "  " + Message$ + "  " + Box$(j + 4)
  746.             CALL LocateIt(Row% + i, BoxText$)
  747.  
  748.             IF Shadow% THEN
  749.                 COLOR 7, 0
  750.                     FOR k = 1 TO 2
  751.                         PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  752.                     NEXT
  753.                 COLOR Fgd%, Bkg%
  754.             END IF
  755.             NEXT i
  756.  
  757.             BoxText$ = Box$(j + 5) + STRING$(BoxWidth%, Box$(j + 6)) + Box$(j + 7)
  758.             CALL LocateIt(Row% + i, BoxText$)
  759.       
  760.             IF Shadow% THEN
  761.                 COLOR 7, 0
  762.                 FOR k = 1 TO 2
  763.                     PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  764.                 NEXT
  765.             'COLOR Fgd%, Bkg%
  766.     
  767.             COLOR 7, 0
  768.             LOCATE Row% + i + 1, Center(BoxText$) + 2
  769.       
  770.                 FOR k = 1 TO BoxWidth% + 2
  771.                     PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  772.                 NEXT
  773.                 COLOR Fgd%, Bkg%
  774.             END IF
  775.     ELSE
  776.  
  777.             BoxText$ = Box$(j) + STRING$(BoxWidth%, Box$(j + 1)) + Box$(j + 2)
  778.             LOCATE Row%, Col%
  779.             PRINT BoxText$;
  780.             Row2% = CSRLIN: Col2% = POS(0)
  781.             Colr% = SCREEN(Row2%, Col2% - 1, 1)
  782.             CALL TwoColrs(Fgd%, Bkg%, Colr%)
  783.  
  784.             FOR i = 1 TO Length% + 1
  785.             BoxText$ = Box$(j + 3) + "  " + Message$ + "  " + Box$(j + 4)
  786.             LOCATE Row% + i, Col%
  787.             PRINT BoxText$;
  788.       
  789.             IF Shadow% THEN
  790.                 COLOR 7, 0
  791.                 FOR k = 1 TO 2
  792.                     PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  793.                 NEXT
  794.                 COLOR Fgd%, Bkg%
  795.             END IF
  796.       
  797.             NEXT i
  798.  
  799.             BoxText$ = Box$(j + 5) + STRING$(BoxWidth%, Box$(j + 6)) + Box$(j + 7)
  800.             LOCATE Row% + i, Col%
  801.             PRINT BoxText$;
  802.       
  803.             IF Shadow% THEN
  804.                 COLOR 7, 0
  805.                 FOR k = 1 TO 2
  806.                     PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  807.                 NEXT
  808.             'COLOR Fgd%, Bkg%
  809.             'COLOR 7,0
  810.                 LOCATE Row% + i + 1, Col% + 2
  811.                 FOR k = 1 TO BoxWidth% + 2
  812.                     PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  813.                 NEXT
  814.                 COLOR Fgd%, Bkg%
  815.             END IF
  816.  
  817.     END IF
  818.  
  819. END SUB
  820.  
  821. SUB TwoColrs (Fgd%, Bkg%, Colr%)
  822.  
  823.     Fgd% = (Colr% AND 128) \ 8 + (Colr% AND 15)
  824.     Bkg% = (Colr% AND 112) \ 16
  825.  
  826. END SUB
  827.  
  828. SUB WaitKey
  829.  
  830.     WHILE INKEY$ <> "": WEND
  831.     DO
  832.         kee$ = INKEY$
  833.     LOOP UNTIL LEN(kee$)
  834.     IF kee$ = CHR$(27) THEN END
  835.  
  836. END SUB
  837.  
  838.