ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/PROG/BASIC/VUDU31Q.ZIP/VUDEMO.BAS

BASIC Source File | 1992-06-07 | 20.4 KB | 684 lines

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
'*             VUDEMO.BAS - VUDU Windows Demonstration Program               *
'*                                                                           *
'*                               Binary Systems                              *
'*                               PO BOX 10714                                *
'*                               FARGO, ND  58106                            *
'*                               [phone]                              *
'*                                                                           *
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'$INCLUDE: 'VUDU.INC'

DECLARE SUB datedemo ()
DECLARE SUB overview ()
DECLARE SUB printdemo ()
DECLARE SUB randomtest ()
DECLARE SUB randscroll ()
DECLARE SUB windowdemo ()
DECLARE SUB windows ()
DECLARE SUB infielddemo ()
DECLARE SUB messagedemo ()
DECLARE SUB scrolldemo ()
DECLARE SUB bardemo ()
DECLARE SUB begin ()


DEFINT A-Z
CONST HEADLINE = "VUDU Windows Version 3.01 for QuickBASIC and PDS 7 ∙ Demo Program"
DIM SHARED background AS STRING
DIM lin(1 TO 3) AS STRING

' Attributes For Window Interactive Demo
DIM SHARED oldrow   AS INTEGER, oldcol   AS INTEGER
DIM SHARED oldwfg   AS INTEGER, oldwbg   AS INTEGER
DIM SHARED oldhedfg AS INTEGER, oldhedbg AS INTEGER
DIM SHARED oldshad  AS INTEGER, oldedge  AS INTEGER

' Type For INFIELD Specifications
TYPE fieldtype
     row AS INTEGER
     Col AS INTEGER
     lng AS INTEGER
END TYPE

'Main Proc
    VINIT   ' call VINIT before executing any VUDU statements

    ' Setting the default values for the 'stretchy box' demo
    oldrow = 22: oldcol = 76
    oldhedfg = 15: oldhedbg = 1
    oldwfg = 15: oldwbg = 1
    oldshad = NO: oldedge = 2

    FirstLet = CM(YEL + BRITE, WHT + BRITE + FLASH)
    LabelPos = RIGHT

    LOCATE , , 0                    'Cursor off
    SCREEN 0: WIDTH 80, 25          '25x80 text mode

    ' This is the whole program?
    SAVSCREEN scr$
    begin
    RESCREEN scr$

    lin(1) = "    For ordering information, type out the file 'README'"
    lin(2) = " Thank you for viewing VUDU Window Demo by Binary Systems."
    lin(3) = "              Good night and drive safely."
    DEFWIN 0, 0, 0, 3, 0, 3, THIN, YES
    a$ = MESSAGE(r, c, "", lin(), "", 10, YES)

    PRINTS SPACE$(80), 25, 1, 0
    LOCATE 25, 1, 1

END



' DATADATADATA - I Like To Keep My DATA Down Out Of The Way - DATADATADATA

menudata:
DATA Windows Overview, Windows Demonstration
DATA Barmenu Function Demo, ScrollMenu Function Demo
DATA Message Function Demo, Infield Function Demo, DatIn Demo
DATA Print Routines
DATA Random Pattern Generator,Random Scroll,Exit To Dos


barmenudata:
DATA Parameters
DATA The barmenu function  accepts two arrays
DATA as  parameters.  The first  contains the
DATA heading  names that  will  appear  above
DATA their  respective menu.  The second is a
DATA two dimensional  array  to  contain  the
DATA lists of items which  appear under their
DATA respective headings.,,,,,,,,,,,,,,

DATA Headings
DATA You may pass as many menu  headings
DATA as  you can  fit on  the  menu bar.
DATA you may  also pass  up to  22 items
DATA for each heading without shadows or
DATA 21  if you prefer shadows.  Barmenu
DATA returns  the  subscript  chosen and
DATA key  the  user  entered to  escape.,,,,,,,,,,,,,,

DATA Sizing
DATA The function automatically sizes
DATA everthing for you.  The  headers
DATA are spaced and the widths of the
DATA windows are set according to the
DATA widest item element.  The header
DATA bar filler character is variable
DATA to suit different styles.,,,,,,,,,,,,,,

DATA Auto-adjust
DATA If you like your menu choices to be  extremely descriptive -
DATA no problem!  The bar menu function will automatically adjust
DATA your sub-menu to fit asthetically under the menu label.   So
DATA use the whole screen if you wish!  Hit ESC or ENTER for menu.
DATA Line 5
DATA Line 6
DATA Line 7
DATA Line 8
DATA Line 9
DATA Line 10
DATA Line 11
DATA Line 12
DATA Line 13
DATA Line 14
DATA Line 15
DATA Line 16
DATA Line 17
DATA Line 18
DATA Line 19
DATA Line 20
DATA Line 21

scrolldata:
DATA The scrollmenu function allows the user to choose from a list
DATA of items which would not normally fit within the boundaries
DATA of a window.  The list may be as long as needed and the window
DATA may be as short as needed (minimum of one line).
DATA "                                                        MORE "
DATA "     Scrolling of one full window length is done with the PgUp"
DATA and PgDn keys.  the up and down cursor keys allow moving one
DATA line at a time.
DATA " "
DATA "     The following is a demonstration of choosing an item from"
DATA the scrollmenu list.            Press <ENTER> to continue

fielddata:
DATA 14,13,17, 14,36,10, 14,52,17
DATA 16,13,17, 16,36,10, 16,52,17

SUB bardemo
   DIM headers(1 TO 4) AS STRING
   DIM Items(1 TO 4, 1 TO 21) AS STRING
   DIM scr AS STRING, retrn  AS STRING

   RESTORE barmenudata
   FOR x = 1 TO 4
       READ headers(x)
       FOR y = 1 TO 21
       READ Items(x, y)
       NEXT y
   NEXT x

   RESCREEN background

   DEFWIN 0, 0, 15, 3, 0, 3, THIN, YES
   DEFBAR 0, 7, 205, NO

   baron = NO
   retrn = BARMENU(headers(), Items(), m, i)
   SELECT CASE retrn
     CASE ESC: retrn = "n escape keypress"
     CASE CR: retrn = " carriage return"
   END SELECT

   DIM Msg(1 TO 1) AS STRING
   Msg(1) = "You exited with a" + retrn
   Msg(1) = Msg(1) + " and chose menu" + STR$(m) + ", item" + STR$(i) + "."
   DEFWIN 15, 0, 15, 4, 14, 4, THIN, YES
   Msg(1) = MESSAGE(14, c, "Message Box", Msg(), "", 5, YES)

END SUB

SUB begin
    DIM win AS STRING, bar AS STRING, raise AS STRING
    DIM fg AS INTEGER, bg AS INTEGER
    DIM lin(1 TO 12) AS STRING
    DIM clr AS STRING, vid AS STRING

    'Create Opening Screen
    DEFWIN 0, 0, 7, 1, 7, 1, NONE, NO
    OPENWIN 1, 1, 25, 80, ""

    'Lightning!
    w$ = STRING$(15, 219)
    var = 56
    FOR x = 1 TO 25
       IF x MOD 7 = 0 THEN var = var + 10
       IF x > 21 THEN w$ = LEFT$(w$, LEN(w$) - 3)
       IF x = 25 THEN var = var + 1
       IF x < 25 THEN HILITE x + 1, var - x * 3 + 1, LEN(w$), 8
       PRINTS w$, x, var - x * 3, CM(14, 7)
    NEXT x

    'Print Bottom Bar Labels
    PRINTS SPACE$(80), 1, 1, ATTRIB(WHT + BRITE, MAG)
    PRINTS HEADLINE, 1, 40 - LEN(HEADLINE) / 2, 0


    'laser sound effect
     PLAY "mf"
     FOR x = 10000 TO 37 STEP -100
     SOUND x \ 2, .03
     SOUND x, .07
     NEXT x

    ' ***********************  FIRST WINDOW  ***************************
    lin(1) = "  V U D U   W I N D O W S   Version 3.01  By Binary Systems"
    lin(2) = "    User interface and display tools for Microsoft BASICs"
    lin(3) = " "
    lin(4) = "       Press Any Key For The Demonstration Program "

    DEFWIN 15, 4, 15, 4, 14, 4, PAIR, YES
    w$ = MESSAGE(r, c, "", lin(), "", 300, YES)


    ' **********************  SECOND MESSAGE  ***************************
    'message window describing VUDU
    lin(1) = "VUDU (Very Useful Display Utilities) features:"
    lin(2) = "      Built in mouse support and mouse procedures"
    lin(3) = "      Automatic sensing of the active video page"
    lin(4) = "      Automatic sensing of monochrome/color card"
    lin(5) = "      Optional auto-centering for all windows"
    lin(6) = "      Auto snow elimination on CGA systems"
    lin(7) = "      Easy customization"
    DEFWIN 15, 4, 15, 4, 14, 4, PAIR, YES
    a$ = MESSAGE(0, 0, "The VUDU Windows", lin(), "", 15, YES)


    ' Print VIDEO INFORMATION
    REDIM lin(1 TO 12) AS STRING
    SELECT CASE VIDCARD
     CASE MONO: lin(1) = "MonoChrome"
     CASE CGA:  lin(1) = "CGA"
     CASE EGA:  lin(1) = "EGA"
     CASE VGA:  lin(1) = "VGA"
    END SELECT
    lin(1) = lin(1) + " Video Card Detected"
    IF Vmouse THEN
       lin(2) = "Mouse is active"
    ELSE
       lin(2) = "Mouse not installed"
    END IF
    DEFWIN 0, 0, YEL + BRITE, 0, WHT + BRITE, 0, THIN, YES
    a$ = MESSAGE(19, 42, "", lin(), "", 0, NO)

    ' Read Menu Data
    RESTORE menudata
    FOR x = 1 TO 11
       READ lin(x)
    NEXT x


  ' Begin the Menu Loop
  DO

    'DISPLAY MENU
    LabelPos = LEFT
    DEFWIN WHT + BRITE, 0, YEL + BRITE, 0, WHT + BRITE, 0, THIN, YES
    a$ = MAKEMENU(3, 3, NO, "VUDU", lin(), selection)
    SAVSCREEN background

    IF a$ <> ESC THEN
      SELECT CASE selection
       CASE 1: overview
       CASE 2: windowdemo
       CASE 3: bardemo
       CASE 4: scrolldemo
       CASE 5: messagedemo
       CASE 6: infielddemo
       CASE 7: datedemo
       CASE 8: printdemo
       CASE 9: randomtest
       CASE 10: randscroll
      END SELECT
    END IF
    RESCREEN background

   LOOP UNTIL a$ = ESC OR selection = 11

END SUB

SUB datedemo
    DIM lin(1 TO 4) AS STRING

    lin(1) = "MMDDYY"
    lin(2) = "MMDDYYYY"
    lin(3) = "YYMMDD"
    lin(4) = "DDMMYY (Euro)"

    LabelPos = CENTER
    DEFWIN WHT + BRITE, RED, WHT + BRITE, RED, BLK, RED, THIN, YES
    a$ = MAKEMENU(3, 50, NO, "Datin", lin(), selection)
    IF a$ = ESC THEN EXIT SUB

    REDIM lin(1 TO 1) AS STRING
    lin(1) = "Input:             Returned:          "
    a$ = MESSAGE(0, 0, "DATIN Function Demo", lin(), "", 0, NO)
    LOCATE 13, 30: VCOLOR YEL + BRITE, BLK
    a$ = DATIN(selection - 1)
    IF (a$ <> ESC) THEN
       PRINTS a$, 13, 51, 0
       VSLEEP 3
    END IF
END SUB

SUB infielddemo
    DIM lin(1 TO 13) AS STRING
    DIM fld(1 TO 6) AS fieldtype
    DIM retrn AS STRING

    RESCREEN background
    LabelPos = CENTER

    lin(1) = "The  InField  function does  just as its name implies; it"
    lin(2) = "allows  user input  within a  specifically  defined field"
    lin(3) = "of the screen.  A powerful alternative to INPUT$, InField"
    lin(4) = "gives  the  programmer  full  control of the screen while"
    lin(5) = "allowing  the user full  control of the cursor.  Here are"
    lin(6) = "some keys you may want to try in the demo fields:"
    lin(7) = " "
    lin(8) = "Enter, Home, End, Ins, Del, Back Space, Tab, Shift+Tab."
    lin(9) = "Press the Esc key to end this part of the demo."
    lin(10) = " ": lin(11) = " ": lin(12) = " ": lin(13) = " "
    DEFWIN 15, 0, CM(4, 7), 0, 15, 0, ILINE, YES
    a$ = MESSAGE(2, c, "Message Boxes", lin(), "", 0, NO)

    'read in data for fields and hilite
    RESTORE fielddata
    VCOLOR CM(14, 0), CM(4, 7)          ' Set global color
    FOR x = 1 TO 6
    READ fld(x).row
    READ fld(x).Col
    READ fld(x).lng
    HILITE fld(x).row, fld(x).Col, fld(x).lng, 30
    NEXT x
    lin(1) = SPACE$(35): lin(2) = ""

    'print returned values window
    c = 0
    a$ = MESSAGE(19, c, "Returned values", lin(), "", 0, NO)
    PRINTS "Text Returned: ", 21, 25, CM(4, 7)

    x = 1
    DO
      LOCATE fld(x).row, fld(x).Col
      retrn = INFIELD(text$, fld(x).lng)
      IF retrn <> ESC THEN
     PRINTS SPACE$(17), 21, 41, 0
     PRINTS text$, 21, 41, 0 'CM(14,7)
      END IF
      IF x = UBOUND(fld) THEN x = 1 ELSE x = x + 1
    LOOP WHILE retrn <> ESC
    LOCATE , , 0
END SUB

SUB messagedemo
    DIM lin(1 TO 6)  AS STRING

    DEFWIN 0, 0, 0, BLU, 0, BLU, NONE, NO
    OPENWIN 2, 1, 25, 80, ""

    LabelPos = LEFT
    DEFWIN 15, 0, 4, 0, 15, 0, ILINE, YES

    lin(1) = "The Message Box  is a multi-purpose display utility."
    lin(2) = "With it  you can create  dialog boxes which   simply"
    lin(3) = "display a message to the user for a specified period"
    lin(4) = "of time or until a key is pressed.  This window will"
    lin(5) = "be active for 15 seconds before continuing..."

    a$ = MESSAGE(11, 3, "Message Boxes", lin(), "", 15, NO)
    IF a$ = ESC THEN EXIT SUB

    lin(1) = "You  may also choose  to create messages  which  require"
    lin(2) = "input  from  the  user  before   continuing.   You  pass"
    lin(3) = "the  possible   keystrokes  to  the   function   and  it"
    lin(4) = "will  display the  message  you  specify  and  await one"
    lin(5) = "of your keystrokes, returning it when it is encountered."
    lin(6) = "For instance, press either 'Q' or 'Z' now..."
    a$ = MESSAGE(7, 8, "Message Boxes", lin(), "QZ", 5, NO)
    IF a$ = ESC THEN EXIT SUB

'   IF A$ <> "" THEN
      lin(1) = "Good, I see you found " + a$ + ".  The Message function is a power-"
      lin(2) = "ful addition to any program requiring user choices.    The"
      lin(3) = "Message function's capabilities  are nicely  enhanced when "
      lin(4) = "used  in  conjunction  with  the  INFIELD  procedure."
      lin(5) = ""
      lin(6) = ""
      a$ = MESSAGE(4, 13, "Message Boxes", lin(), CHR$(13), 5, NO)
 '  END IF

    RESCREEN scr$
END SUB

SUB overview
DIM head(1 TO 6) AS STRING
DIM Msg(1 TO 7) AS STRING, Choice  AS STRING, ret AS STRING
DIM colors(0 TO 4) AS INTEGER

colors(0) = 6
colors(1) = 2
colors(2) = 1
colors(3) = 5
colors(4) = 3

head(1) = "NONE"
head(2) = "THIN"
head(3) = "PAIR"
head(4) = "ILINE"
head(5) = "HLINE"
head(6) = "THICK"

RESCREEN background
FOR x = 0 TO 4
    LabelPos = 4 - x
    DEFWIN 15, colors(x), 15, colors(x), 15, colors(x), x + 1, YES
    OPENWIN 3 + x * 2, 47 - x * 8, 11 + x * 2, 75 - x, head(x + 1)
NEXT x

Msg(1) = "Windows may be  defined  as  having the  shown  border "
Msg(2) = "attributes.   VUDU  supports all  colors in color text"
Msg(3) = "mode including  blinking  attributes.   Other features"
Msg(4) = "are  automatic  horizontal  and  vertical  positioning"
Msg(5) = "and optional transparent shadows.  Labels may be  pos-"
Msg(6) = "itioned  centered, right or left  offset on the  upper"
Msg(7) = "border of the window."

DEFWIN 15, 4, 15, 4, 15, 4, THICK, YES
ret = MESSAGE(13, 11, head(6), Msg(), Choice, 20, YES)
IF ret = ESC THEN EXIT SUB

Msg(1) = "If your  programs  utilize the video paging feature of "
Msg(2) = "the color video cards,  VUDU will write  to the active"
Msg(3) = "video page.  This allows  writing  to one  page  while"
Msg(4) = "viewing  another.  VUDU also automatically  determines"
Msg(5) = "the  installed   video  card  and  will  perform  snow"
Msg(6) = "checking if a CGA card is found."
Msg(7) = ""

DEFWIN 15, 2, 15, 2, 15, 2, THICK, YES
LabelPos = RIGHT
ret = MESSAGE(13, 11, head(6), Msg(), Choice, 20, NO)
END SUB

SUB printdemo
    DIM lines(1 TO 10) AS STRING, rtn  AS STRING, StrVar AS STRING
    DIM row AS INTEGER, Col AS INTEGER

    FOR x = 5 TO 10: lines(x) = " ": NEXT x 'Give spaces
    lines(1) = "Syntax: PRINTS StrVar$, row%, col%, ColorAttribute%"
    lines(2) = "        PRINTV StrVar$, row%, col%, ColorAttribute%"
    lines(3) = " "
    lines(4) = "PRINTS displays a string in the horizontal position"
    LabelPos = CENTER
    DEFWIN 15, 4, 15, 4, 15, 4, THIN, YES


    rtn = MESSAGE(r, Col, "PRINTS/PRINTV", lines(), "", 0, NO)
    BRIDGE 12, Col, 68, 0

    Col = Col + 5
    FOR x = 1 TO 6
       st$ = st$ + " Prints "
       PRINTS st$, 12 + x, Col, x
    NEXT x
    VSLEEP 5

    Col = Col - 2
    PRINTS "PRINTV displays a string in the vertical position  ", 11, Col, 0

    FOR x = 1 TO 49
       PRINTV "PRINTV", 13, Col + x, x
    NEXT x
    VSLEEP 5

END SUB

SUB randomtest
position = 2
counter = 100
DO
    IF (counter = 100) THEN
       counter = 0
       PRINTS SPACE$(80), 25, 1, 63
       PRINTS "Esc for menu", 25, position, 0
       position = position + 1
       IF (position = 69) THEN position = 2
    END IF
    counter = counter + 1

    ulr = RND * 17: WHILE ulr < 1: ulr = RND * 17: WEND
    lrr = RND * 24: WHILE lrr < ulr + 2: lrr = RND * 24: WEND
    ulc = RND * 60: WHILE ulc < 1: ulc = RND * 60: WEND
    lrc = RND * 79: WHILE lrc < ulc + 2: lrc = RND * 79: WEND
    fore = RND * 15: back = RND * 7
    DEFWIN 0, 0, fore + INT(RND * 2) * 16, back, fore, back, INT(RND * 6 + 1), (INT(RND * 2) - 1) * ((lrr < 24) * -1)
    OPENWIN ulr, ulc, lrr, lrc, ""
LOOP WHILE (CLICK <> ESC)
randscroll
END SUB

SUB randscroll
    direction = INT(RND * 4)
    ScrollAttrib = CM(1, 7)

    IF direction > RIGHT THEN
       reps = 25
    ELSE
       reps = 80
    END IF

    FOR x = 1 TO reps
      SCROLL 1, 1, 25, 80, direction
    NEXT x
END SUB

SUB scrolldemo
    DIM win AS STRING
    DIM Items(1 TO 25)  AS STRING
    DIM tem(1 TO 1) AS STRING
    DIM Choice AS INTEGER, row AS INTEGER, Col AS INTEGER

    RESTORE scrolldata
    FOR x = 1 TO 11
    READ Items(x)
    NEXT x

    DEFWIN 1, 3, 1, 3, 1, 3, PAIR, YES
    IF SCROLLMENU(0, 0, 5, YES, Items(), "The ScrollMenu Function", Choice) = ESC THEN
       EXIT SUB
    END IF

    FOR x = 1 TO 25
    Items(x) = "  Item Number " + STR$(x) + "  "
    NEXT x

    'pick an item scroll menu
    DEFWIN 14, 0, 14, 0, 15, 0, ILINE, YES
    IF SCROLLMENU(0, 0, 5, YES, Items(), "Scroll Choices", Choice) = ESC THEN
       EXIT SUB
    END IF

    tem(1) = "You Chose " + LTRIM$(RTRIM$(Items(Choice)))

    DEFWIN 14, 4, 14, 4, 14, 4, HLINE, YES
    a$ = MESSAGE(row, Col, "Result", tem(), "", 3, YES)

END SUB

SUB windowdemo
  DIM in AS STRING

  LabelPos = LEFT
  DEFWIN 15, 4, CM(15, 0), CM(1, 7), CM(15, 0), CM(1, 7), THIN, NO
  OPENWIN 1, 1, 25, 80, "VUDU Window Interactive Demonstration"

  'Print Prompts
  PRINTS "Press:", 3, 5, 30
  PRINTS "<H> To Change Header Color", 5, 5, 30
  PRINTS "<F> To Change Foreground Color", 7, 5, 30
  PRINTS "<B> To Change Background Color", 9, 5, 30
  PRINTS "<A> To Change Border Attribute", 11, 5, 30
  PRINTS "<S> To Toggle Shadows", 13, 5, 30
  PRINTS "<> To Shrink Length", 15, 5, 30
  PRINTS "<> To Expand Length", 17, 5, 30
  PRINTS "<> To Shrink Width", 19, 5, 30
  PRINTS "<" + CHR$(26) + "> To Expand Width", 21, 5, 30
  PRINTS "<Esc> Return To Menu", 23, 5, 30

  LabelPos = CENTER

  endcol = oldcol: endrow = oldrow
  wfg = oldwfg: wbg = oldwbg
  HedFG = oldhedfg: HedBG = oldhedbg
  edge = oldedge
  shad = oldshad
  winflag = TRUE

  DO

    IF endrow < oldrow THEN
       PRINTS SPACE$(38), oldrow, 40, 16
       IF oldshad THEN HILITE oldrow + 1, 42, 38, 16
    END IF

    IF endcol < oldcol THEN
       PRINTV SPACE$(oldrow - 2), 3, oldcol, 16
       IF shad THEN
     HILITV 4, oldcol + 2, 20, 16
       END IF
    END IF

    'Remove old shadow
    IF shad <> oldshad AND shad = NO THEN
      HILITE endrow + 1, 42, 38, 16
      HILITV 4, endcol + 1, 20, 16
      HILITV 4, endcol + 2, 20, 16
      winflag = NO
    END IF

    oldwfg = wfg: oldwbg = wbg
    oldhedfg = HedFG: oldhedbg = HedBG

    DEFWIN HedFG, HedBG, wfg, wbg, wfg, wbg, edge, shad
    IF winflag THEN OPENWIN 3, 40, endrow, endcol, "demo"

    oldcol = endcol: oldrow = endrow
    wfg = oldwfg: wbg = oldwbg
    HedFG = oldhedfg: HedBG = oldhedbg
    oldedge = edge
    oldshad = shad
    winflag = YES

    'Process Users Key
    IF Vmouse THEN
       oldr = 13: oldc = 40
       SETMOUSE oldr, oldc
       DO
      in = CLICK
      IF (in = "") THEN
         MOUSEXY mr, mc
         IF (mr > oldr) THEN in = DnKey
         IF (mr < oldr) THEN in = UpKey
         IF (mc > oldc + 5) THEN in = RKey
         IF (mc < oldc - 5) THEN in = LKey
         IF (mr = 1) OR (mr = 25) OR (mc = 1) OR (mc = 80) THEN
        SETMOUSE 13, 40: oldr = 13: oldc = 40: in = ""
         END IF
      END IF
       LOOP WHILE (in = "")
       oldr = mr: oldc = mc
    ELSE
       in = GETCH
    END IF
    in = UCASE$(in)

    SELECT CASE in
       CASE UpKey: endrow = endrow - 1             'Up Arrow
         IF endrow < 5 THEN endrow = 5
       CASE DnKey: endrow = endrow + 1             'Down Arrow
         IF endrow > 22 THEN endrow = 22
       CASE RKey: endcol = endcol + 1              'Right Arrow
         IF endcol > 76 THEN endcol = 76
       CASE LKey: endcol = endcol - 1              'Left Arrow
         IF endcol < 53 THEN endcol = 53
       CASE "H": HedFG = HedFG + 1
         IF HedFG = 16 THEN
           HedFG = 0: HedBG = HedBG + 1
           IF HedBG = 8 THEN HedBG = 0
         END IF
       CASE "F": wfg = wfg + 1                    'Foreground Attrib
         IF wfg > 15 THEN wfg = 0
       CASE "B": wbg = wbg + 1                    'Background Attrib
         IF wbg > 7 THEN wbg = 0
       CASE "A": edge = edge + 1                  'Edge Attribute
         IF edge > 6 THEN edge = 1
       CASE "S": shad = NOT shad                  'Shadow Toggle
       CASE ELSE: winflag = NO
   END SELECT

  IF ATTRIB(wfg, wbg) = 0 THEN wfg = 1

  LOOP UNTIL in = ESC

END SUB