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