Re: scroll part 3 of 3

Area:    Quik_Bas
  Msg:    #391
 Date:    12-27-92 12:27 (Public) 
 From:    Dik Coates               
 To:      Coridon Henshaw          
 Subject: Re: scroll part 3 of 3   

This is the last of the installments... Part 3 of 3


- - - - - - - - - - - -  Cut on Dashed Line - - - - - - - - - - - - -

'****************************************************** SUBPROGRAM ScrollText
'
' Procedure prints to screen WARNING MESSAGES returned from the various
' program screens.  The messages if greater in number than the permitted
' number of lines on the screen can be scrolled down and up for viewing.
'
' CALL:   ScrollText (a$(), srow%, scol%, frow%, fcol%, txtfga%, txtbga%,
'                     tartln%)
'
' ARG:  a$()    -   text array to be printed to screen
'       srow%   -   start row of the active screen area
'       scol%   -   start column of the active screen area
'       frow%   -   end row of the active screen area
'       fcol%   -   end column of the active screen area
'       txtfga% -   text foreground attribute
'       txtbga% -   text background attribute
'       startln%-   starting line of the text array to be printed
'
' USES: ClearScrollText()
'       ScrollDn()
'       ClearScrollLine()
'       ScrollUp()
'
' COMP: MS Basic 7.1
'
' REV:  91-03-23
'       91-11-14  header revised
'
'****************************************************************************
'
SUB ScrollText (a$(), srow%, scol%, frow%, fcol%, textfga%, 
textbga%, startln%)

  COLOR textfga%, textbga%
  scrwidth% = fcol% - scol% + 1
  linesperscreen% = frow% - srow% + 1  'OK
  lenoffile% = UBOUND(a$, 1)  'OK

  IF linesperscreen% >= lenoffile% THEN                      'single screen
    CALL ClearScrollText(srow%, scol%, frow%, fcol%, textfga%, textbga%)

    FOR c% = 1 TO lenoffile%                                'print screen
      LOCATE srow% - 1 + c%, scol%
      PRINT a$(c%);
    NEXT c%

    DO                                 'exit single screen on escape only
      DO
        key$ = INKEY$
      LOOP UNTIL LEN(key$)

      IF LEN(key$) = 2 THEN
        BEEP
      ELSEIF LEN(key$) = 1 THEN
        IF ASC(key$) = 27 THEN
          EXIT SUB
        ELSE
          BEEP
        END IF
      END IF
    LOOP
  ELSE                                                    'multiple screens
    maxtoprow% = lenoffile% - linesperscreen% + 1 'OK initialize

    IF startln% + linesperscreen% > lenoffile% THEN
      oldtoprow% = maxtoprow%
      oldbotrow% = lenoffile%
    ELSE
      oldtoprow% = startln%
      oldbotrow% = startln% + linesperscreen% - 1
    END IF

    FOR c% = 1 TO linesperscreen%                           'print screen
      LOCATE srow% - 1 + c%, scol%
      PRINT a$(oldtoprow% - 1 + c%);
    NEXT c%

    DO
      DO
        key$ = INKEY$
      LOOP UNTIL LEN(key$)
 
      IF LEN(key$) = 2 THEN
        temp% = ASC(RIGHT$(key$, 1))

        SELECT CASE temp%
          CASE 71 'home
            scrollflag% = 0
            oldtoprow% = 1
            oldbotrow% = linesperscreen%
          CASE 72 AND oldbotrow% <= linesperscreen% 'cursor up
            scrollflag% = 2
          CASE 72 AND oldbotrow% > linesperscreen%
            scrollflag% = 1
            oldtoprow% = oldtoprow% - 1
            oldbotrow% = oldbotrow% - 1
          CASE 73 AND oldtoprow% <= linesperscreen% 'page up
            scrollflag% = 0
            oldtoprow% = 1
            oldbotrow% = linesperscreen%
          CASE 73 AND oldtoprow% > linesperscreen%
            scrollflag% = 0
            oldtoprow% = oldtoprow% - linesperscreen%
            oldbotrow% = oldbotrow% - linesperscreen%
          CASE 79 'end
            scrollflag% = 0
            oldtoprow% = maxtoprow%
            oldbotrow% = lenoffile%
          CASE 80 AND oldtoprow% < maxtoprow% 'cursor down
            scrollflag% = -1
            oldtoprow% = oldtoprow% + 1
            oldbotrow% = oldbotrow% + 1
          CASE 80 AND oldtoprow% = maxtoprow%
            scrollflag% = 2
          CASE 81 AND oldbotrow% >= maxtoprow%'page down
            scrollflag% = 0
            oldtoprow% = maxtoprow%
            oldbotrow% = lenoffile%
          CASE 81 AND oldbotrow% < maxtoprow%
            scrollflag% = 0
            oldtoprow% = oldtoprow% + linesperscreen%
            oldbotrow% = oldbotrow% + linesperscreen%
          CASE ELSE
            BEEP
        END SELECT

        IF scrollflag% = 1 THEN 'movement up
          CALL ScrollDn(srow%, scol%, frow%, fcol%, 1, textbga%)
          CALL ClearScrollLine(srow%, scol%, fcol%, textfga%, textbga%)
          LOCATE srow%, scol%
          PRINT a$(oldtoprow%);
        ELSEIF scrollflag% = -1 THEN 'movement down
          temp% = srow% + linesperscreen% - 1
          CALL ScrollUp(srow%, scol%, frow%, fcol%, 1, textbga%)
          CALL ClearScrollLine(temp%, scol%, fcol%, textfga%, textbga%)
          LOCATE temp%, scol%
          PRINT a$(oldbotrow%);
        ELSEIF scrollflag% = 0 THEN                     'print screen
          CALL ClearScrollText(srow%, scol%, frow%, fcol%, textfga%, textbga%)

          FOR c% = 1 TO linesperscreen%
            LOCATE srow% - 1 + c%, scol%
            PRINT a$(oldtoprow% - 1 + c%);
          NEXT c%
        END IF

        scrollflag% = 0
      ELSE
        temp% = ASC(key$)

        SELECT CASE temp%
          CASE 27 'escape
            EXIT SUB
          CASE ELSE
            BEEP
        END SELECT
      END IF
    LOOP
  END IF

END SUB 'ScrollText



'********************************************************* SUB TextFile2Array
'
' The procedure copies a BINARY text file to a string array.  The format of
' binary file is:  (size%, LENstring1%, string1$, LENstring2%, string2$,...)
' Error handling must be done in the calling program.
'
' CALL: TextFile2Array (filename$, a$())
'
' ARG:  filename$ - name of the BINARY file to be copied
'
' RET:  a$()      - string array containing contents of binary file
'
' COMP: MS Basic 7.1
'
' REV:  91-10-30
'
'****************************************************************************
'
SUB TextFile2Array (filename$, a$())

  filenum% = FREEFILE
  OPEN filename$ FOR BINARY AS filenum%
  GET filenum%, , size%
  REDIM a$(size%)

  FOR c% = 1 TO size%
    GET filenum%, , dummy%
    a$(c%) = INPUT$(dummy%, filenum%)
  NEXT c%
  CLOSE filenum%
-end-