Category : BASIC Source Code
Archive   : PSCREEN.ZIP
Filename : PS-DEMO.BAS

 
Output of file : PS-DEMO.BAS contained in archive : PSCREEN.ZIP
'*** PS-Demo.BAS *************************************(C) 1988 R.W. Smetana *
'
' Demo program included with P-Screen (Pro~Formance Screen Design).
'
' QuickBASIC 4.0 or later required to run this. TYPE & SEG used.
'
' 2 Purposes: Demonstrate how to:
' 1. Display screens stored in a Library.
' - Press [H]elp to view a Help Screen. Examine the
' small amount of code needed to display a screen.
' 2. Display a directory of Library Screen names.
'
' To run: Run QB, loading a Quick Library that contains:
' - rsLoadScrn -rsLodBin -rsScrnRest (optional)
'
' We include PS-DEMO.QLB with P-Screen for this purpose.
'
' Example: QB ps-demo /l ps-demo
'
' Compatibility: QuickBasic 4.0 + only (rsLoadScrn uses TYPE, here we use SEG)
'
' History: 1st cut 12/88
'
'****************************************************************************

DEFINT A-Z '... Integers ONLY. If not, called routines will crash.

'................. ................. ................. .................

DECLARE SUB LoadQB (QBMenu%(), QB.ErrCode%) '... included here; rest are in PS-Demo.Qlb

DECLARE SUB rsLoadScrn (Sc2%(), LibName$, FileName$, Desc$, TopRow%, TopCol%, BotRow%, BotCol%, x%, ErrCode%)
DECLARE SUB rsScrnRest (TopRow%, BotRow%, SEG Array%)
DECLARE SUB rsScrnRestPlus (SEG Sc1%, Top, Lft, Bot, Rht)

'...Caution: Use rsScrnRest ONLY for full-width screens. Registered users
' receive a Screen Restore subprogram useful for full/partial/sub screens.
' In place of rsScrnRest, use a screen restore subprogram you already have.
' But, it must be able to handle $Dynamic Integer arrays (see REdim below).

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 ScreenLib AS ScrLib

'... If you prefer Field statements rather than TYPES
'... FIELD #1, 8 AS ScrName$, 15 AS Description$, 14 AS IgnoreMe$

'................. ................. ................. .................

LibName$ = "P-SCREEN" '... Display all screens from P-Screen.Psl

ON ERROR GOTO CantFindLibrary '... This demo aborts if P-Screen.Psl isn't found.

'... 1st, see if "P-Screen.Psl" exists. If not, stop.

CLOSE : OPEN LibName$ + ".Psl" FOR INPUT AS #1 '... Just checking. Your
CLOSE ' programs MUST ensure
' Libraries exist BEFORE
' calling our routines

REDIM QBMenu%(1) '... QBMenuDemo has Details
CALL LoadQB(QBMenu%(), QB.ErrCode) ' LoadQB is in PS-Demo.Qlb

'................. ................. ................. .................

'... Main Menu
DO
CLS
PRINT TAB(31); "P~F Screen Demo"
a$ = "Do you want: Help/Directory/QB Demo?" '... Help displays a Help Screen
b$ = "Press [H]elp, [D]irectory, [Q]B" '... Directory displays screens/descriptions
' in P-Screen.Psl. Both are useful.
' See QBDemo for details on it
c$ = "Esc] = Exit this Demo"
GOSUB MidMessage '... print the Main Menu

Option$ = UCASE$(INPUT$(1))
CLS

ON INSTR("HDQ", Option$) GOSUB Help, Directory, QBDemo '... do it or exit

LOOP WHILE Option$ <> CHR$(27)

END
'................. ................. ................. .................
Help: '... demonstrate how to Display Library Screen/interpret ErrCode
'................. ................. ................. .................
LibName$ = "P-Screen" '... P-Screen.Psl comes with P-Screen
ScreenName$ = "QUIKREF1" '... 1st P-Screen Help Screen

REDIM Array%(1) '... Load screen into Array%(), then
' restore screen from Array%(). Don't
' use Dim. It's REdimension as needed.
GOSUB DisplayScreen '... That's it. See below for how it's done
RETURN

'................. ................. ................. .................
DisplayScreen:

'... If we got here, LibName$ + ".Psl" is available. Load ScreenName$
'................. ................. ................. .................

LibName$ = UCASE$(LibName$)
ScreenName$ = UCASE$(ScreenName$) '... Screen names stored in Upper Case

CALL rsLoadScrn(Array%(), LibName$, ScreenName$, Desc$, TopRow, TopCol, BotRow, BotCol, x, ErrCode)
'... Notes: You needn't Open/Close
' the Library File. That's done in
' rsLoadScrn.
' TopRow/TopCol/BotRow/BotCol define
' the Original coordinates of the screen.
' (1/1/25/80 = Rows 1-25, Columns 1-80).
' ErrCode has 3 possible values:::
SELECT CASE ErrCode

CASE IS < 0 'Negative ErrCode means Error (usually -99 or -1)
BEEP
IF ErrCode = -99 THEN '... screen NOT in Library
PRINT TAB(20); "["; ScreenName$; "] was NOT in "; LibName$; ".Psl";
ELSE '... error loading it (probably -1)
PRINT " Error loading "; ScreenName$;
END IF

GOSUB pause

CASE IS >= 0 '...everything went OK
'... Caution: rsScrnRest is ONLY
' for full-width screens.
' Use any screen restore subprogram you want.

CALL rsScrnRest(TopRow%, BotRow%, SEG Array%(1))
ERASE Array% '... no longer needed

GOSUB ShowInfo '... for your information

d$ = INPUT$(1) '... pause

CASE ELSE
END SELECT
'................. ................. ................. .................
RETURN
'................. ................. ................. .................
ShowInfo: '... display info returned by rsLoadScrn
'................. ................. ................. .................

COLOR 0, 7
LOCATE 7, 12: PRINT "Ú" + STRING$(54, 196); "¿"
FOR x = 1 TO 8: LOCATE , 12: PRINT "³"; SPC(54); "³": NEXT
LOCATE , 12: PRINT "À" + STRING$(54, 196); "Ù"

LOCATE 7, 24: PRINT "rsLoadScrn reported the following:"
LOCATE 9, 16: PRINT " Error Code: "; ErrCode; " It went just fine!"
LOCATE , 16: PRINT " Library: "; LibName$
LOCATE , 16: PRINT " Screen: "; ScreenName$
LOCATE , 16: PRINT " Description: "; Desc$
LOCATE , 16: PRINT " Top Row / Column: "; TopRow; TopCol
LOCATE , 16: PRINT "Bottom Row / Column: "; BotRow; BotCol

LOCATE 16, 31: PRINT "Press a key . . .";
COLOR 7, 0

RETURN

'................. ................. ................. .................
Directory: '... Demonstrate how to review Library Screen Names/Descriptions
'................. ................. ................. .................

CLOSE
OPEN Path$ + LibName$ + ".PSL" FOR RANDOM AS #1 LEN = LEN(ScreenLib)

PRINT TAB(26); "Screens Stored in "; LibName$; ".Psl": PRINT
PRINT TAB(7); "Name"; TAB(17); "Description"; TAB(49); "Name"; TAB(59); "Description"
PRINT

FOR x = 2 TO 51 '... start at record #2
GET #1, x, ScreenLib '... using TYPE format/NOT Field
a$ = LTRIM$(RTRIM$(ScreenLib.ScrName)) '... strip blanks
IF a$ = "" THEN EXIT FOR
PRINT USING " ##. "; x - 1;
PRINT LEFT$(a$ + SPACE$(10), 10); ScreenLib.Description,
NEXT
CLOSE

GOSUB pause

RETURN
'................. ................. ................. .................
pause:
'................. ................. ................. .................
LOCATE 24, 20: PRINT SPC(12); "Press a key . . ."; SPC(15);
a$ = INPUT$(1) '... pause

RETURN
'................. ................. ................. .................
QBDemo: '... Demonstrate displaying screens from an array. The array
' QBMenu%() was loaded with screens from P-Screen.Psl when
' you first ran this --- Call LoadQB (QBMenu%(), QB.ErrCode).
' QBMenu%() needs about 5800 bytes of FAR memory. Loading
' these 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 was
' probably altered. The Row/Column and QBMenu% offsets BELOW may no
' longer correspond to where they were loaded.

'................. ................. ................. .................

IF QB.ErrCode <> 0 THEN '... error occurred loading screens
PRINT TAB(12); "Error occurred loading screens earlier. Can't do demo."
BEEP: d$ = INPUT$(1): RETURN
END IF

'...Alt-key scan codes for Alt- : : :
'F (!), E (Chr$(18)), V (/), S (31), R (19), D (" "), O (24), H (#)

AltKey$ = "!/ #" + CHR$(18) + CHR$(31) + CHR$(19) + CHR$(24)


DO '... Outer Loop
CLS
CALL rsScrnRestPlus(SEG QBMenu%(QBMenu%(1)), 1, 1, 1, 80) ' see note below re: Offsets

LOCATE 19, 3: PRINT "This demonstrates displaying menus via an Integer array. These menus are"
LOCATE , 3: PRINT "NOT displayed from disk. They were loaded into QBMenu%() when you ran this."
LOCATE , 3: PRINT "See 'Performance Hints' in your manual. Screens displayed via rsRestPlus."

LOCATE 24, 20: PRINT "Press Alt- F/E/V/S/R/D/O/H [Esc] = Exit";

DO '... get a key
d$ = "": d$ = INKEY$
LOOP WHILE d$ <> CHR$(27) AND LEN(d$) < 2 ' we only want Extended Keys

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)

SELECT CASE d$ '... NOTICE: We reserved the 1st 10
' elements in QBMenu%() to store
' the offset into QBMenu% where
' each screen BEGINS.
' See Sub LoadQB for details

CASE "!" '... Alt-F (File)
CALL rsScrnRestPlus(SEG QBMenu%(QBMenu%(2)), 1, 2, 18, 23)
GOSUB pause
CASE CHR$(18) '... Alt-E (Edit)
CALL rsScrnRestPlus(SEG QBMenu%(QBMenu%(3)), 1, 8, 11, 32)
GOSUB pause
CASE "/" '... Alt-V (View)
CALL rsScrnRestPlus(SEG QBMenu%(QBMenu%(4)), 1, 14, 12, 38)
GOSUB pause
CASE CHR$(31) '... Alt-S (Search)
CALL rsScrnRestPlus(SEG QBMenu%(QBMenu%(5)), 1, 20, 8, 47)
GOSUB pause
CASE CHR$(19) '... Alt-R (Run)
CALL rsScrnRestPlus(SEG QBMenu%(QBMenu%(6)), 1, 28, 12, 50)
GOSUB pause
CASE " " '... Alt-D (Debug)
CALL rsScrnRestPlus(SEG QBMenu%(QBMenu%(7)), 1, 33, 16, 63)
GOSUB pause
CASE CHR$(24) '... Alt-O (Options)
CALL rsScrnRestPlus(SEG QBMenu%(QBMenu%(8)), 1, 47, 8, 66)
GOSUB pause
CASE "#" '... Alt-H (Help)
CALL rsScrnRestPlus(SEG QBMenu%(QBMenu%(9)), 1, 52, 7, 80)
GOSUB pause
CASE ELSE 'nada

END SELECT

LOOP

RETURN
'................. ................. ................. .................
CantFindLibrary: '... couldn't find LibName$ + ".Psl"
'................. ................. ................. .................
CLS : CLOSE

PRINT TAB(18); "Can't find "; LibName$ + ".Psl. Press a key . . .";
BEEP: a$ = INPUT$(1): END

'................. ................. ................. .................

MidMessage:
COLOR 0, 7
LOCATE 8, 20: PRINT "Ú"; STRING$(39, "Ä"); "¿"
FOR x = 9 TO 13
LOCATE , 20: PRINT "³"; SPACE$(39); "³"
NEXT
LOCATE , 20: PRINT "À"; STRING$(39, "Ä"); "Ù"
LOCATE 10, 21: PRINT STRING$(38, "Ä")

LOCATE 9, 22: PRINT a$
LOCATE 14, 22: PRINT "["; c$; "]"
LOCATE 12, 22: PRINT b$;

a$ = "": b$ = "": c$ = ""
COLOR 7, 0
RETURN

'................. ................. ................. .................
SUB LoadQB (QBMenu%(), QB.ErrCode)
'................. ................. ................. .................
' Purpose: 1) Load ALL QB-Type screens from P-Screen.Psl into QBMenu%()
' for fast display later on. Press [Q]B at the menu.
' 2) Demonstrate how to do this in your programs -- for those
' situations needing Instant screens/subscreens
'
' Calls: Run only with LoadScrn.obj & rsLodBin.obj in your Quick Library
'................. ................. ................. .................
'... setup
'................. ................. ................. .................
CLS

REDIM QBMenu%(1 TO 4200) '... Just 4200 bytes FAR memory needed to store
' all qb screens. Saves lots of string space.
' In your programs, you can calculate (4200) on the fly.
REDIM Tmp%(1) '... Temporary storage for each screen

CONST LibNm$ = "P-SCREEN" '... Same Screen Library for all loads.

OffSet = 10 '... Offset into QBMenu% to load each new screen.
' We have 9 screens. Reserve 10 elements to store
' offset of each screen for re-displaying.
ScreenNumber = 1 ' To store Offset for re-displaying screen.

'................. ................. ................. .................
'... start loading screens (1 to 9)
'................. ................. ................. .................

ScrnN$ = "QB-MAIN"
CALL rsLoadScrn(Tmp%(), LibNm$, ScrnN$, Desc$, TopRow, TopCol, BotRow, BotCol, x, ErrCode)
GOSUB CalcOffset

ScrnN$ = "FILE-1"
CALL rsLoadScrn(Tmp%(), LibNm$, ScrnN$, Desc$, TopRow, TopCol, BotRow, BotCol, x, ErrCode)
GOSUB CalcOffset

ScrnN$ = "EDIT-1"

CALL rsLoadScrn(Tmp%(), LibNm$, ScrnN$, Desc$, TopRow, TopCol, BotRow, BotCol, x, ErrCode)
GOSUB CalcOffset

ScrnN$ = "VIEW-1"
CALL rsLoadScrn(Tmp%(), LibNm$, ScrnN$, Desc$, TopRow, TopCol, BotRow, BotCol, x, ErrCode)
GOSUB CalcOffset

ScrnN$ = "SEARCH-1"
CALL rsLoadScrn(Tmp%(), LibNm$, ScrnN$, Desc$, TopRow, TopCol, BotRow, BotCol, x, ErrCode)
GOSUB CalcOffset

ScrnN$ = "RUN-1"
CALL rsLoadScrn(Tmp%(), LibNm$, ScrnN$, Desc$, TopRow, TopCol, BotRow, BotCol, x, ErrCode)
GOSUB CalcOffset

ScrnN$ = "DEBUG-1"
CALL rsLoadScrn(Tmp%(), LibNm$, ScrnN$, Desc$, TopRow, TopCol, BotRow, BotCol, x, ErrCode)
GOSUB CalcOffset

ScrnN$ = "OPTNS-1"
CALL rsLoadScrn(Tmp%(), LibNm$, ScrnN$, Desc$, TopRow, TopCol, BotRow, BotCol, x, ErrCode)
GOSUB CalcOffset

ScrnN$ = "HELP-1"
CALL rsLoadScrn(Tmp%(), LibNm$, ScrnN$, Desc$, TopRow, TopCol, BotRow, BotCol, x, ErrCode)
GOSUB CalcOffset

'... NOTE: UNComment next line (& 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 QBMenu%,
' then store Offset in QBMenu% for displaying
'................. ................. ................. .................
IF ErrCode < 0 THEN QB.ErrCode = -99: EXIT SUB '...tsk tsk, jumping out of a gosub.
' just for demo. do gracefully in your program.

OffSet = OffSet + ScrnSize '... Offset into QBMenu% to load each new screen.
' Starts = 10; bumped by ScrnSize.
' For 1st screen, ScrnSize = 0 so Offset = 10

ScrnSize = ((BotRow - TopRow) + 1) * ((BotCol - TopCol) + 1)'... Size of this screen

FOR x = 1 TO UBOUND(Tmp%) '... Copy it into QBMenu%

IF x + OffSet > UBOUND(QBMenu%) THEN EXIT FOR '... just in case

QBMenu%(x + OffSet) = Tmp%(x) ' NOTE: 1st screen begins at 11
NEXT ' (Offset+x or 10+1)

QBMenu%(ScreenNumber) = OffSet + 1 '... '+1' because we add x in For..Next
' See QBDemo to see how QBMenu%(1-10) are used.
ScreenNumber = ScreenNumber + 1 '... bump it for the next screen


'... NOTE: UNComment next line (& Pause above) if you want to see stats as screens are loaded

'' PRINT USING " \ \ ##### ##### TopRow, TopCol, BotRow, BotCol ## ## ## ##"; ScrnN$; ScrnSize; OffSet + 1; TopRow; TopCol; BotRow; BotCol

RETURN

END SUB



  3 Responses to “Category : BASIC Source Code
Archive   : PSCREEN.ZIP
Filename : PS-DEMO.BAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/