home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / clarion / library / scrlta / scrltst.cla next >
Text File  |  1991-10-01  |  2KB  |  79 lines
  1. !───────────────────────────────────────────────────────────────────────────────
  2.          TITLE( 'ScrollTA() Test Program' )
  3. !         Copyright Mark A. Zurier 1991
  4. !         Rev.:  91/09/26
  5. !───────────────────────────────────────────────────────────────────────────────
  6. ScrlTst         PROGRAM
  7.  
  8.          MAP
  9.            MODULE( 'ScrollTA.BIN' ),BINARY
  10.          PROC( ScrollTA )
  11.            END
  12.          END
  13.  
  14. frmTest         SCREEN      HUE(15,1)
  15.            ROW(1,1)      STRING('┌─{18}<0{43}>─{17}┐')
  16.            ROW(2,1)      REPEAT(23);STRING('│<0{78}>│') .
  17.            ROW(25,1)  STRING('└─{78}┘')
  18.            ROW(1,20)  STRING('ScrollTA Test Copyright Mark A. Zurier 1991')
  19.            ROW(3,5)      STRING('This program will draw a rather simple '     |
  20.                 & 'screen and scroll it several times')
  21.            ROW(4,5)      STRING('using both Clarion''s SCROLL and the '       |
  22.                 & 'ScrollTA function.')
  23.            ROW(21,30) STRING('Hit any key to continue'),HUE(7,1)
  24.               REPEAT(10),INDEX(ibNdx)
  25. ssOutside1     ROW(6,13)    STRING(12),HUE(15,4)
  26. ssOutside2     COL(55)    STRING(12),HUE(15,3)
  27. ssString     COL(25)    STRING(30),HUE(0,7)
  28.               .
  29.          COL(25)  POINT(10,30),USE(?ScrollArea)
  30. ssMsg           ROW(20,10) STRING(60)
  31.          .
  32.  
  33. ibNdx         BYTE
  34.  
  35. ibTop         BYTE
  36. ibLeft         BYTE
  37. ibRows         BYTE
  38. ibCols         BYTE
  39.  
  40.          CODE
  41.  
  42.          OPEN( frmTest )
  43.  
  44.          ! Set Clarion coords of scroll area
  45.          ibTop = ROW( ?ScrollArea )
  46.          ibLeft = COL( ?ScrollArea )
  47.          ibRows = ROWS( ?ScrollArea )
  48.          ibCols = COLS( ?ScrollArea )
  49.  
  50.          ! Draw test scroll area and text just outside of it.
  51.          LOOP ibNdx = 1 TO 10
  52.            ssOutside1 = 'No scroll ' & FORMAT( ibNdx, @N2 )
  53.            ssOutside2 = ibNdx & ' No scroll'
  54.            ssString = 'Scroll line ' & FORMAT( ibNdx, @N2 ) & '.{16}'
  55.          END
  56.  
  57.          ! Paint 5th line red
  58.          SETHUE( 4, 7 )
  59.          COLOR( ibTop+4, ibLeft, 1, 30 )
  60.          SETHUE()
  61.  
  62.          ssMsg = CENTER( 'About to SCROLL up 1 line', SIZE( ssMsg ) )
  63.          ASK
  64.  
  65.          SCROLL( ibTop, ibLeft, ibRows, ibCols, 1 )
  66.          ssMsg = CENTER( 'About to ScrollTA() up 1 line -- watch line 6', SIZE( ssMsg ) )
  67.          ASK
  68.  
  69.          ScrollTA( ibTop, ibLeft, ibRows, ibCols, 1 )
  70.          ssMsg = CENTER( 'About to ScrollTA() down 1 line -- filling black on white', SIZE( ssMsg ) )
  71.          ASK
  72.  
  73.          ScrollTA( ibTop, ibLeft, ibRows, ibCols, -1 )
  74.          ssMsg = CENTER( 'End of demo', SIZE( ssMsg ) )
  75.          ASK
  76.  
  77.          RETURN
  78.  
  79.