home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / gwbasic / fancycls / fancycls.bas next >
Encoding:
BASIC Source File  |  1994-05-24  |  3.1 KB  |  83 lines
  1. 100 ' ***************************************************************
  2. 110 ' ***************************************************************
  3. 120 ' **                       GW-BASIC 3.23                       **
  4. 130 ' **                         FANCYCLS                          **
  5. 140 ' **                  Fancy Clear Screen Routine               **
  6. 150 ' **                        (c) 1990 by                        **
  7. 160 ' **                       Thomas Jaeger                       **
  8. 170 ' **                   1848 Andalucia Drive                    **
  9. 180 ' **                   El Paso, Texas 79935                    **
  10. 190 ' **                            USA                            **
  11. 200 ' ***************************************************************
  12. 210 ' ***************************************************************
  13. 220 '
  14. 230 '
  15. 240 ' This program is distributed under the shareware concept.
  16. 250 '
  17. 260 ' You can put this routine in your next GW-, TURBO-, POWER-, or
  18. 270 ' QuickBASIC routine. If you use this routine, please make a
  19. 280 ' distribution of US $1-5 to support this shareware concept.
  20. 290 '
  21. 300 ' Other routines will follow.
  22. 310 '
  23. 320 ' ----------------------------------------------------------------------
  24. 330 '
  25. 340 ' How about a fancy clear screen routine to impress your friends
  26. 350 ' in your next program?
  27. 360 ' Immediately you called FANCYCLS with GOSUB 10000, the screen starts
  28. 370 ' to crumble by coincidence. A great effect.
  29. 380 ' The routine will detect, if you have a monochrome, graphics card.
  30. 390 ' (screenseg &HB800 vs. &HB000). If you don't want the
  31. 400 ' background color to be changed, just erase line 10090.
  32. 410 '
  33. 420 ' ----------------------------------------------------------------------
  34. 430 '
  35. 440 DIM F%(2000) ' dimension is necessary for screen
  36. 450 KEY OFF
  37. 460 '
  38. 470 ' >>>>> Your program starts hier <<<<<
  39. 480 '
  40. 490 ' The following code only fills the screen with asteriks to give a better
  41. 500 ' demonstration. You can leave this code out of your program.
  42. 510 '
  43. 520 WAITING$ = INKEY$
  44. 530 CLS
  45. 540 WHILE WAITING$ = ""
  46. 550   WHILE NOT ENDPRINT = -1
  47. 560      FOR COUNTER% = 1 TO 25
  48. 570         PRINT STRING$(80, CHR$(219));
  49. 580      NEXT COUNTER%
  50. 590      ENDPRINT = -1
  51. 600      LOCATE 13, 35
  52. 610      PRINT " PRESS ANY KEY! "
  53. 620   WEND
  54. 630   WAITING$ = INKEY$
  55. 640 WEND
  56. 650 LOCATE 14, 35
  57. 660 PRINT "  WAIT A SECOND "
  58. 670 GOSUB 10000   '* CALL FANCYCLS
  59. 680 ' You probably want to end your program then.
  60. 690 END ' Program
  61. 9997  '
  62. 9998  '* SUB FANCYCLS
  63. 9999  '
  64. 10000 FOR COUNTER% = 0 TO 2000
  65. 10010   F%(COUNTER%) = COUNTER%
  66. 10020 NEXT COUNTER%
  67. 10030 FOR COUNTER% = 2000 TO 0 STEP -1
  68. 10040   SWAP F%(INT(RND(1) * COUNTER%)), F%(COUNTER)
  69. 10050 NEXT COUNTER%
  70. 10051 DEF SEG = &H40
  71. 10052   IF PEEK(&H49) = 7 THEN SCRSEG% = &HB000 ELSE SCRSEG% = &HB800
  72. 10059 DEF SEG
  73. 10060 DEF SEG = SCRSEG%
  74. 10070 FOR COUNTER% = 0 TO 2000
  75. 10075   FOR DELAY% = 1 TO 300: NEXT DELAY%    '* if a compiler is used!
  76. 10080   POKE F%(COUNTER%) * 2, 32
  77. 10090   POKE F%(COUNTER%) * 2 + 1, 0 ' Background = black
  78. 10100 NEXT COUNTER%
  79. 10105 DEF SEG
  80. 10110 RETURN  ' to your main program
  81. 10120 '* END SUB
  82.  
  83.