Monster Media 1994 #1/monster.zip/monster/PROG_BAS/DNALIB59.ZIP/SCROLBOX.BAS

BASIC Source File | 1994-02-07 | 14KB | 495 lines

DECLARE SUB PopWind(Title$,TopRow%,LeftColumn%,BottomRow%,RightColumn%,Attr%,Shadow%,Border%)
DECLARE SUB SaveScreen(ScreenID$,TopRow%,LeftColumn%,BottomRow%,RightColumn%,Shadow%)
DECLARE SUB RestoreScreen(ScreenID$,TopRow%,LeftColumn%)
DECLARE SUB CalcByte(Attr%,LowByte%,HiByte%)
DECLARE SUB Clicked(Rgt%,Lft%,Row%,Col%)
DECLARE SUB HideCursor()
DECLARE SUB ShowCursor()
DECLARE SUB LocateCursor(Row%,Col%)
DECLARE FUNCTION LeftButtonReleased%()
DECLARE FUNCTION RightButtonReleased%()

SUB ScrollBox(Choices$(),Rtrn$,Title$,Mouse%,Winsize%,Tag%,Cntr%,Scrolling%,TextColor%,HiAttr%,Attr%,TopRow%,LeftColumn%,Shadow%,Border%) PUBLIC

CalcByte Attr%,FGround%,BGround%
CalcByte HiAttr%,HiFG%,HiBG%

i% = 0                                      'loop counter
j% = 0                                      'loop compare
Maxlength% = 0                              'string length counter

IF Mouse% THEN HideCursor

DO

INCR i%
INCR j%                                 'first find out how many
                    'strings there are and the
IF LEN (Choices$(i%)) = 0 THEN          'length of the longest one
  DECR i%
ELSEIF LEN (Choices$(i%)) > Maxlength% THEN
  Maxlength% = LEN (Choices$(i%))
END IF

LOOP WHILE i% = j%

Count% = i%
Rtrn$ = ""
INCR Maxlength%                'add a space
LessThanWinsize% = 0           'initialize to zero

IF Cntr% < 2 THEN
  FOR i% = 1 TO Count%
    Choices$(i%) = " " + Choices$(i%)
  NEXT i%
END IF

IF Count% <= Winsize% - 1 THEN
  LessThanWinsize% = 1
END IF

IF LessThanWinsize% THEN      'we need to transfer Count% to Finish%
  Finish% = Count%
  ScrollBar% = 0
ELSE                          'fixed size scrolling box
  Finish% = Winsize%
  IF Scrolling% THEN
    ScrollBar% = 0
  ELSE
    ScrollBar% = Count% \ (Winsize% - 2)
  END IF
END IF

SELECT CASE Cntr%

    CASE 1
      Centre% = 1            'centre the window

    CASE 2
      CentreText% = 1        'centre text in window

    CASE 3
      Centre% = 1            'centre both window and text
      CentreText% = 1

END SELECT

IF Centre% THEN                            'do they want it centred
  LeftColumn% = 40 - ((Maxlength% + 2) \ 2)
  RightColumn% = LeftColumn% + (Maxlength% + 2)
  TopRow% = (25 - Finish% ) \ 2
  BottomRow% = TopRow% + (Finish% + 1)
ELSE
  RightColumn% = LeftColumn% + (Maxlength% + 2)
  BottomRow% = TopRow% + (Finish% + 1)
END IF

SaveScreen ScrollScreen$,TopRow%,LeftColumn%,BottomRow%,RightColumn%,Shadow%
PopWind Title$,TopRow%,LeftColumn%,BottomRow%,RightColumn%,Attr%,Shadow%,Border%

IF Mouse% AND Scrolling% THEN
  COLOR FGround%,BGround%
  LOCATE BottomRow%,RightColumn% - 6
  PRINT CHR$(91,30,32,31,93);
END IF

IF Mouse% THEN
  Test% = LEN(Title$)
    IF Test% + 12 <= RightColumn% - LeftColumn% THEN
      COLOR FGround%,BGround%
      LOCATE TopRow%,LeftColumn% + 2,0
      PRINT CHR$(91,254,93);
    ELSE
      COLOR FGround%,BGround%
      LOCATE BottomRow%,LeftColumn% + 2,0
      PRINT CHR$(91,254,93);
    END IF
END IF

Pointer% = 1                      'initialize all these
Start% = 1
SelectionMade% = 0

DO
PrintRoutine:
IF Mouse% THEN HideCursor
Bar% = 0
Row% = TopRow% + 1
Col% = LeftColumn% + 1

FOR a% = Start% TO Finish%
  IF Scrolling% < 1 AND a% = Pointer% THEN
    COLOR HiFG%,HiBG%
    LOCATE Row%,Col%,0
    MouseRow% = Row%
    IF CentreText% THEN
      b% = (Maxlength% + 1) - LEN(Choices$(a%))
      c% = b% \ 2
      d% = b% - c%
      PRINT SPACE$(c%) + Choices$(a%) + SPACE$(d%)
    ELSE
      PRINT Choices$(a%) + SPACE$(Maxlength% - LEN(Choices$(a%)) + 1)
    END IF
  ELSE
    COLOR TextColor%,BGround%
    LOCATE Row%,Col%,0
    IF CentreText% THEN
      b% = (Maxlength% + 1) - LEN(Choices$(a%))
      c% = b% \ 2
      d% = b% - c%
      PRINT SPACE$(c%) + Choices$(a%) + SPACE$(d%)
    ELSE
      PRINT Choices$(a%) + SPACE$(Maxlength% - LEN(Choices$(a%)) + 1)
    END IF
  END IF
  IF ScrollBar% THEN
    COLOR FGround%,BGround%
    LOCATE Row%,RightColumn%,0
    IF a% = Start% THEN
      PRINT CHR$(24);
    ELSEIF a% = Finish% THEN
      PRINT CHR$(25);
    ELSE
      IF Bar% =  0 THEN
        c% = Pointer%
        FOR i% = 1 TO ScrollBar%
          b% = c% \ ScrollBar%
          IF a% = b% + Start% THEN
            Bar% = 1
            EXIT FOR
          ELSE
            INCR c%
          END IF
        NEXT i%
    IF Bar%  THEN
      PRINT CHR$(219);
        ELSE
          IF Bar% = 0 AND a% = Finish% - 1 THEN
            PRINT CHR$(219);
          ELSE
            PRINT CHR$(176);
          END IF
    END IF
      ELSE
        PRINT CHR$(176);
      END IF
    END IF
  END IF
  INCR Row%
NEXT a%

WHILE NOT INSTAT
  IF Mouse% THEN
    IF SaveMouse% THEN LocateCursor MouseRow%,MCol%
    Rgt% = 0:Lft% = 0:MRow% = 0:MCol% = 0:SaveMouse% = 0
    ShowCursor
    Clicked Rgt%,Lft%,MRow%,MCol%
    IF MRow% >= TopRow% AND MRow% =< BottomRow% AND MCol% >= LeftColumn% AND MCol% =< RightColumn% THEN
      IF MRow% > TopRow% AND MRow% < BottomRow% AND MCol% > LeftColumn% AND MCol% < RightColumn% THEN
        IF Scrolling% = 0 THEN
          HideCursor
          IF RightButtonReleased% THEN
            IF Tag% THEN
              Chose% = 32: GOTO KeyBoardRoutine
            END IF
          ELSEIF LeftButtonReleased% THEN
              Chose% = 13: GOTO KeyBoardRoutine
          END IF
          IF LessThanWinsize% THEN
            Pointer% = MRow% - TopRow%
            GOTO PrintRoutine
          ELSE
            Offset% = MRow% - (TopRow% + 1)
            Pointer% = Start% + Offset%
            GOTO PrintRoutine
          END IF
        END IF
      ELSE
        SELECT CASE MRow%
          CASE TopRow%
            IF MCol% = LeftColumn% + 3 THEN
              IF LeftButtonReleased% THEN  'Cancel Box bottom
                Chose% = 27: GOTO KeyBoardRoutine
              END IF
            END IF
          CASE TopRow% + 1
            IF MCol% = RightColumn% THEN
              IF LeftButtonReleased% THEN
                Chose% = -73: GOTO KeyBoardRoutine
              END IF
            END IF
          CASE BottomRow% - 1
            IF MCol% = RightColumn% THEN
              IF LeftButtonReleased% THEN
                Chose% = -81: GOTO KeyBoardRoutine
              END IF
            END IF
          CASE BottomRow%
            SELECT CASE MCol%
              CASE LeftColumn% + 3
                IF LeftButtonReleased% THEN  'Cancel Box bottom
                  Chose% = 27: GOTO KeyBoardRoutine
                END IF
              CASE RightColumn% - 5
                IF Scrolling% THEN
                  IF Lft% THEN Chose% = -72: GOTO KeyBoardRoutine
                END IF
              CASE RightColumn% - 3
                IF Scrolling% THEN
                  IF Lft% THEN Chose% = -80: GOTO KeyBoardRoutine
                END IF
            END SELECT
        END SELECT
      END IF
    ELSE
      IF LeftButtonReleased% THEN
        Chose% = 27: GOTO KeyBoardRoutine
      END IF
    END IF
  END IF
WEND

Ky$ = INKEY$

IF LEN(Ky$) = 1 THEN
  Chose% = ASC(Ky$)
ELSE
  Chose% = -ASC(RIGHT$(Ky$,1))
END IF

KeyBoardRoutine:

IF Mouse% THEN
  IF MRow% > TopRow% AND MRow% < BottomRow% AND_
    MCol% > LeftColumn% AND MCol% < RightColumn% THEN
    SaveMouse% = 1
    LocateCursor 1,1
  END IF
END IF

SELECT CASE Chose%
    CASE 13                          'enter key, exit and pass the
      SelectionMade% = 1                'selection to Rtrn$
      IF Tag% > 0 THEN
        IF LEN(Rtrn$) THEN
          Rtrn$ = Rtrn$
        ELSE
          Rtrn$ = "EMPTY"
        END IF
      ELSE
          Rtrn$ = LTRIM$(Choices$(Pointer%))
      END IF
    CASE 27                          'Esc key, just exit routine
      SelectionMade% = 1
      Rtrn$ = ""
    CASE 32
      IF Tag% THEN
        IF INSTR(Choices$(Pointer%),CHR$(Tag%)) THEN
          Rtrn$ = REMOVE$(Rtrn$,Choices$(Pointer%))
          Choices$(Pointer%) = " " + LTRIM$(Choices$(Pointer%),CHR$(Tag%))
        ELSE
          Choices$(Pointer%) = CHR$(Tag%) + LTRIM$(Choices$(Pointer%))
          Rtrn$ = Rtrn$ + Choices$(Pointer%)
        END IF
        IF LessThanWinsize% THEN     'it's not a scrolling box
          IF Pointer% < Finish% THEN
        INCR Pointer%
          ELSE
        Pointer% = Start%
          END IF
        ELSE                              'it's a scrolling box
          IF Pointer% < Finish% THEN
        INCR Pointer%
          ELSEIF Finish% < Count% THEN    'check to see if we have
        INCR Pointer%                 'any more choices waiting
        INCR Start%
        INCR Finish%
          END IF
        END IF
      ELSE
        IF Scrolling% THEN
          SelectionMade% = 1
        END IF
      END IF
    CASE 65 TO 90,97 TO 122
          IF Scrolling% = 0 THEN
        Found% = 0
        Marker% = Pointer%
        IF Pointer% + 1 <= Count% THEN  'search forward from pointer
          FOR i% = Pointer% + 1 TO Count%
        Temp$ = LEFT$(Choices$(i%),2)       'get two characters
        TestKey$ = UCASE$(RIGHT$(Temp$,1))  'char after the space or tag
          IF TestKey$ = UCASE$(CHR$(Chose%)) THEN 'compare first char to key
            Found% = 1
            Pointer% = i%
            IF LessThanWinsize% = 0 THEN
              IF Pointer% + Winsize% <= Count% THEN
            Finish% = Pointer% + (Winsize% - 1)
            Start% = Finish% - (Winsize% - 1)
              ELSE
            Finish% = Count%
            Start% = Finish% - (Winsize% - 1)
              END IF
            END IF
            EXIT FOR
          END IF
          NEXT i%
        END IF
        IF Found% = 0 THEN
          FOR j% = 1 TO Pointer%
        Temp$ = LEFT$(Choices$(j%),2)
        TestKey$ = UCASE$(RIGHT$(Temp$,1))
          IF TestKey$ = UCASE$(CHR$(Chose%)) THEN
            Found% = 1
            Pointer% = j%
            IF Pointer% = Marker% THEN
              BEEP:EXIT FOR
            ELSE
              IF LessThanWinsize% = 0 THEN
            IF Pointer% + Winsize% <= Count% THEN
              Finish% = Pointer% + (Winsize% - 1)
              Start% = Finish% - (Winsize% - 1)
            ELSE
              Finish% = Count%
              Start% = Finish% - (Winsize% - 1)
            END IF
              END IF
            END IF
            EXIT FOR
          END IF
          NEXT j%
        END IF
        IF Found% = 0 THEN
          BEEP
        END IF
      ELSE
        SelectionMade% = 1
      END IF
    CASE -71  'home key
      IF Scrolling% THEN
        IF Start% > 1 THEN
          Start% = 1
          Finish% = (Start% + (Winsize% - 1))
              Pointer% = Start%
        END IF
      ELSE
        Pointer% = Start%
      END IF
    CASE -72  'up arrow
      IF LessThanWinsize% THEN    'it's not a scrolling box
        IF Pointer% > Start% THEN
          DECR Pointer%
        ELSE
          Pointer% = Finish%
        END IF
      ELSE                            'it's a scrolling box
        IF Scrolling% THEN
          IF Start% > 1 THEN
        DECR Start%
        DECR Finish%
                DECR Pointer%
          END IF
        ELSE
          IF Pointer% > Start% THEN
        DECR Pointer%
          ELSEIF Start% > 1 THEN
        DECR Pointer%
        DECR Start%
        DECR Finish%
          END IF
        END IF
      END IF
    CASE -73  'page up
      IF Start% - (Winsize% - 1) >= 1 THEN    'this block handles the
        DECR Start%,(Winsize% - 1)            'pageing
        DECR Pointer%,(Winsize% - 1)
        DECR Finish%,(Winsize% - 1)
      ELSE
        Pointer% = 1
        Start% = 1
        IF LessThanWinsize% THEN    'if we jump back to Start% make
          Finish% = Count%              'sure we check to see what kind
        ELSE                            'of scroll box and set Finish%
          Finish% = Winsize%            'accordingly
        END IF
      END IF
    CASE -79  'end key
      IF Scrolling% THEN                      'if we are using the
        IF Finish < Count% THEN                   'routine as a scroll
          Start% = (Count% - (Winsize% - 1))      'box, and not a pick
          Finish% = Count%                        'list we handle
              Pointer% = Count%
        END IF
      ELSE
        Pointer% = Finish%
      END IF
    CASE -80  'down arrow
      IF LessThanWinsize% THEN    'it's not a scrolling box
        IF Pointer% < Finish% THEN
          INCR Pointer%
        ELSE
          Pointer% = Start%
        END IF
      ELSE                            'it's a scrolling box
        IF Scrolling% THEN
          IF Finish% < Count% THEN
        INCR Start%
        INCR Finish%
                INCR Pointer%
          END IF
        ELSE
          IF Pointer% < Finish% THEN
        INCR Pointer%
          ELSEIF Finish% < Count% THEN    'check to see if we have
        INCR Pointer%                 'any more choices waiting
        INCR Start%
        INCR Finish%
          END IF
        END IF
      END IF
    CASE -81  'page down
      IF Finish% + (Winsize% - 1) <= Count% THEN    'this block handles
        INCR Start%,(Winsize% - 1)                  'the pageing
        INCR Finish%,(Winsize% - 1)
        INCR Pointer%,(Winsize% - 1)
      ELSE
        Pointer% = Count%
        Finish% = Count%
        IF LessThanWinsize% THEN       'if we jump to Finish% make
          Start% = 1                       'sure we check to see what
        ELSE                               'kind of scroll box and set
          Start% = Count% - (Winsize% - 1) 'Start% accordingly
        END IF
      END IF
    CASE ELSE
      IF Scrolling% THEN
        SelectionMade% = 1
      ELSE
        BEEP
      END IF
END SELECT



LOOP UNTIL SelectionMade%



FOR i% = 1 TO Count%
  IF INSTR(Choices$(i%),CHR$(Tag%)) THEN
    Choices$(i%) = LTRIM$(Choices$(i%),CHR$(Tag%)) 'remove tag char
  ELSE
    Choices$(i%) = LTRIM$(Choices$(i%))            'remove the space
  END IF
NEXT i%

IF Mouse% THEN HideCursor
IF SaveMouse% THEN LocateCursor MouseRow%,MCol%

RestoreScreen ScrollScreen$,TopRow%,LeftColumn%

END SUB