home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / grafik / shadow / 3dshadow.bas next >
Encoding:
BASIC Source File  |  1994-03-20  |  6.4 KB  |  269 lines
  1. '******************************3DSHADOW.BAS********************************
  2. 'JRD NOTE:
  3. '
  4. 'Got the shadow idea from a high school kid's program....
  5. '
  6. 'John De Palma on CompuServe
  7. 'Mon 03-21-94 00:51:00
  8. '
  9. 'Declarations
  10. DEFINT A-Z
  11. DECLARE SUB TextBox (Row%, Col%, Message$, Outline%, Length%)
  12. DECLARE SUB PauseClick ()
  13. DECLARE SUB LocateIt (Row%, text$)
  14. DECLARE SUB TwoColrs (Fgd%, Bkg%, Colr%)
  15. DECLARE SUB CursorOff ()
  16.  
  17. DECLARE FUNCTION Center% (text$)
  18. DECLARE FUNCTION OneColr% (Fgd%, Bkg%)
  19.    
  20. 'Executable code 
  21.    
  22.     COLOR 15, 1
  23.     CLS
  24.     CursorOff
  25.    
  26.     FOR i = 1 TO 24
  27.         PRINT STRING$(80, 96 + i);
  28.         PLAY "p32"
  29.     NEXT
  30.  
  31.  
  32.     COLOR 14, 3
  33.     Message$ = SPACE$(40)
  34.     CALL TextBox(10, 4, Message$, 5, 2)
  35.     text$ = "PRESS {Enter} ─┘ to see a new Screen"
  36.     LOCATE 12, 8: PRINT text$
  37.     PauseClick
  38.  
  39.     COLOR 15, 4
  40.     Message$ = "How to make a 3-D Shadow Box"
  41.     CALL TextBox(4, 0, Message$, 4, 0)
  42.     PauseClick
  43.    
  44.     COLOR 11, 0
  45.     Message$ = "Using the SCREEN Function"
  46.     CALL TextBox(20, 0, Message$, 2, 0)
  47.     PauseClick
  48.  
  49.     COLOR 14, 2
  50.     Message$ = "Program by John De Palma"
  51.     CALL TextBox(9, 32, Message$, 3, 0)
  52.     PauseClick
  53.    
  54.     COLOR 14, 4
  55.     Message$ = "With some High School Help!"
  56.     CALL TextBox(14, 38, Message$, 1, 0)
  57.     PauseClick
  58.  
  59.     COLOR 10, 3
  60.     text$ = "DATE: " + DATE$ + " Time: " + TIME$
  61.     Message$ = SPACE$(LEN(text$) \ 2)
  62.     CALL TextBox(2, 50, Message$, 0, 1)
  63.     LOCATE 3, 52: PRINT "DATE: "; DATE$
  64.     LOCATE 4, 52: PRINT "Time: "; TIME$
  65.     PauseClick
  66.  
  67.     COLOR 12, 4
  68.     Message$ = "Thanks for Watchin'"
  69.     CALL TextBox(18, 4, Message$, 0, 0)
  70.     PauseClick
  71.  
  72.     COLOR 7, 0
  73.  
  74. FUNCTION Center% (text$)
  75. Center% = 41 - LEN(text$) \ 2
  76. END FUNCTION
  77.  
  78. SUB CursorOff
  79. LOCATE , , 0
  80. END SUB
  81.  
  82. SUB LocateIt (Row%, text$)
  83.      LOCATE Row%, Center(text$)
  84.      PRINT text$;
  85. END SUB
  86.  
  87. DEFINT A-Z
  88. FUNCTION OneColr% (Fgd%, Bkg%)
  89.     OneColr% = (Fgd% AND 16) * 8 + ((Bkg% AND 7) * 16 + (Fgd% AND 15))
  90. END FUNCTION
  91.  
  92. DEFINT A-Z
  93. SUB PauseClick
  94.     WHILE INKEY$ <> "": WEND
  95.     WHILE INKEY$ = "": WEND
  96.     PLAY "P32"
  97. END SUB
  98.  
  99. SUB TextBox (Row%, Col%, Message$, Outline%, Length%)
  100.  
  101.     'Will put a message into a three line box -or-
  102.     'draw a box without a message using Message$=SPACE$(x)
  103.     'where "x" is the width of the box and Length%= number of lines > 3
  104.     'All boxes are centered.
  105.     'Now to make them non centered....
  106.  
  107.     Message$ = LEFT$(Message$, 60)
  108.     BoxWidth% = LEN(Message$) + 4
  109.     SELECT CASE Outline%
  110.         CASE 0
  111.             j = 8 * 5 + 1
  112.         CASE 1
  113.             j = 1
  114.         CASE 2
  115.             j = 8 + 1
  116.         CASE 3
  117.             j = 8 * 2 + 1
  118.         CASE 4
  119.             j = 8 * 3 + 1
  120.         CASE 5
  121.             j = 8 * 4 + 1
  122.         CASE ELSE
  123.             j = 8 * 5 + 1
  124.     END SELECT
  125.   
  126.         'if you use a lot of boxes put this in the main module as:
  127.         'DIM SHARED Box$(1 to 8 * 6)
  128.         REDIM Box$(1 TO 8 * 6)
  129.  
  130. 'single line box
  131.     Box$(1) = "┌"
  132.     Box$(2) = "─"
  133.     Box$(3) = "┐"
  134.     Box$(4) = "│"
  135.     Box$(5) = "│"
  136.     Box$(6) = "└"
  137.     Box$(7) = "─"
  138.     Box$(8) = "┘"
  139.  
  140. 'double top box
  141.     Box$(9) = "╒"
  142.     Box$(10) = "═"
  143.     Box$(11) = "╕"
  144.     Box$(12) = "│"
  145.     Box$(13) = "│"
  146.     Box$(14) = "╘"
  147.     Box$(15) = "═"
  148.     Box$(16) = "╛"
  149.  
  150. 'double side box
  151.     Box$(17) = "╓"
  152.     Box$(18) = "─"
  153.     Box$(19) = "╖"
  154.     Box$(20) = "║"
  155.     Box$(21) = "║"
  156.     Box$(22) = "╙"
  157.     Box$(23) = "─"
  158.     Box$(24) = "╜"
  159.  
  160. 'double box
  161.     Box$(25) = "╔"
  162.     Box$(26) = "═"
  163.     Box$(27) = "╗"
  164.     Box$(28) = "║"
  165.     Box$(29) = "║"
  166.     Box$(30) = "╚"
  167.     Box$(31) = "═"
  168.     Box$(32) = "╝"
  169.  
  170. 'bold and thick box
  171.     Box$(33) = "█"
  172.     Box$(34) = "▀"
  173.     Box$(35) = "█"
  174.     Box$(36) = "█"
  175.     Box$(37) = "█"
  176.     Box$(38) = "█"
  177.     Box$(39) = "▄"
  178.     Box$(40) = "█"
  179.  
  180. 'no box
  181.     Box$(41) = " "
  182.     Box$(42) = " "
  183.     Box$(43) = " "
  184.     Box$(44) = " "
  185.     Box$(45) = " "
  186.     Box$(46) = " "
  187.     Box$(47) = " "
  188.     Box$(48) = " "
  189.   
  190.     IF Col% = 0 THEN
  191.       
  192.             BoxText$ = Box$(j) + STRING$(BoxWidth%, Box$(j + 1)) + Box$(j + 2)
  193.             CALL LocateIt(Row%, BoxText$)
  194.             Row2% = CSRLIN: Col2% = POS(0)
  195.             Colr% = SCREEN(Row2%, Col2% - 1, 1)
  196.             CALL TwoColrs(Fgd%, Bkg%, Colr%)
  197.            
  198.             FOR i = 1 TO Length% + 1
  199.             BoxText$ = Box$(j + 3) + "  " + Message$ + "  " + Box$(j + 4)
  200.             CALL LocateIt(Row% + i, BoxText$)
  201.             COLOR 8, 0
  202.             FOR k = 1 TO 2
  203.                  PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  204.             NEXT
  205.             COLOR Fgd%, Bkg%
  206.             NEXT i
  207.   
  208.             BoxText$ = Box$(j + 5) + STRING$(BoxWidth%, Box$(j + 6)) + Box$(j + 7)
  209.             CALL LocateIt(Row% + i, BoxText$)
  210.             COLOR 8, 0
  211.             FOR k = 1 TO 2
  212.                  PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  213.             NEXT
  214.             'COLOR Fgd%, Bkg%
  215.            
  216.             COLOR 8, 0
  217.             LOCATE Row% + i + 1, Center(BoxText$) + 2
  218.             FOR k = 1 TO BoxWidth% + 2
  219.                 PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  220.             NEXT
  221.             COLOR Fgd%, Bkg%
  222.   
  223.     ELSE
  224.  
  225.             BoxText$ = Box$(j) + STRING$(BoxWidth%, Box$(j + 1)) + Box$(j + 2)
  226.             LOCATE Row%, Col%
  227.             PRINT BoxText$;
  228.             Row2% = CSRLIN: Col2% = POS(0)
  229.             Colr% = SCREEN(Row2%, Col2% - 1, 1)
  230.             CALL TwoColrs(Fgd%, Bkg%, Colr%)
  231.  
  232.             FOR i = 1 TO Length% + 1
  233.             BoxText$ = Box$(j + 3) + "  " + Message$ + "  " + Box$(j + 4)
  234.             LOCATE Row% + i, Col%
  235.             PRINT BoxText$;
  236.             COLOR 8, 0
  237.             FOR k = 1 TO 2
  238.                  PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  239.             NEXT
  240.             COLOR Fgd%, Bkg%
  241.             NEXT i
  242.  
  243.             BoxText$ = Box$(j + 5) + STRING$(BoxWidth%, Box$(j + 6)) + Box$(j + 7)
  244.             LOCATE Row% + i, Col%
  245.             PRINT BoxText$;
  246.             COLOR 8, 0
  247.             FOR k = 1 TO 2
  248.                  PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  249.             NEXT
  250.             'COLOR Fgd%, Bkg%
  251.             'COLOR 8, 0
  252.             LOCATE Row% + i + 1, Col% + 2
  253.             FOR k = 1 TO BoxWidth% + 2
  254.                 PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  255.             NEXT
  256.             COLOR Fgd%, Bkg%
  257.  
  258.     END IF
  259. END SUB
  260.  
  261. DEFINT A-Z
  262. SUB TwoColrs (Fgd%, Bkg%, Colr%)
  263.  
  264.     Fgd% = (Colr% AND 128) \ 8 + (Colr% AND 15)
  265.     Bkg% = (Colr% AND 112) \ 16
  266.  
  267. END SUB
  268.  
  269.