home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a012 / 1.ddi / APPENDIX.EXE / MSGBOX.PRG < prev   
Encoding:
Text File  |  1991-05-01  |  8.6 KB  |  282 lines
  1. /*
  2.    MSGBOX.PRG:  MsgBox(), a user interface building block function.
  3.                 Calls should be made through the MESSAGE user-defined
  4.                 command found in MSGBOX.CH.
  5.    Author: Craig Yellick
  6.    Excerpted from "Clipper 5: A Developer's Guide"
  7.    Copyright (c) 1991 M&T Books
  8.                       501 Galveston Drive
  9.                       Redwood City, CA 94063-4728
  10.                       (415) 366-3600
  11. */
  12.  
  13. //───── NOTE: must compile with the /N option!
  14.  
  15. //  Required for using the MESSAGE command.
  16. #include "msgbox.ch"
  17.  
  18. //  Required for using the ColorSet() function.
  19. #include "colors.ch"
  20.  
  21. //  Other handy programming things.
  22. #include "inkey.ch"
  23. #command DEFAULT <a> := <b> => <a> := if(<a> = nil, <b>, <a>)
  24.  
  25.  
  26. /*
  27.    This #define will cause the testing/demo routine to be included in
  28.    the compile. Delete the line and recompile to get rid of the test
  29.    code and produce a smaller OBJ file.  However-- leave the source
  30.    code here so you can more easily test changes and additions in the
  31.    future.
  32. */
  33. #define TESTING
  34. #ifdef TESTING
  35.   function MsgTest()
  36.   local dir_, sel, mess
  37.  
  38.     //  Must be called prior to using ColorSet().
  39.     ColorInit()
  40.  
  41.     //  Clean up screen so this demo looks nice.
  42.     setcursor(0)
  43.     @ 0,0 clear
  44.  
  45.     message "This is a simple test of the MESSAGE command."
  46.  
  47.     message "Can direct message to specific",;
  48.             "row/col: 12,40." at 12,40
  49.  
  50.     message "Multiple","Lines","Per","Message" at 1,50
  51.  
  52.     message "Notice how box is being sized", ;
  53.             "exactly large enough to hold the", ;
  54.             "lines of text, automatically?" at 19, 1
  55.  
  56.     message "Of course,","we can","control this", ;
  57.             "by specifying","all the","coordinates." at 6,3 to 16,20
  58.  
  59.     message "Press Any Key to Continue..." ;
  60.              wait 0 at 8,30 color C_MESSAGE
  61.  
  62.     @ 0,0 clear
  63.  
  64.     message "We can also specify the WIDTH and DEPTH", ;
  65.             "of the box directly, rather than trying to", ;
  66.             "calculate the ending coordinates.  This", ;
  67.             "box is directly set to be 10 by 40..." ;
  68.              at 2,2 width 40 depth 10 color C_ENHANCED
  69.  
  70.     //  Load an array with filenames
  71.     dir_ := {}
  72.     aeval(directory(), { |f_| aadd(dir_, f_[1]) } )
  73.  
  74.     message "Better yet, we can specify that the lower", ;
  75.             "part of the box be used as a scrolling", ;
  76.             "window where you can make a selction.", "" , ;
  77.             "Pick a file..." color C_ENHANCED ;
  78.             choose dir_ choosecolor C_BOLD into sel ;
  79.             at 8,32 depth 14
  80.  
  81.     message "You selected: " +if(sel = 0, "<none>", dir_[sel]), ;
  82.             "Press any key to continue..." color C_WARNING ;
  83.             wait 0 at 9,38
  84.  
  85.     //  Can stick message lines in an array.
  86.     mess := {"There's always the option to restore the", ;
  87.             "screen that was underneath, should we cover", ;
  88.             "up something important.  Press a key to", ;
  89.             "bring back the File Selection message."}
  90.  
  91.     message mess at 7,23 wait 0 color C_MESSAGE restore
  92.  
  93.     message "That's it for the demo..." at 18,1 ;
  94.              color C_BLINK wait 5
  95.  
  96.     @ 0,0 clear
  97.  
  98.   return nil
  99. #endif
  100.  
  101. /*------------------------------------------------------------------*/
  102.  
  103.  
  104. function MsgBox(r1, c1, r2, c2, width, depth, ;
  105.                 msg_, msgClr, ;
  106.                 ch_, chClr, ;
  107.                 wait, restore)
  108. /*
  109.    General-purpose message display and choice selection function.
  110.  
  111.    Parameter  Description
  112.    ---------  -----------
  113.    r1         Starting row, default is row().
  114.    c1         Starting column, default is col().
  115.  
  116.    r2         Ending row, default based on messages/choices.
  117.    c2         Ending column, default based on messages/choices.
  118.  
  119.    width      Columns wide, defaults to length of longest line.
  120.    depth      Rows deep, defaults to number of message/choice lines.
  121.               (Width and depth are ignored if r2 and/or c2
  122.               are specified.
  123.  
  124.    msg_       Array of message lines.
  125.    msgClr     Color number for main box and message section.
  126.    ch_        Array of choice lines.
  127.    chClr      Color number for choice section.
  128.  
  129.    wait       How long to wait (nil = don't)
  130.    restore    True = restore screen afterwards, False/nil = leave.
  131.  
  132.                              ┌────────────────┐
  133.                              │ Message Line 1 │
  134.    General layout if         │ Message Line 2 │
  135.    both Message lines        │ : etc          │
  136.    and Choice lines          ├────────────────┤
  137.    are used:                 │ Choice Line 1  │
  138.                              │ Choice Line 2  │
  139.                              │ :  etc         │
  140.                              └────────────────┘
  141. */
  142.  
  143. local sel                      //  User's selection to return (if any)
  144. local msgLen := 0, chLen := 0  //  Length of longest line in msg_, ch_
  145. local boxWide, boxDeep         //  Box dimensions
  146. local oldCur, oldClr, oldScr   //  Existing color, cursor and screen
  147. local oldR, oldC               //  Existing row/column position
  148. local cr1                      //  Starting choice row
  149. local i                        //  Everyone's favorite iterator
  150.  
  151.  
  152.   //  Some parameters have direct default values.
  153.   default r1 := row()
  154.   default c1 := col()
  155.   default msg_ := {}
  156.   default ch_  := {}
  157.   default msgClr := C_NORMAL
  158.   default chClr  := C_ENHANCED
  159.   default restore := .f.
  160.  
  161.   //  Nil is used to indicate no message is desired, just choices.
  162.   if (len(msg_) > 0) .and. (msg_[1] = nil)
  163.     msg_ := {}
  164.   endif
  165.  
  166.  
  167.   /*
  168.      Message and choices may be passed as a nested array due to the way
  169.      the MESSAGE #command works, to provide maximum flexibility.
  170.      Aclone() is used because we're dealing with an array reference, and
  171.      yanking out a nested level may not please the calling routine which
  172.      owns the array.
  173.   */
  174.   if (len(msg_) > 0) .and. (valtype(msg_[1]) = "A")
  175.     msg_ := aclone(msg_[1])
  176.   endif
  177.   if (len(ch_) > 0) .and. (valtype(ch_[1]) = "A")
  178.     ch_ := aclone(ch_[1])
  179.   endif
  180.  
  181.  
  182.   /*
  183.      At this point we can determine some default dimensions. User can
  184.      override them based on the "TO R, C" or DEPTH, WIDTH parameters.
  185.   */
  186.   //  Length of longest line in message area.
  187.   aeval(msg_, { |s| msgLen := max(msgLen, len(s)) })
  188.  
  189.   //  Length of longest line in choice area.
  190.   aeval(ch_,  { |s| chLen  := max(chLen,  len(s)) })
  191.  
  192.   //  Initial depth of box is messages plus choice lines.
  193.   //  Add one line for bottom of box and one for separator line.
  194.   boxDeep := if(len(msg_) = 0, 0, len(msg_) +1) ;
  195.             +if(len(ch_)  = 0, 0, len(ch_)  +1)
  196.   boxDeep := min(boxDeep, maxrow() -r1)
  197.  
  198.   //  Initial width of box is longest of message and choice lines.
  199.   //  Add one column for right edge of box.
  200.   boxWide := max(msgLen, chLen) +1
  201.  
  202.  
  203.   /*
  204.      Some parameters can now be defaulted based on others.
  205.   */
  206.   default r2 := r1 +if(depth = nil, boxDeep, depth)
  207.   default c2 := c1 +if(width = nil, boxWide, width)
  208.  
  209.  
  210.   /*
  211.      Adjust confused parameters so programmer can see what's happened
  212.      and keep on testing.
  213.   */
  214.   if r2 <= r1
  215.     r2 := maxrow()
  216.   endif
  217.   if c2 <= c1
  218.     c2 := maxcol()
  219.   endif
  220.  
  221.  
  222.   /*
  223.      Now that we know the dimensions we can save
  224.      the screen region and draw the initial box.
  225.   */
  226.   if restore
  227.     oldScr := savescreen(r1, c1, r2, c2)
  228.   endif
  229.   oldR := row() ; oldC := col()
  230.   oldCur := setcursor(0)
  231.   oldClr := ColorSet(msgClr)
  232.   @ r1, c1 clear to r2, c2
  233.   @ r1, c1 to r2, c2
  234.  
  235.  
  236.   //  Display as many message lines as can fit in box.
  237.   //  Trim line widths to fit in interior of box.
  238.   for i := 1 to min(len(msg_), r2 -(r1 +1))
  239.     devpos(r1 +i, c1 +1)
  240.     devout(left(msg_[i], c2 -(c1 +1)))
  241.   next i
  242.  
  243.   //  If a choice array was sent.
  244.   if len(ch_) > 0
  245.  
  246.     //  If a message array was sent.
  247.     if len(msg_) >0
  248.       //  Separator line between message and choice sections.
  249.       devpos(r1 +len(msg_) +1, c1)
  250.       devout(chr(195) +replicate(chr(196), c2-(c1+1)) +chr(180))
  251.       cr1 := r1 +len(msg_) +2
  252.     else
  253.       cr1 := r1 +1
  254.     endif
  255.  
  256.     //  Use "choices" color setting.
  257.     ColorSet(chClr)
  258.  
  259.     //  ENTER or ESC key allow exit.
  260.     do while .t.
  261.       sel := achoice(cr1, c1 +1, r2 -1, c1 +(c2 -c1) -1, ch_)
  262.       if (lastkey() = K_ENTER) .or. (lastkey() = K_ESC)
  263.         exit
  264.       endif
  265.     enddo
  266.  
  267.   elseif valtype(wait) = "N"
  268.     sel := inkey(wait)
  269.   endif
  270.  
  271.   //  Restore the screen environment before exit.
  272.   if restore
  273.     restscreen(r1, c1, r2, c2, oldScr)
  274.   endif
  275.   setcolor(oldClr)
  276.   setcursor(oldCur)
  277.   devpos(oldR, oldC)
  278.  
  279. return sel
  280.  
  281. // end of file MSGBOX.PRG
  282.