home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / BASIC / BAS_SUB.ZIP / SCROLL.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1985-04-19  |  6.3 KB  |  87 lines
  1. 100  '**************************************************************************
  2. 110  '*                                                                        *
  3. 120  '*                              SCROLL                                    *
  4. 130  '*                                                                        *
  5. 140  '*                            WRITTEN BY:                                 *
  6. 150  '*                                                                        *
  7. 160  '*                            JOHN BOURG                                  *
  8. 170  '*                         13614 CHERRYDOWN                               *
  9. 180  '*                      SUGAR LAND, TX.  77478                            *
  10. 190  '*                          (713) 494-7687                                *
  11. 200  '*                                                                        *
  12. 210  '**************************************************************************
  13. 220  '*                                                                        *
  14. 230  '*   This routine will Scroll a window up and down. The direction of the  *
  15. 240  '*   scrolling window is controled by the value in register AH to change  *
  16. 250  '*   the value in AH after the program is running use MID$(A$,2,1)=CHR$(n)*
  17. 260  '*   where n is the direction to scroll, 6 = up and 7 = down.             *
  18. 270  '*   To change the number of lines to blank at the top or bottom of the   *
  19. 280  '*   window change the value in register AL to a number between 0 and 24, *
  20. 290  '*   (0 will blank the entire window). After the program is running use   *
  21. 300  '*   MID$(A$,4,1)=CHR$(n). To set the size of the window to be scrolled   *
  22. 310  '*   change the values in registers CX and DX. To set the upper left hand *
  23. 320  '*   corner of the window a number between 0 and 18H in CH for the row,   *
  24. 330  '*   and a number between 0 and 4FH for the column. After the program is  *
  25. 340  '*   running use MID$(A$,6,1)=CHR$(n) for CH, MID$(A$,8,1)=CHR$(n) for CL *
  26. 350  '*   MID$(A$,10,1)=CHR$(n) for DH, and MID$(A$,12,1)=CHR$(n) for DL.      *
  27. 360  '*   To set the attribute of the blank line set the BX register to a value*
  28. 370  '*   according to the table below.                                        *
  29. 380  '*                                                                        *
  30. 390  '**************************************************************************
  31. 400  '
  32. 410  '                            ATTRIBUTE TABLE
  33. 420  'VARPTRSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDBSAVESOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDBSAVESOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDCOLOR        CALL     Attribute Byte         CALL      Monochrome    CALL  Color/Graphics    CALL
  34. 430  'CALL7  6   5   4   3  2   1   0 CALL    Display Adapter CALL  Monitor Adapter   CALL
  35. 440  'BLOADSOUNDSOUNDBSAVESOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDBSAVESOUNDSOUNDSOUNDBSAVESOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDBEEPSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDBSAVESOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDBEEPSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDBSAVESOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND<0xB4!>        CALLB CALLR   G   B CALL I CALLR   G   B CALL          CALL         CALL          CALL         CALL
  36. 450  'BLOADSOUNDSOUNDBEEPSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDBEEPSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND<0xB4!>BackgroundCALLCharacterCALLBackgroundCALLCharacterCALL
  37. 460  'CALLFGCALLBackgroundCALL    ForegroundCALL   Color  CALL  Color  CALL   Color  CALL  Color  CALL
  38. 470  'BLOADSOUNDSOUNDBEEPSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDBEEPSOUNDSOUNDSOUNDBSAVESOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDBEEPSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDBEEPSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDBEEPSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDBEEPSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND<0xB4!>        CALLB CALL0   0   0 CALL I CALL1   1   1 CALL   Black  CALL  White  CALL   Black  CALL  White  CALL
  39. 480  'CALLB CALL1   1   1 CALL I CALL0   0   0 CALL   White  CALL  Black  CALL   White  CALL  Black  CALL
  40. 490  'CALLB CALL0   0   0 CALL I CALL0   0   0 CALL   Black  CALL  Black  CALL   Black  CALL  Black  CALL
  41. 500  'CALLB CALL1   1   1 CALL I CALL1   1   1 CALL   White  CALL  White  CALL   White  CALL  White  CALL
  42. 510  'CLSSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND'
  43. 520  '
  44. 530  '                      FOR THE COLOR/GRAPHICS ADAPTER
  45. 540  'VARPTRSOUNDSOUNDSOUNDSOUNDSOUNDBSAVESOUNDSOUNDSOUNDSOUNDSOUNDBSAVESOUNDSOUNDSOUNDSOUNDSOUNDBSAVESOUNDSOUNDSOUNDSOUNDSOUNDBSAVESOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDCOLOR        CALL  R  CALL  G  CALL  B  CALL  I  CALL               COLOR                          CALL
  46. 550  'BLOADSOUNDSOUNDSOUNDSOUNDSOUNDBEEPSOUNDSOUNDSOUNDSOUNDSOUNDBEEPSOUNDSOUNDSOUNDSOUNDSOUNDBEEPSOUNDSOUNDSOUNDSOUNDSOUNDBEEPSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND<0xB4!>        CALL  0  CALL  0  CALL  0  CALL  0  CALL        Black                                 CALL
  47. 560  'CALL  0  CALL  0  CALL  1  CALL  0  CALL        Blue                                  CALL        CALL  0  CALL  1  CALL  0  CALL  0  CALL        Green                                 CALL
  48. 570  'CALL  0  CALL  1  CALL  1  CALL  0  CALL        Cyan                                  CALL        CALL  1  CALL  0  CALL  0  CALL  0  CALL        Red                                   CALL
  49. 580  'CALL  1  CALL  0  CALL  1  CALL  0  CALL        Magenta                               CALL        CALL  1  CALL  1  CALL  0  CALL  0  CALL        Brown                                 CALL
  50. 590  'CALL  1  CALL  1  CALL  1  CALL  0  CALL        White                                 CALL        CALL  0  CALL  0  CALL  0  CALL  1  CALL        Gray                                  CALL
  51. 600  'CALL  0  CALL  0  CALL  1  CALL  1  CALL        Light Blue                            CALL        CALL  0  CALL  1  CALL  0  CALL  1  CALL        Light Green                           CALL
  52. 610  'CALL  0  CALL  1  CALL  1  CALL  1  CALL        Light Cyan                            CALL        CALL  1  CALL  0  CALL  0  CALL  1  CALL        Light Red                             CALL
  53. 620  'CALL  1  CALL  0  CALL  1  CALL  1  CALL        Light Magenta                         CALL        CALL  1  CALL  1  CALL  0  CALL  1  CALL        Yellow                                CALL
  54. 630  'CALL  1  CALL  1  CALL  1  CALL  1  CALL        White (High Intensity)                CALL
  55. 640  'CLSSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND'
  56. 650  '
  57. 660  CLS
  58. 670  A$=STRING$(18," ")
  59. 680  FOR X = 1 TO 18
  60. 690  READ D:MID$(A$,X,1)=CHR$(D)
  61. 700  NEXT
  62. 710  T = VARPTR(A$)
  63. 720  START = PEEK(T+1)+PEEK(T+2)*256
  64. 730  LOCATE 8,1:PRINT"THIS LINE STAYS HERE";
  65. 740  FOR X = 9 TO 22
  66. 750  LOCATE X,1:PRINT USING "##";X-8;:PRINT"*************************"X-8
  67. 760  NEXT
  68. 770  LOCATE 24,1:PRINT"THIS STAYS HERE";
  69. 780  LOCATE 23,3:PRINT"HIT ANY KEY TO SCROLL UP";
  70. 790  B$ = INKEY$: IF B$ ="" THEN 790
  71. 800  DEF SEG: CALL START
  72. 810  LOCATE 23,3:PRINT"HIT ANY KEY TO SCROLL DOWN";
  73. 820  B$ = INKEY$: IF B$ ="" THEN 820
  74. 830  MID$(A$,2,1)=CHR$(7)
  75. 840  CALL START
  76. 850  LOCATE 9,3:PRINT"THIS IS AT THE TOP";
  77. 860  MID$(A$,2,1)=CHR$(6):GOTO 780
  78. 870  DATA  &HB4,&H06:'           MOV     AH,06   ;SCROLL ACTIVE PAGE UP
  79. 880  DATA  &HB0,&H01:'           MOV     AL,01   ;NUMBER OF LINES TO BLANK
  80. 890  DATA  &HB5,&H08:'           MOV     CH,08   ;ROW OF UPPER LEFT CORNER
  81. 900  DATA  &HB1,&H02:'           MOV     CL,02   ;COLUMN OF UPPER LEFT CORNER
  82. 910  DATA  &HB6,&H16:'           MOV     DH,17   ;ROW OF LOWER RIGHT CORNER
  83. 920  DATA  &HB2,&H1B:'           MOV     DL,1B   ;COLUMN OF LOWER RIGHT CORNER
  84. 930  DATA  &HBB,&H07,&H00:'      MOV     BX,0007 ;ATTRIBUTE USED ON BLANK LINE
  85. 940  DATA  &HCD,&H10:'           INT     10      ;SCROLL THE WINDOW
  86. 950  DATA  &HCB:'                RETF            ;RETURN TO SENDER
  87.