home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / pscrn55 / basic.exe / DEMOSCR2.BAS < prev    next >
BASIC Source File  |  1994-10-09  |  6KB  |  146 lines
  1. DEFINT A-Z
  2.  
  3. '$INCLUDE: 'PScreen.Inc'            '... Declare functions in PScreen.Obj
  4.                                     '    For Microsoft Basics only.
  5. '===================================================
  6. ' POWERBASIC USERS:  'un-REM the next few lines
  7. '===================================================
  8. ''$INCLUDE "PScreen.Inc"    '...declare routines
  9. ''$Link    "Demo.Obj"       '...link 3 "callable" screens
  10. ''$Link    "Brite.Obj"      '...link a "bright background" callable screen
  11. ''$Link    "PScreen.Obj"    '...essential "screen restore" routines
  12. '===================================================
  13. ' END:  POWERBASIC USERS
  14. '===================================================
  15.  
  16. '***************************************************************************
  17. '
  18. '    DemoScr2.Bas        P-Screen Demo -- Copyright 1994, Rob W. Smetana
  19. '
  20. ' QB/PDS/VB-DOS Users:   To run this you must first create a Quick Library
  21. '                        containing:  PScreen.Obj and Demo.Obj
  22. '
  23. '    Note:               In shareware versions, the "re-color" demo(s)
  24. '                        do NOTHING.  But please review them to see how
  25. '                        easily you can re-color screens on-the-fly.
  26. '
  27. '    Purpose:            This **extremely simply** demo shows how easily
  28. '                        you can:
  29. '
  30. '                        1.  Call P-Screen's ASM/OBJ screens (e.g., FROG () ;).
  31. '
  32. '                        2.  Display bright background screens -- IF you
  33. '                            have a CGA, EGA, VGA or compatible monitor !!!
  34. '
  35. '                        3.  Re-color "callable" screens -- if you detect
  36. '                            your users have mono/Hercules screens on
  37. '                            which bright background colors would blink.
  38. '
  39. '    Requires:           Demo.Obj        3 "callable" ASM/OBJ screens
  40. '                        Brite.Obj       A "bright background" callable screen
  41. '
  42. '                        PScreen.Obj with functions:
  43. '
  44. '                          psBrightBG      ASM function to toggle bright
  45. '                                          backgrounds on/off.
  46. '
  47. '                          psRecolor       To re-color screens on-the-fly.
  48. '
  49. '***************************************************************************
  50.  
  51. DECLARE SUB Falcon ()               '... declare our "callable screens"
  52. DECLARE SUB Frog ()
  53. DECLARE SUB Frog2 ()
  54. DECLARE SUB Brite ()
  55.  
  56. DECLARE FUNCTION BriteSegAddr& ()   '... memory-locate functions letting
  57. DECLARE FUNCTION BriteNUMELS% ()    '    us re-color our BRIGHTBG screen!
  58.  
  59. DECLARE SUB Pause (ticks%)          '... pause for # of timer ticks you specify
  60.  
  61. '***************************************************************************
  62.     COLOR 7,1:Cls
  63.  
  64.     Call psInitialize:Cls                '...for SHAREWARE versions ONLY
  65.  
  66.     CALL Falcon:  CALL Pause(30)
  67.  
  68.     FOR n = 1 TO 3
  69.         CALL Frog:  CALL Pause(20)
  70.         CALL Frog2: CALL Pause(5)        '... slurp!
  71.     NEXT
  72.  
  73.     CALL Frog: CALL Pause(10)
  74.  
  75.     CALL Brite               '... this screen will blink -- since we have NOT
  76.                              '... turned bright bg ON yet; but we will...
  77.     CALL Pause(40)
  78.  
  79.     CALL psBrightBG(-1)      '... turn blinking into bright bg -- IF you have
  80.                              '... a CGA, EGA, VGA or compatible monitor
  81.     CALL Pause(40)
  82.  
  83.     '... Now RE-COLOR bright background/blinking colors -- as you might in your
  84.     '    programs if you detect your users have mono or Hercules monitors.
  85.     '    In shareware versions, the "re-color" demo(s) will DO NOTHING.
  86.     '    But review this to see how easily you can re-color screens on-the-fly.
  87.     '
  88.     '  * Each call to psRecolor below changes one color to another.  Our
  89.     '    bright-background screen has several bright colors we need to change.
  90.     '
  91.     '  * The 1st number (e.g., 200) is the # of the color we want to change.
  92.     '    The 2nd number (e.g., 79) is the # of the color we want now.
  93.     '    Both Ruler.Exe and P-Screen can help you determine these numbers.
  94.     '
  95.  
  96.     '... 1st # = color to change;  2nd # = color we want #1 changed to.
  97.  
  98.     '... Locate our bright background screen in memory, and get its size.
  99.     SegAddr& = BriteSegAddr&: NumIntegers = BriteNUMELS%
  100.  
  101.     CALL psRecolor(SegAddr&, NumIntegers%, 200, 79)
  102.     CALL psRecolor(SegAddr&, NumIntegers%, 134, 64)
  103.     CALL psRecolor(SegAddr&, NumIntegers%, 131, 14)
  104.     CALL psRecolor(SegAddr&, NumIntegers%, 192, 49)
  105.     CALL psRecolor(SegAddr&, NumIntegers%, 211, 80)
  106.     CALL psRecolor(SegAddr&, NumIntegers%, 224, 30)
  107.  
  108.     CALL Brite               '... display it again -- with colors re-mapped!
  109.     CALL Pause(20)
  110.  
  111.     '... RESTORE our bright background colors  --  reverse what we did above.
  112.  
  113.     '... In shareware versions, "re-color" does NOTHING.  But review
  114.     '    this to see how easily you can re-color screens on-the-fly.
  115.  
  116.     '... Locate our bright background screen in memory, and get its size.
  117.     SegAddr& = BriteSegAddr&: NumIntegers = BriteNUMELS%
  118.  
  119.     CALL psRecolor(SegAddr&, NumIntegers%, 79, 200)
  120.     CALL psRecolor(SegAddr&, NumIntegers%, 64, 134)
  121.     CALL psRecolor(SegAddr&, NumIntegers%, 14, 131)
  122.     CALL psRecolor(SegAddr&, NumIntegers%, 49, 192)
  123.     CALL psRecolor(SegAddr&, NumIntegers%, 80, 211)
  124.     CALL psRecolor(SegAddr&, NumIntegers%, 30, 224)
  125.  
  126.     CALL Brite               '... display it again -- with colors re-mapped!
  127.     CALL Pause(40)
  128.  
  129.     CALL psBrightBG(0)       '... return to normal
  130.     CALL Pause(20)
  131.  
  132. '
  133. SUB Pause (ticks%)           '...pause for the # of timer ticks you specify
  134.  
  135.     DEF SEG = 0
  136.  
  137.     DO UNTIL TestTick% > ticks%
  138.        LastTick% = GetTick%: GetTick% = PEEK(&H46C)
  139.        IF LastTick% <> GetTick% THEN TestTick% = TestTick% + 1
  140.     LOOP
  141.  
  142.     DEF SEG
  143.  
  144. END SUB
  145.  
  146.