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