home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / QBASIC / BASWIND8.ZIP / MAKEWIND.SUB < prev    next >
Encoding:
Text File  |  1990-09-14  |  7.4 KB  |  236 lines
  1. '
  2. '
  3. '******************************************************************************
  4. '                    Function : MAKEWIND                                      *
  5. '                                                                             *
  6. ' Purpose:                                                                    *
  7. '                                                                             *
  8. '                                                                             *
  9. ' Results:                                                                    *
  10. '                                                                             *
  11. ' Usage  :                                                                    *
  12. '                                                                             *
  13. '                                                                             *
  14. ' Date Written : 09/01/90 - Date Tested: 09/01/90 - Author: James P Morgan    *
  15. ' Date Modified:          -            :          -       :                   *
  16. '-----------------------------------------------------------------------------*
  17. ' NOTE:                                                                       *
  18. '******************************************************************************
  19. '                                                                             *
  20. '     SUB PROGRAM NAME          (PARAMETERS)                 STATIC/RECURSIVE *
  21. '-----------------------------------------------------------------------------*
  22. '                                                                             *
  23. SUB    MAKEWIND(ULR%,ULC%,LRR%,LRC%,FRAME%,FORE%,BACK%,GROW%,SHADOW%,LABEL$,RETURN.CODE%)  STATIC
  24.  
  25.        DEFINT A-Z                               'make all short intergers by default
  26.  
  27.        RETURN.CODE%=0
  28.        VIDEO.RETURN.CODE%=0
  29.  
  30.        IF GROW%=0 THEN                          'is the window to "grow" onto the screen
  31.            GOSUB MAKEWIND.STD
  32.            GOSUB MAKEWIND.SHADE
  33.          GOTO MAKEWIND.DONE
  34.        END IF
  35.  
  36. '-------------------- Growing Window Module ---------------------------
  37.  
  38. '      SHADOW%=0                                'grow and shadow no longer mutually exclusive
  39.  
  40.        X1=ULC%+(INT((LRC%-ULC%)\2))
  41.        X2=LRC%-(INT((LRC%-ULC%)\2))
  42.        Y1=ULR%+(INT((LRR%-ULR%)\2))
  43.        Y2=LRR%-(INT((LRR%-ULR%)\2))
  44.  
  45. '
  46. MAKEWIND.NXT:
  47.        IF X1>ULC% THEN
  48.            X1=X1-3
  49.          IF X1<ULC% THEN
  50.               X1=ULC%
  51.          END IF
  52.        END IF
  53.  
  54.        IF X2<LRC% THEN
  55.            X2=X2+3
  56.          IF X2>LRC% THEN
  57.            X2=LRC%
  58.          END IF
  59.        END IF
  60.  
  61.        IF Y1>ULR% THEN
  62.            Y1=Y1-1
  63.        END IF
  64.  
  65.        IF Y2<LRR% THEN
  66.            Y2=Y2+1
  67.        END IF
  68.  
  69.        GOSUB MAKEWIND.SETUP
  70.  
  71.        IF (X1=ULC%) AND (X2=LRC%) AND (Y1=ULR%) AND (Y2=LRR%) THEN
  72.             GOSUB MAKEWIND.SHADE
  73.           GOTO MAKEWIND.DONE
  74.        END IF
  75.  
  76.        GOTO MAKEWIND.NXT
  77.  
  78. '
  79. '------------------- Regular Window Module ----------------------------
  80. MAKEWIND.STD:
  81.        X1=ULC%
  82.        X2=LRC%
  83.        Y1=ULR%
  84.        Y2=LRR%
  85. MAKEWIND.SETUP:
  86.        ATTR=(BACK% AND 7)*16+FORE%
  87.  
  88.        IF FRAME%<0 OR FRAME%>4 THEN           'if frame invalid, then no frame
  89.            FRAME%=0
  90.        END IF
  91.  
  92.        SELECT CASE FRAME%
  93.           CASE 0
  94.                   GOSUB MAKEWIND.NOFRAME
  95.           CASE 1
  96.                   GOSUB MAKEWIND.H1V1
  97.           CASE 2
  98.                   GOSUB MAKEWIND.H2V2
  99.           CASE 3
  100.                   GOSUB MAKEWIND.H1V2
  101.           CASE 4
  102.                   GOSUB MAKEWIND.H2V1
  103.  
  104.        END SELECT
  105.  
  106.        IF (LABEL$="") OR (LEN(LABEL$) > LEN(TOP$)-5) THEN
  107.            GOTO MAKEWIND.MAKE
  108.        END IF
  109.  
  110. '
  111. ' center the heading on top of the window
  112. '
  113.        MID$(TOP$,(LEN(TOP$)/2)-((LEN(LABEL$)+1)/2))="["+LABEL$+"]"
  114.  
  115. '
  116. '------------------------ Produce Window Module -----------------------
  117. MAKEWIND.MAKE:
  118.        ROW=Y1-1
  119.        COL=X1-1
  120.        CALL FASTPRT(TOP$,ROW,COL,ATTR,VIDEO.RETURN.CODE%)
  121.  
  122.        FOR I=Y1 TO Y2
  123.           ROW=I
  124.           COL=X1-1
  125.           CALL FASTPRT(MIDL$,ROW,COL,ATTR,VIDEO.RETURN.CODE%)
  126.        NEXT
  127.  
  128.        ROW=Y2+1
  129.        COL=X1-1
  130.        CALL FASTPRT(BOTTM$,ROW,COL,ATTR,VIDEO.RETURN.CODE%)
  131.        RETURN
  132.  
  133. '
  134. '--------------- Single Line Frame ---------------------
  135. MAKEWIND.H1V1:
  136.        TOP$  =CHR$(218)+STRING$((X2-X1)+1,196)+CHR$(191)
  137.        MIDL$ =CHR$(179)+STRING$((X2-X1)+1, 32)+CHR$(179)
  138.        BOTTM$=CHR$(192)+STRING$((X2-X1)+1,196)+CHR$(217)
  139.        RETURN
  140.  
  141. '
  142. '--------------- Double Line Frame ----------------------
  143. MAKEWIND.H2V2:
  144.        TOP$  =CHR$(201)+STRING$((X2-X1)+1,205)+CHR$(187)
  145.        MIDL$ =CHR$(186)+STRING$((X2-X1)+1, 32)+CHR$(186)
  146.        BOTTM$=CHR$(200)+STRING$((X2-X1)+1,205)+CHR$(188)
  147.        RETURN
  148.  
  149. '
  150. '---- Double Vertical, Single Horizontal Line Frame ----
  151. MAKEWIND.H1V2:
  152.        TOP$  =CHR$(214)+STRING$((X2-X1)+1,196)+CHR$(183)
  153.        MIDL$ =CHR$(186)+STRING$((X2-X1)+1, 32)+CHR$(186)
  154.        BOTTM$=CHR$(211)+STRING$((X2-X1)+1,196)+CHR$(189)
  155.        RETURN
  156.  
  157. '
  158. '---- Double Horizontal, Single Vertical Line Frame ----
  159. MAKEWIND.H2V1:
  160.        TOP$  =CHR$(213)+STRING$((X2-X1)+1,205)+CHR$(184)
  161.        MIDL$ =CHR$(179)+STRING$((X2-X1)+1, 32)+CHR$(179)
  162.        BOTTM$=CHR$(212)+STRING$((X2-X1)+1,205)+CHR$(190)
  163.        RETURN
  164.  
  165. '
  166. '---------------- No Frame ----------------------------
  167. MAKEWIND.NOFRAME:
  168.        TOP$=SPACE$((X2-X1)+3)
  169.        MIDL$=TOP$
  170.        BOTTM$=TOP$
  171.        RETURN
  172. '
  173. '---------------------------- Shadow Module ---------------------------
  174. MAKEWIND.SHADE:
  175.        IF SHADOW%=0 THEN                        'are we to "shade" the window
  176.            RETURN
  177.        END IF
  178.  
  179.        X1=ULC%
  180.        X2=LRC%
  181.        Y1=ULR%
  182.        Y2=LRR%
  183.  
  184.        COL=X1-3                                 'allow for window frame and 2 "shadow" columns
  185.  
  186.        IF COL<1 OR COL>80 THEN                  'still within physical screen co-ordinates
  187.             SHADOW%=0                           'NO, so no shadow, even if requested
  188.           RETURN
  189.        END IF
  190.  
  191.        DAT$="  "                                'allow for 2 "shadow" colums
  192.        BLACK=&H07                               'low intensity white on black
  193.  
  194. '
  195. ' draw the shadow around the window frame
  196. '
  197.        FOR I=Y1 TO (Y2+2)
  198.           ROW=I
  199.  
  200.           V=SCREEN(I,COL)                       'get the two left chars outside the window frame
  201.           MID$(DAT$,1,1)=CHR$(V)                'from the physical screen
  202.           V=SCREEN(I,COL+1)
  203.           MID$(DAT$,2,1)=CHR$(V)
  204.  
  205. '
  206. ' are we on the last line of the window, just below the botttom window frame.
  207. '
  208.           IF I=Y2+2 THEN
  209.             DAT$=STRING$(80," ")                'intialize to cut down on string collection
  210.             CHAR.CNT=0                          'keep track of length of string
  211.             FOR J=COL TO COL+((X2-X1)+3)
  212.                 CHAR.CNT=CHAR.CNT+1
  213.                 V=SCREEN(I,J)                   'get the char from screen, that will be in shadow
  214.                 MID$(DAT$,CHAR.CNT,1)=CHR$(V)   'and save it with the rest
  215.             NEXT
  216.  
  217.             DAT$=LEFT$(DAT$,CHAR.CNT)           'now adjust for real string length
  218.  
  219.           END IF
  220.  
  221.          CALL FASTPRT(DAT$,ROW,COL,BLACK,VIDEO.RETURN.CODE%)
  222.        NEXT
  223.  
  224.        RETURN
  225.  
  226. '
  227. MAKEWIND.DONE:
  228.        GROW%=0
  229.  
  230.        DAT$=""                                   'free up any string space used
  231.        TOP$=""
  232.        MIDL$=""
  233.        BOTTM$=""
  234.  
  235. END SUB
  236.