home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / basic / mlib30 / mlibsam4.bas < prev    next >
Encoding:
BASIC Source File  |  1994-02-21  |  14.3 KB  |  498 lines
  1.  
  2.  '============================= MLIBSAM4.BAS ================================
  3.  '             Copyright (C) 1994 Terry Venn. All rights reserved.
  4.  '
  5.  '                  THIS SAMPLE PROGRAM IS PROVIDED AS IS.
  6.  '
  7.  ' You may modify/use this code in any way you wish, provided that you agree
  8.  ' that Terry Venn has no warranties, obligations or liabilities for any code
  9.  ' contained in this sample program.
  10.  '
  11.  ' This sample program shows how to display a menu (in text mode) offering
  12.  ' multiple items to choose from. MLIB's non-event-driven (standard) routine,
  13.  ' GetButtonM(), provides mouse support. The MouseStatus() routine in this
  14.  ' module converts the mouse pointer virtual coordinates to BASIC's row-
  15.  ' column format. For simplicity reasons, error trapping is not included.
  16.  '
  17.  ' QB refers to: QuickBasic 4.5
  18.  ' VBDOS refers to: Visual Basic for DOS
  19.  '
  20.  ' To run this sample program from inside the QB environment, start the QB
  21.  ' editor by typing: QB/L MLIBN
  22.  '
  23.  ' To run this sample program from inside the VBDOS environment, start the
  24.  ' editor by typing: VBDOS/L MLIBF
  25.  '
  26.  ' QuickBasic and Visual Basic are trademarks of Microsoft Corporation.
  27.  '===========================================================================
  28.  
  29.  DEFINT A-Z
  30.  ' $INCLUDE: 'MLIB.BI'
  31.  
  32.  DECLARE SUB KeyBoardCheck (Kbd$, ChosenItem%)
  33.  DECLARE SUB ShowMenu (Row%, Col%, Title$)
  34.  DECLARE SUB PrintMenuItems ()
  35.  DECLARE SUB DrawBox (R%, C%, Wide%, High%, Title$)
  36.  DECLARE SUB MoveBar (LastItem%, NewItem)
  37.  DECLARE SUB MouseLoop ()
  38.  DECLARE SUB MouseCheck (NewItem, MouseRow%, MouseCol%)
  39.  DECLARE SUB MouseStatus (MousePress%, MouseCol%, MouseRow%)
  40.  DECLARE FUNCTION MouseOnItem% (X%, MouseRow%, MouseCol%)
  41.  TYPE MenuType
  42.       mnuCol     AS INTEGER
  43.       mnuRow     AS INTEGER
  44.  END TYPE
  45.  CONST TRUE = -1, FALSE = 0
  46.  COMMON SHARED /Menu/ Menu()           AS MenuType ' Menu control array.
  47.  COMMON SHARED /Menu/ MenuItem()       AS STRING   ' Menu item array.
  48.  COMMON SHARED /Menu/ MinItem          AS INTEGER  ' First menu item.
  49.  COMMON SHARED /Menu/ MaxItem          AS INTEGER  ' Last menu item.
  50.  COMMON SHARED /Menu/ LongestMenuItem  AS INTEGER  ' Longest menu item.
  51.  COMMON SHARED /Menu/ LastItem         AS INTEGER  ' Last item highlighted.
  52.  COMMON SHARED /Menu/ NewItem          AS INTEGER  ' Current item.
  53.  COMMON SHARED /Menu/ MenuForeColor    AS INTEGER  ' Menu foreground color.
  54.  COMMON SHARED /Menu/ MenuBackColor    AS INTEGER  ' Menu background color.
  55.  
  56.  COMMON SHARED /Menu/ FrameForeColor       AS INTEGER ' DrawBox()
  57.  COMMON SHARED /Menu/ FrameBackColor       AS INTEGER ' variables.
  58.  COMMON SHARED /Menu/ BoxForeColor         AS INTEGER
  59.  COMMON SHARED /Menu/ BoxBackColor         AS INTEGER
  60.  COMMON SHARED /Menu/ TitleForeColor       AS INTEGER
  61.  COMMON SHARED /Menu/ TitleBackColor       AS INTEGER
  62.  
  63.  DIM SHARED CurMouseRow AS STRING * 2           ' Current pointer
  64.  DIM SHARED CurMouseCol AS STRING * 2           ' position.
  65.  
  66.  FrameForeColor = 0
  67.  FrameBackColor = 7
  68.  BoxForeColor = 7
  69.  BoxBackColor = 1
  70.  TitleForeColor = 15
  71.  TitleBackColor = 5
  72.  
  73.  CLS
  74.  
  75.  ' Use the whole screen.
  76.  VIEW PRINT
  77.  
  78.  ' Initialize MLIB and mouse driver.
  79.  CALL InitPointer(IsMouse%)
  80.  
  81.  ' Place pointer in upper left corner of screen.
  82.  CALL SetPointer(0, 0)
  83.  
  84.  ' Draw main background box.
  85.  CALL DrawBox(1, 1, 80, 24, "MLIB: Mouse Library Menu Demo")
  86.  
  87.  COLOR 0, 3
  88.  HelpBar$ = " <Arrow Keys=Scroll Menu Items> <Enter=Choose Menu Item> <Esc=Quit Demo> │      "
  89.  LOCATE 25, 1: PRINT HelpBar$;
  90.  
  91.  FrameForeColor = 0: FrameBackColor = 3
  92.  BoxForeColor = 7: BoxBackColor = 0
  93.  
  94.  MenuForeColor = BoxForeColor: MenuBackColor = BoxBackColor
  95.  COLOR MenuForeColor, MenuBackColor
  96.  CALL DrawBox(15, 22, 37, 5, "Menu Item Chosen:")
  97.  
  98.  ' Show the mouse pointer
  99.  CALL ShowPointer
  100.  
  101.  ' Define the items that will appear on the menu.
  102.  TotalItem% = 6   ' Total number of menu items.
  103.  
  104.  REDIM MenuItem(1 TO TotalItem%) AS STRING ' Array to hold menu items.
  105.  
  106.  MenuItem(1) = "           Menu Item  #1           "
  107.  MenuItem(2) = "           Menu Item  #2           "
  108.  MenuItem(3) = "           Menu Item  #3           "
  109.  MenuItem(4) = "           Menu Item  #4           "
  110.  MenuItem(5) = "           Menu Item  #5           "
  111.  MenuItem(6) = "           Quit Demo               "
  112.  
  113.  ' Upper left corner of menu.
  114.  Row% = 5: Col% = 22
  115.  Title$ = "Menu"
  116.  CALL ShowMenu(Row%, Col%, Title$)
  117.  
  118.  ' Mouse and keyboard code...
  119.  DO
  120.     DO ' Loop until a mouse button or a key is pressed.
  121.        CALL MouseStatus(MousePress%, MouseCol%, MouseRow%)
  122.       
  123.        ' Show pointer position.
  124.        IF MouseRow% <> OldMouseRow% OR MouseCol% <> OldMouseCol% THEN
  125.           CurMouseRow = LTRIM$(STR$(MouseRow%))
  126.           CurMouseCol = LTRIM$(STR$(MouseCol%))
  127.           COLOR 0, 3: CALL HidePointer
  128.           LOCATE 25, 75: PRINT CurMouseRow; ":"; CurMouseCol;
  129.           CALL ShowPointer: COLOR BoxForeColor, BoxBackColor
  130.           OldMouseRow% = MouseRow%
  131.           OldMouseCol% = MouseCol%
  132.        END IF
  133.  
  134.        KeyPress$ = INKEY$
  135.     LOOP UNTIL MousePress% AND 1 OR LEN(KeyPress$)
  136.  
  137.     ' Clear Menu Chosen Item box.
  138.     CALL HidePointer: LOCATE 17, 23: PRINT SPACE$(LEN(MenuItem(MinItem))): ShowPointer
  139.  
  140.     ' Check for a mouse event first.
  141.     IF MousePress% AND 1 THEN
  142.        CALL MouseCheck(ChosenItem%, MouseRow%, MouseCol%)
  143.     END IF
  144.  
  145.     ' Check for a key press.
  146.     IF KeyPress$ <> "" THEN
  147.        CALL KeyBoardCheck(KeyPress$, ChosenItem%)
  148.     END IF
  149.   
  150.     IF ChosenItem% THEN
  151.        ReturnedItem$ = LTRIM$(RTRIM$(MenuItem(ChosenItem%)))
  152.        SELECT CASE ReturnedItem$
  153.           CASE "Menu Item  #1":    ' Place your code to branch here
  154.           CASE "Menu Item  #2":    ' (or CHAIN another program)according
  155.           CASE "Menu Item  #3":    ' to chosen item.
  156.           CASE "Menu Item  #4":
  157.           CASE "Menu Item  #5":
  158.           CASE "Quit Demo": EXIT DO
  159.        END SELECT
  160.      
  161.        ' Update Menu Chosen Item box.
  162.        CALL HidePointer: LOCATE 17, 23: PRINT MenuItem(ChosenItem%): ShowPointer
  163.     ELSE
  164.        ReturnedItem$ = ""
  165.     END IF
  166.    
  167.  LOOP UNTIL KeyPress$ = CHR$(27)
  168.  
  169.  ' We done...
  170.  CALL HidePointer
  171.  COLOR 7, 0
  172.  CLS
  173.  END
  174.  
  175. '
  176. ' Some simple code to get a box on the screen.
  177. ' R - Row
  178. ' C - Col
  179. '
  180. SUB DrawBox (R%, C%, Wide%, High%, Title$)
  181.  
  182.  CALL HidePointer
  183.    
  184.  ' Draw frame.
  185.  COLOR FrameForeColor, FrameBackColor ' Frame color.
  186.     
  187.  LOCATE R%, C%: PRINT "┌┤";
  188.  LOCATE R%, C% + Wide% - 2: PRINT "├┐";
  189.  
  190.  FOR RR% = R% + 1 TO R% + High% - 2
  191.     LOCATE RR%, C%: PRINT "│";
  192.     LOCATE RR%, C% + Wide% - 1: PRINT "│";
  193.  NEXT RR%
  194.     
  195.  LOCATE R% + High% - 1, C%:
  196.  PRINT "└"; STRING$(Wide% - 2, "─"); "┘";
  197.     
  198.  ' Calculate title stuff.
  199.  TitleBarWidth% = Wide% - 4
  200.  TitleBarCenter% = (TitleBarWidth%) \ 2
  201.  
  202.  Text$ = Title$
  203.  TitleLen% = LEN(Text$)
  204.  
  205.  ' Draw title bar background.
  206.  COLOR TitleForeColor, TitleBackColor
  207.  LOCATE R%, C% + 2: PRINT SPACE$(TitleBarWidth%)
  208.  
  209.  ' Clip title if needed.
  210.  IF TitleLen% > TitleBarWidth% THEN
  211.     Text$ = LEFT$(Text$, TitleBarWidth%)
  212.     TitleLen% = LEN(Text$)
  213.  END IF
  214.  
  215.  ' Center and print title.
  216.  LOCATE R%, C% + TitleBarCenter% - (TitleLen% \ 2) + 2
  217.  PRINT Text$
  218.     
  219.  ' Fill in frame.
  220.  COLOR BoxForeColor, BoxBackColor ' Frame fill color.
  221.  FOR RR% = R% + 1 TO R% + High% - 2
  222.      LOCATE RR%, C% + 1: PRINT SPACE$(Wide% - 2);
  223.  NEXT RR%
  224.    
  225.  ' Shade color.
  226.  COLOR 8, 0
  227.  
  228.  ' Draw shading (vertical).
  229.  FOR RR% = R% + 1 TO R% + High%
  230.    
  231.     ' Clip shading if needed.
  232.     IF RR% <= 25 AND C% + Wide% <= 80 THEN
  233.        S% = SCREEN(RR%, C% + Wide%)
  234.        LOCATE RR%, C% + Wide%: PRINT CHR$(S%);
  235.     END IF
  236.  NEXT RR%
  237.     
  238.  FOR CC% = C% + 1 TO C% + Wide%
  239.    
  240.     ' Clip shading if needed.
  241.     IF R% + High% <= 25 AND CC% <= 80 THEN
  242.        S% = SCREEN(R% + High%, CC%)
  243.        LOCATE R% + High%, CC%: PRINT CHR$(S%);
  244.     END IF
  245.  NEXT CC%
  246.  
  247.  CALL ShowPointer
  248.  
  249. END SUB
  250.  
  251. '
  252. ' Keyboard support for menu.
  253. '
  254. ' Scroll selection (highlight) bar using the arrow keys.
  255. '
  256. ' ChosenItem% - returns the chosen item's element value.
  257. '
  258. SUB KeyBoardCheck (Kbd$, ChosenItem%)
  259.  
  260.  ChosenItem% = FALSE
  261.  
  262.  SELECT CASE Kbd$
  263.     
  264.      CASE CHR$(0) + "H", CHR$(0) + "K"  ' Up and right arrow.
  265.         NewItem = LastItem - 1
  266.         ChangeBar% = TRUE
  267.     
  268.      CASE CHR$(0) + "P", CHR$(0) + "M"  ' Down and left arrow.
  269.         NewItem = LastItem + 1
  270.         ChangeBar% = TRUE
  271.  
  272.      CASE CHR$(0) + "G", CHR$(0) + "I"  ' Home and page up.
  273.         NewItem = MinItem
  274.         ChangeBar% = TRUE
  275.     
  276.      CASE CHR$(0) + "O", CHR$(0) + "Q"  ' End and page down.
  277.         NewItem = MaxItem
  278.         ChangeBar% = TRUE
  279.  
  280.      CASE CHR$(13)                      ' Enter.
  281.         NewItem = LastItem
  282.        
  283.         ' Return chosen menu item.
  284.         ChosenItem% = NewItem
  285.        
  286.  END SELECT
  287.  
  288.  ' Show item highlighted.
  289.  IF ChangeBar% = TRUE THEN
  290.     CALL MoveBar(LastItem, NewItem)
  291.     LastItem = NewItem
  292.  END IF
  293. END SUB
  294.  
  295. '
  296. ' Mouse support for menu.
  297. '
  298. SUB MouseCheck (NewItem, MouseRow%, MouseCol%)
  299.  
  300.  ' Check if cursor is on a menu item.
  301.  IF MouseOnItem(NewItem, MouseRow%, MouseCol%) THEN
  302.     OnItem% = TRUE
  303.  
  304.     DO ' Use the mouse pointer position that was passed to us first.
  305.       
  306.        IF MouseOnItem(NewItem, MouseRow%, MouseCol%) THEN
  307.           OnItem% = TRUE
  308.        ELSE
  309.           OnItem% = FALSE
  310.        END IF
  311.  
  312.        'Show item highlighted.
  313.        IF OnItem% = TRUE AND LastItem <> NewItem THEN
  314.           CALL MoveBar(LastItem, NewItem)
  315.           LastItem = NewItem
  316.        END IF
  317.       
  318.        CALL MouseStatus(MousePress%, MouseCol%, MouseRow%)
  319.       
  320.        ' When using mouse events, we should check for a LButtonUp
  321.        ' event and see if pointer is still on an item.
  322.        IF NOT MousePress% AND 1 THEN    ' This menu item has been chosen,
  323.           EXIT SUB                      ' NewItem - returns the item's
  324.        END IF                           ' element value.
  325.       
  326.        OnItem% = FALSE
  327.    
  328.     LOOP WHILE MousePress% AND 1
  329.  END IF
  330.  
  331.  'We checked the entire array, no match of cursor to menu item.
  332.  NewItem = FALSE
  333.   
  334.  ' Mouse was pressed off the menu, loop while mouse button is down.
  335.  ' Not needed when called by the MLIBSAM6.BAS modual.
  336.  'CALL MouseLoop
  337.  
  338. END SUB
  339.  
  340. '
  341. ' Loop while mouse button is down.
  342. '
  343. SUB MouseLoop
  344.  DO ' Check for mouse event.
  345.     CALL GetButtonM(MousePress%, D%, D%)
  346.  LOOP WHILE MousePress%
  347. END SUB
  348.  
  349. '
  350. ' Checks if mouse pointer is on a menu item.
  351. '
  352. FUNCTION MouseOnItem (X%, MouseRow%, MouseCol%)
  353.    
  354.  FOR X% = MinItem TO MaxItem
  355.  
  356.      IF MouseRow% = Menu(X%).mnuRow THEN
  357.  
  358.            SELECT CASE MouseCol%
  359.               CASE Menu(X%).mnuCol TO Menu(X%).mnuCol + LongestMenuItem - 1
  360.                  MouseOnItem = TRUE
  361.                  EXIT FUNCTION
  362.            END SELECT
  363.      END IF
  364.  NEXT X%
  365.  
  366.  ' No match found.
  367.  X% = FALSE
  368.  
  369.  MouseOnItem = FALSE
  370.  
  371. END FUNCTION
  372.  
  373. '
  374. ' Returns mouse button presses and coordinates of pointer.
  375. '
  376. ' By default, the mouse coordinating system works on a virtual screen of 640
  377. ' by 200 (8 * number-of-text-rows) pixels.
  378. '
  379. ' To convert the virtual mouse position to text mode's row/column format, the
  380. ' x and y variables must be swapped.
  381. '
  382. ' For example:
  383. '
  384. '               For graphics  - CALL GetButtonM(MousePress%, X%, Y%)
  385. '
  386. '               X% = Horizontal coordinates.
  387. '               Y% = Vertical coordinates.
  388. '
  389. '               For text mode - CALL GetButtonM(MousePress%, Y%, X%)
  390. '
  391. '               X% = Row coordinates.
  392. '               Y% = Column coordinates.
  393. '
  394. SUB MouseStatus (MousePress%, MouseCol%, MouseRow%)
  395.  CALL GetButtonM(MousePress%, MouseCol%, MouseRow%)
  396.  
  397.  ' Convert virtual mouse position to BASIC's 1-based row/column format.
  398.  MouseCol% = MouseCol% \ 8 + 1  ' Divide by width of current character.
  399.  MouseRow% = MouseRow% \ 8 + 1  ' Divide by height of current character.
  400. END SUB
  401.  
  402. '
  403. ' Highlights a selected menu item.
  404. '
  405. SUB MoveBar (LastItem, NewItem)
  406.  
  407.  ' *** Keep pointers within range. ***
  408.                                                ' Un-REM these two IF - THENs
  409.  ' Selection bar stops at top and bottom.      ' to stop selection bar from
  410.  'IF NewItem > MaxItem THEN NewItem = MaxItem  ' continuously looping. Make
  411.  'IF NewItem < MinItem THEN NewItem = MinItem  ' sure the next two IF - THENs
  412.                                                ' are REM-ed.
  413.  '' Selection bar moves continuously.
  414.  IF NewItem > MaxItem THEN NewItem = MinItem
  415.  IF NewItem < MinItem THEN NewItem = MaxItem
  416.  ' ***********************************
  417.  
  418.  IF LastItem <> NewItem THEN
  419.    
  420.     CALL HidePointer
  421.    
  422.     ' Turn off highlight on the last selected menu item.
  423.     COLOR MenuForeColor, MenuBackColor
  424.     LOCATE Menu(LastItem).mnuRow, Menu(LastItem).mnuCol
  425.     PRINT MenuItem(LastItem)
  426.    
  427.     ' Highlight new selected menu item by reversing colors.
  428.     COLOR MenuBackColor, MenuForeColor  ' Reverse colors.
  429.     LOCATE Menu(NewItem).mnuRow, Menu(NewItem).mnuCol
  430.     PRINT MenuItem(NewItem)
  431.     COLOR MenuForeColor, MenuBackColor  ' Restore colors.
  432.     CALL ShowPointer
  433.   END IF
  434.  
  435. END SUB
  436.  
  437. '
  438. ' Print all menu items using the menu control array coordinates.
  439. '
  440. SUB PrintMenuItems
  441.  
  442.  COLOR MenuForeColor, MenuBackColor
  443.  
  444.  CALL HidePointer
  445.  ' Print menu items.
  446.  FOR X% = MinItem TO MaxItem
  447.     LOCATE Menu(X%).mnuRow, Menu(X%).mnuCol
  448.     PRINT MenuItem(X%)
  449.  NEXT X%
  450.  CALL ShowPointer
  451. END SUB
  452.  
  453. '
  454. ' Initializes menu control array and draws menu on the screen.
  455. ' Length of the longest menu item determines the width of the menu box.
  456. '
  457. SUB ShowMenu (Row%, Col%, Title$)
  458.  
  459.  MinItem = LBOUND(MenuItem, 1)
  460.  MaxItem = UBOUND(MenuItem, 1)
  461.  REDIM Menu(MinItem TO MaxItem)  AS MenuType
  462.  
  463.  ' Make sure we start at zero length.
  464.  LongestMenuItem = 0
  465.  
  466.  ' Use a copy.
  467.  R% = Row%
  468.  
  469.  ' Initialize menu control array.
  470.  FOR X% = MinItem TO MaxItem
  471.     R% = R% + 1
  472.     Menu(X%).mnuCol = Col% + 1
  473.     Menu(X%).mnuRow = R%
  474.    
  475.     ' Find the longest menu item.
  476.     NewLen% = LEN(MenuItem(X%))
  477.     IF NewLen% > LongestMenuItem THEN
  478.        LongestMenuItem = NewLen%
  479.     END IF
  480.  
  481.  NEXT X%
  482.  
  483.  CALL HidePointer
  484.  
  485.  ' Draw a menu backgound box 2 columns wider than the longest item.
  486.  High% = MaxItem - MinItem + 3
  487.  Wide% = LongestMenuItem + 2
  488.  CALL DrawBox(Row%, Col%, Wide%, High%, Title$)
  489.  
  490.  ' Print menu items on screen and show first selection highlighted.
  491.  CALL PrintMenuItems
  492.  CALL MoveBar(MaxItem, MinItem)
  493.  LastItem = MinItem: NewItem = MinItem
  494.  CALL ShowPointer
  495.  
  496. END SUB
  497.  
  498.