home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Database / CLIPR503.W96 / BOX.PR_ / BOX.PR
Text File  |  1995-06-20  |  4KB  |  139 lines
  1. /***
  2. *
  3. *  Box.prg
  4. *
  5. *  Sample user-defined functions defining menus
  6. *
  7. *  Copyright (c) 1993-1995, Computer Associates International Inc.
  8. *  All rights reserved.
  9. *
  10. *  NOTE: compile with /a /m /n /w
  11. *
  12. */
  13.  
  14.  
  15. /***
  16. *
  17. *  BoxMenu( <aMenuItems>, [<nTop>], [<nLeft>], [<nBottom>], [<nRight>],
  18. *           [<cMenuTitle>], [<nChoice>], [<cBoxChars>], [<cColorString>] )
  19. *  --> nChoice
  20. *
  21. *  Paint quick and simple menu inside a box with a drop shadow.
  22. *
  23. *  Returns a numeric value which denotes the subscript of the array
  24. *  passed to the BoxMenu() function which holds the menu prompts.
  25. *
  26. *  One menu choice per element.
  27. *
  28. */
  29. FUNCTION BoxMenu( aMenuItems, nTop, nLeft, nBottom, nRight, cMenuTitle, ;
  30.                   nChoice, cBoxChars, cMenuColor )
  31.  
  32.    LOCAL i
  33.    LOCAL nMenuRow
  34.    LOCAL nMenuCol
  35.    LOCAL cOldColor
  36.    LOCAL nLength     := 0
  37.    LOCAL lArrNotChar := .F.
  38.  
  39.    // If no array is passed or array will not fit on screen, return NIL
  40.    IF aMenuItems == NIL .OR. LEN( aMenuItems ) > ( MAXROW() - 3 )
  41.       RETURN ( NIL )       // *NOTE*
  42.    ENDIF
  43.  
  44.    // Check if starting choice (nChoice) was passed
  45.    nChoice := IF( nChoice == NIL, 1, nChoice )
  46.  
  47.    // Find the longest array element (menu prompt) and check if any element
  48.    // is not of character type.
  49.    ASCAN( aMenuItems, { |str| nLength := MAX( nLength, LEN( str ) ), ;
  50.                           lArrNotChar := ( VALTYPE( str ) <> "C" ) } )
  51.  
  52.    // If any element is not of character type then return NIL
  53.    IF lArrNotChar
  54.       RETURN ( NIL )       // *NOTE*
  55.    ENDIF
  56.  
  57.    // Initialize the four coordinates
  58.    nTop    := IF( nTop == NIL, 0, nTop )
  59.    nLeft   := IF( nLeft == NIL, 0, nLeft )
  60.  
  61.    nBottom := MIN( MAX( nTop + LEN( aMenuItems ) + 3,;
  62.               IF( nBottom == NIL, MAXROW(), nBottom ) ), MAXROW() )
  63.  
  64.    nRight  := MIN( MAX( nLeft + nLength + 3, ;
  65.               IF( nRight == NIL, MAXCOL(), nRight ) ), MAXCOL() )
  66.  
  67.    // Check if box characters and color specification was passed
  68.    cBoxChars  := IF( cBoxChars  == NIL, "╔═╗║╝═╚║", cBoxChars  )
  69.    cMenuColor := IF( cMenuColor == NIL, SETCOLOR(), cMenuColor )
  70.  
  71.    // Save the old color and set a new color
  72.    cOldColor := SETCOLOR( cMenuColor )
  73.  
  74.    // Paint the box
  75.    @ nTop, nLeft CLEAR TO nBottom, nRight
  76.    @ nTop, nLeft, nBottom, nRight BOX cBoxChars
  77.  
  78.    IF cMenuTitle != NIL
  79.       @ nTop, nLeft + 2 SAY "[" + cMenuTitle + "]"
  80.    ENDIF
  81.  
  82.    // Paint the drop shadow
  83.    BoxShadow( nTop, nLeft, nBottom, nRight )
  84.  
  85.    // Determine the starting row and column of the first menu prompt
  86.    // so as to center the menu
  87.    nMenuRow := nTop + INT( (( nBottom - nTop ) - LEN( aMenuItems )) / 2 ) + 1
  88.    nMenuCol := nLeft + INT( (( nRight - nLeft ) - nLength ) / 2 ) + 1
  89.  
  90.    // Invoke the menu
  91.    FOR i := 1 TO LEN( aMenuItems )
  92.       @ nMenuRow++, nMenuCol ;
  93.       PROMPT LEFT( aMenuItems[i] + SPACE(nLength), nLength )
  94.    NEXT
  95.  
  96.    MENU TO nChoice
  97.  
  98.    // Reset the old color
  99.    SETCOLOR( cOldColor )
  100.  
  101.    RETURN nChoice
  102.  
  103.  
  104.  
  105. /***
  106. *
  107. *  BoxShadow( <nTop>, <nLeft>, <nBottom>, <nRight> ) --> NIL
  108. *
  109. *  Draw a box shadow with see through
  110. *
  111. */
  112. FUNCTION BoxShadow( nTop, nLeft, nBottom, nRight )
  113.  
  114.    LOCAL nShadTop
  115.    LOCAL nShadLeft
  116.    LOCAL nShadBottom
  117.    LOCAL nShadRight
  118.  
  119.    nShadTop   := nShadBottom := MIN( nBottom + 1, MAXROW() )
  120.    nShadLeft  := nLeft + 1
  121.    nShadRight := MIN( nRight + 1, MAXCOL() )
  122.  
  123.    // This paints the shadow region by replacing the actual screen color
  124.    // attributes with "" (CHR(7), low intensity white on black) which
  125.    // gives the illusion of a shadow
  126.    RESTSCREEN( nShadTop, nShadLeft, nShadBottom, nShadRight,                 ;
  127.       TRANSFORM( SAVESCREEN(nShadTop, nShadLeft, nShadBottom, nShadRight),   ;
  128.       REPLICATE("X", nShadRight - nShadLeft + 1 ) ) )
  129.  
  130.    nShadTop    := nTop + 1
  131.    nShadLeft   := nShadRight := MIN( nRight + 1, MAXCOL() )
  132.    nShadBottom := nBottom
  133.  
  134.    RESTSCREEN( nShadTop, nShadLeft, nShadBottom, nShadRight,                 ;
  135.       TRANSFORM( SAVESCREEN(nShadTop,  nShadLeft, nShadBottom,  nShadRight), ;
  136.       REPLICATE("X", nShadBottom - nShadTop + 1 ) ) )
  137.  
  138.    RETURN ( NIL )
  139.