DP Tool Club 15/CD_ASCQ_15_070894.iso/vrac/dnalib7a.zip/SUBMENU.BAS

BASIC Source File | 1994-05-16 | 13KB | 442 lines

DECLARE SUB Browse(FileName$,Mouse%,TextColor%,TopRow%,LeftColumn%,BottomRow%,RightColumn%,Attr%,Shadow%,Border%)
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 SUB SplitPath(FilePath$, Path$, FileName$)
DECLARE FUNCTION GetProgramName$()
DECLARE FUNCTION GetPSP%()
DECLARE FUNCTION LeftButtonReleased%()
DECLARE FUNCTION RightButtonReleased%()
DECLARE FUNCTION TRIML$(Strng$,Amount%)

SUB ScrollMenu(Choices$(),Infoline$(),Rtrn$,Mouse%,Winsize%,Tag%,Centre%,HotKey%,HelpTextColor%,HelpAttr%,HiAttr%,Attr%,TopRow%,LeftColumn%,Shadow%,Border%) PUBLIC

$CODE SEG "DNASEG2"

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

SplitPath GetProgramName$,Home$,EXEName$

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%
ELSE
  IF LEN(REMOVE$(Choices$(i%),"@")) > Maxlength% THEN
    Maxlength% = LEN(REMOVE$(Choices$(i%),"@"))
  END IF
END IF

LOOP WHILE i% = j%

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

FOR i% = 1 TO Count%
  Choices$(i%) = " " + Choices$(i%)
NEXT i%

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%
  ScrollBar% = Count% \ (Winsize% - 2)
END IF


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 ScrollMenuScreen$,TopRow%,LeftColumn%,BottomRow%,RightColumn%,Shadow%
PopWind Title$,TopRow%,LeftColumn%,BottomRow%,RightColumn%,Attr%,Shadow%,Border%

IF Mouse% THEN
  Test% = LEN(Title$)
  IF Test% THEN
    IF Test% + 12 <= RightColumn% - LeftColumn% THEN
      COLOR FGround%,BGround%
      LOCATE TopRow%,LeftColumn% + 1,0
      PRINT CHR$(91,254,93);
    ELSE
      COLOR FGround%,BGround%
      LOCATE BottomRow%,LeftColumn% + 1,0
      PRINT CHR$(91,254,93);
    END IF
  ELSE
    COLOR FGround%,BGround%
    LOCATE TopRow%,LeftColumn% + 1,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 a% = Pointer% THEN
    Fixedup$ = REMOVE$(Choices$(a%),"@")
    COLOR HiFG%,HiBG%
    LOCATE Row%,Col%,0
    MouseRow% = Row%
    PRINT Fixedup$ + SPACE$(Maxlength% - LEN(Fixedup$) + 1);
    IF LEN(Infoline$(a%)) THEN
      InfoLinePrinted% = 1
      COLOR FGround%,BGround%
      LOCATE 25,10,0
      PRINT LEFT$(SPACE$((60 - LEN(Infoline$(a%))) \ 2) + Infoline$(a%) + SPACE$(60),60);
    END IF
  ELSE
    IF INSTR(Choices$(a%),"@") > 0 THEN
      HotKeyPos% = INSTR(Choices$(a%),"@")
      Fixedup$ = REMOVE$(Choices$(a%),"@")
      Front$ = LEFT$(Fixedup$,(HotKeyPos% - 1))
      HotKey$ = MID$(Fixedup$,(HotKeyPos%),1)
      Back$ = RIGHT$(Fixedup$,LEN(Fixedup$) - HotKeyPos%)
      COLOR FGround%,BGround%
      LOCATE Row%,Col%,0
      PRINT Front$;
      COLOR HotKey%,BGround%
      PRINT HotKey$;
      COLOR FGround%,BGround%
      PRINT Back$ + SPACE$(Maxlength% - LEN(Fixedup$) + 1);
    ELSE
      COLOR FGround%,BGround%
      LOCATE Row%,Col%,0
      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
        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
      ELSE
        SELECT CASE MRow%
          CASE TopRow%
            IF MCol% = LeftColumn% + 2 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% + 2
                IF LeftButtonReleased% THEN  'Cancel Box bottom
                  Chose% = 27: 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% THEN
        IF LEN(Rtrn$) THEN
          Rtrn$ = Rtrn$
        ELSE
              Rtrn$ = REMOVE$(LTRIM$(Choices$(Pointer%)),"@")
        END IF
      ELSE
              Rtrn$ = REMOVE$(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$,REMOVE$(Choices$(Pointer%),"@"))
          Choices$(Pointer%) = " " + LTRIM$(Choices$(Pointer%),CHR$(Tag%))
        ELSE
          Choices$(Pointer%) = CHR$(Tag%) + TRIML$(Choices$(Pointer%),1)
          Rtrn$ = Rtrn$ + REMOVE$(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
      END IF
    CASE 65 TO 90,97 TO 122
          FOR m% = 1 TO Count%
            IF INSTR(Choices$(m%),"@") > 0 THEN
              HotKeyPos% = INSTR(Choices$(m%),"@")
              HotKey$ = UCASE$(MID$(Choices$(m%),(HotKeyPos% + 1),1))
              TestKey$ = UCASE$(CHR$(Chose%))
              IF HotKey$ = TestKey$ THEN
                IF Tag% THEN
                  Pointer% = m%
                  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
                ELSE
                  Rtrn$ = REMOVE$(LTRIM$(Choices$(m%)),"@")
                  SelectionMade% = 1
                  EXIT FOR
                END IF
              END IF
            END IF
          NEXT m%
    CASE -71  'home key
          Pointer% = Start%
    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 Pointer% > Start% THEN
              DECR Pointer%
            ELSEIF Start% > 1 THEN
              DECR Pointer%
              DECR Start%
              DECR Finish%
            END IF
      END IF
        CASE -59  ' F1 Help key
          IF LEN(REMOVE$(Choices$(Pointer%),ANY "@ ")) > 8 THEN
            FileName$ = LEFT$(UCASE$(REMOVE$(Choices$(Pointer%),ANY "@ ")),8) + ".HLP"
          ELSE
            FileName$ = UCASE$(REMOVE$(Choices$(Pointer%),ANY "@ ")) + ".HLP"
          END IF
          BROWSE Home$ + FileName$,Mouse%,HelpTextColor%,7,16,18,64,HelpAttr%,Shadow%,Border%
    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
          Pointer% = Finish%
    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 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
    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 -118  'Ctrl PgDown
          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
    CASE -132  'Ctrl PgUp
          IF Start% > 1 THEN
            Start% = 1
            Finish% = (Start% + (Winsize% - 1))
            Pointer% = Start%
          END IF
    CASE ELSE
          BEEP
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 SaveMouse% THEN LocateCursor MouseRow%,MCol%

IF Mouse% THEN HideCursor

IF InfoLinePrinted% = 1 THEN
  COLOR FGround%,BGround%
  LOCATE 25,15,0
  PRINT SPACE$(50);
END IF

RestoreScreen ScrollMenuScreen$,TopRow%,LeftColumn%

END SUB