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