home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / basic / mlib30 / mlibsam5.bas < prev    next >
Encoding:
BASIC Source File  |  1994-02-21  |  10.4 KB  |  370 lines
  1.  DEFINT A-Z
  2.  '============================= MLIBSAM5.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 (using SCREEN 9) offering
  12.  ' multiple items to choose from. MLIB's standard routines provide mouse
  13.  ' support. For simplicity reasons, error trapping is not included.
  14.  '
  15.  ' QB refers to: QuickBasic 4.5
  16.  ' VBDOS refers to: Visual Basic for DOS
  17.  '
  18.  ' To run this sample program from inside the QB environment, start the QB
  19.  ' editor by typing: QB/L MLIBN
  20.  '
  21.  ' To run this sample program from inside the VBDOS environment, start the
  22.  ' editor by typing: VBDOS/L MLIBF
  23.  '
  24.  ' QuickBasic and Visual Basic are trademarks of Microsoft Corporation.
  25.  '===========================================================================
  26.  
  27.  ' $INCLUDE: 'MLIB.BI'
  28.  DECLARE SUB BackGround ()
  29.  DECLARE SUB KeyBoardCheck (Kbd$, ChosenItem%)
  30.  DECLARE SUB ShowMenu (Row%, Col%)
  31.  DECLARE SUB PrintMenuItems ()
  32.  DECLARE SUB MoveBar (LastItem%, NewItem)
  33.  DECLARE SUB MouseLoop ()
  34.  DECLARE SUB MouseCheck (NewItem)
  35.  DECLARE FUNCTION MouseOnItem% (X%)
  36.  TYPE MType
  37.       x1        AS INTEGER
  38.       y1        AS INTEGER
  39.       x2        AS INTEGER
  40.       y2        AS INTEGER
  41.       R         AS INTEGER
  42.       C         AS INTEGER
  43.  END TYPE
  44.  CONST TRUE = -1, FALSE = 0
  45.  COMMON SHARED /Menu/ M()             AS MType    ' Menu control array.
  46.  COMMON SHARED /Menu/ MenuItem()      AS STRING   ' Menu item array.
  47.  COMMON SHARED /Menu/ MinItem         AS INTEGER  ' First menu item.
  48.  COMMON SHARED /Menu/ MaxItem         AS INTEGER  ' Last menu item.
  49.  COMMON SHARED /Menu/ LongestMenuItem AS INTEGER  ' Longest item in array.
  50.  COMMON SHARED /Menu/ LastItem        AS INTEGER  ' Last item highlighted.
  51.  COMMON SHARED /Menu/ NewItem         AS INTEGER  ' New item to highlight.
  52.  COMMON SHARED /Menu/ CharacterHeight AS INTEGER  ' Height of current char.
  53.  COMMON SHARED /Menu/ CharacterWidth  AS INTEGER  ' Width of current char.
  54.  COMMON SHARED /Menu/ HighLightColor  AS INTEGER  ' Selected item outline.
  55.  COMMON SHARED /Menu/ OutLineColor    AS INTEGER  ' Normal outline color.
  56.  
  57.  SCREEN 9
  58.  
  59.  ' Ask BIOS for character info.
  60.  DEF SEG = &H40
  61.  CharacterHeight = PEEK(&H85)
  62.  CharacterWidth = 8
  63.  DEF SEG
  64.  
  65.  ' Initialize MLIB plus the mouse driver, and place pointer at 0 X 0.
  66.  CLS : CALL InitPointer(IsMouse%): CALL ARROW0: CALL SetPointer(0, 0)
  67.  CALL BackGround
  68.  COLOR 15, 0
  69.  VIEW PRINT
  70.  LOCATE 1, 26: PRINT "MLIB: Mouse Library Menu Demo"
  71.  LOCATE 24, 1: PRINT "<Arrow Keys=Scroll Menu Items> <Enter or Click=Choose Menu Item> <Esc=Quit Demo>"
  72.  LOCATE 19, 7: PRINT "You have chosen:"
  73.  COLOR 14, 0
  74.  CALL ShowPointer
  75.  
  76.  ' Define the items that will appear on the menu.
  77.  TotalItem% = 6   ' Total number of menu items.
  78.  
  79.  REDIM MenuItem(1 TO TotalItem%) AS STRING ' Array to hold menu items.
  80.  
  81.  MenuItem(1) = "           Menu Item  #1           "
  82.  MenuItem(2) = "           Menu Item  #2           "
  83.  MenuItem(3) = "           Menu Item  #3           "
  84.  MenuItem(4) = "           Menu Item  #4           "
  85.  MenuItem(5) = "           Menu Item  #5           "
  86.  MenuItem(6) = "           Quit Demo               "
  87.  
  88.  ' Upper left corner of menu.
  89.  Row% = 6: Col% = 23
  90.  
  91.  ' Outline color of each selection.
  92.  OutLineColor = 9
  93.  
  94.  ' Highlight color of selected item.
  95.  HighLightColor = 12
  96.  
  97.  ' Show menu selection.
  98.  CALL ShowMenu(Row%, Col%)
  99.  
  100.  ' Mouse and keyboard code...
  101.  DO
  102.     DO ' Loop until a mouse button or a key is pressed.
  103.        CALL GetButtonM(MousePress%, X%, Y%)
  104.        KeyPress$ = INKEY$
  105.     LOOP UNTIL MousePress% AND 1 OR LEN(KeyPress$)
  106.    
  107.     ' Clear chosen item.
  108.     CALL HidePointer: LOCATE 19, 23: PRINT SPACE$(LEN(MenuItem(MinItem))): ShowPointer
  109.  
  110.     ' Check for a mouse event first.
  111.     IF MousePress% AND 1 THEN
  112.        CALL MouseCheck(ChosenItem%)
  113.     END IF
  114.  
  115.     ' Check for a key press.
  116.     IF KeyPress$ <> "" THEN
  117.        CALL KeyBoardCheck(KeyPress$, ChosenItem%)
  118.     END IF
  119.  
  120.     IF ChosenItem% THEN
  121.        ReturnedItem$ = LTRIM$(RTRIM$(MenuItem(ChosenItem%)))
  122.        SELECT CASE ReturnedItem$
  123.           CASE "Menu Item  #1"
  124.           CASE "Menu Item  #2"
  125.           CASE "Menu Item  #3"
  126.           CASE "Menu Item  #4"
  127.           CASE "Menu Item  #5"
  128.           CASE "Quit Demo": EXIT DO
  129.        END SELECT
  130.        ' Update chosen item.
  131.        CALL HidePointer: LOCATE 19, 23: PRINT MenuItem(ChosenItem%): ShowPointer
  132.     ELSE
  133.        ReturnedItem$ = ""
  134.     END IF
  135.  
  136.  LOOP UNTIL KeyPress$ = CHR$(27)
  137.  
  138.  ' We done...
  139.  CALL HidePointer
  140.  SCREEN 0, 0, 0
  141.  COLOR 7, 0
  142.  CLS
  143.  END
  144.  
  145. '
  146. ' Doodle a background pic.
  147. '
  148. SUB BackGround
  149.  FOR X% = 1 TO 640 STEP 4
  150.     LINE (1, 1)-(X%, 350), 1
  151.     LINE (1, 1)-(X% + 1, 350), 8
  152.     LINE (640, 350)-(X%, 1), 1
  153.     LINE (640, 350)-(X% + 1, 1), 8
  154.  NEXT X%
  155. END SUB
  156.  
  157. '
  158. ' Keyboard support for menu.
  159. '
  160. ' Scroll selection (highlight) bar using the arrow keys.
  161. '
  162. ' ChosenItem% - returns the chosen item's element value.
  163. '
  164. SUB KeyBoardCheck (Kbd$, ChosenItem%)
  165.  
  166.  ChosenItem% = FALSE
  167.  
  168.  SELECT CASE Kbd$
  169.     
  170.      CASE CHR$(0) + "H", CHR$(0) + "K"  ' Up and right arrow.
  171.         NewItem = LastItem - 1
  172.         ChangeBar% = TRUE
  173.     
  174.      CASE CHR$(0) + "P", CHR$(0) + "M"  ' Down and left arrow.
  175.         NewItem = LastItem + 1
  176.         ChangeBar% = TRUE
  177.  
  178.      CASE CHR$(0) + "G", CHR$(0) + "I"  ' Home and page up.
  179.         NewItem = MinItem
  180.         ChangeBar% = TRUE
  181.     
  182.      CASE CHR$(0) + "O", CHR$(0) + "Q"  ' End and page down.
  183.         NewItem = MaxItem
  184.         ChangeBar% = TRUE
  185.  
  186.      CASE CHR$(13)                      ' Enter.
  187.         NewItem = LastItem
  188.        
  189.         ' Return chosen menu item.
  190.         ChosenItem% = NewItem
  191.        
  192.  END SELECT
  193.  
  194.  'Show item highlighted.
  195.  IF ChangeBar% = TRUE THEN
  196.     CALL MoveBar(LastItem, NewItem)
  197.     LastItem = NewItem
  198.  END IF
  199. END SUB
  200.  
  201. '
  202. ' Mouse support for menu.
  203. '
  204. SUB MouseCheck (NewItem)
  205.  
  206.  ' Check if cursor is on a menu item.
  207.  IF MouseOnItem(NewItem) THEN
  208.     OnItem% = TRUE
  209.  
  210.     DO
  211.        CALL GetButtonM(MousePress%, d1%, d2%)
  212.        IF MouseOnItem(NewItem) THEN
  213.           OnItem% = TRUE
  214.        ELSE
  215.           OnItem% = FALSE
  216.        END IF
  217.  
  218.        'Show item highlighted.
  219.        IF OnItem% = TRUE AND LastItem <> NewItem THEN
  220.           CALL MoveBar(LastItem, NewItem)
  221.           LastItem = NewItem
  222.        END IF
  223.     
  224.        IF NOT MousePress% AND 1 THEN   'This menu item has been chosen,
  225.           EXIT SUB               'NewItem - returns the item's element value.
  226.        END IF
  227.       
  228.        OnItem% = FALSE
  229.       
  230.        A$ = INKEY$ ' Clear keyboard.
  231.  
  232.     LOOP WHILE MousePress% AND 1
  233.  END IF
  234.  
  235.  'We checked the entire array, no match of cursor to menu item.
  236.  NewItem = FALSE
  237.   
  238.  ' Mouse was pressed off the menu, loop while mouse button is down.
  239.  CALL MouseLoop
  240.  
  241. END SUB
  242.  
  243. '
  244. ' Loop while mouse button is down.
  245. '
  246. SUB MouseLoop
  247.  DO ' Check for mouse event.
  248.     CALL GetButtonM(MousePress%, D%, D%)
  249.     A$ = INKEY$ ' Clear keyboard.
  250.  LOOP WHILE MousePress%
  251. END SUB
  252.  
  253. '
  254. ' Check if pointer is on a menu item.
  255. '
  256. ' X% - Returns element value.
  257. '
  258. FUNCTION MouseOnItem (X%)
  259.  
  260.  FOR X% = MinItem TO MaxItem
  261.     IF InWinM(M(X%).x1, M(X%).y1, M(X%).x2, M(X%).y2) THEN
  262.       MouseOnItem = TRUE
  263.       EXIT FUNCTION
  264.     END IF
  265.  NEXT X%
  266.  
  267.  ' No match found.
  268.  X% = FALSE
  269.  
  270.  MouseOnItem = FALSE
  271.  
  272. END FUNCTION
  273.  
  274. '
  275. ' Highlights a selected menu item.
  276. '
  277. SUB MoveBar (LastItem, NewItem)
  278.  
  279.  ' *** Keep pointers within range. ***
  280.                                                ' Un-REM these two IF - THENs
  281.  ' Selection bar stops at top and bottom.      ' to stop selection bar from
  282.  'IF NewItem > MaxItem THEN NewItem = MaxItem  ' continuously looping. Make
  283.  'IF NewItem < MinItem THEN NewItem = MinItem  ' sure the next two IF - THENs
  284.                                                ' are REM-ed.
  285.  '' Selection bar moves continuously.
  286.  IF NewItem > MaxItem THEN NewItem = MinItem
  287.  IF NewItem < MinItem THEN NewItem = MaxItem
  288.  ' ***********************************
  289.  
  290.  IF LastItem <> NewItem THEN
  291.    
  292.     CALL HidePointer
  293.    
  294.     ' Turn off highlight on the last selected menu item.
  295.     LINE (M(LastItem).x1, M(LastItem).y1)-(M(LastItem).x2, M(LastItem).y2), OutLineColor, B
  296.     LINE (M(LastItem).x1 - 1, M(LastItem).y1 - 1)-(M(LastItem).x2 + 1, M(LastItem).y2 + 1), OutLineColor, B
  297.  
  298.     ' Highlight new selected menu item with a brighter outline.
  299.     LINE (M(NewItem).x1, M(NewItem).y1)-(M(NewItem).x2, M(NewItem).y2), HighLightColor, B
  300.     LINE (M(NewItem).x1 - 1, M(NewItem).y1 - 1)-(M(NewItem).x2 + 1, M(NewItem).y2 + 1), HighLightColor, B
  301.    
  302.     CALL ShowPointer
  303.  
  304.   END IF
  305.  
  306. END SUB
  307.  
  308. '
  309. ' Print all menu items using the menu control array coordinates.
  310. '
  311. SUB PrintMenuItems
  312.  CALL HidePointer
  313.  ' Print menu items.
  314.  FOR X% = MinItem TO MaxItem
  315.     LOCATE M(X%).R, M(X%).C
  316.     PRINT MenuItem(X%)
  317.    
  318.     ' Draw a box around each item.
  319.     LINE (M(X%).x1, M(X%).y1)-(M(X%).x2, M(X%).y2), OutLineColor, B
  320.     LINE (M(X%).x1 - 1, M(X%).y1 - 1)-(M(X%).x2 + 1, M(X%).y2 + 1), OutLineColor, B
  321.  NEXT X%
  322.  CALL ShowPointer
  323. END SUB
  324.  
  325. '
  326. ' Initializes menu control array and draws menu on the screen.
  327. '
  328. SUB ShowMenu (Row%, Col%)
  329.  
  330.  MinItem = LBOUND(MenuItem, 1)
  331.  MaxItem = UBOUND(MenuItem, 1)
  332.  REDIM M(MinItem TO MaxItem)  AS MType
  333.  
  334.  ' Make sure we start at zero length.
  335.  LongestMenuItem = 0
  336.  
  337.  ' Find the longest menu item.
  338.  FOR X% = MinItem TO MaxItem
  339.     NewLen% = LEN(MenuItem(X%))
  340.     IF NewLen% > LongestMenuItem THEN
  341.        LongestMenuItem = NewLen%
  342.     END IF
  343.  NEXT X%
  344.  
  345.  ' Use  copies.
  346.  R% = Row%
  347.  C% = Col%
  348.  
  349.  ' Initialize menu control array.
  350.  FOR X% = MinItem TO MaxItem
  351.     M(X%).x1 = (C% - 1) * CharacterWidth
  352.     M(X%).y1 = (R% - 1) * CharacterHeight
  353.     M(X%).x2 = M(X%).x1 + (CharacterWidth * LongestMenuItem)
  354.     M(X%).y2 = M(X%).y1 + CharacterHeight
  355.     M(X%).R = (M(X%).y1 \ CharacterHeight) + 1
  356.     M(X%).C = (M(X%).x1 \ CharacterWidth) + 1
  357.     R% = R% + 2 ' Print menu item on every second row.
  358.  NEXT X%
  359.  
  360.  CALL HidePointer
  361.  
  362.  ' Print menu items on screen and show first selection highlighted.
  363.  CALL PrintMenuItems
  364.  CALL MoveBar(MaxItem, MinItem)
  365.  LastItem = MinItem: NewItem = MinItem
  366.  CALL ShowPointer
  367.  
  368. END SUB
  369.  
  370.