home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / CLIPPER / NFSRC.ZIP / XBOX.PRG < prev    next >
Encoding:
Text File  |  1991-08-17  |  8.4 KB  |  229 lines
  1. /*
  2.  * File......: XBOX.PRG
  3.  * Author....: Don Opperthauser
  4.  * Date......: $Date:   17 Aug 1991 15:47:06  $
  5.  * Revision..: $Revision:   1.3  $
  6.  * Log file..: $Logfile:   E:/nanfor/src/xbox.prv  $
  7.  * 
  8.  * This is an original work by Don Opperthauser and is placed in the
  9.  * public domain.
  10.  *
  11.  * Modification history:
  12.  * ---------------------
  13.  *
  14.  * $Log:   E:/nanfor/src/xbox.prv  $
  15.  * 
  16.  *    Rev 1.3   17 Aug 1991 15:47:06   GLENN
  17.  * Don Caton fixed some spelling errors in the doc
  18.  * 
  19.  *    Rev 1.2   15 Aug 1991 23:05:12   GLENN
  20.  * Forest Belt proofread/edited/cleaned up doc
  21.  * 
  22.  *    Rev 1.1   14 Jun 1991 17:55:50   GLENN
  23.  * Fixed bug where extra blank line was displayed in the box.
  24.  * 
  25.  *    Rev 1.0   01 Apr 1991 01:02:34   GLENN
  26.  * Nanforum Toolkit
  27.  *
  28.  */
  29.  
  30. /*  $DOC$
  31.  *  $FUNCNAME$
  32.  *     FT_XBOX()
  33.  *  $CATEGORY$
  34.  *     Menus/Prompts
  35.  *  $ONELINER$
  36.  *     Display a self-sizing message box and message
  37.  *  $SYNTAX$
  38.  *     FT_XBOX( [ <cJustType> ], [ <cRetWait> ], [ <cBorType> ],   ;
  39.  *              [ <cBorColor> ], [ <cBoxColor> ], [ <nStartRow> ], ;
  40.  *              [ <nStartCol> ], <cLine1>,  <cLine2>, <cLine3>,    ;
  41.  *              <cLine4>, <cLine5>, <cLine6>, <cLine7>, <cLine8> ) -> NIL
  42.  *  $ARGUMENTS$
  43.  *     <cJustType> is a character indicating the type of text justification.
  44.  *     "L" or "l" will cause the text to be left-justified in the box.
  45.  *     Centered text is the default.
  46.  *
  47.  *     <cRetWait> is a character which determines if the function will wait
  48.  *     for a keypress after displaying the box.  "W" or "w" will cause the
  49.  *     function to wait for a keypress before returning control to the
  50.  *     calling routine.  Not waiting is the default
  51.  *
  52.  *     <cBorType> is a character which determines whether a single or double
  53.  *     border will be displayed.  "D" or "d" will cause a double border to
  54.  *     be displayed.  A single border is the default.
  55.  *
  56.  *     <cBorColor> is a character string denoting the border color.  'N/W' is
  57.  *     the default if this parameter is not a string.
  58.  *
  59.  *     <cBoxColor> is a character string denoting the text color.  'W/N' is
  60.  *     the default if this parameter is not a string.
  61.  *
  62.  *     <nStartRow> is a number denoting the starting row.  If '99' is passed,
  63.  *     the box is centered vertically.  If necessary, nStartRow is decreased
  64.  *     so the entire box can be displayed.
  65.  *
  66.  *     <nStartCol> is a number denoting the starting column.  If '99' is passed,
  67.  *     the box is centered horizontally.  If necessary, nStartCol is decreased
  68.  *     so the entire box can be displayed.
  69.  *
  70.  *     <cLine1> thru <cLine8> are 1 to 8 character strings to be displayed.
  71.  *     They are truncated to fit on the screen if necessary.
  72.  *  $RETURNS$
  73.  *     NIL
  74.  *  $DESCRIPTION$
  75.  *     FT_XBOX() allows the programmer to display a message box on the screen
  76.  *     without needing to calculate the dimensions of the box.  Only the upper
  77.  *     left corner needs to be defined.  The function will calculate the lower
  78.  *     right corner based on the number and length of strings passed.
  79.  *    
  80.  *     A maximum of eight strings can be displayed.  If a string is too long
  81.  *     to fit on the screen it is truncated.
  82.  * 
  83.  *     The first seven parameters are optional.  The default settings are:
  84.  *        Lines of text are centered.
  85.  *        Control is returned to the calling routine immediately.
  86.  *        A single line border is painted.
  87.  *        The border is black on white.
  88.  *        The text is white on black.
  89.  *        The box is centered both vertically and horizontally.
  90.  *
  91.  *     WARNING:  Shadowing is achieved by a call to FT_SHADOW(), an assembly
  92.  *               routine not found in this .PRG.  In order to use XBOX,
  93.  *               SHADOW.OBJ must also be present somewhere (if you are using
  94.  *               NANFOR.LIB, then it is).
  95.  *  $EXAMPLES$
  96.  *     The following displays a two-line box with default settings:
  97.  * 
  98.  *       FT_XBOX(,,,,,,,'This is a test','of the XBOX() function')
  99.  *
  100.  *     The following uses all optional parameters and displays a three-line
  101.  *     box.  The box is left-justified with a double border.  It has a yellow
  102.  *     on red border and white on blue text.  The function will wait for a
  103.  *     keypress before returning control to the calling routine.
  104.  * 
  105.  *       FT_XBOX('L','W','D','GR+/R','W/B',5,10,'It is so nice',;
  106.  *                       'to not have to do the messy chore',;
  107.  *                       'of calculating the box size!')
  108.  *  $END$
  109.  */
  110.  
  111.  
  112. #ifdef FT_TEST
  113.    FUNCTION MAIN()
  114.        local i
  115.        setcolor('W/B')
  116.        * clear screen
  117.        for i = 1 to 24
  118.            @ i, 0 say replicate('@', 80)
  119.        next
  120.  
  121.        FT_XBOX(,,,,,,,'This is a test','of the XBOX() function')
  122.        FT_XBOX('L','W','D','GR+/R','W/B',1,10,'It is so nice',;
  123.                          'to not have to do the messy chore',;
  124.                          'of calculating the box size!')
  125.        FT_XBOX(,'W','D','GR+/R','W/B',16,10,'It is so nice',;
  126.                          'to not have to do the messy chore',;
  127.                          'of calculating the box size!',;
  128.                          'Even though this line is way too long, and is in fact more than 80 characters long, if you care to check!')
  129.  
  130.    return ( nil )
  131. #endif
  132.  
  133.  
  134. FUNCTION FT_XBOX(cJustType,; // "L" = left, otherwise centered
  135.                 cRetWait, ; // "W" = wait for keypress before continuing
  136.                 cBorType, ; // "D" = double, anything else single border
  137.                 cBorColor,; // color string for border
  138.                 cBoxColor,; // color string for text
  139.                 nStartRow,; // upper row of box.  99=center vertically
  140.                 nStartCol,; // left edge of box.  99=center horizontally
  141.                 cLine1, cLine2, cLine3, cLine4, cLine5, cLine6, cLine7, cLine8)
  142.  
  143.   LOCAL nLLen := 0, ;
  144.         cOldColor,  ; 
  145.         nLCol,      ;
  146.         nRCol,      ;
  147.         nTRow,      ;
  148.         nBRow,      ;
  149.         nLoop,      ;
  150.         cSayStr,    ;
  151.         nSayRow,    ;
  152.         nSayCol,    ;
  153.         nNumRows,   ;
  154.         aLines_[8]
  155.  
  156.   // validate parameters
  157.   cJustType := if(ValType(cJustType)='C',Upper(cJustType),'')
  158.   cRetWait  := if(ValType(cRetWait )='C',Upper(cRetWait), '')
  159.   cBorType  := if(ValType(cBorType )='C',Upper(cBorType), '')
  160.   cBorColor := if(ValType(cBoxColor)='C',cBorColor, 'N/W')
  161.   cBoxColor := if(ValType(cBoxColor)='C',cBoxColor, 'W/N')
  162.   nStartRow := if(ValType(nStartRow)='N',nStartRow,99)
  163.   nStartCol := if(ValType(nStartCol)='N',nStartCol,99)
  164.  
  165.   nNumRows := Min(PCount()-7,8)
  166.  
  167.   //establish array of strings to be displayed
  168.   aLines_[1] := if(ValType(cLine1) = 'C',AllTrim(SubStr(cLine1,1,74)),'')
  169.   aLines_[2] := if(ValType(cLine2) = 'C',AllTrim(SubStr(cLine2,1,74)),'')
  170.   aLines_[3] := if(ValType(cLine3) = 'C',AllTrim(SubStr(cLine3,1,74)),'')
  171.   aLines_[4] := if(ValType(cLine4) = 'C',AllTrim(SubStr(cLine4,1,74)),'')
  172.   aLines_[5] := if(ValType(cLine5) = 'C',AllTrim(SubStr(cLine5,1,74)),'')
  173.   aLines_[6] := if(ValType(cLine6) = 'C',AllTrim(SubStr(cLine6,1,74)),'')
  174.   aLines_[7] := if(ValType(cLine7) = 'C',AllTrim(SubStr(cLine7,1,74)),'')
  175.   aLines_[8] := if(ValType(cLine8) = 'C',AllTrim(SubStr(cLine8,1,74)),'')
  176.   ASize(aLines_,Min(nNumRows,8))
  177.  
  178.   // determine longest line
  179.   nLoop := 1
  180.   AEVAL(aLines_,{|| nLLen:=Max(nLLen,Len(aLines_[nLoop])),nLoop++})
  181.  
  182.   // calculate corners
  183.   nLCol = if(nStartCol=99,Int((76-nLLen)/2),Min(nStartCol,74-nLLen))
  184.   nRCol = nLCol+nLLen+3
  185.   nTRow = if(nStartRow=99,INT((24-nNumRows)/2),Min(nStartRow,22-nNumRows))
  186.   nBRow = nTRow+nNumRows+1
  187.  
  188.   // form box and border
  189.  
  190.   // save screen color and set new color
  191.   cOldColor = SetColor(cBoxColor)
  192.   @ nTRow,nLCol Clear to nBRow,nRCol
  193.  
  194.   // draw border
  195.   SetColor(cBorColor)
  196.   IF cBorType = "D"
  197.     @ nTRow,nLCol TO nBRow,nRCol double
  198.   ELSE
  199.     @ nTRow,nLCol TO nBRow,nRCol
  200.   ENDIF
  201.  
  202.  
  203.   // write shadow
  204.   FT_SHADOW(nTRow,nLCol,nBRow,nRCol)
  205.  
  206.   // print text in box
  207.   SetColor(cBoxColor)
  208.   nLoop :=1
  209.   AEVAL(aLines_,{|cSayStr|;
  210.                  nSayRow := nTRow+nLoop,;
  211.                  nSayCol := if(cJustType = 'L',;
  212.                                nLCol+2,;
  213.                                nLCol+2+(nLLen-Int(Len(aLines_[nLoop])))/2),;
  214.                  nLoop++,;
  215.                  _FTSAY(nSayRow,nSayCol,cSayStr);
  216.                 })
  217.  
  218.   // wait for keypress if desired
  219.   IF cRetWait ='W'
  220.     Inkey(0)
  221.   ENDIF
  222.  
  223.   RETURN NIL
  224.  
  225.  
  226. STATIC FUNCTION _FTSAY(nSayRow,nSayCol,cSayStr)
  227.     @ nSayRow,nSayCol SAY cSayStr
  228.     RETURN NIL
  229.