home *** CD-ROM | disk | FTP | other *** search
- '┌───────────────────────────────────────────────────────────────────────────┐
- '│ P-Screen Demo QuickBASIC 4.x -OR- PDS 7 Only │
- '├───────────────────────────────────────────────────────────────────────────┤
- '│ Demo program included with P-Screen (Pro~Formance Screen Design). │
- '│ │
- '│ Compatibility: QuickBasic 4.x only -OR- PDS 7 │
- '│ │
- '│ 3 Purposes: Demonstrate how to: │
- '│ 1. Display screens stored in a Library. │
- '│ - Press <H>elp to view a Help Screen. Notice the │
- '│ small amount of code needed to display a screen.│
- '│ │
- '│ 2. Display a directory of Library Screen names. │
- '│ │
- '│ 3. Load several screens (Menus) at once, then later │
- '│ display 'em on demand. │
- '│ │
- '│ To run: Run QB or QBX, loading a Quick Library that contains: │
- '│ │
- '│ - rsLoadScrn.obj -rsLodBin.obj -rsCompRest.obj │
- '│ │
- '│ For QuickBASIC 4.5: │
- '│ │
- '│ QB ps_demo /l ps_demo (note underline characters)│
- '│ │
- '│ For PDS 7: │
- '│ │
- '│ QBX ps_demo /l bc7demo (note underline character) │
- '│ │
- '│ History: 1st cut 12/88 │
- '│ p-screen menus 4/90 │
- '│ rsWindow added 8/90 │
- '│ ASM screen demo added 9/91 │
- '└───────────────────────────────────────────── (C) 1988-1991 R.W. Smetana ─┘
-
- DEFINT A-Z '... Integers ONLY. If not, called routines will crash.
-
- '................. ................. ................. .................
-
- '... Declare SUBs and FUNCTIONs in this module.
-
- DECLARE SUB LoadMenus (MenuDemo%(), Menu.ErrCode%)
- DECLARE SUB ASM.Screens ()
- DECLARE FUNCTION Display.Screen (LibName$, ScreenName$, IsBrightOn%)
- DECLARE SUB Display.Directory (LibraryName$)
-
- '... Declare procedures included in PS-Demo.Qlb
-
- DECLARE SUB rsLoadScrn (Array%(), LibraryName$, FileName$, Desc$, TopRow%, LeftCol%, BotRow%, RhtCol%, x%, ErrCode%)
- DECLARE SUB rsCompRest (TopRow%, BotRow%, SEG Array%)
- DECLARE SUB CompRestPLUS (Top, Lft, Bot, Rht, SEG Array%)
-
-
-
- '...Caution: Use rsCompRest ONLY for full-width screens. Registered
- ' users receive CompRestPlus which can display ANY SIZE screens.
- ' P-Screen COMPRESSES screens. Only our display routines can display 'em.
- ' But you can use our screen-display routines to restore ANY screen,
- ' compressed or normal. And we use the same routines to display ASM screens.
-
-
- CONST True = -1: False = NOT True
-
- CONST LibraryName$ = "P-SCREEN" '... Display all screens from
- ' P-Screen.Psl
-
- TYPE ScrLib '... TYPE to read Names/Descriptions
- ScrName AS STRING * 8 ' of screens in a Library
- Description AS STRING * 15
- IgnoreMe AS STRING * 14
- END TYPE
- DIM SHARED ScreenLib AS ScrLib
-
- '................. ................. ................. .................
-
- '... 1st, see if "P-Screen.Psl" exists. If not, stop.
-
- ON ERROR GOTO CantFindLibrary '... Demo aborts if P-Screen.Psl isn't found.
-
- CLOSE : OPEN LibraryName$ + ".Psl" FOR INPUT AS #1 '... Just checking. Your
- CLOSE ' programs must ensure
- ' Libraries exist BEFORE
- ' calling our routines.
-
- REDIM MenuDemo%(1) '... Load ALL P-Screen-style
- CALL LoadMenus(MenuDemo%(), Menu.ErrCode) ' menus into one array.
- ' Press "M" at the menu
- ' to see the results.
-
- '................. ................. ................. .................
- '... Main Menu
- '................. ................. ................. .................
-
- LOCATE , , 1 '... turn on the cursor
-
- DO UNTIL Option$ = CHR$(27) '... press ESCAPE to exit this demo
-
- GOSUB PrintMenu '... display our Main Menu
-
- DO: Option$ = UCASE$(INKEY$): LOOP UNTIL LEN(Option$)
-
- Option$ = UCASE$(Option$)
-
- CLS
-
- SELECT CASE Option$
- CASE "H": GOSUB Help
- CASE "D": Display.Directory LibraryName$
- GOSUB Pause
- CASE "M": GOSUB MenuDemo
- CASE "A": ASM.Screens
- END SELECT
-
- LOOP
-
- PRINT "Thank you for trying P-Screen ..... <rws>"
-
- END
- '................. ................. ................. .................
- Help: '... demonstrate how to Display Library Screen/interpret ErrCode
- '................. ................. ................. .................
-
- ScreenName$ = "QUIKREF1" '... P-Screen's Quick Reference Guide
-
- '... If we got this far, LibraryName$ + ".Psl" is available on the
- ' "current" drive. So, display ScreenName$.
- '................. ................. ................. .................
-
- '... NOTE: Screen names are stored in Upper Case in screen libraries.
- ' So we pass "UCase$(ScreenName$) to ensure we find it.
-
- '... Also note how we use the function Display.Screen (in this case
- ' in a Select Case statement).
-
- SELECT CASE Display.Screen(LibraryName$, UCASE$(ScreenName$), IsBrightOn%)
-
- CASE 0 '... No error
- GOSUB ShowInfo '... for your information
-
- CASE -99 '... screen NOT in Library
- PRINT TAB(20); "<"; ScreenName$; "> was NOT in "; LibraryName$; ".Psl";
-
- CASE -88 '... error loading it (probably -1)
- PRINT TAB(20); "<Too little Memory> to display screens.";
-
- CASE ELSE
- PRINT TAB(20); " An error occurred loading "; ScreenName$;
- END SELECT
-
-
- GOSUB Pause2 '... pause
-
- RETURN
- '................. ................. ................. .................
- ShowInfo: '... display info returned by rsLoadScrn
- '................. ................. ................. .................
-
- CALL rsWindow(" Press a key . . . ", 32, 7, 12, 16, 67, 2, 112, True)
-
- COLOR 0, 7
- LOCATE 9, 15: PRINT "This shows how to display full-screen Help Screens."
- LOCATE 11, 20: PRINT "This one is P-Screen's summary of commands."
- LOCATE , 21: PRINT "We displayed this from a screen library."
- LOCATE 14, 14: PRINT "We used the Display.Screen function to display this.";
- COLOR 7, 0
-
- RETURN
-
- '................. ................. ................. .................
- Pause: '...print a message and pause
- '................. ................. ................. .................
- LOCATE 23, 20: PRINT SPC(12); "Press a key . . ."; SPC(15);
-
- Pause2: '...just pause
-
- DO UNTIL LEN(INKEY$): LOOP
-
- RETURN
- '................. ................. ................. .................
- MenuDemo: '... Demonstrate displaying screens from an array.
- '................. ................. ................. .................
- 'Uses CompRestPlus (Call CompRestPlus ...) to display ANY
- 'size full screen or sub-screen (registered users only).
-
- 'The array MenuDemo%() was loaded with screens from P-Screen.Psl
- 'when you first ran this demo --- Call LoadMenus (MenuDemo%(), Menu.ErrCode).
- 'Loading menus from a screen library into an Integer array
- 'saves you a few '000 bytes of valuable string/data space.
-
- 'NOTE: If strange things happen when you run this, P-Screen.Psl, or
- ' this demo, were probably tampered with. The Row/Column and
- ' MenuDemo% offsets BELOW may no longer be correct. If not,
- ' you'll get some bizzare looking screens.
- '............... ................. ................. .................
-
- IF Menu.ErrCode THEN '... error occurred loading screens
- PRINT TAB(12); "Error occurred loading screens earlier. Can't do demo."
- BEEP: GOSUB Pause2: RETURN
- END IF
-
- '--- We're only interested in "OurKeys$" -- certain (Alt-/Cursor) keys : : :
-
- '... Alt-key scan codes for Alt- : : :
- 'F (!), D (" "), B (0), E (Chr$(18)), O (24), H (#)
-
- '... Scan codes for Right/Left Cursor keys ==>> M/K. Escape = Chr$(27)
- ' We want these in a certain order. Thus the gyrations below.
-
- OurKeys$ = "! 0" + CHR$(18) + CHR$(24) + "#MK"
-
- Waitfor! = 1 '... length of pause (see below)
- Start = 0 '... For Left/Right Cursor
-
- '... First, blast all our menus up
-
- CALL CompRestPLUS(1, 1, 1, 80, SEG MenuDemo%(MenuDemo%(1))) ' see note below re: Offsets
-
- d$ = " "
- FOR x = 1 TO LEN(OurKeys$)
- LSET d$ = MID$(OurKeys$, x, 1): GOSUB DisplayMenu
- NEXT
- GOSUB Pause
-
- CALL rsWindow(Blank$, Zero, 18, 1, 25, 80, 177, 11, True)
- LOCATE 19, 3: PRINT "These menus are displayed from an INTEGER array, NOT disk. This demo shows"
- LOCATE , 3: PRINT "how you can load many screens as programs start, then display them later."
- LOCATE , 3: PRINT "See 'Performance Hints' in your manual. Screens displayed with CompRestPlus."
- LOCATE 23, 21: PRINT " Pausing"; Waitfor!; "second(s) before clearing menus ";
-
- LOCATE 25, 6: PRINT "Press: "; CHR$(27); "/"; CHR$(26); " cursor keys, or Alt- F, D, B, E, O, H <Esc> = Exit";
-
-
- DO '... Outer Loop
-
- '... use rsWindow again, this time to "clear" some of the screen
- CALL rsWindow(Blank$, 32, 2, 1, 17, 80, 32, 7, True)
-
- '... use it again to "paint" our top menu line (restore color)
- CALL rsWindow(Blank$, 32, 1, 1, 1, 80, 255, 112, True)
-
- '>>>> Note the Pause between screens at the end of this loop <<<<
-
-
- DO '... get a key
-
- d$ = INKEY$
-
- LOOP UNTIL (LEN(d$) = 2 AND INSTR(OurKeys$, RIGHT$(d$, 1))) OR d$ = CHR$(27)
-
-
- IF d$ = CHR$(27) THEN EXIT DO '... exit Outer Loop on Esc
-
- d$ = RIGHT$(d$, 1) '... It's Extended, take 2nd key/Strip Chr$(0)
-
- IF INSTR("MK", d$) THEN '... if Right/Left Cursor then...
- IF d$ = "M" THEN 'right cursor
- Start = Start + 1: IF Start > 6 THEN Start = 1
- ELSE 'left cursor
- Start = Start - 1: IF Start < 1 THEN Start = 6
- END IF
-
- '... turn d$ into it's Alt-key equivalent based on Start
- d$ = MID$(OurKeys$, Start, 1)
-
- END IF
-
- GOSUB DisplayMenu
-
-
- '--- Pause briefly before we refresh the screen. To change the length
- ' of the pause, change the value of WaitFor! above the Main Loop.
-
- GOSUB MenuPause
-
- LOOP
-
- RETURN
- '................. ................. ................. .................
- MenuPause:
- '................. ................. ................. .................
-
- x! = TIMER: DO UNTIL TIMER > x! + Waitfor!: LOOP
-
- RETURN
- '................. ................. ................. .................
- DisplayMenu:
- '................. ................. ................. .................
-
- SELECT CASE d$ '... NOTE: We reserved the 1st 10
- ' elements in MenuDemo%() to store
- ' the offset into MenuDemo% where
- ' each screen BEGINS.
- ' See Sub LoadMenus for details.
-
- CASE "!" '... Alt-F (File)
- CALL CompRestPLUS(1, 2, 15, 27, SEG MenuDemo%(MenuDemo%(2)))
-
- CASE " " '... Alt-D (Draw)
- CALL CompRestPLUS(1, 11, 8, 34, SEG MenuDemo%(MenuDemo%(3)))
-
- CASE "0" '... Alt-B (Block)
- CALL CompRestPLUS(1, 20, 17, 43, SEG MenuDemo%(MenuDemo%(4)))
-
- CASE CHR$(18) '... Alt-E (Edit)
- CALL CompRestPLUS(1, 30, 9, 50, SEG MenuDemo%(MenuDemo%(5)))
-
- CASE CHR$(24) '... Alt-O (Options)
- CALL CompRestPLUS(1, 39, 14, 63, SEG MenuDemo%(MenuDemo%(6)))
-
- CASE "#" '... Alt-H (Help)
- CALL CompRestPLUS(1, 51, 12, 75, SEG MenuDemo%(MenuDemo%(7)))
-
- END SELECT
-
- RETURN
- '................. ................. ................. .................
- CantFindLibrary: '... couldn't find LibraryName$ + ".Psl"
- '................. ................. ................. .................
-
- OurErr = ERR
- CLS : CLOSE
- PRINT TAB(18); "Can't find "; LibraryName$ + ".Psl. Press a key . . .";
- BEEP: GOSUB Pause2: END
-
-
- '................. ................. ................. .................
- PrintMenu:
- '................. ................. ................. .................
-
- '... First, clear the screen, filling it with some character.
- ' This is the "fill screen" option of rsWindow
-
- CALL rsWindow(" P-Screen Demo ", 176, 1, 1, 25, 80, 2, 15, True)
-
- '... The next 6 lines aren't really necessary,
- ' but rsWindow is kind of handy.
-
- '--- Draw a VERTICAL line (no For...Next loop needed) !!
- CALL rsWindow(Blank$, 177, 2, 80, 24, 80, 177, 2, True)
- '--- add some arrows
- CALL rsWindow(Blank$, Zero, 2, 80, 2, 80, 24, 112, True)
- CALL rsWindow(Blank$, Zero, 24, 80, 24, 80, 25, 112, True)
-
- '--- Draw a HORIZONTAL line
- CALL rsWindow(Blank$, Zero, 25, 2, 25, 79, 177, 2, True)
- '--- add some arrows
- CALL rsWindow(Blank$, Zero, 25, 3, 25, 3, 27, 112, True)
- CALL rsWindow(Blank$, Zero, 25, 78, 25, 78, 26, 112, True)
-
-
- '... Now display our menu options.
-
- a$ = "Do you want Help, a Directory or a Menu Demo?"
- b$ = "Press: <H>elp, <D>irectory, <M>enu ──"
- c$ = "Esc> = Exit this Demo"
-
- '... use rsWindow to "shadow" the next one (rsWindow's "paint" option)
- CALL rsWindow(Blank$, 32, 9, 12, 19, 72, 255, 8, True)
-
- '... Now create our Window
- CALL rsWindow(" Choose a demo of one of these: ", 32, 8, 10, 18, 70, 1, 112, True)
- CALL rsWindow("", 196, 14, 11, 14, 69, 196, 112, True)
-
- COLOR 0, 7
- LOCATE 10, 18: PRINT "A demo of ASM screens, a help screen demo,"
- LOCATE 12, 18: PRINT "a screen library directory, or a menu demo."
- LOCATE 18, 28: PRINT "<Esc> = Exit this Demo"
- LOCATE 16, 18: PRINT "Press: <A>sm, <H>elp, <D>irectory, <M>enu ──";
-
- a$ = "": b$ = "": c$ = ""
- COLOR 7, 0
-
- RETURN
-
- '
- SUB ASM.Screens
- '
-
- '... Some screens we're about to display have bright backgrounds. So call
- ' BrightBG to enable these (these will blink on Mono or Herc monitors).
-
- CALL BrightBG(1)
-
- CLS
- LOCATE 20, 2: PRINT "These are ASM screens: assembled, then displayed with a simple CALL MyScreen."
- LOCATE 22, 10: PRINT "Press any key to quit. Number of screens displayed: ";
-
- '... let's time this
- Start! = TIMER
-
- MaxNumberScreens = 11
-
- DO UNTIL LEN(INKEY$) '... press a key to exit this
-
- WhichScreen = WhichScreen + 1
- IF WhichScreen > MaxNumberScreens THEN WhichScreen = 1
-
- SELECT CASE WhichScreen
-
- CASE 1: CALL pscrTop1
- CASE 2: CALL pscrFile
- CASE 3: CALL pscrDraw
- CASE 4: CALL pscrBlok
- CASE 5: CALL pscrEdit
- CASE 6: CALL pscrOptn
- CASE 7: CALL pscrHelp
- CASE 8: CALL Box1
- CASE 9: CALL Box2
- CASE 10: CALL Box3
- CASE 11: CALL Box4
-
- END SELECT
-
- x& = x& + 1: LOCATE 22, 64: PRINT x&;
-
- LOOP
-
- NumSeconds! = TIMER - Start!: IF NumSeconds! < 1 THEN NumSeconds! = 1
-
- LOCATE 22, 1: PRINT x&; "screens in"; NumSeconds!; "seconds ("; CINT(x& / NumSeconds!); "screens per second! ). Press a key.";
- LOCATE 24, 1: PRINT "This also shows 'bright background' screens. Run again if you didn't see them.";
-
- WHILE INKEY$ = "": WEND
-
- '... We no longer need BrightBG. Turn it off.
-
- CALL BrightBG(0)
-
-
- END SUB
-
- '
- SUB Display.Directory (LibraryName$)
- '
- FileNum = FREEFILE
- OPEN Path$ + LibraryName$ + ".PSL" FOR RANDOM AS #FileNum LEN = LEN(ScreenLib)
-
- PRINT TAB(26); "Screens Stored in "; LibraryName$; ".Psl": PRINT
- PRINT TAB(7); "Name"; TAB(17); "Description"; TAB(49); "Name"; TAB(59); "Description"
- PRINT
- '... skip header record and
- FOR x = 2 TO 101 ' start at record #2
- GET #FileNum, x, ScreenLib '... using TYPE format
-
- a$ = LTRIM$(RTRIM$(ScreenLib.ScrName)) '... strip blanks
- IF a$ = "" THEN EXIT FOR '1st blank means "all done"
-
- PRINT USING " ##. "; x - 1;
- PRINT LEFT$(a$ + SPACE$(10), 10); ScreenLib.Description,
- NEXT
-
- CLOSE
-
-
- END SUB
-
- '
- '-------------------------------------------------------------
- '
- FUNCTION Display.Screen (LibName$, ScreenName$, IsBrightOn%)
- '
- ' Feel free to merge this into your own programs.
- '
- ' Purpose: Display a screen it it's original location.
- ' Returns: Display.Screen (an integer)
- ' - If zero on return, everything went fine.
- ' - If NEGATIVE, an error occurred:
- ' -88 Not enough memory to allocate screen array
- ' -99 The Screen Library wasn't found
- '
- '-------------------------------------------------------------
-
- '... assume NO error
- Display.Screen = 0
-
-
- '... Test to see if there's enough memory for an array big
- ' enough for your largest screen.
-
- ArraySize = 2000 '2000 for 80 columns by 25
- 'rows. Use 4000 for 80 x 50.
-
- IF FRE(-1) < ArraySize THEN '... if there's not enough
- Display.Screen = -88 ' memory, abort to caller
- EXIT FUNCTION
- END IF
-
- REDIM Array%(0 TO ArraySize) '... BE SURE to dimension from element 0
-
- CALL rsLoadScrn(Array%(), LibName$, ScreenName$, Desc$, TopRow, LeftCol, BotRow, RhtCol, ScrnSize, ErrCode)
-
- '... If ErrCode is positive or 0, everything went ok.
- IF ErrCode >= 0 THEN
-
- '... If the first element (0) returns NON-Zero, this is a bright-
- ' background screen. So CALL BrightBG if we haven't done so before.
-
- IF Array%(0) <> IsBrightOn% THEN
- IsBrightOn% = Array%(0) '...Note: Calling BrightBG DOES
- CALL BrightBG(Array%(0)) ' take time. So let's do it ONLY
- END IF ' when needed -- when the screen
- ' we're displaying DIFFERS from
- ' earlier ones: Array%(0) <> IsBrightOn%
-
- '...registered users would use: : :
- CALL CompRestPLUS(TopRow, LeftCol, BotRow, RhtCol, SEG Array%(1))
-
- ELSE
- '... an error occurred; return it to the caller.
- Display.Screen = ErrCode
-
- END IF
-
- '... clean up memory (we don't need the array any more)
- ERASE Array
-
- END FUNCTION
-
- '................. ................. ................. .................
- SUB LoadMenus (MenuDemo%(), Menu.ErrCode)
- '................. ................. ................. .................
- ' Purpose: 1) Load ALL menu screens from P-Screen.Psl into our
- ' MenuDemo%() array for fast display later on.
- ' 2) Demonstrate how to do this in your programs -- for those
- ' situations needing instant screens.
- '
- ' Calls: Run only with LoadScrn.obj & rsLodBin.obj in your Quick Library
- '................. ................. ................. .................
- '... setup
- '................. ................. ................. .................
- CLS
-
- REDIM MenuDemo%(1 TO 2000) '... Less than 2000 bytes FAR memory needed to
- ' store ALL menus. Saves lots of string space.
- ' In your programs, calculate (##) on the fly.
- ' See commented-out sections below for how.
-
- REDIM Tmp%(1) '... Temporary storage for each screen
-
-
- Offset = 10 '... Offset into MenuDemo% to load each new screen.
- ' We have 9 screens. Elements 1-9 of MenuDemo%
- ' store the offset of each screen for re-displaying.
- ScreenNumber = 1 ' To store Offset for re-displaying screen.
-
- '................. ................. ................. .................
- '... start loading "Menu" screens
- '................. ................. ................. .................
-
- ScrnN$ = "PSCRTOP1": GOSUB CalcOffset
-
- ScrnN$ = "PSCRFILE": GOSUB CalcOffset
-
- ScrnN$ = "PSCRDRAW": GOSUB CalcOffset
-
- ScrnN$ = "PSCRBLOK": GOSUB CalcOffset
-
- ScrnN$ = "PSCREDIT": GOSUB CalcOffset
-
- ScrnN$ = "PSCROPTN": GOSUB CalcOffset
-
- ScrnN$ = "PSCRHELP": GOSUB CalcOffset
-
-
- '... UNComment next 2 lines (& line near end) if you want to see stats as screens are loaded
-
- '' PRINT : PRINT TAB(4); "Press a key . . .";
- '' D$ = INPUT$(1) 'pause '... see below, if you print stats, pause before exit
-
- '................. ................. ................. .................
- EXIT SUB '... all done
- '................. ................. ................. .................
-
- '................. ................. ................. .................
- CalcOffset: '... this does the actual work: find the right spot
- ' (Offset) for each new screen, copy screen to MenuDemo%,
- ' then store Offset in MenuDemo% for displaying
- '................. ................. ................. .................
- CALL rsLoadScrn(Tmp%(), LibraryName$, ScrnN$, Desc$, TopRow, LeftCol, BottomRow, RhtCol, ScrnSize, ErrCode)
-
- IF ErrCode < 0 THEN Menu.ErrCode = -99: EXIT SUB
-
-
- FOR x = 1 TO UBOUND(Tmp%) '... Copy it into MenuDemo%
-
- IF x + Offset > UBOUND(MenuDemo%) THEN EXIT FOR '... just in case
-
- MenuDemo%(Offset + x) = Tmp%(x) ' NOTE: 1st screen begins at 11
- NEXT ' (Offset+x or 10+1)
-
- MenuDemo%(ScreenNumber) = Offset + 1 '... Save the beginning of each screen.
- ' See MenuDemo to see how MenuDemo%(1-10) are used.
-
-
- ScreenNumber = ScreenNumber + 1 '... bump it for the next screen
-
- Offset = Offset + ScrnSize '... Adjust Offset MenuDemo% so next screen
- ' is stored after this one.
-
- '... NOTE: UNComment next line (& Pause above) if you want to see stats as screens are loaded
-
- '' PRINT USING " \ \ Size:#### Ends:##### Top Row/Col ## ##, Bottom Row/Col ## ##"; ScrnN$; ScrnSize; Offset; TopRow; LeftCol; BottomRow; RhtCol
-
- RETURN
- '................. ................. ................. .................
-
- END SUB
-
-