/* * File......: XBOX.PRG * Author....: Don Opperthauser * CIS ID....: ? * * This is an original work by Don Opperthauser and is placed in the * public domain. * * Modification history: * --------------------- * * Rev 1.3 17 Aug 1991 15:47:06 GLENN * Don Caton fixed some spelling errors in the doc * * Rev 1.2 15 Aug 1991 23:05:12 GLENN * Forest Belt proofread/edited/cleaned up doc * * Rev 1.1 14 Jun 1991 17:55:50 GLENN * Fixed bug where extra blank line was displayed in the box. * * Rev 1.0 01 Apr 1991 01:02:34 GLENN * Nanforum Toolkit * */ /* $DOC$ * $FUNCNAME$ * FT_XBOX() * $CATEGORY$ * Menus/Prompts * $ONELINER$ * Display a self-sizing message box and message * $SYNTAX$ * FT_XBOX( [ ], [ ], [ ], ; * [ ], [ ], [ ], ; * [ ], , , , ; * , , , , ) -> NIL * $ARGUMENTS$ * is a character indicating the type of text justification. * "L" or "l" will cause the text to be left-justified in the box. * Centered text is the default. * * is a character which determines if the function will wait * for a keypress after displaying the box. "W" or "w" will cause the * function to wait for a keypress before returning control to the * calling routine. Not waiting is the default * * is a character which determines whether a single or double * border will be displayed. "D" or "d" will cause a double border to * be displayed. A single border is the default. * * is a character string denoting the border color. 'N/W' is * the default if this parameter is not a string. * * is a character string denoting the text color. 'W/N' is * the default if this parameter is not a string. * * is a number denoting the starting row. If '99' is passed, * the box is centered vertically. If necessary, nStartRow is decreased * so the entire box can be displayed. * * is a number denoting the starting column. If '99' is passed, * the box is centered horizontally. If necessary, nStartCol is decreased * so the entire box can be displayed. * * thru are 1 to 8 character strings to be displayed. * They are truncated to fit on the screen if necessary. * $RETURNS$ * NIL * $DESCRIPTION$ * FT_XBOX() allows the programmer to display a message box on the screen * without needing to calculate the dimensions of the box. Only the upper * left corner needs to be defined. The function will calculate the lower * right corner based on the number and length of strings passed. * * A maximum of eight strings can be displayed. If a string is too long * to fit on the screen it is truncated. * * The first seven parameters are optional. The default settings are: * Lines of text are centered. * Control is returned to the calling routine immediately. * A single line border is painted. * The border is black on white. * The text is white on black. * The box is centered both vertically and horizontally. * * WARNING: Shadowing is achieved by a call to FT_SHADOW(), an assembly * routine not found in this .PRG. In order to use XBOX, * SHADOW.OBJ must also be present somewhere (if you are using * NANFOR.LIB, then it is). * $EXAMPLES$ * The following displays a two-line box with default settings: * * FT_XBOX(,,,,,,,'This is a test','of the XBOX() function') * * The following uses all optional parameters and displays a three-line * box. The box is left-justified with a double border. It has a yellow * on red border and white on blue text. The function will wait for a * keypress before returning control to the calling routine. * * FT_XBOX('L','W','D','GR+/R','W/B',5,10,'It is so nice',; * 'to not have to do the messy chore',; * 'of calculating the box size!') * $END$ */ #ifdef FT_TEST FUNCTION MAIN() local i setcolor('W/B') * clear screen for i = 1 to 24 @ i, 0 say replicate('@', 80) next FT_XBOX(,,,,,,,'This is a test','of the XBOX() function') FT_XBOX('L','W','D','GR+/R','W/B',1,10,'It is so nice',; 'to not have to do the messy chore',; 'of calculating the box size!') FT_XBOX(,'W','D','GR+/R','W/B',16,10,'It is so nice',; 'to not have to do the messy chore',; 'of calculating the box size!',; 'Even though this line is way too long, and is in fact more than 80 characters long, if you care to check!') return ( nil ) #endif FUNCTION FT_XBOX(cJustType,; // "L" = left, otherwise centered cRetWait, ; // "W" = wait for keypress before continuing cBorType, ; // "D" = double, anything else single border cBorColor,; // color string for border cBoxColor,; // color string for text nStartRow,; // upper row of box. 99=center vertically nStartCol,; // left edge of box. 99=center horizontally cLine1, cLine2, cLine3, cLine4, cLine5, cLine6, cLine7, cLine8) LOCAL nLLen := 0, ; cOldColor, ; nLCol, ; nRCol, ; nTRow, ; nBRow, ; nLoop, ; cSayStr, ; nSayRow, ; nSayCol, ; nNumRows, ; aLines_[8] // validate parameters cJustType := if(ValType(cJustType)='C',Upper(cJustType),'') cRetWait := if(ValType(cRetWait )='C',Upper(cRetWait), '') cBorType := if(ValType(cBorType )='C',Upper(cBorType), '') cBorColor := if(ValType(cBoxColor)='C',cBorColor, 'N/W') cBoxColor := if(ValType(cBoxColor)='C',cBoxColor, 'W/N') nStartRow := if(ValType(nStartRow)='N',nStartRow,99) nStartCol := if(ValType(nStartCol)='N',nStartCol,99) nNumRows := Min(PCount()-7,8) //establish array of strings to be displayed aLines_[1] := if(ValType(cLine1) = 'C',AllTrim(SubStr(cLine1,1,74)),'') aLines_[2] := if(ValType(cLine2) = 'C',AllTrim(SubStr(cLine2,1,74)),'') aLines_[3] := if(ValType(cLine3) = 'C',AllTrim(SubStr(cLine3,1,74)),'') aLines_[4] := if(ValType(cLine4) = 'C',AllTrim(SubStr(cLine4,1,74)),'') aLines_[5] := if(ValType(cLine5) = 'C',AllTrim(SubStr(cLine5,1,74)),'') aLines_[6] := if(ValType(cLine6) = 'C',AllTrim(SubStr(cLine6,1,74)),'') aLines_[7] := if(ValType(cLine7) = 'C',AllTrim(SubStr(cLine7,1,74)),'') aLines_[8] := if(ValType(cLine8) = 'C',AllTrim(SubStr(cLine8,1,74)),'') ASize(aLines_,Min(nNumRows,8)) // determine longest line nLoop := 1 AEVAL(aLines_,{|| nLLen:=Max(nLLen,Len(aLines_[nLoop])),nLoop++}) // calculate corners nLCol = if(nStartCol=99,Int((76-nLLen)/2),Min(nStartCol,74-nLLen)) nRCol = nLCol+nLLen+3 nTRow = if(nStartRow=99,INT((24-nNumRows)/2),Min(nStartRow,22-nNumRows)) nBRow = nTRow+nNumRows+1 // form box and border // save screen color and set new color cOldColor = SetColor(cBoxColor) @ nTRow,nLCol Clear to nBRow,nRCol // draw border SetColor(cBorColor) IF cBorType = "D" @ nTRow,nLCol TO nBRow,nRCol double ELSE @ nTRow,nLCol TO nBRow,nRCol ENDIF // write shadow FT_SHADOW(nTRow,nLCol,nBRow,nRCol) // print text in box SetColor(cBoxColor) nLoop :=1 AEVAL(aLines_,{|cSayStr|; nSayRow := nTRow+nLoop,; nSayCol := if(cJustType = 'L',; nLCol+2,; nLCol+2+(nLLen-Int(Len(aLines_[nLoop])))/2),; nLoop++,; _FTSAY(nSayRow,nSayCol,cSayStr); }) // wait for keypress if desired IF cRetWait ='W' Inkey(0) ENDIF RETURN NIL STATIC FUNCTION _FTSAY(nSayRow,nSayCol,cSayStr) @ nSayRow,nSayCol SAY cSayStr RETURN NIL