home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / VISUAL_B / CODIGO_1 / BCC101 / TESTDLOG.BAS < prev    next >
Encoding:
BASIC Source File  |  1993-01-13  |  7.0 KB  |  155 lines
  1.         '''''''''''''''''''''''''''''''''''''''''''''''''''''''
  2.         '                    testdlog.bas                     '
  3.         '                                                     '
  4.         '''''''''''''''''''''''''''''''''''''''''''''''''''''''
  5.         '  compile ->  bc testdlog /o;                        '
  6.         '  compile ->  bc dialog /o;                          '
  7.         '  link ->     link /e testdlog + dialog, , nul, qb;  '
  8.         '                                                     '
  9.         '''''''''''''''''''''''''''''''''''''''''''''''''''''''
  10. '
  11. '$INCLUDE: 'DIALOG.BI'
  12.  
  13.     DIM Menu$(1 TO 5), Prompt$(1 TO 5)
  14.  
  15.     Menu$(1) = " Lotus 123 spreadsheet reports "
  16.     Menu$(2) = " dBase company product reports "
  17.     Menu$(3) = " Telix - com to main facility  "
  18.     Menu$(4) = " SERVICES system management    "
  19.     Menu$(5) = " Exit this phoney menu system  "
  20.  
  21.     Prompt$(1) = " Make, create or modify company profit/loss reports.  "
  22.     Prompt$(2) = " Track salesmen and accounts to various product lines."
  23.     Prompt$(3) = " Telephone hookup to company's main computer in Tulsa."
  24.     Prompt$(4) = " Promo for ORCA Pacific's Professional SERVICES 4.0   "
  25.     Prompt$(5) = " Quit, finished, done, ie., we're out of this program."
  26.  
  27.     Msg1$ = ""
  28.     Msg1$ = Msg1$ + " ░▒▓ BoxDialog Demonstration ▓▒░"
  29.     Msg1$ = Msg1$ + "                                "
  30.     Msg1$ = Msg1$ + "Simply define the message to dis-play (like this one), "
  31.     Msg1$ = Msg1$ + "the row to start the display, the corner and side "
  32.     Msg1$ = Msg1$ + "characters of the dis-play box, the color attribute for "
  33.     Msg1$ = Msg1$ + "the display and the width of the boxed display.  The "
  34.     Msg1$ = Msg1$ + "routine will automatically word wrap your text and "
  35.     Msg1$ = Msg1$ + "center the box, re-gardless of the number of col-umns "
  36.     Msg1$ = Msg1$ + "your display is currently set for."
  37.  
  38.     Strike$ = " Strike any key to continue... "
  39.     StrikeCorners$ = "█▀████▄█"
  40.  
  41.     VidInfo                             ' obtain video information
  42.  
  43.     Background$ = STRING$(MonRows * MonCols, 176)  ' setup fancy background
  44.     WriteStr Background$, 1, 1, ClrAttr(12, 1)     ' do a fancy background
  45.  
  46.     BoxDialog 1, 37, "╔═╗║║╙─╜", Msg1$, ClrAttr(15, 5), 1
  47.     BoxDialog 19, LEN(Strike$) + 4, StrikeCorners$, Strike$, ClrAttr(1, 3), 1
  48.     GOSUB Wait4Key
  49.  
  50.     WIDTH 40                            ' change to 40 column screen
  51.     VidInfo                             ' obtain video information
  52.  
  53.     WriteStr LEFT$(Background$, 1000), 1, 1, ClrAttr(12, 1) ' fancy background
  54.  
  55.     Msg1$ = Msg1$ + "  BTW, this call to BoxDialog is exactly the "
  56.     Msg1$ = Msg1$ + "same as before."
  57.  
  58.                                         ' exact same call as before
  59.     BoxDialog 1, 37, "╔═╗║║╙─╜", Msg1$, ClrAttr(14, 4), 1
  60.     BoxDialog 21, LEN(Strike$) + 4, StrikeCorners$, Strike$, ClrAttr(14, 2), 1
  61.     GOSUB Wait4Key
  62.  
  63.     WIDTH 80                            ' change to 80 column screen
  64.     VidInfo                             ' obtain video information
  65.  
  66.     WriteStr Background$, 1, 1, ClrAttr(12, 1)    ' do a fancy background
  67.  
  68.     BoxDialog 1, 37, "╔═╗║║╙─╜", Msg1$, ClrAttr(1, 3), 1 ' still the same call
  69.     BoxDialog 21, LEN(Strike$) + 4, StrikeCorners$, Strike$, ClrAttr(15, 3), 1
  70.     GOSUB Wait4Key
  71.  
  72.     Msg$ = "Use this routine for all kinds of things like helpful prompts "
  73.     Msg$ = Msg$ + "correlated to your highlighted menu options."
  74.     Msg$ = Msg$ + SPACE$(53)
  75.     Msg$ = Msg$ + "Two more notes:  This routine word wraps at spaces, "
  76.     Msg$ = Msg$ + "dashes, dots, commas, colons and semi-colons.  Also, "
  77.     Msg$ = Msg$ + "leading spaces are NOT trimmed!"
  78.  
  79.     BoxDialog 3, 58, "╒═╕║║╘═╛", Msg$, ClrAttr(15, 4), 1
  80.     BoxDialog 13, LEN(Strike$) + 4, "▐▀▌▐▌▐▄▌", Strike$, 14, 1
  81.     GOSUB Wait4Key
  82.  
  83.     WriteStr Background$, 1, 1, ClrAttr(12, 1)  ' do a fancy background
  84.  
  85.     '---- Now show how to use this for menu systems. ----
  86.     promptW = LEN(Prompt$(1)) + 4      ' calculate width of box
  87.     leftpos = 1 + ((MonCols - promptW) \ 2)  ' compute left column
  88.     IF leftpos > 1 THEN leftpos = leftpos + (promptW MOD 2)
  89.     leftpos = leftpos + 2              ' move it beyound left side of box
  90.  
  91.     BoxWidth = LEN(Menu$(1)) + 4       ' calculate width of box
  92.     Temp$ = "   QBNews Phoney Menu System   "  ' add menu title
  93.     Temp$ = Temp$ + SPACE$(LEN(Temp$))         ' add one line of space
  94.     Temp$ = Temp$ + Menu$(1) + Menu$(2) + Menu$(3) + Menu$(4) + Menu$(5)
  95.  
  96.     BoxDialog 3, BoxWidth, "╔═╗║║╚═╝", Temp$, 14, 1  ' draw the menu
  97.                                                      ' draw boxed prompt
  98.     BoxDialog 14, promptW, "╒═╕││╘═╛", Prompt$(1), ClrAttr(15, 5), 1
  99.  
  100.     Temp$ = "This phoney menu system is sized and displayed via BoxDialog()."
  101.     Temp$ = Temp$ + "Use <Up> and <Down> to select.   "
  102.     Temp$ = Temp$ + "<Enter> on #5 or <Esc> aborts."
  103.                                                  ' draw message sans shadow
  104.     BoxDialog 19, 67, "┌─┐││└─┘", Temp$, ClrAttr(15, 4), 0 
  105.  
  106.     choice = 1                         ' start with menu choice #1
  107.     leftcol = 1 + ((MonCols - BoxWidth) \ 2)    ' compute left column
  108.     IF leftcol > 1 THEN leftcol = leftcol + (BoxWidth MOD 2)
  109.     leftcol = leftcol + 2              ' move it beyound left side of box
  110.  
  111.     GOSUB HiChoice                     ' highlight first choice
  112.  
  113.     DO
  114.         ans$ = INKEY$                  ' get a key from the keyboard buffer
  115.         IF ans$ = CHR$(0) + CHR$(72) THEN    ' up arrow
  116.             GOSUB ClearHi                    ' clear highlighted item
  117.             choice = choice - 1              ' decrement choice
  118.             IF choice < 1 THEN choice = 5    ' wrap if at top
  119.             GOSUB HiChoice                   ' highlight new choice
  120.         ELSEIF ans$ = CHR$(0) + CHR$(80) THEN    ' down arrow
  121.             GOSUB ClearHi                    ' clear highlighted item
  122.             choice = choice + 1              ' increment choice
  123.             IF choice > 5 THEN choice = 1    ' wrap if at bottom
  124.             GOSUB HiChoice                   ' highlight new choice
  125.         ELSEIF ans$ = CHR$(13) THEN          ' enter key
  126.             IF choice = 5 THEN EXIT DO ELSE BEEP  ' if at "exit" choice
  127.         ELSEIF ans$ = CHR$(27) THEN          ' escape key
  128.             EXIT DO
  129.         ELSEIF LEN(ans$) THEN                ' any other keystroke
  130.             BEEP                             ' beep em up, Scotty
  131.         END IF
  132.     LOOP
  133.  
  134.     Msg$ = STRING$(MonRows * MonCols, 32)    ' string of blanks
  135.     WriteStr Msg$, 1, 1, 7              ' clear the screen
  136.  
  137.     END
  138.  
  139. Wait4Key:
  140.     DO: LOOP UNTIL LEN(INKEY$)          ' wait for a keystroke
  141. RETURN
  142.  
  143. HiChoice:
  144.     ' ---- highlight menu choice
  145.     WriteStr Menu$(choice), choice + 5, leftcol, ClrAttr(0, 7)
  146.     ' ---- display new menu prompt
  147.     WriteStr Prompt$(choice), 15, leftpos, ClrAttr(15, 5)
  148. RETURN
  149.  
  150. ClearHi:
  151.     ' ---- clear highlight from menu item
  152.     WriteStr Menu$(choice), choice + 5, leftcol, 14
  153. RETURN
  154.  
  155.