home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / xbase / library / clipper / rlib / rl_sayin.prg < prev    next >
Encoding:
Text File  |  1989-02-18  |  6.0 KB  |  95 lines
  1. * Function..: SAYINBOX
  2. * Author....: Richard Low
  3. * Syntax....: SAYINBOX( [color,] line1 [,line2, line3...] [, seconds ] )
  4. * Returns...: Nothing.
  5. * Parameters: color .... Optional variable or constant indicating the screen
  6. *                        color to use in the form 'W/N'.  This variable is
  7. *                        deemed to be a color setting if the 2nd, 3rd, or 4th
  8. *                        character is the '/' character.  The default color
  9. *                        is WHITE foreground on RED background.
  10. *             line1..... The lines to be displayed.
  11. *             seconds... Optional timeout in seconds
  12. * Notes.....: Displays a multi-line message in a window centered on screen.
  13.  
  14. FUNCTION SAYINBOX
  15. PARAMETERS p1, p2, p3, p4, p5, p6, p7, p8, p9, p10, p11, p12
  16.  
  17. PRIVATE f_pcount, f_color, f_lines, f_indexp, f_brows, f_bcols, f_top,;
  18.         f_bottom, f_widest, f_x, f_pname, f_left, f_rite, f_window,;
  19.         f_incolor, f_saverow, f_savecol, f_pausing
  20.  
  21. f_pcount  = PCOUNT()                                            && get param count, multiple calls to PCOUNT() do not work!
  22. f_pname   = 'p' + LTRIM(STR(f_pcount,2,0))                      && get name of last parameter
  23. f_pausing = .F.                                                 && no pause by default
  24. IF TYPE(f_pname) = 'N'                                          && if last parameter is numeric
  25.    f_pausing = .T.                                              && flag to save the screen
  26.    f_seconds = &f_pname                                         && it is number of seconds to pause
  27.    f_pcount  = f_pcount - 1                                     && decrement parameter count
  28. ENDIF
  29. f_color   = SETCOLOR()                                          && default color is current color
  30. f_lines   = f_pcount                                            && 'parameter to display' count; assume each param is a line to display
  31. f_indexp  = 1                                                   && pointer to show which parm line to print
  32. f_saverow = ROW()                                               && save cursor position for restoration
  33. f_savecol = COL()                                               &&  on return
  34. IF STR(AT('/',p1),1,0) $ '234'                                  && if 1st parm is a color setting, a '/' will be at position 2,3, or 4
  35.    f_color  = p1                                                && use 1st parameter as color setting
  36.    f_indexp = 2                                                 && change parm pointer to next one
  37.    f_lines  = f_pcount - 1                                      && adjust 'parameter to display' count
  38. ENDIF
  39. f_brows  = 1                                                    && number of blank rows above and below message
  40. f_bcols  = 5                                                    && blank columns on either side of messages
  41. f_top    = (10 + f_brows) - ROUND(f_lines / 2, 0)               && put in middle of screen with 2 lines above and below
  42. f_bottom = f_top + (2 * f_brows) + f_lines + 1                  && calculate bottom row of window
  43. f_widest = 10                                                   && widest window width default is 10 columns
  44. FOR f_x = f_indexp TO f_pcount                                  && get widest width for window
  45.    f_pname  = 'p' + LTRIM(STR(f_x,2,0))
  46.    f_widest = MAX( f_widest, LEN(&f_pname) )
  47. NEXT f_x
  48. f_widest = MIN( f_widest + (2 * f_bcols), 77 )                  && pad with (bcol) spaces on both sides, max width is 77 columns
  49. f_left = (80 - f_widest) / 2                                    && calculate left column position
  50. f_rite = f_left + f_widest + 1                                  && calculate right column of window
  51. IF f_pausing                                                    && if we are to pause and restore screen
  52.    f_window = SAVESCREEN(f_top,f_left,f_bottom,f_rite)          && save what is underneath
  53.    f_retval = '    '                                            && no need to save window coordinates
  54. ELSE
  55.    f_retval = CHR(f_top)+CHR(f_left)+CHR(f_bottom)+CHR(f_rite)+;
  56.               SAVESCREEN(f_top,f_left,f_bottom,f_rite)          && save window coordinates as 4 byte string and contents
  57. ENDIF
  58. f_incolor = SETCOLOR(f_color)                                   && save old color an set to white on red, or color specified
  59. SCROLL( f_top, f_left, f_bottom, f_rite, 0 )                    && clear screen and paint in designated color
  60. @ f_top,f_left,f_bottom,f_rite BOX '┌─┐│┘─└│'                   && draw box around window
  61. FOR f_x = f_indexp TO f_pcount                                  && get widest width for window
  62.    f_pname = 'p' + LTRIM(STR(f_x,2,0))                          && build name of parameter
  63.    @ f_top+f_brows+IF( f_lines=f_pcount, f_x, f_x-1 ),;
  64.      (80-LEN(&f_pname))/2 SAY SUBSTR(&f_pname,1,65)             && say it in the center of screen
  65. NEXT f_x
  66. IF f_pausing                                                    && if we are to pause and restore screen
  67.    INKEY(f_seconds)                                             && wait that many seconds
  68.    RESTSCREEN(f_top,f_left,f_bottom,f_rite,f_window)            && restore what was underneath
  69. ENDIF
  70. @ f_saverow,f_savecol SAY ''                                    && re-position the cursor to where it was on entry
  71. SETCOLOR(f_incolor)                                             && restore old color
  72. RETURN f_retval
  73.  
  74.  
  75.  
  76. * Function..: POPBOX
  77. * Author....: Richard Low
  78. * Syntax....: POPBOX( boxstring )
  79. * Returns...: True if sucessful, false otherwise
  80. * Parameters: Specialized string returned by SAYINBOX().  Used to restore a
  81. *             section of screen overwritten by the SAYINBOX() function.
  82.  
  83. FUNCTION POPBOX
  84. PARAMETERS pstring
  85. PRIVATE f_top, f_left, f_bottom, f_rite, f_window
  86.  
  87. *-- retrieve the 4 screen coordinates from prefix 4 byte string
  88. f_top    = ASC( SUBSTR(pstring,1,1) )
  89. f_left   = ASC( SUBSTR(pstring,2,1) )
  90. f_bottom = ASC( SUBSTR(pstring,3,1) )
  91. f_right  = ASC( SUBSTR(pstring,4,1) )
  92.  
  93. RESTSCREEN( f_top, f_left, f_bottom, f_right, SUBSTR(pstring,5) )
  94. RETURN .T.
  95.