home *** CD-ROM | disk | FTP | other *** search
/ Power CD-ROM!! 7 / POWERCD7.ISO / prgmming / clipper / gt_rmemo.prg < prev    next >
Text File  |  1993-10-14  |  6KB  |  206 lines
  1. /*
  2.  * File......: GT_RMemo.prg
  3.  * Author....: Niall Scott
  4.  * BBS.......: The Dark Knight Returns
  5.  * Net/Node..: 050/069
  6.  * User Name.: Niall Scott
  7.  * Date......: 29/6/93
  8.  * Revision..: 1.0
  9.  * Log file..: $Logfile$
  10.  *
  11.  * This is an original work by Niall R Scott and is placed in the
  12.  * public domain.
  13.  *
  14.  * Modification history:
  15.  * ---------------------
  16.  *
  17.  * Rev 1.0  29/6/93
  18.  * Initial Revision
  19.  */
  20.  
  21. /*  $DOC$
  22.  *  $FUNCNAME$
  23.  *      GT_MEMOREAD
  24.  *  $CATEGORY$
  25.  *      Get Reader
  26.  *  $ONELINER$
  27.  *      GET a Memo Field
  28.  *  $SYNTAX$
  29.  *         @ <row>, <col> GET <memo> MEMO COORD <coords> ;
  30.  *       BOXCOLOR <bcolor> TITLE <title>
  31.  *  $ARGUMENTS$
  32.  *      Standard Get parameters +
  33.  *        coords     - array of 4 elements Top,left,bottom,right of MemoEdit Box
  34.  *        bcolor  - color of MemoEdit Box (optional)
  35.  *        title   - title of Memoedit Box (optional)
  36.  *  $RETURNS$
  37.  *      Updated Get:buffer
  38.  *  $DESCRIPTION$
  39.  *      To allow a standard GET/Read on a Memo field.
  40.  *        displays MEMO/memo at the <row>, <col> position depending
  41.  *        if the memo field has anything in it.
  42.  *        Control_Page_Down to enter the Memo reader
  43.  *        Allows all standard features of get system eg WHEN,VALID
  44.  *        if get COLOR is used this will be used for the MEMO/memo
  45.  *
  46.  *        REQUIRES GT_Cent() if the TITLE option is used
  47.  *  $EXAMPLES$
  48.  *PROCEDURE TestMemo()
  49.  *    LOCAL GetList := {}
  50.  *    LOCAL mNotes
  51.  *
  52.  *      CLS
  53.  *      mNotes := "This is the default memo string at entry to the GET."
  54.  *
  55.  *      @ 4,0 SAY "Notes:"
  56.  *      @ 4,10 GET mNotes MEMO COORD {5, 10, 15, 50} ;
  57.  *                                BOXCOLOR "W+/B,GR+/B" TITLE 'Test'
  58.  *      READ
  59.  *
  60.  *      ? mNotes
  61.  *     RETURN
  62.  *  $SEEALSO$
  63.  *
  64.  *  $INCLUDE$
  65.  *        GT_Memo.ch
  66.  *  $END$
  67.  */
  68.  
  69. #include "gt_lib.ch"
  70. #include "gt_memo.ch"
  71.  
  72. //  Layout of cargo instance variable
  73. #define  ID       1                 // cargo col 1 - option id
  74. #define  DATA     2                 // cargo col 2 - memo data
  75. #define  COORDS   3                 // cargo col 3 - coordinates array
  76. #define  COLOR    4                 // cargo col 4 - optional box color
  77. #define  HEADER      5                 // cargo col 5 - optional Box Title
  78.  
  79. //  Layout of COORDS element in cargo instance variable
  80. #define  T        1                 // coords col 1 - top
  81. #define  L        2                 // coords col 2 - left
  82. #define  B        3                 // coords col 3 - bottom
  83. #define  R        4                 // coords col 4 - right
  84.  
  85. //  For compatibility  with Clipper 5.01 taken from
  86. //  Common.ch included with Clipper 5.2
  87. #translate ISBLOCK( <v1> )       => ( valtype( <v1> ) == "B" )
  88. #translate ISCHARACTER( <v1> )   => ( valtype( <v1> ) == "C" )
  89.  
  90. #define MEMO_OPEN    K_CTRL_PGDN
  91. #define MEMO_CLOSE  K_CTRL_W
  92.  
  93.  
  94.  
  95. PROCEDURE GT_MemoRead(g)
  96.    Local cOldColor
  97.    cOldColor := SetColor()
  98.    IF (GetPreValidate(g))
  99.       SETKEY(K_CTRL_PGUP, {|| KeyWrite()})
  100.       g:setFocus()
  101.  
  102.       WHILE(g:exitstate == GE_NOEXIT)
  103.  
  104.          WHILE(g:exitstate == GE_NOEXIT)
  105.             MyApplyKey(g, INKEY(0))
  106.          ENDDO
  107.  
  108.          IF (!GetPostValidate(g))
  109.             g:exitstate := GE_NOEXIT
  110.          ENDIF
  111.  
  112.       ENDDO
  113.  
  114.       g:killFocus()
  115.       SETKEY(MEMO_CLOSE, NIL)
  116.    ENDIF
  117.    SetColor( cOldColor )
  118. RETURN
  119.  
  120. FUNCTION KeyWrite
  121.  
  122.    KEYBOARD CHR(K_CTRL_END)
  123.  
  124. RETURN NIL
  125.  
  126. PROCEDURE MyApplyKey(get, key)
  127. LOCAL cKey
  128. LOCAL bKeyBlock
  129.  
  130.    // check for SET KEY first
  131.    IF ((bKeyBlock := SETKEY(key)) <> NIL)
  132.       GetDoSetKey(bKeyBlock, get)
  133.       RETURN                                    // NOTE
  134.    ENDIF
  135.  
  136.    DO CASE
  137.    CASE (key == K_UP);              get:exitState := GE_UP
  138.    CASE (key == K_SH_TAB);          get:exitState := GE_UP
  139.    CASE (key == K_DOWN);            get:exitState := GE_DOWN
  140.    CASE (key == K_TAB);             get:exitState := GE_DOWN
  141.    CASE (key == K_ENTER);           get:exitState := GE_ENTER
  142.  
  143.    CASE (key == K_ESC);             IF (SET(_SET_ESCAPE)) ;;
  144.                                       get:exitState := GE_ESCAPE ;;
  145.                                     ENDIF
  146.  
  147.    CASE (key == K_PGUP);            get:exitState := GE_WRITE
  148.    CASE (key == K_PGDN);            get:exitState := GE_WRITE
  149.    CASE (key == K_CTRL_HOME);       get:exitState := GE_TOP
  150.    CASE (key == MEMO_OPEN);         GetMemo(get)
  151.    ENDCASE
  152.  
  153. RETURN
  154.  
  155.  
  156.  
  157. FUNCTION GetMemo( oGet)
  158. LOCAL cTempScrn, aCoords
  159. LOCAL cOldColor := SETCOLOR()
  160. LOCAL lOldScore := SET(_SET_SCOREBOARD, .F.)
  161. LOCAL nRow := ROW(), nCol := COL()
  162. LOCAL cTitle
  163.  
  164.    //Default aCoords to Full Screen
  165.    aCoords := IF(VALTYPE( oGet:cargo[COORDS]) == "A", ;
  166.      oGet:cargo[COORDS], {0, 0, MAXROW(), MAXCOL()})
  167.  
  168.    cTempScrn := SAVESCREEN(aCoords[T], aCoords[L], aCoords[B], aCoords[R])
  169.  
  170.    IF  oGet:cargo[COLOR] <> NIL
  171.       SETCOLOR( oGet:cargo[COLOR])
  172.    ENDIF
  173.  
  174.    // Draw Single Line Box
  175.    @ aCoords[T], aCoords[L] TO aCoords[B], aCoords[R]
  176.  
  177.    //Draw Title centred on top line if passed
  178.    IF ( oGet:cargo[HEADER] <> NIL ) .AND. ( ISCHARACTER( oGet:cargo[HEADER] ))
  179.             cTitle := '┤ '+ oGet:cargo[HEADER]+ ' ├'
  180.             @ aCoords[T], aCoords[L] + GT_CENT(cTitle,aCoords[R]-aCoords[L]) SAY cTitle
  181.  
  182.    ENDIF
  183.  
  184.     //The Meat of the function
  185.     oGet:varPut( oGet:cargo[DATA] := MEMOEDIT( oGet:cargo[DATA], aCoords[T] + 1, ;
  186.     aCoords[L] + 1, aCoords[B] - 1, aCoords[R] - 1))
  187.  
  188.     oGet:updateBuffer()
  189.  
  190.    RESTSCREEN(aCoords[T], aCoords[L], aCoords[B], aCoords[R], cTempScrn)
  191.  
  192.    SETCOLOR(cOldColor)
  193.    SET(_SET_SCOREBOARD, lOldScore)
  194.    SETPOS(nRow, nCol)
  195.  
  196. RETURN NIL
  197.  
  198.  
  199. FUNCTION xGetNew(nRow, nCol, bBlock, cName, bValid, bWhen)
  200. LOCAL oGet := GetNew(nRow, nCol, bBlock, cName)
  201.  
  202.    oGet:postBlock := bValid
  203.    oGet:preBlock := bWhen
  204.  
  205. RETURN(oGet)
  206.