home *** CD-ROM | disk | FTP | other *** search
/ Black Box 4 / BlackBox.cdr / progbas / baswind4.arj / BASWIND4.BAS < prev    next >
BASIC Source File  |  1987-12-26  |  5KB  |  124 lines
  1.  
  2.  
  3. DECLARE SUB FASTPRT (TOP$, ROW%, COL%, ATTR%)
  4.         DEFINT A-Z
  5.  
  6. DEFSNG A-Z
  7.        '************************** WINDOW SUBROUTINE *************************
  8.        ' Modified 3/23/87 to eliminate shadow routine and parameter...WAD.
  9.        SUB MAKEWIND (ULR%, ULC%, LRR%, LRC%, FRAME%, FORE%, BACK%, GROW%, LABEL$) STATIC
  10.        DEFINT A-Z
  11.        IF GROW = 0 THEN GOSUB STD: GOTO DONE
  12.        '-------------------- Growing Window Module ---------------------------
  13.        X1 = ULC + INT((LRC - ULC) / 2)
  14.        X2 = LRC - INT((LRC - ULC) / 2)
  15.        Y1 = ULR + INT((LRR - ULR) / 2)
  16.        Y2 = LRR - INT((LRR - ULR) / 2)
  17. NXT: IF X1 > ULC THEN X1 = X1 - 3: IF X1 < ULC THEN X1 = ULC
  18.        IF X2 < LRC THEN X2 = X2 + 3: IF X2 > LRC THEN X2 = LRC
  19.        IF Y1 > ULR THEN Y1 = Y1 - 1
  20.        IF Y2 < LRR THEN Y2 = Y2 + 1
  21.        GOSUB SETUP
  22.        IF (X1 = ULC) AND (X2 = LRC) AND (Y1 = ULR) AND Y2 = (LRR) THEN GOTO DONE ELSE GOTO NXT
  23. DONE: GROW = 0
  24.        EXIT SUB
  25.        '------------------- Regular Window Module ----------------------------
  26. STD: X1 = ULC: X2 = LRC: Y1 = ULR: Y2 = LRR
  27. SETUP: ATTR = (BACK AND 7) * 16 + FORE
  28.        IF FRAME = 0 THEN GOSUB NOFRAME ELSE ON FRAME GOSUB H1V1, H2V2, H1V2, H2V1
  29.        IF LABEL$ = "" OR LEN(LABEL$) > (LEN(TOP$) - 5) THEN GOTO SHADE
  30.        MID$(TOP$, 2) = "[" + LABEL$ + "]"
  31. SHADE: '---------------------------- Shadow Module --(Deleted)----------------
  32.  
  33. MAKE:  '------------------------ Produce Window Module -----------------------
  34.        ROW = Y1 - 1: COL = X1 - 1
  35.        CALL FASTPRT(TOP$, ROW, COL, ATTR)
  36.        FOR I = Y1 TO Y2
  37.          ROW = I: COL = X1 - 1
  38.          CALL FASTPRT(MIDL$, ROW, COL, ATTR)
  39.        NEXT I
  40.        ROW = Y2 + 1: COL = X1 - 1
  41.        CALL FASTPRT(BOTTM$, ROW, COL, ATTR)
  42.        RETURN
  43. H1V1:  '--------------- Single Line Frame ---------------------
  44.        TOP$ = CHR$(218) + STRING$((X2 - X1) + 1, 196) + CHR$(191)
  45.        MIDL$ = CHR$(179) + STRING$((X2 - X1) + 1, 32) + CHR$(179)
  46.        BOTTM$ = CHR$(192) + STRING$((X2 - X1) + 1, 196) + CHR$(217)
  47.        RETURN
  48. H2V2:  '--------------- Double Line Frame ----------------------
  49.        TOP$ = CHR$(201) + STRING$((X2 - X1) + 1, 205) + CHR$(187)
  50.        MIDL$ = CHR$(186) + STRING$((X2 - X1) + 1, 32) + CHR$(186)
  51.        BOTTM$ = CHR$(200) + STRING$((X2 - X1) + 1, 205) + CHR$(188)
  52.        RETURN
  53. H1V2:  '---- Double Vertical, Single Horizontal Line Frame ----
  54.        TOP$ = CHR$(214) + STRING$((X2 - X1) + 1, 196) + CHR$(183)
  55.        MIDL$ = CHR$(186) + STRING$((X2 - X1) + 1, 32) + CHR$(186)
  56.        BOTTM$ = CHR$(211) + STRING$((X2 - X1) + 1, 196) + CHR$(189)
  57.        RETURN
  58. H2V1:  '---- Double Horizontal, Single Vertical Line Frame ----
  59.        TOP$ = CHR$(213) + STRING$((X2 - X1) + 1, 205) + CHR$(184)
  60.        MIDL$ = CHR$(179) + STRING$((X2 - X1) + 1, 32) + CHR$(179)
  61.        BOTTM$ = CHR$(212) + STRING$((X2 - X1) + 1, 205) + CHR$(190)
  62.        RETURN
  63.  
  64. NOFRAME: '---------------- No Frame ----------------------------
  65.  
  66.        TOP$ = SPACE$((X2 - X1) + 3)
  67.        MIDL$ = TOP$
  68.        BOTTM$ = TOP$
  69.        RETURN
  70.  
  71.        END SUB
  72.  
  73.               SUB SCROLL (ULR%, ULC%, LRR%, LRC%, LINES%, DIR%, NEWMSG$) STATIC
  74.  
  75.         'Modified 3/23/87 By WAD to prevent altering the window coordinates
  76.         'passed to scroll. ULR,ULC,LRR & LRC are now not changed!
  77.  
  78.               'Adjust for 0 reference of parameters for BIOS call
  79.               SULR% = ULR% - 1
  80.               SULC% = ULC% - 1
  81.               SLRR% = LRR% - 1
  82.               SLRC% = LRC% - 1
  83.  
  84.               DIM INARRY%(7), OUTARRY%(7)
  85.  
  86.               'Prepare INARRY% variables with data for SCROLL BIOS CALL
  87.  
  88.               'Determine if SCROLL UP (6) or SCROLL DOWN (7) Service
  89.  
  90.               IF DIR% = 1 THEN INARRY%(0) = 1536 ELSE IF DIR% = -1 THEN INARRY%(0) = 1792 ELSE EXIT SUB
  91.               'Service 6 = 6 shifted 8 = 1536, Service 7 = 7 shifted 4 = 1792
  92.               'Service goes in AH register
  93.  
  94.               INARRY%(0) = INARRY%(0) + LINES%
  95.               'Lines goes in AL register
  96.  
  97.               INARRY%(1) = SCREEN(SULR%, SULC%, 1) * 256
  98.               'BH = Color Attribute of window
  99.  
  100.               INARRY%(2) = (SULR% * 256) + SULC%
  101.               'CH=SULR, CL=SULC
  102.  
  103.               INARRY%(3) = (SLRR% * 256) + SLRC%
  104.               'DH=LRR, DL=LRC
  105.  
  106.               INARRY%(4) = 0: INARRY%(5) = 0: INARRY%(6) = 0: INARRY%(7) = 0
  107.               'All other registers empty
  108.  
  109.               'Perform Scroll
  110.               INTRRPT% = 16: 'Video BIOS Interrupt
  111.  
  112.               CALL INT86OLD(INTRRPT%, INARRY%(), OUTARRY%())
  113.  
  114.               'Determine if NEWMSG$ goes on top or bottom line
  115.  
  116.               IF DIR% = 1 THEN ROW% = SLRR% + 1 ELSE IF DIR% = -1 THEN ROW% = SULR% + 1
  117.               COL% = SULC% + 1
  118.               ATTR% = SCREEN(SULR%, SULC%, 1)
  119.  
  120.               CALL FASTPRT(NEWMSG$, ROW%, COL%, ATTR%)
  121.  
  122.               END SUB
  123.  
  124.