home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / QBAS / QBNWS301.ZIP / WINDOW.BAS < prev    next >
BASIC Source File  |  1992-03-19  |  8KB  |  216 lines
  1.  ' Shadowed window routines by Mark H Butler placed into the public domain
  2.  ' on February 28, 1992 (bye bye babies). I would appreciate any feedback
  3.  ' on these routines and if you improve on them I'd kinda like to know what
  4.  ' you did so I can benefit by the improvements to. If that's a deal then
  5.  ' enjoy the routines... there all yours now.
  6.  
  7.  DECLARE SUB Drawbox (UpRow%, LtCol%, LoRow%, RtCol%)
  8.  DECLARE SUB Shadow (UpRow%, LtCol%, LoRow%, RtCol%)
  9.  DECLARE SUB Explode (UpRow%, LtCol%, LoRow%, RtCol%)
  10.  DECLARE SUB Expand (UpRow%, LtCol%, LoRow%, RtCol%)
  11.  DECLARE SUB ScreenClear (LineColor%)
  12.  DECLARE SUB Delay (ticks!)
  13.  
  14.  ' These first lines of code are included to demo the
  15.  ' exploding and expanding window routines.
  16.  ' We'll fill the sceen with a bunch of crap so our windows
  17.  ' will have a backdrop you can see their shadows against.
  18.  
  19.     LOCATE , , 0
  20.     COLOR 14, 1
  21.     CLS
  22.     FOR I = 1 TO 13
  23.         FOR ch = 33 TO 178
  24.             PRINT CHR$(ch);
  25.         NEXT ch
  26.     NEXT I
  27.  
  28.     COLOR 4, 7
  29.     Explode 5, 15, 15, 65
  30.  
  31.     COLOR 0
  32.     LOCATE 9, 27
  33.     PRINT "This 'exploding' window was"
  34.     LOCATE 10, 25
  35.     PRINT "written entirely in QuickBASIC! "
  36.     LOCATE 12, 21
  37.     PRINT "(press any key for the 'Expand' routine)"
  38.     SLEEP
  39.  
  40.     COLOR 0, 3
  41.     Expand 2, 5, 22, 75
  42.  
  43.     COLOR 4
  44.     LOCATE 8, 12
  45.     PRINT "This is the 'Expand' routine. Like 'Explode' it calls"
  46.     LOCATE 9, 12
  47.     PRINT "the 'Drawbox' routine. It expands to it's full horizontal"
  48.     LOCATE 10, 12
  49.     PRINT "width  *before*  it begins to expand vertically though."
  50.     LOCATE 13, 12
  51.     PRINT "(press any key for some semi-fancy screen clearing)"
  52.     SLEEP
  53.     ScreenClear 3
  54.  
  55.  SUB Drawbox (UpRow%, LtCol%, LoRow%, RtCol%) STATIC
  56.  ' This routine draws a double line box to the dimensions set
  57.  ' in UpRow%, LtCol%, LoRow% and RtCol%. If you want a single line box
  58.  ' just change the ascii chars, e.g. change CHR$(205) to CHR$(196) etc.
  59.  '
  60.     Wide% = (RtCol% - LtCol%) - 1
  61.     LOCATE UpRow%, LtCol%
  62.     PRINT CHR$(201); STRING$(Wide%, CHR$(205)); CHR$(187);
  63.     FOR I% = UpRow% + 1 TO LoRow% - 1
  64.         LOCATE I%, LtCol%
  65.         PRINT CHR$(186); SPACE$(Wide%); CHR$(186);
  66.     NEXT I%
  67.     LOCATE LoRow%, LtCol%
  68.     PRINT CHR$(200); STRING$(Wide%, CHR$(205)); CHR$(188);
  69.  END SUB
  70.  
  71.  SUB Expand (UpRow%, LtCol%, LoRow%, RtCol%) STATIC
  72.  ' This routine will "expand" the window onto the screen calling on
  73.  ' DRAWBOX to draw sucessively wider boxes until it hits the width
  74.  ' dimensions. Then it will expand to meet the vertical dimensions.
  75.  '
  76.     RowCenter% = ((LoRow% - UpRow%) / 2) + UpRow%
  77.     ColCenter% = ((RtCol% - LtCol%) / 2) + LtCol%
  78.     UprRow% = RowCenter%: LeftCol% = ColCenter%
  79.     LwrRow% = RowCenter%: RghtCol% = ColCenter%
  80.     DO
  81.         LeftCol% = LeftCol% - 1
  82.         RghtCol% = RghtCol% + 1
  83.         IF LeftCol% < LtCol% THEN LeftCol% = LtCol%
  84.         IF RghtCol% > RtCol% THEN RghtCol% = RtCol%
  85.         Drawbox UprRow%, LeftCol%, LwrRow%, RghtCol%
  86.         IF LeftCol% = LtCol% AND RghtCol% = RtCol% THEN EXIT DO
  87.     LOOP
  88.     DO
  89.         UprRow% = UprRow% - 1
  90.         LwrRow% = LwrRow% + 1
  91.         IF UprRow% < UpRow% THEN UprRow% = UpRow%
  92.         IF LwrRow% >= LoRow% THEN LwrRow% = LoRow%
  93.         Drawbox UprRow%, LeftCol%, LwrRow%, RghtCol%
  94.         IF UprRow% = UpRow% AND LwrRow% = LoRow% THEN EXIT DO
  95.     LOOP
  96.     Shadow UpRow%, LtCol%, LoRow%, RtCol%
  97.  END SUB
  98.  
  99.  SUB Explode (UpRow%, LtCol%, LoRow%, RtCol%) STATIC
  100.  ' This routine will "explode" the window onto the screen calling on
  101.  ' DRAWBOX to draw sucessively larger boxes until it hits the limits
  102.  ' set in UpRow%, LtCol%, LoRow% and RtCol%. The first few lines determine
  103.  ' where the approximate center of the box begins even if the window is
  104.  ' to be located off-center with respect to the screen.
  105.  '
  106.     RowCenter% = ((LoRow% - UpRow%) / 2) + UpRow%
  107.     ColCenter% = ((RtCol% - LtCol%) / 2) + LtCol%
  108.     UprRow% = RowCenter%: LeftCol% = ColCenter%
  109.     LwrRow% = RowCenter%: RghtCol% = ColCenter%
  110.     DO
  111.         UprRow% = UprRow% - 1
  112.         LeftCol% = LeftCol% - 3
  113.         LwrRow% = LwrRow% + 1
  114.         RghtCol% = RghtCol% + 3
  115.         IF UprRow% < UpRow% THEN UprRow% = UpRow%
  116.         IF LeftCol% < LtCol% THEN LeftCol% = LtCol%
  117.         IF LwrRow% > LoRow% THEN LwrRow% = LoRow%
  118.         IF RghtCol% > RtCol% THEN RghtCol% = RtCol%
  119.         Drawbox UprRow%, LeftCol%, LwrRow%, RghtCol%
  120.         IF UprRow% = UpRow% AND LeftCol% = LtCol% THEN
  121.             IF LwrRow% = LoRow% AND RghtCol% = RtCol% THEN
  122.                 EXIT DO
  123.             END IF
  124.         END IF
  125.     LOOP
  126.     Shadow UpRow%, LtCol%, LoRow%, RtCol%   '*** now give it a shadow ****
  127.  END SUB
  128.  SUB ScreenClear (LineColor%) STATIC
  129.  'This routine will do a little fancy screen clearing by simulating
  130.  'an old style 1950s TV set being shut off. Screen shrinks to a single
  131.  'horizontal line then disappears to a shrinking dot and is gone.
  132.  'I wrote it for 80x25 text mode so if your displaying more screen lines
  133.  'than 25 you'll have to play with it to get it to erase them all.
  134.  '
  135.     LOCATE , , 0
  136.     DIM Lines$(1 TO 23)
  137.     Lines$(1) = STRING$(80, CHR$(196))
  138.     Sp% = 2
  139.     Length% = 76
  140.     FOR I% = 2 TO 21
  141.         Lines$(I%) = SPACE$(Sp%) + STRING$(Length%, CHR$(196)) + SPACE$(2)
  142.         Sp% = Sp% + 2
  143.         Length% = Length% - 4
  144.     NEXT I%
  145.     Lines$(22) = SPACE$(39) + CHR$(254) + SPACE$(2)
  146.  
  147.     Lines$(23) = SPACE$(39) + "." + SPACE$(2)
  148.     COLOR 0, 0
  149.     x% = 1
  150.     y% = 25
  151.     FOR I% = 1 TO 12
  152.         LOCATE y%, 1
  153.         PRINT STRING$(80, CHR$(32));
  154.         LOCATE x%, 1
  155.         PRINT STRING$(80, CHR$(32));
  156.         Delay .04
  157.         x% = x% + 1
  158.         y% = y% - 1
  159.     NEXT I%
  160.     COLOR LineColor%, 0
  161.     FOR I% = 1 TO 23
  162.         LOCATE 13, 1
  163.         PRINT Lines$(I%);
  164.         Delay .04
  165.     NEXT I%
  166.     COLOR 7
  167.     LOCATE , , 1, 6, 7
  168.     CLS
  169.  END SUB
  170.  
  171.  SUB Shadow (UpRow%, LtCol%, LoRow%, RtCol%) STATIC
  172.  ' This routine creates a transparent shadow along the right side
  173.  ' and bottom edge of the box. Note: Special thanks to John Strong
  174.  ' for his very helpful tips on what to POKE and where.
  175.  '
  176.     DEF SEG = &H40
  177.     mono% = PEEK(&H10)
  178.     IF (mono% AND 48) = 48 THEN
  179.         EXIT SUB            '*** Forget the shadow if it's monochrome.
  180.     ELSE
  181.         DEF SEG = &HB800
  182.     END IF
  183.  
  184.  '****** find out what the screen attributes already are ****
  185.  
  186.     attr% = SCREEN(LoRow% + 1, RtCol% + 1, -1)  ' Get the attribute.
  187.     attr% = attr% AND 15                     ' Calculate forground.
  188.     attr% = attr% - 8                        ' Remove bright.
  189.     IF attr% < 1 THEN attr% = 8              ' In case color wasn't bright.
  190.  
  191.  '****** use the given box dimensions to POKE a ***********
  192.  '****** shadow on the right side and bottom edge *********
  193.  
  194.     FOR row% = UpRow% + 1 TO LoRow% + 1       '***** right edge locations.
  195.         FOR Col% = RtCol% + 1 TO RtCol% + 2   '***** make it 2 chars Wide.
  196.             offset% = (row% - 1) * 160 + (Col% - 1) * 2 + 1
  197.             POKE offset%, attr%
  198.         NEXT
  199.     NEXT
  200.     row% = LoRow% + 1                        '***** now POKE along the
  201.     FOR Col% = LtCol% + 2 TO RtCol% + 2      '***** bottom edge
  202.         offset% = (row% - 1) * 160 + (Col% - 1) * 2 + 1
  203.         POKE offset%, attr%
  204.     NEXT
  205.     DEF SEG
  206.  END SUB
  207.  
  208.  SUB Delay (ticks!)
  209.  'The next sub is just a little delay that ScreenClear needs
  210.  '
  211.     begintime! = TIMER
  212.     DO
  213.     LOOP UNTIL TIMER - begintime! > ticks!
  214.  END SUB
  215.  
  216.