home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 15 / CD_ASCQ_15_070894.iso / vrac / dnalib7a.zip / SCROLBOX.BAS < prev    next >
BASIC Source File  |  1994-05-16  |  13KB  |  422 lines
  1. DECLARE SUB PopWind(Title$,TopRow%,LeftColumn%,BottomRow%,RightColumn%,Attr%,Shadow%,Border%)
  2. DECLARE SUB SaveScreen(ScreenID$,TopRow%,LeftColumn%,BottomRow%,RightColumn%,Shadow%)
  3. DECLARE SUB RestoreScreen(ScreenID$,TopRow%,LeftColumn%)
  4. DECLARE SUB CalcByte(Attr%,LowByte%,HiByte%)
  5. DECLARE SUB Clicked(Rgt%,Lft%,Row%,Col%)
  6. DECLARE SUB HideCursor()
  7. DECLARE SUB ShowCursor()
  8. DECLARE SUB LocateCursor(Row%,Col%)
  9. DECLARE FUNCTION LeftButtonReleased%()
  10. DECLARE FUNCTION RightButtonReleased%()
  11. DECLARE FUNCTION TRIML$(Strng$,Amount%)
  12.  
  13. SUB ScrollBox(Choices$(),Rtrn$,Title$,Mouse%,Winsize%,Tag%,Centre%,DefaultPointer%,HiAttr%,Attr%,TopRow%,LeftColumn%,Shadow%,Border%) PUBLIC
  14.  
  15. $CODE SEG "DNASEG1"
  16.  
  17. CalcByte Attr%,FGround%,BGround%
  18. CalcByte HiAttr%,HiFG%,HiBG%
  19.  
  20. i% = 0                                      'loop counter
  21. j% = 0                                      'loop compare
  22. Maxlength% = 0                              'string length counter
  23.  
  24. IF Mouse% THEN HideCursor
  25.  
  26. DO
  27.  
  28. INCR i%
  29. INCR j%                                 'first find out how many
  30.                     'strings there are and the
  31. IF LEN (Choices$(i%)) = 0 THEN          'length of the longest one
  32.   DECR i%
  33. ELSE
  34.   IF LEN (Choices$(i%)) > Maxlength% THEN Maxlength% = LEN (Choices$(i%))
  35. END IF
  36.  
  37. LOOP WHILE i% = j%
  38.  
  39. Count% = i%
  40. Rtrn$ = ""
  41. INCR Maxlength%                'add a space
  42. LessThanWinsize% = 0           'initialize to zero
  43.  
  44. FOR i% = 1 TO Count%
  45.   Choices$(i%) = " " + Choices$(i%)
  46. NEXT i%
  47.  
  48. IF Count% <= Winsize% - 1 THEN
  49.   LessThanWinsize% = 1
  50. END IF
  51.  
  52. IF LessThanWinsize% THEN      'we need to transfer Count% to Finish%
  53.   Finish% = Count%
  54.   ScrollBar% = 0
  55. ELSE                          'fixed size scrolling box
  56.   Finish% = Winsize%
  57.   ScrollBar% = Count% \ (Winsize% - 2)
  58. END IF
  59.  
  60. IF Centre% THEN                            'do they want it centred
  61.   LeftColumn% = 40 - ((Maxlength% + 2) \ 2)
  62.   RightColumn% = LeftColumn% + (Maxlength% + 2)
  63.   TopRow% = (25 - Finish% ) \ 2
  64.   BottomRow% = TopRow% + (Finish% + 1)
  65. ELSE
  66.   RightColumn% = LeftColumn% + (Maxlength% + 2)
  67.   BottomRow% = TopRow% + (Finish% + 1)
  68. END IF
  69.  
  70. SaveScreen ScrollScreen$,TopRow%,LeftColumn%,BottomRow%,RightColumn%,Shadow%
  71. PopWind Title$,TopRow%,LeftColumn%,BottomRow%,RightColumn%,Attr%,Shadow%,Border%
  72.  
  73. IF Mouse% THEN
  74.   Test% = LEN(Title$)
  75.   IF Test% THEN
  76.     IF Test% + 12 <= RightColumn% - LeftColumn% THEN
  77.       COLOR FGround%,BGround%
  78.       LOCATE TopRow%,LeftColumn% + 1,0
  79.       PRINT CHR$(91,254,93);
  80.     ELSE
  81.       COLOR FGround%,BGround%
  82.       LOCATE BottomRow%,LeftColumn% + 1,0
  83.       PRINT CHR$(91,254,93);
  84.     END IF
  85.   ELSE
  86.     COLOR FGround%,BGround%
  87.     LOCATE TopRow%,LeftColumn% + 1,0
  88.     PRINT CHR$(91,254,93);
  89.   END IF
  90. END IF
  91.  
  92. IF DefaultPointer% THEN
  93.   IF DefaultPointer% <= Count% THEN
  94.     Pointer% = DefaultPointer%
  95.     IF LessThanWinsize% THEN
  96.       Start% = 1
  97.     ELSE
  98.       IF Pointer% + (Winsize% - 1) <= Count% THEN
  99.         Start% = Pointer%: Finish% = Pointer% + (Winsize% - 1)
  100.       ELSE
  101.         IF Count% - (Winsize% - 1) >= Pointer% THEN
  102.           Start% = Count% - (Winsize% - 1): Finish% = Count%
  103.         END IF
  104.       END IF
  105.     END IF
  106.   ELSE
  107.     Pointer% = 1
  108.     Start% = 1
  109.   END IF
  110. ELSE
  111.   Pointer% = 1
  112.   Start% = 1
  113. END IF
  114.  
  115. SelectionMade% = 0
  116.  
  117. DO
  118.  
  119. PrintRoutine:
  120.  
  121. IF Mouse% THEN HideCursor
  122. Bar% = 0
  123. Row% = TopRow% + 1
  124. Col% = LeftColumn% + 1
  125.  
  126. FOR a% = Start% TO Finish%
  127.   IF a% = Pointer% THEN
  128.     COLOR HiFG%,HiBG%
  129.     LOCATE Row%,Col%,0
  130.     MouseRow% = Row%
  131.     PRINT Choices$(a%) + SPACE$(Maxlength% - LEN(Choices$(a%)) + 1)
  132.   ELSE
  133.     COLOR FGround%,BGround%
  134.     LOCATE Row%,Col%,0
  135.     PRINT Choices$(a%) + SPACE$(Maxlength% - LEN(Choices$(a%)) + 1)
  136.   END IF
  137.   IF ScrollBar% THEN
  138.     COLOR FGround%,BGround%
  139.     LOCATE Row%,RightColumn%,0
  140.     IF a% = Start% THEN
  141.       PRINT CHR$(24);
  142.     ELSEIF a% = Finish% THEN
  143.       PRINT CHR$(25);
  144.     ELSE
  145.       IF Bar% =  0 THEN
  146.         c% = Pointer%
  147.         FOR i% = 1 TO ScrollBar%
  148.           b% = c% \ ScrollBar%
  149.           IF a% = b% + Start% THEN
  150.             Bar% = 1
  151.             EXIT FOR
  152.           ELSE
  153.             INCR c%
  154.           END IF
  155.         NEXT i%
  156.     IF Bar%  THEN
  157.       PRINT CHR$(219);
  158.         ELSE
  159.           IF Bar% = 0 AND a% = Finish% - 1 THEN
  160.             PRINT CHR$(219);
  161.           ELSE
  162.             PRINT CHR$(176);
  163.           END IF
  164.     END IF
  165.       ELSE
  166.         PRINT CHR$(176);
  167.       END IF
  168.     END IF
  169.   END IF
  170.   INCR Row%
  171. NEXT a%
  172.  
  173. WHILE NOT INSTAT
  174.   IF Mouse% THEN
  175.     IF SaveMouse% THEN LocateCursor MouseRow%,MCol%
  176.     Rgt% = 0:Lft% = 0:MRow% = 0:MCol% = 0:SaveMouse% = 0
  177.     ShowCursor
  178.     Clicked Rgt%,Lft%,MRow%,MCol%
  179.     IF MRow% >= TopRow% AND MRow% =< BottomRow% AND MCol% >= LeftColumn% AND MCol% =< RightColumn% THEN
  180.       IF MRow% > TopRow% AND MRow% < BottomRow% AND MCol% > LeftColumn% AND MCol% < RightColumn% THEN
  181.         HideCursor
  182.         IF RightButtonReleased% THEN
  183.           IF Tag% THEN
  184.             Chose% = 32: GOTO KeyBoardRoutine
  185.           END IF
  186.         ELSEIF LeftButtonReleased% THEN
  187.           Chose% = 13: GOTO KeyBoardRoutine
  188.         END IF
  189.         IF LessThanWinsize% THEN
  190.           Pointer% = MRow% - TopRow%
  191.           GOTO PrintRoutine
  192.         ELSE
  193.           Offset% = MRow% - (TopRow% + 1)
  194.           Pointer% = Start% + Offset%
  195.           GOTO PrintRoutine
  196.         END IF
  197.       ELSE
  198.         SELECT CASE MRow%
  199.           CASE TopRow%
  200.             IF MCol% = LeftColumn% + 2 THEN
  201.               IF LeftButtonReleased% THEN  'Cancel Box bottom
  202.                 Chose% = 27: GOTO KeyBoardRoutine
  203.               END IF
  204.             END IF
  205.           CASE TopRow% + 1
  206.             IF MCol% = RightColumn% THEN
  207.               IF LeftButtonReleased% THEN
  208.                 Chose% = -73: GOTO KeyBoardRoutine
  209.               END IF
  210.             END IF
  211.           CASE BottomRow% - 1
  212.             IF MCol% = RightColumn% THEN
  213.               IF LeftButtonReleased% THEN
  214.                 Chose% = -81: GOTO KeyBoardRoutine
  215.               END IF
  216.             END IF
  217.           CASE BottomRow%
  218.             SELECT CASE MCol%
  219.               CASE LeftColumn% + 2
  220.                 IF LeftButtonReleased% THEN  'Cancel Box bottom
  221.                   Chose% = 27: GOTO KeyBoardRoutine
  222.                 END IF
  223.             END SELECT
  224.         END SELECT
  225.       END IF
  226.     ELSE
  227.       IF LeftButtonReleased% THEN
  228.         Chose% = 27: GOTO KeyBoardRoutine
  229.       END IF
  230.     END IF
  231.   END IF
  232. WEND
  233.  
  234. Ky$ = INKEY$
  235.  
  236. IF LEN(Ky$) = 1 THEN
  237.   Chose% = ASC(Ky$)
  238. ELSE
  239.   Chose% = -ASC(RIGHT$(Ky$,1))
  240. END IF
  241.  
  242. KeyBoardRoutine:
  243.  
  244. IF Mouse% THEN
  245.   IF MRow% > TopRow% AND MRow% < BottomRow% AND_
  246.     MCol% > LeftColumn% AND MCol% < RightColumn% THEN
  247.     SaveMouse% = 1
  248.     LocateCursor 1,1
  249.   END IF
  250. END IF
  251.  
  252. SELECT CASE Chose%
  253.     CASE 13                          'enter key, exit and pass the
  254.       SelectionMade% = 1                'selection to Rtrn$
  255.       IF Tag% > 0 THEN
  256.         IF LEN(Rtrn$) THEN
  257.           Rtrn$ = Rtrn$
  258.         ELSE
  259.           Rtrn$ = ""
  260.         END IF
  261.       ELSE
  262.           Rtrn$ = LTRIM$(Choices$(Pointer%))
  263.       END IF
  264.     CASE 27                          'Esc key, just exit routine
  265.       SelectionMade% = 1
  266.       Rtrn$ = ""
  267.     CASE 32
  268.       IF Tag% THEN
  269.         IF INSTR(Choices$(Pointer%),CHR$(Tag%)) THEN
  270.           Rtrn$ = REMOVE$(Rtrn$,Choices$(Pointer%))
  271.           Choices$(Pointer%) = " " + LTRIM$(Choices$(Pointer%),CHR$(Tag%))
  272.         ELSE
  273.           Choices$(Pointer%) = CHR$(Tag%) + TRIML$(Choices$(Pointer%),1)
  274.           Rtrn$ = Rtrn$ + Choices$(Pointer%)
  275.         END IF
  276.         IF LessThanWinsize% THEN     'it's not a scrolling box
  277.           IF Pointer% < Finish% THEN
  278.         INCR Pointer%
  279.           ELSE
  280.         Pointer% = Start%
  281.           END IF
  282.         ELSE                              'it's a scrolling box
  283.           IF Pointer% < Finish% THEN
  284.         INCR Pointer%
  285.           ELSEIF Finish% < Count% THEN    'check to see if we have
  286.         INCR Pointer%                 'any more choices waiting
  287.         INCR Start%
  288.         INCR Finish%
  289.           END IF
  290.         END IF
  291.       END IF
  292.     CASE 65 TO 90,97 TO 122
  293.           Found% = 0: Marker% = Pointer%
  294.           IF Pointer% + 1 <= Count% THEN  'search forward from pointer
  295.             FOR i% = Pointer% + 1 TO Count%
  296.               Temp$ = LEFT$(Choices$(i%),2)       'get two characters
  297.               TestKey$ = UCASE$(RIGHT$(Temp$,1))  'char after the space or tag
  298.               IF TestKey$ = UCASE$(CHR$(Chose%)) THEN 'compare first char to key
  299.                 Found% = 1
  300.                 Pointer% = i%
  301.                 IF LessThanWinsize% = 0 THEN
  302.                   IF Pointer% + Winsize% <= Count% THEN
  303.                     Finish% = Pointer% + (Winsize% - 1)
  304.                     Start% = Finish% - (Winsize% - 1)
  305.                   ELSE
  306.                     Finish% = Count%
  307.                     Start% = Finish% - (Winsize% - 1)
  308.                   END IF
  309.                 END IF
  310.                   EXIT FOR
  311.               END IF
  312.             NEXT i%
  313.           END IF
  314.           IF Found% = 0 THEN
  315.             FOR j% = 1 TO Pointer%
  316.               Temp$ = LEFT$(Choices$(j%),2)
  317.               TestKey$ = UCASE$(RIGHT$(Temp$,1))
  318.               IF TestKey$ = UCASE$(CHR$(Chose%)) THEN
  319.                 Found% = 1: Pointer% = j%
  320.                 IF Pointer% = Marker% THEN
  321.                   BEEP: EXIT FOR
  322.                 ELSE
  323.                   IF LessThanWinsize% = 0 THEN
  324.                     IF Pointer% + Winsize% <= Count% THEN
  325.                       Finish% = Pointer% + (Winsize% - 1)
  326.                       Start% = Finish% - (Winsize% - 1)
  327.                     ELSE
  328.                       Finish% = Count%
  329.                       Start% = Finish% - (Winsize% - 1)
  330.                     END IF
  331.                   END IF
  332.                 END IF
  333.                   EXIT FOR
  334.               END IF
  335.             NEXT j%
  336.           END IF
  337.           IF Found% = 0 THEN
  338.             BEEP
  339.           END IF
  340.     CASE -71  'home key
  341.           Pointer% = Start%
  342.     CASE -72  'up arrow
  343.       IF LessThanWinsize% THEN    'it's not a scrolling box
  344.         IF Pointer% > Start% THEN
  345.           DECR Pointer%
  346.         ELSE
  347.           Pointer% = Finish%
  348.         END IF
  349.       ELSE                            'it's a scrolling box
  350.             IF Pointer% > Start% THEN
  351.               DECR Pointer%
  352.             ELSEIF Start% > 1 THEN
  353.               DECR Pointer%
  354.               DECR Start%
  355.               DECR Finish%
  356.             END IF
  357.       END IF
  358.     CASE -73  'page up
  359.       IF Start% - (Winsize% - 1) >= 1 THEN    'this block handles the
  360.         DECR Start%,(Winsize% - 1)            'pageing
  361.         DECR Pointer%,(Winsize% - 1)
  362.         DECR Finish%,(Winsize% - 1)
  363.       ELSE
  364.         Pointer% = 1: Start% = 1
  365.         IF LessThanWinsize% THEN    'if we jump back to Start% make
  366.           Finish% = Count%              'sure we check to see what kind
  367.         ELSE                            'of scroll box and set Finish%
  368.           Finish% = Winsize%            'accordingly
  369.         END IF
  370.       END IF
  371.     CASE -79  'end key
  372.           Pointer% = Finish%
  373.     CASE -80  'down arrow
  374.       IF LessThanWinsize% THEN    'it's not a scrolling box
  375.         IF Pointer% < Finish% THEN
  376.           INCR Pointer%
  377.         ELSE
  378.           Pointer% = Start%
  379.         END IF
  380.       ELSE                            'it's a scrolling box
  381.             IF Pointer% < Finish% THEN
  382.               INCR Pointer%
  383.             ELSEIF Finish% < Count% THEN    'check to see if we have
  384.               INCR Pointer%                 'any more choices waiting
  385.               INCR Start%
  386.               INCR Finish%
  387.             END IF
  388.       END IF
  389.     CASE -81  'page down
  390.       IF Finish% + (Winsize% - 1) <= Count% THEN    'this block handles
  391.         INCR Start%,(Winsize% - 1)                  'the pageing
  392.         INCR Finish%,(Winsize% - 1)
  393.         INCR Pointer%,(Winsize% - 1)
  394.       ELSE
  395.         Pointer% = Count%: Finish% = Count%
  396.         IF LessThanWinsize% THEN       'if we jump to Finish% make
  397.           Start% = 1                       'sure we check to see what
  398.         ELSE                               'kind of scroll box and set
  399.           Start% = Count% - (Winsize% - 1) 'Start% accordingly
  400.         END IF
  401.       END IF
  402.     CASE ELSE
  403.           BEEP
  404. END SELECT
  405.  
  406. LOOP UNTIL SelectionMade%
  407.  
  408. FOR i% = 1 TO Count%
  409.   IF INSTR(Choices$(i%),CHR$(Tag%)) THEN
  410.     Choices$(i%) = LTRIM$(Choices$(i%),CHR$(Tag%)) 'remove tag char
  411.   ELSE
  412.     Choices$(i%) = LTRIM$(Choices$(i%))            'remove the space
  413.   END IF
  414. NEXT i%
  415.  
  416. IF SaveMouse% THEN LocateCursor MouseRow%,MCol%
  417.  
  418. IF Mouse% THEN HideCursor
  419.  
  420. RestoreScreen ScrollScreen$,TopRow%,LeftColumn%
  421.  
  422. END SUB