home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PROG_BAS / DNALIB59.ZIP / HORZMENU.BAS < prev    next >
BASIC Source File  |  1994-02-14  |  7KB  |  338 lines
  1. DECLARE SUB CalcByte(Attr%,LowByte%,HiByte%)
  2. DECLARE SUB Clicked(Rgt%,Lft%,Row%,Col%)
  3. DECLARE SUB HideCursor()
  4. DECLARE SUB ShowCursor()
  5.  
  6. SUB HorizontalMenu(Choices$(),BarSave$,HiLight%,Mouse%,HPointer%,HotKey%,BarAttr%,HiAttr%,MenuRow%,Gap%,Marker%) PUBLIC
  7.  
  8. CalcByte HiAttr%,HiFG%,HiBG%
  9. CalcByte BarAttr%,BarFG%,BarBG%
  10.  
  11.  
  12. 'first we initialize these to zero
  13.  
  14. i% = 0
  15. j% = 0
  16. Maxlength% = 0
  17.  
  18. 'next we count the choices and set the result to count%
  19.  
  20. DO
  21.  
  22. INCR i%
  23. INCR j%
  24.  
  25. IF LEN(Choices$(i%)) = 0 THEN
  26.   DECR i%
  27. ELSE
  28.   Fixedup$ = REMOVE$(Choices$(i%),"@")
  29.   Maxlength% = Maxlength% + LEN(Fixedup$)
  30. END IF
  31.  
  32. LOOP WHILE i% = j%
  33.  
  34. Count% = i%
  35.  
  36. DIM Position%(1 TO Count%)
  37.  
  38. 'here we do a bit of checking to see if the menu bar will fit
  39.  
  40. IF Maxlength% + ((Gap% * Count%) + Gap%) > 80 THEN
  41.   COLOR 0,7
  42.   LOCATE 12,27,0
  43.   PRINT "Horizontal Menu is too big";
  44.   EXIT SUB
  45. END IF
  46.  
  47. 'I am using the variable Marker to talk between horizontal and
  48. 'and vertical menus, if Esc is used to cancel the pulldown in
  49. 'the vertical menu, then marker is reset to zero, if marker
  50. 'contains a value then SelectionMade is preset to 1, so from
  51. 'horizontal menu, Marker carries the cursor position for the
  52. 'location of the pulled down menu, and either returns with that
  53. 'same value or a reset to zero.
  54.  
  55. IF Marker% = 0 THEN
  56.   SelectionMade% = 0
  57.   HPointer% = 0
  58. ELSE
  59.   IF Marker% = 99 THEN
  60.     Marker% = 0
  61.   END IF
  62.   SelectionMade% = 1
  63. END IF
  64.  
  65. 'I test the condition of HPointer to see if the vertical menu has
  66. 'changed it's position, the vertical menu can increment or decrement
  67. 'the variable HPointer and controls the choice when pulldown is active.
  68.  
  69. IF Marker% > 0 THEN
  70.   IF HPointer% > Count% THEN
  71.     Pointer% = 1
  72.   ELSEIF HPointer% < 1 THEN
  73.     Pointer% = Count%
  74.   ELSE
  75.     Pointer% = HPointer%
  76.   END IF
  77. END IF
  78.  
  79. 'just paint a back ground for the horizontal menu
  80.  
  81. IF Marker% = 0 THEN
  82.   LOCATE MenuRow%,1,0
  83.   COLOR BarFG%,BarBG%
  84.   PRINT SPACE$(80);
  85. END IF
  86.  
  87. Jump:
  88.  
  89. DO
  90.  
  91. GOSUB PrintRoutine
  92.  
  93. IF SelectionMade% THEN
  94.   EXIT SUB
  95. END IF
  96.  
  97. WHILE NOT INSTAT
  98.   IF Mouse% THEN
  99.     Rgt% = 0:Lft% = 0:MRow% = 0:MCol% = 0
  100.     ShowCursor
  101.     Clicked Rgt%,Lft%,MRow%,MCol%
  102.     IF Lft% AND MRow% = MenuRow% THEN
  103.       FOR i% = 1 TO Count%
  104.         IF MCol% >= Position%(i%) AND MCol% < Position%(i%) + LEN(REMOVE$(Choices$(i%),"@")) THEN
  105.           Pointer% = i%
  106.           SelectionMade% = 1
  107.           GOTO Jump
  108.         END IF
  109.       NEXT i%
  110.     END IF
  111.   END IF
  112. WEND
  113.  
  114. Ky$ = INKEY$
  115.  
  116. IF LEN(Ky$) = 1 THEN
  117.   Chose% = ASC(Ky$)
  118. ELSE
  119.   Chose% = -ASC(RIGHT$(Ky$,1))
  120. END IF
  121.  
  122. SELECT CASE Chose%
  123.   CASE -16
  124.     TestKey$ = "Q"
  125.     GOSUB AltKeys
  126.   CASE -17
  127.     TestKey$ = "W"
  128.     GOSUB AltKeys
  129.   CASE -18
  130.     TestKey$ = "E"
  131.     GOSUB AltKeys
  132.   CASE -19
  133.     TestKey$ = "R"
  134.     GOSUB AltKeys
  135.   CASE -20
  136.     TestKey$ = "T"
  137.     GOSUB AltKeys
  138.   CASE -21
  139.     TestKey$ = "Y"
  140.     GOSUB AltKeys
  141.   CASE -22
  142.     TestKey$ = "U"
  143.     GOSUB AltKeys
  144.   CASE -23
  145.     TestKey$ = "I"
  146.     GOSUB AltKeys
  147.   CASE -24
  148.     TestKey$ = "O"
  149.     GOSUB AltKeys
  150.   CASE -25
  151.     TestKey$ = "P"
  152.     GOSUB AltKeys
  153.   CASE -30
  154.     TestKey$ = "A"
  155.     GOSUB AltKeys
  156.   CASE -31
  157.     TestKey$ = "S"
  158.     GOSUB AltKeys
  159.   CASE -32
  160.     TestKey$ = "D"
  161.     GOSUB AltKeys
  162.   CASE -33
  163.     TestKey$ = "F"
  164.     GOSUB AltKeys
  165.   CASE -34
  166.     TestKey$ = "G"
  167.     GOSUB AltKeys
  168.   CASE -35
  169.     TestKey$ = "H"
  170.     GOSUB AltKeys
  171.   CASE -36
  172.     TestKey$ = "J"
  173.     GOSUB AltKeys
  174.   CASE -37
  175.     TestKey$ = "K"
  176.     GOSUB AltKeys
  177.   CASE -38
  178.     TestKey$ = "L"
  179.     GOSUB AltKeys
  180.   CASE -44
  181.     TestKey$ = "Z"
  182.     GOSUB AltKeys
  183.   CASE -45
  184.     TestKey$ = "X"
  185.     GOSUB AltKeys
  186.   CASE -46
  187.     TestKey$ = "C"
  188.     GOSUB AltKeys
  189.   CASE -47
  190.     TestKey$ = "V"
  191.     GOSUB AltKeys
  192.   CASE -48
  193.     TestKey$ = "B"
  194.     GOSUB AltKeys
  195.   CASE -49
  196.     TestKey$ = "N"
  197.     GOSUB AltKeys
  198.   CASE -50
  199.     TestKey$ = "M"
  200.     GOSUB AltKeys
  201.   CASE -75 'left arrow
  202.     IF Pointer% THEN
  203.       IF Pointer% > 1 THEN      'if Pointer is greater than Count
  204.         DECR Pointer%
  205.       ELSE
  206.         Pointer% = Count%
  207.       END IF
  208.     ELSE
  209.       Pointer% = Count%
  210.     END IF
  211.   CASE -77 'right arrow
  212.     IF Pointer% THEN
  213.       IF Pointer% < Count% THEN  'if Pointer is greater than Count
  214.         INCR Pointer%
  215.       ELSE
  216.         Pointer% = 1
  217.       END IF
  218.     ELSE
  219.       Pointer% = 1
  220.     END IF
  221.   CASE 13  'enter key
  222.     IF Pointer% THEN
  223.       SelectionMade% = 1
  224.     END IF
  225.   CASE 65 TO 90,97 TO 122
  226.     TestKey$ = UCASE$(Ky$)
  227.     GOSUB AltKeys
  228.   CASE 27  'Esc key
  229.     SelectionMade% = 1
  230.     HPointer% = 0: Marker% = 0
  231.     Pointer% = 0: HiLight% = 0
  232.   CASE ELSE
  233.     SelectionMade% = 1
  234.     HPointer% = 0: Marker% = 0
  235.     Pointer% = 0: HiLight% = 0
  236.     BEEP
  237. END SELECT
  238.  
  239. LOOP
  240.  
  241. EXIT SUB
  242. '----------------------------------------------------------------------------
  243. AltKeys:
  244.  
  245. Ptr% = 1
  246.  
  247. FOR i% = 1 TO Count%
  248.   IF INSTR(Choices$(i%),"@") > 0 THEN
  249.     HotKeyPos% = INSTR(Choices$(i%),"@")
  250.     HotKey$ = UCASE$(MID$(Choices$(i%),(HotKeyPos% + 1),1))
  251.     IF HotKey$ = TestKey$ THEN
  252.       Pointer% = i%
  253.       Ptr% = 0
  254.       SelectionMade% = 1
  255.     END IF
  256.   END IF
  257. NEXT i%
  258.  
  259. IF Ptr% THEN
  260.   Pointer% = 0: HiLight% = 0: Marker% = 0: HPointer% = 0
  261.   SelectionMade% = 1
  262.   BEEP
  263. END IF
  264.  
  265. RETURN
  266. '----------------------------------------------------------------------------
  267. PrintRoutine:
  268.  
  269. IF HiLight% THEN
  270.   OnOff% = Hotkey%
  271. ELSE
  272.   OnOff% = BarFG%
  273. END IF
  274.  
  275. IF Mouse% THEN HideCursor
  276.  
  277. FOR k% = 1 TO Count%             'this looks for the pointer
  278.   IF k% = Pointer% THEN          'and calculates the column
  279.     IF k% > 1 THEN               'to start printing the hi lite
  280.       Total% = 0
  281.       FOR l% = 1 TO (k% - 1)
  282.         INCR Total%,(Gap%)
  283.         Fixedup$ = REMOVE$(Choices$(l%),"@")
  284.         Total% = Total% + LEN(Fixedup$)
  285.       NEXT l%
  286.       Colpos% = Total% + (Gap% + 1)
  287.     ELSE
  288.       Colpos% = Gap% + 1
  289.     END IF
  290.     COLOR HiFG%,HiBG%
  291.     LOCATE MenuRow%,Colpos%,0
  292.     Position%(k%) = Colpos%
  293.     Marker% = Colpos%
  294.     HPointer% = Pointer%
  295.     PRINT REMOVE$(Choices$(k%),"@");
  296.   ELSE
  297.     IF k% > 1 THEN                      'this determines the column
  298.       Total% = 0                        'position for printing the
  299.       FOR l% = 1 TO (k% - 1)            'rest of the menu
  300.         INCR Total%,(Gap%)
  301.         Fixedup$ = REMOVE$(Choices$(l%),"@")
  302.         Total% = Total% + LEN(Fixedup$)
  303.       NEXT l%
  304.       Colpos% = Total% + (Gap% + 1)
  305.     ELSE
  306.       Colpos% = Gap% + 1
  307.     END IF
  308.     LOCATE MenuRow%,Colpos%,0
  309.     Position%(k%) = Colpos%
  310.     IF INSTR(Choices$(k%),"@") > 0 THEN
  311.       HotKeyPos% = INSTR(Choices$(k%),"@")
  312.       Fixedup$ = REMOVE$(Choices$(k%),"@")
  313.       COLOR BarFG%,BarBG%
  314.       PRINT Fixedup$;
  315.       LOCATE MenuRow%,Colpos% + (HotKeyPos% - 1),0
  316.       COLOR OnOff%,BarBG%
  317.       HotKey$ = MID$(Choices$(k%),(HotKeyPos% + 1),1)
  318.       PRINT HotKey$;
  319.     ELSE
  320.       COLOR BarFG%,BarBG%
  321.       PRINT Choices$(k%);
  322.     END IF
  323.   END IF
  324. NEXT k%
  325.  
  326. IF Pointer% = 0 THEN
  327.   IF HiLight% = 0 THEN
  328.     EndAddress% = MenuRow% * 160
  329.     StartAddress% = EndAddress% - 160
  330.     DEF SEG = &HB800
  331.     BarSave$ = PEEK$(StartAddress%,EndAddress%)
  332.   END IF
  333. END IF
  334.  
  335. RETURN
  336. '----------------------------------------------------------------------------
  337. END SUB
  338.