home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / pscrn55 / basic.exe / DEMOSCR1.BAS < prev    next >
BASIC Source File  |  1994-10-09  |  7KB  |  188 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    "PScreen.Obj"    '...essential "screen restore" routines
  10. ''$Link    "LoadScrn.PBU"   '...link our "load screen" routines
  11. '===================================================
  12. '   END:  POWERBASIC USERS
  13. '===================================================
  14.  
  15. '***************************************************************************
  16.  
  17. '  DemoScr1.Bas          P-Screen demo.  Copyright 1994,  Rob W. Smetana
  18. '
  19. '  Requires:
  20. '
  21. '   1. PScreen.Inc -- an "include file" declaring procedures and functions.
  22. '
  23. '   2. PScreen.Obj -- assembler screen-restore (and other) routines.
  24. '
  25. '   3. LoadScr?.Obj (Microsoft Basics) or LoadScrn.Pbu (PowerBasic).
  26. '      ("?" = "4" for QuickBASIC 4.x, "7" for PDS 7.x, or "V" = VB-DOS)
  27. '
  28. '      The "load screen" module contains these functions:
  29. '
  30. '         DisplayScreen% (...)
  31. '         LoadScreen% (...)
  32. '         NumberScreensInLib% (...)
  33. '
  34. '   4. A P-Screen screeen library (e.g., Lessons.PSL).
  35. '
  36. '
  37. '  Purpose:             1. Show how easy it is to display screens
  38. '                          from SCREEN LIBRARIES.
  39. '
  40. '                       2. Show how to determine # of screens in library.
  41. '
  42. '                       3. Demonstrate using function DISPLAYSCREEN(...)
  43. '
  44. '                       4. Display screens using function LOADSCREEN(...)
  45. '
  46. '                       5. Demonstrate RE-COLORING screens on-the-fly!
  47. '                          (NOTE:  In shareware versions, "re-color"
  48. '                           does nothing.  But please review the code
  49. '                           below to see how easily you can re-color
  50. '                           screens on-the-fly.)
  51. '
  52. '                       6. Demonstrate how to detect errors and interpret
  53. '                          ERROR codes.
  54. '
  55. '                       7. Demonstrate using psSaveScrn and
  56. '                          psRestScrn to ALSO save/restore NORMAL
  57. '                          screens -- not just our compressed screens.
  58. '
  59. '*************************************************************************
  60.  
  61.  
  62.    COLOR 7, 1: CLS
  63.  
  64.    Call psInitialize:Cls           '...for SHAREWARE versions ONLY
  65.  
  66.    '... put something on the screen to demonstrate saving/restoring it
  67.  
  68.    FOR TRow = 1 TO 25
  69.        PRINT "               Welcome to P-Screen!    Press a key . . ."
  70.    NEXT
  71.  
  72.    ky$ = INPUT$(1)
  73.  
  74.    '...Allocate a buffer to save/restore the screen.
  75.  
  76.    TRow = 1: LCol = 1: BRow = 25: RCol = 80
  77.  
  78.    '...Use a formula so if you switch to 43- or 50-line screens,
  79.    '   the screen buffer (integer array) will be large enough.
  80.  
  81.    NumInts = ((BRow - TRow + 1) * (RCol - LCol + 1))
  82.  
  83.    REDIM ScrnBuf%(1 TO NumInts)     '...each integer element holds 2 bytes!
  84.  
  85.    '...save the underlying screen
  86.    CALL psSaveScrn(TRow, LCol, BRow, RCol, SEG ScrnBuf(1))
  87.  
  88.    CLS
  89.  
  90.    'We'll display screens from one of P-Screen's screen libraries.
  91.    'Screen libraries are created with '.PSL'...extensions.  If you
  92.    'don't include an extension here, '.PSL'...will be assumed.
  93.  
  94.    '...NOTE:  Add a PATH if Lessons.Psl isn't on the current drive/directory
  95.  
  96.     LibName$ = "Lessons"
  97.  
  98.    '... get # of screens in screen library
  99.  
  100.     ErrorCode = NumScreensInLib(LibName$)
  101.     GOSUB ProcessError                  '...halt if error occurred
  102.  
  103.     PRINT "...  Library ["; LibName$; "] contains"; ErrorCode; " screens.  Press a key. . .";
  104.     ky$ = INPUT$(1)
  105.  
  106.     FOR ScreenNumber = 1 TO 7
  107.  
  108.       '...Quickly display several screens by number!  Note blank screen name.
  109.  
  110.       ErrorCode = DisplayScreen(LibName$, "", ScreenNumber)
  111.       GOSUB ProcessError
  112.  
  113.     NEXT
  114.  
  115.     CLS : LOCATE 12, 20: COLOR 16, 7
  116.     PRINT "< 7 screens f-a-s-t, and all from disk. >";
  117.     ky$ = INPUT$(1)
  118.  
  119.     COLOR 7, 0
  120.     CLS
  121.     PRINT "   You just saw 7 screens displayed from a screen library using function"
  122.     PRINT "   DisplayScreen.  We displayed these screens by NUMBER -- which is easy!"
  123.     PRINT
  124.     PRINT "   When you press a key, we'll display the first 2 screens, but this time: : :"
  125.     PRINT
  126.     PRINT "    1.  We'll use function LoadScreen and then call psRestScrn. "
  127.     PRINT "    2.  But BEFORE we display the screens, we'll re-color them dynamically!"
  128.     PRINT "        (Note:  In shareware versions, re-color does nothing.)"
  129.     PRINT
  130.     PRINT "   Press a key . . .";
  131.     ky$ = INPUT$(1)
  132.  
  133.     CLS
  134.     REDIM Arry(0)                   '...initialize integer array
  135.  
  136.     FOR ScreenNumber = 1 TO 2       '...when displaying screens by number,
  137.                                     '...pass a blank/nul screen name
  138.  
  139.         ErrorCode = LoadScreen(LibName$, "", ScreenNumber, Arry(), LastScreen, Description$, TopRow, LeftCol, BottomRow, RhtCol, NumInts)
  140.  
  141.         GOSUB ProcessError
  142.  
  143.        '...Change color  2 (green on black) to 79 (or any color you like
  144.        '...Change color 10 (brite green on black) to 112 (or any color you like
  145.  
  146.        '...In shareware versions, psRecolor does nothing.  But note
  147.        '   how easily YOU can re-color screens in your own programs.
  148.  
  149.        SegAddr& = 256& * ((VARSEG(Arry(1)) * 256&) + VARPTR(Arry(1)))
  150.        CALL psRecolor(SegAddr&, NumInts, 2, 79)
  151.        CALL psRecolor(SegAddr&, NumInts, 10, 112)
  152.  
  153.        CALL psRestScrn(TopRow, LeftCol, BottomRow, RhtCol, SEG Arry(1))
  154.        ky$ = INPUT$(1)
  155.     NEXT
  156.  
  157.     '...now restore the underlying "welcome" screen
  158.     CALL psRestScrn(TRow, LCol, BRow, RCol, SEG ScrnBuf(1))
  159.  
  160. END
  161.  
  162. '=============================================================
  163. ProcessError:   '...check ErrorCode; exit if an error occurs
  164. '=============================================================
  165.  
  166.     IF ErrorCode < -1 THEN
  167.  
  168.        'ErrorCodes:   0 Okay, and screen is NOT a bright background screen
  169.        '             -1 Okay, and screen IS a bright background screen
  170.        '
  171.        '           -999 Screen library NOT found
  172.        '            -99 ScrnName not in library
  173.        '            -66 Memory allocation error:  Can't allocate screen buffer
  174.        '            -88 Error reading disk (shouldn't happen, but who knows)
  175.        '
  176.         CLS
  177.         PRINT " Sorry, I have to end.":Print
  178.         Print " Error "; ErrorCode; "occurred displaying screen from "; LibName$;
  179.         If Instr(LibName$,".") = 0 then print ".PSL"
  180.         ky$ = INPUT$(1)
  181.         END
  182.     END IF
  183.  
  184. RETURN
  185.  
  186.  
  187.  
  188.