Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive : RLIB.ZIP
Filename : RL_BOXAS.PRG
Output of file : RL_BOXAS.PRG contained in archive : RLIB.ZIP
* Author..: Richard Low
* Syntax..: BOXASK(
* Returns.: Character pressed in response to a message displayed on screen
* after displaying each parameter (up to maximum of 9) on a
* separate line centered in a single line box.
* Notes...: If the first parameter is a color setting, BOXASK will use
* that color combination instead of the default White on Red.
*
FUNCTION BOXASK
PARAMETERS p1, p2, p3, p4, p5, p6, p7, p8, p9, p10, p11, p12
PRIVATE f_pcount, f_color, f_lines, f_indexp, f_brows, f_bcols, f_toprow,;
f_botrow, f_widest, f_x, f_pname, f_leftcol, f_ritecol, f_window,;
f_incolor, f_key, f_saverow, f_savecol, f_seconds
f_pcount = PCOUNT() && get param count, multiple calls to PCOUNT() do not work!
f_pname = 'p' + LTRIM(STR(f_pcount,2,0))
f_seconds = 0 && default is wait forever for keypress
IF TYPE(f_pname) = 'N' && if last parameter is numeric
f_seconds = &f_pname && it is number of seconds to pause
f_pcount = f_pcount - 1 && decrement parameter count
ENDIF
f_color = SETCOLOR() && default color is current color
f_lines = f_pcount && 'parameter to display' count; assume each param is a line to display
f_indexp = 1 && pointer to show which parm line to print
f_saverow = ROW() && save cursor position for restoration
f_savecol = COL() && on return
IF STR(AT('/',p1),1,0) $ '234' && if 1st parm is a color setting, a '/' will be at position 2,3, or 4
f_color = p1 && use 1st parameter as color setting
f_indexp = 2 && change parm pointer to next one
f_lines = f_pcount - 1 && adjust 'parameter to display' count
ENDIF
f_brows = 1 && number of blank rows above and below message
f_bcols = 5 && blank columns on either side of messages
f_toprow = (10 + f_brows) - ROUND(f_lines / 2, 0) && put in middle of screen with 2 lines above and below
f_botrow = f_toprow + (2 * f_brows) + f_lines + 1 && calculate bottom row of window
f_widest = 10 && widest window width default is 10 columns
FOR f_x = f_indexp TO f_pcount && get widest width for window
f_pname = 'p' + LTRIM(STR(f_x,2,0))
f_widest = MAX( f_widest, LEN(&f_pname) )
NEXT f_x
f_widest = MIN( f_widest + (2 * f_bcols), 77 ) && pad with (bcol) spaces on both sides, max width is 77 columns
f_leftcol = (80 - f_widest) / 2 && calculate left column position
f_ritecol = f_leftcol + f_widest + 1 && calculate right column of window
f_window = SAVESCREEN(f_toprow,f_leftcol,f_botrow,f_ritecol) && save what is underneath
f_incolor = SETCOLOR(f_color) && save old color an set to white on red, or color specified
SCROLL(f_toprow,f_leftcol,f_botrow,f_ritecol,0) && clear screen and paint in designated color
@ f_toprow,f_leftcol,f_botrow,f_ritecol BOX 'ÚÄ¿³ÙÄÀ³' && draw box around window
FOR f_x = f_indexp TO f_pcount && get widest width for window
f_pname = 'p' + LTRIM(STR(f_x,2,0)) && build name of parameter
@ f_toprow+f_brows+IF( f_lines=f_pcount, f_x, f_x-1 ),;
(80-LEN(&f_pname))/2 SAY SUBSTR(&f_pname,1,65) && say it in the center of screen
NEXT f_x
f_key = INKEY(f_seconds) && wait for keypress
SETCOLOR(f_incolor) && restore old color
RESTSCREEN(f_toprow,f_leftcol,f_botrow,f_ritecol,f_window) && restore what was underneath
@ f_saverow,f_savecol SAY '' && re-position the cursor to where it was on entry
RETURN UPPER(CHR(f_key)) && return the character pressed
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/