home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / CLIPPER / PDRD1 / DEMO.PRG < prev    next >
Text File  |  1992-12-01  |  5KB  |  158 lines
  1. /*
  2.     DEMO.PRG
  3.     Copyright (c) Angelito Dizon.  All Rights Reserved.
  4.  
  5.     Demonstrates various features of ADread(), a mouseable and extensible
  6.     replacement of READMODAL().
  7.  
  8.     In-line documentation was intentionally avoided in this program.  It
  9.     was not designed to instruct, but to show the ADread features.  See
  10.     the various instructional examples in Read.Doc for this kind of info.
  11.  
  12.     Compile and link with either of the accompanying batch files, CB.BAT and
  13.     CR.BAT.
  14. */
  15.  
  16. #include "read.ch"
  17. #include "inkey.ch"
  18.  
  19. //---------
  20. func main()
  21. field dbfname, shared, rlocked, date, comments
  22. local xdbfname, xshared, xrlocked, xdate, xcomments
  23. local aScn, nT := 17, nL := 10, nB := 23, nR := 69, getlist[0], aReadRetval
  24. local aReadConfig := ADr_defaults()
  25. local cColor := setcolor( if( iscolor(), "W+/BG, GR+/R,,, B/BG", ) )
  26.  
  27. use demo
  28. cls
  29. Xinstructions()
  30.  
  31. xdbfname = dbfname
  32. xshared = shared
  33. xrlocked = rlocked
  34. xdate = date
  35. xcomments = comments
  36.  
  37. aScn = ADbox( nT, nL, nB, nR )
  38. @nT+0, nL+2 say "[-][?]";
  39.             color if( iscolor(), "R/BG", "W+/N" )
  40. @nT+1, nL+2 say "Database name         " adget xdbfname picture "@!"
  41. @nT+2, nL+2 say "Opened in shared mode?" adget xshared
  42. @nT+3, nL+2 say "Locked record number  " adget xrlocked 
  43. @nT+4, nL+2 say "Date locked           " adget xdate
  44. @nT+5, nL+2 say "Comments              " adget xcomments picture "@S33"
  45. aReadConfig[R_KEYS] = { K_F2 }
  46. aReadConfig[R_KHANDLER] = {|e,c,p,nth,nk| Xmessage(), .F.}
  47. aReadConfig[R_LBUTTONS] = {;
  48.                                 {nT, nL+2, nT, nL+4 },;
  49.                                 {nT, nL+5, nT, nL+7 };
  50.                           }
  51. aReadConfig[R_LBHANDLER] = {|e,c,p,nth,mr,mc| Xlbhandler(e,c,p,nth,mr,mc)}
  52. aReadConfig[R_KEYVALIDBLOCK] = {|cKey,nPos,nthGet,cBuffer| Xkeyvalid(cKey,nPos,nthGet,cBuffer)}
  53. aReadRetval = ADread( getlist, aReadConfig )
  54.  
  55. if aReadRetval[2] != K_ESC .and. aReadRetval[2] != RX_ABORT;  // IF ADread() was not aborted
  56. .and. ascan( aReadRetval[1], .T. ) > 0                        // .AND. at least one of the Gets was updated   
  57.     dbfname = xdbfname                                        // THEN update the database
  58.     shared = xshared
  59.     rlocked = xrlocked
  60.     date = xdate
  61.     comments = xcomments
  62. endif
  63.  
  64. ? ""
  65. ? "Exit Code: ", aReadRetval[2]
  66. ? " ┌─────── Updated?"
  67. ? " │     ┌─ Updated Values"
  68. ? "      "
  69. ? aReadRetval[1][1], dbfname
  70. ? aReadRetval[1][2], shared
  71. ? aReadRetval[1][3], rlocked
  72. ? aReadRetval[1][4], date
  73. ? aReadRetval[1][5], comments
  74. setcolor( cColor )
  75. return nil
  76.  
  77.  
  78. //------------------------------
  79. func Xlbhandler(e,c,p,nth,mr,mc)
  80. local lRetval
  81.  
  82. ADm_rwait()
  83.  
  84. if nth = 1      // clicked [-]
  85.     lRetval = ADr_save()
  86. elseif nth = 2  // clicked [?]
  87.     Xmessage()
  88.     lRetval = .F.
  89. endif
  90.  
  91. return lRetval
  92.  
  93.  
  94. //----------------------------------------------
  95. func Xkeyvalid( cKey, nPos, nthGet, cGetBuffer )
  96. local lValid := .t.
  97.  
  98. if nthGet = 4   // will accept only October, November and December dates
  99.     if nPos = 1
  100.         if cKey != "1"
  101.             lValid = .f.
  102.         endif
  103.     elseif nPos = 2
  104.         if ( left( cGetBuffer, 1 ) + cKey ) > "12"
  105.             lValid = .f.
  106.         endif
  107.     endif
  108. endif
  109.  
  110. return lValid
  111.  
  112.  
  113. //-------------
  114. func Xmessage()
  115. local cColor := if( iscolor(), "B/W", "W+/N" )
  116. local nCursor := setcursor(0), nRow := row(),  nCol := col()
  117. local aScn := ADbox( 10, 9, 12, 70, cColor )
  118.  
  119. if ADr_varid() == "XDBFNAME"
  120.     @11,11 say "Enter the name of a database, without the .DBF extension" color cColor
  121. elseif ADr_varid() == "XSHARED"
  122.     @11,11 say "Enter a TRUE if it is opened in shared mode, else a FALSE" color cColor
  123. elseif ADr_varid() == "XRLOCKED"
  124.     @11,11 say "Enter the record number of the record to lock or check" color cColor
  125. elseif ADr_varid() == "XDATE"
  126.     @11,11 say "Enter the date you think the record may have been locked" color cColor
  127. elseif ADr_varid() == "XCOMMENTS"
  128.     @11,11 say "Enter anything you want. Press [TAB] to expand to memoedit" color cColor
  129. endif
  130.  
  131. ADywait()
  132. ADm_rwait()
  133. ADrestscn( aScn )
  134. setpos( nRow, nCol )
  135. setcursor( nCursor )
  136. return nil
  137.  
  138. //------------------
  139. func Xinstructions()
  140. ADbox( 0,0,16,79,,,.F. )
  141. @0,30 say " ADread() Demonstration "
  142. @1,2 say "Check these out: (There are more demo examples in READ.DOC.)"
  143. @2,2 say "    √ Left-click any Get to jump to it."
  144. @3,2 say "    √ 'Comments' is a memo field.  Go to it then left-click it.  It will"
  145. @4,2 say "      expand to a memoedit().  While in memoedit, left-click [-] to return"
  146. @5,2 say "      to the Get, updating it with the memoedited text.  You may abort the"
  147. @6,2 say "      the memoedit by clicking the right button."
  148. @7,2 say "    √ You can also press [TAB] to expand the Get.  While in memoedit, [TAB]"
  149. @8,2 say "      and [ESC] saves and aborts, respectively."
  150. @9,2 say "    √ Press [F2] or left-click [?] to display a Get-sensitive message"
  151. @10,2 say "    √ Left-click [-] to save the Gets and exit ADread()."
  152. @11,2 say "    √ Click the right button or press [ESC] to abort ADread()."
  153. @12,2 say "    √ The LEFT and RIGHT arrows behave like UP and DOWN if the cursor is at"
  154. @13,2 say "      first or last position."
  155. @14,2 say "    √ The 'Date Locked' Get processes every key press such that only '10',"
  156. @15,2 say "      '11', and '12' are accepted in the first 2 positions."
  157. return nil
  158.