home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 15 / CD_ASCQ_15_070894.iso / vrac / dnalib7a.zip / VERTMENU.BAS < prev    next >
BASIC Source File  |  1994-05-16  |  8KB  |  307 lines
  1. DECLARE SUB Browse(FileName$,Mouse%,TextColor%,TopRow%,LeftColumn%,BottomRow%,RightColumn%,Attr%,Shadow%,Border%)
  2. DECLARE SUB PopWind(Title$,TopRow%,LeftColumn%,BottomRow%,RightColumn%,Attr%,Shadow%,Border%)
  3. DECLARE SUB SaveScreen(ScreenID$,TopRow%,LeftColumn%,BottomRow%,RightColumn%,Shadow%)
  4. DECLARE SUB SplitPath(FilePath$, Path$, FileName$)
  5. DECLARE SUB RestoreScreen(ScreenID$,TopRow%,LeftColumn%)
  6. DECLARE SUB CalcByte(Attr%,LowByte%,HiByte%)
  7. DECLARE SUB Clicked(Rgt%,Lft%,Row%,Col%)
  8. DECLARE SUB FindMenu(Row%,Col%,Found%)
  9. DECLARE SUB HideCursor()
  10. DECLARE SUB ShowCursor()
  11. DECLARE FUNCTION LeftButtonReleased%()
  12. DECLARE FUNCTION GetProgramName$()
  13. DECLARE FUNCTION GetPSP%()
  14.  
  15. SUB VerticalMenu(Choices$(),Infoline$(),Rtrn$,BarSave$,Mouse%,HotKey%,HelpTextColor%,HelpAttr%,HiAttr%,MenuRow%,Marker%,HPointer%,Attr%,Shadow%,Border%) PUBLIC
  16.  
  17. $CODE SEG "DNASEG2"
  18.  
  19. IF Mouse% THEN HideCursor
  20.  
  21. CalcByte Attr%,FGround%,BGround%
  22. CalcByte HiAttr%,HiFG%,HiBG%
  23.  
  24. SplitPath GetProgramName$,Home$,EXEName$
  25.  
  26. SELECT CASE Border%
  27.   CASE 1,3
  28.     Leftside% = 195
  29.     Middle% = 196
  30.     Rightside% = 180
  31.   CASE 2,4
  32.     Leftside% = 199
  33.     Middle% = 196
  34.     Rightside% = 182
  35.   CASE ELSE
  36.     Leftside% = 32
  37.     Middle% = 32
  38.     Rightside% = 32
  39. END SELECT
  40.  
  41. i% = 0                                      'loop counter
  42. j% = 0                                      'loop compare
  43. Maxlength% = 0                              'string length counter
  44. Colpos% = Marker%
  45. LeftColumn% = Colpos%
  46. TopRow% = MenuRow% + 1
  47.  
  48. DO
  49.  
  50. INCR i%
  51. INCR j%                                 'first find out how many
  52.                                         'strings there are and the
  53. IF LEN (Choices$(i%)) = 0 THEN          'length of the longest one
  54.  DECR i%
  55. ELSEIF LEN(REMOVE$(Choices$(i%),"@")) > Maxlength% THEN
  56.  Maxlength% = LEN(REMOVE$(Choices$(i%),"@"))
  57. END IF
  58.  
  59. LOOP WHILE i% = j%
  60.  
  61. Count% = i%
  62.  
  63. INCR Maxlength%              'add a space
  64.  
  65. 'a simple test to see what size the window will be with the shadow
  66.  
  67. IF Shadow% = 1 THEN
  68.   b% = 5
  69. ELSE
  70.   b% = 3
  71. END IF
  72.  
  73.  
  74. 'test the position of the menu to see if it fits and adjust
  75. 'its position if its off the screen
  76.  
  77. IF LeftColumn% + (Maxlength% + b%) >= 80 THEN
  78.   LeftColumn% = 80 - (Maxlength% + b%)
  79. END IF
  80.  
  81. 'work out the size of the window to pass to PopWind
  82.  
  83. RightColumn% = LeftColumn% + (Maxlength% + 2)
  84. BottomRow% = TopRow% + (Count% + 1)
  85.  
  86. 'this saves just the area under the pulled down window
  87.  
  88. SaveScreen VertScreen$,TopRow%,LeftColumn%,BottomRow%,RightColumn%,Shadow%
  89.  
  90. PopWind Title$,TopRow%,LeftColumn%,BottomRow%,RightColumn%,Attr%,Shadow%,Border%
  91.  
  92. Pointer% = 1                      'initialize all these
  93. SelectionMade% = 0
  94.  
  95.  
  96. DO
  97.  
  98. PrintRoutine:
  99.  
  100. IF Mouse% THEN HideCursor
  101.  
  102. Row% = TopRow% + 1
  103. Col% = LeftColumn% + 1
  104.  
  105. FOR a% = 1 TO Count%
  106.   IF a% = Pointer% THEN
  107.     Fixedup$ = REMOVE$(Choices$(a%),"@")
  108.     COLOR HiFG%,HiBG%
  109.     LOCATE Row%,Col%,0
  110.     PRINT SPACE$(1) + Fixedup$ + SPACE$(Maxlength% - LEN(Fixedup$));
  111.     IF LEN(Infoline$(a%)) > 0 THEN
  112.       InfoLinePrinted% = 1
  113.       COLOR FGround%,BGround%
  114.       LOCATE 25,10,0
  115.       PRINT LEFT$(SPACE$((60 - LEN(Infoline$(a%))) \ 2) + Infoline$(a%) + SPACE$(60),60);
  116.     END IF
  117.   ELSE
  118.     IF INSTR(Choices$(a%),"@") > 0 THEN
  119.       HotKeyPos% = INSTR(Choices$(a%),"@")
  120.       Fixedup$ = REMOVE$(Choices$(a%),"@")
  121.       Front$ = LEFT$(Fixedup$,(HotKeyPos% - 1))
  122.       HotKey$ = MID$(Fixedup$,(HotKeyPos%),1)
  123.       Back$ = RIGHT$(Fixedup$,LEN(Fixedup$) - HotKeyPos%)
  124.       COLOR FGround%,BGround%
  125.       LOCATE Row%,Col%,0
  126.       PRINT SPACE$(1) + Front$;
  127.       COLOR HotKey%,BGround%
  128.       PRINT HotKey$;
  129.       COLOR FGround%,BGround%
  130.       PRINT Back$ + SPACE$(Maxlength% - LEN(Fixedup$));
  131.     ELSE
  132.       IF INSTR(Choices$(a%),"_") THEN
  133.         COLOR FGround%,BGround%
  134.         LOCATE Row%,LeftColumn%,0
  135.         PRINT CHR$(Leftside%) + STRING$(Maxlength% + 1,Middle%) + CHR$(Rightside%);
  136.       ELSE
  137.         COLOR FGround%,BGround%
  138.         LOCATE Row%,Col%,0
  139.         PRINT SPACE$(1) + Choices$(a%) + SPACE$(Maxlength% - LEN(Choices$(a%)));
  140.       END IF
  141.     END IF
  142.   END IF
  143.   INCR Row%
  144. NEXT a%
  145.  
  146. WHILE NOT INSTAT
  147.   IF Mouse% THEN
  148.     Rgt% = 0:Lft% = 0:MRow% = 0:MCol% = 0
  149.     ShowCursor
  150.     Clicked Rgt%,Lft%,MRow%,MCol%
  151.     IF MRow% > TopRow% AND MRow% < BottomRow% AND MCol% > LeftColumn% AND MCol% < RightColumn% THEN
  152.       SELECT CASE MRow%
  153.         CASE Pointer% + TopRow%
  154.           IF LeftButtonReleased% THEN
  155.             Chose% = 13
  156.             HideCursor
  157.             GOTO KeyBoardRoutine
  158.           END IF
  159.         CASE ELSE
  160.           IF Lft% THEN
  161.             FOR i% = (TopRow% + 1) TO (Count% + TopRow% + 1)
  162.               IF i% = MRow% THEN
  163.                 Pointer% = i% - TopRow%
  164.                 IF ISFALSE INSTR(Choices$(Pointer%),"_")  THEN
  165.                   GOTO PrintRoutine
  166.                 END IF
  167.               END IF
  168.             NEXT i%
  169.           END IF
  170.       END SELECT
  171.     ELSE
  172.       IF Lft% AND MRow% = MenuRow% THEN
  173.         FindMenu MRow%,MCol%,Found%
  174.         IF Found% AND Found% <> HPointer% THEN
  175.           HPointer% = Found%
  176.           Rtrn$ = ""
  177.           HideCursor
  178.           GOTO WayOut
  179.         END IF
  180.       ELSE
  181.         IF LeftButtonReleased% THEN
  182.           Chose% = 27
  183.           HideCursor
  184.           GOTO KeyBoardRoutine
  185.         END IF
  186.       END IF
  187.     END IF
  188.   END IF
  189. WEND
  190.  
  191. Ky$ = INKEY$
  192.  
  193.  
  194. IF LEN(Ky$) = 1 THEN
  195.   Chose% = ASC(Ky$)
  196. ELSE
  197.   Chose% = -ASC(RIGHT$(Ky$,1))
  198. END IF
  199.  
  200. KeyBoardRoutine:
  201.  
  202. SELECT CASE Chose%
  203.  
  204.         CASE 13   'enter key
  205.           Rtrn$ = REMOVE$(Choices$(Pointer%),"@")
  206.           SelectionMade% = 1
  207.           Marker% = 0
  208.  
  209.         CASE 27   'Esc key
  210.           Marker% = 0
  211.           SelectionMade% = 1
  212.           Rtrn$ = ""
  213.  
  214.         CASE -59  ' F1 Help key
  215.           IF LEN(REMOVE$(Choices$(Pointer%),ANY "@ ")) > 8 THEN
  216.             FileName$ = LEFT$(UCASE$(REMOVE$(Choices$(Pointer%),ANY "@ ")),8) + ".HLP"
  217.           ELSE
  218.             FileName$ = UCASE$(REMOVE$(Choices$(Pointer%),ANY "@ ")) + ".HLP"
  219.           END IF
  220.           BROWSE Home$ + FileName$,Mouse%,HelpTextColor%,7,16,18,64,HelpAttr%,Shadow%,Border%
  221.  
  222.         CASE -71  'home key
  223.           Pointer% = 1
  224.  
  225.         CASE -72  'up arrow
  226.           IF Pointer% > 1 THEN
  227.             DECR Pointer%
  228.           ELSE
  229.             Pointer% = Count%
  230.           END IF
  231.           IF INSTR(Choices$(Pointer%),"_")  THEN
  232.             IF Pointer% > 1 THEN
  233.               DECR Pointer%
  234.             ELSE
  235.               Pointer% = Count%
  236.             END IF
  237.           END IF
  238.  
  239.         CASE -75 'left arrow
  240.           DECR HPointer%
  241.           SelectionMade% = 1
  242.           Rtrn$ = ""
  243.  
  244.         CASE -77 'right arrow
  245.           INCR HPointer%
  246.           SelectionMade% = 1
  247.           Rtrn$ = ""
  248.  
  249.         CASE -79  'end key
  250.           Pointer% = Count%
  251.  
  252.         CASE -80  'down arrow
  253.           IF Pointer% < Count% THEN
  254.             INCR Pointer%
  255.           ELSE
  256.             Pointer% = 1
  257.           END IF
  258.           IF INSTR(Choices$(Pointer%),"_")  THEN
  259.             IF Pointer% < Count% THEN
  260.               INCR Pointer%
  261.             ELSE
  262.               Pointer% = 1
  263.             END IF
  264.           END IF
  265.  
  266.         CASE 32 TO 90, 97 TO 122
  267.           FOR m% = 1 TO Count%
  268.             IF INSTR(Choices$(m%),"@") > 0 THEN
  269.               HotKeyPos% = INSTR(Choices$(m%),"@")
  270.               HotKey$ = UCASE$(MID$(Choices$(m%),(HotKeyPos% + 1),1))
  271.               TestKey$ = UCASE$(CHR$(Chose%))
  272.               IF HotKey$ = TestKey$ THEN
  273.                 Rtrn$ = REMOVE$(Choices$(m%),"@")
  274.                 SelectionMade% = 1
  275.                 Marker% = 0
  276.                 EXIT FOR
  277.               END IF
  278.             END IF
  279.           NEXT m%
  280.  
  281.         CASE ELSE
  282.           BEEP
  283.  
  284. END SELECT
  285.  
  286.  
  287. LOOP UNTIL SelectionMade% = 1
  288.  
  289. WayOut:
  290.  
  291. IF Mouse% THEN HideCursor
  292.  
  293. RestoreScreen VertScreen$,TopRow%,LeftColumn%
  294.  
  295. DEF SEG = &HB800
  296. StartAddress% = (MenuRow% * 160) - 160
  297. POKE$ StartAddress%,BarSave$
  298. DEF SEG
  299.  
  300. IF InfoLinePrinted% = 1 THEN
  301.   COLOR FGround%,BGround%
  302.   LOCATE 25,15,0
  303.   PRINT SPACE$(50);
  304. END IF
  305.  
  306. END SUB
  307.