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