home *** CD-ROM | disk | FTP | other *** search
/ Power CD-ROM!! 7 / POWERCD7.ISO / prgmming / clipper / gt_brows.prg < prev    next >
Text File  |  1993-10-14  |  8KB  |  318 lines
  1. /*
  2.     File......: GT_Browse.prg
  3.     Author....: Martin Bryant
  4.     BBS.......: The Dark Knight Returns
  5.     Net/Node..: 050/069
  6.     User Name.: Martin Bryant
  7.     Date......: 12/02/93
  8.     Revision..: 1.0
  9.  
  10.     This is an original work by Martin Bryant and is placed
  11.     in the public domain.
  12.  
  13.     Modification history:
  14.     ---------------------
  15.  
  16.     Rev 1.0 12/02/93
  17.     PD Revision.
  18. */
  19.  
  20. /*  $DOC$
  21.  *  $FUNCNAME$
  22.  *      GT_BROWSE()
  23.  *  $CATEGORY$
  24.  *      General
  25.  *  $ONELINER$
  26.  *      Browse a DBF with for and while clauses.
  27.  *  $SYNTAX$
  28.  *      GT_Browse(<aFields>,<aTitles>,[<cHead>],[<nTop>], ;
  29.  *          [<nLeft>],[<nBottom>],[<nRight>],[<bFind>], ;
  30.  *          [<bFor>],[<nFreeze>],[<bKeyEx>],[<bWaitFunc>], ;
  31.  *          [<cBox>],[<lScreen>]) -> lSelected
  32.  *  $ARGUMENTS$
  33.  *      <aFields> is an array of code blocks defining the
  34.  *      information to be displayed.
  35.  *
  36.  *      <aTitles> is an array of strings to display as
  37.  *      column titles.
  38.  *
  39.  *      <cHead> is a title for the Browse.
  40.  *
  41.  *      <nTop>,<nLeft>,<nBottom>,<nRight> are the table
  42.  *      corners.
  43.  *
  44.  *      <bFind> is the while clause code block to compare
  45.  *      against the index key.
  46.  *
  47.  *      <bFor> is the for condition code block.
  48.  *
  49.  *      <nFreeze> is the number of columns to freeze from
  50.  *      the left.
  51.  *
  52.  *      <bKeyEx> is a code block containing the code for
  53.  *      handling key exceptions. Should return .T. if an
  54.  *      item has been selected, otherwise .F..
  55.  *
  56.  *      <bWaitFunc> is the code block defining the 'Waiting
  57.  *      For a Key Press' function.
  58.  *
  59.  *      <cBox> box lines definition.
  60.  *
  61.  *      <lScreen> Should the screen be saved and restored ?
  62.  *  $RETURNS$
  63.  *      lSelected
  64.  *  $DESCRIPTION$
  65.  *      Browse a DBF with for and while clauses.
  66.  *  $EXAMPLES$
  67.  *  $SEEALSO$
  68.  *
  69.  *  $INCLUDE$
  70.  *
  71.  *  $END$
  72.  */
  73.  
  74. #include "GT_LIB.ch"
  75.  
  76. FUNCTION GT_Browse(aFields,aTitles,cHead,nTop,nLeft, ;
  77.     nBottom,nRight,bFind,bFor,nFreeze,bKeyEx,bWaitFunc, ;
  78.     cBox,lRestScreen)
  79.  
  80. LOCAL aStdKeys := { ;
  81.     K_DOWN, ;
  82.     K_UP, ;
  83.     K_PGDN, ;
  84.     K_PGUP, ;
  85.     K_CTRL_PGUP, ;
  86.     K_CTRL_PGDN, ;
  87.     K_RIGHT, ;
  88.     K_LEFT, ;
  89.     K_HOME, ;
  90.     K_END, ;
  91.     K_CTRL_LEFT, ;
  92.     K_CTRL_RIGHT, ;
  93.     K_CTRL_HOME, ;
  94.     K_CTRL_END }
  95.  
  96. LOCAL aStdFuncs := { ;
  97.     { | oTBCol | oTBCol:Down() }, ;
  98.     { | oTBCol | oTBCol:Up() }, ;
  99.     { | oTBCol | oTBCol:PageDown() }, ;
  100.     { | oTBCol | oTBCol:PageUp() }, ;
  101.     { | oTBCol | oTBCol:GoTop() }, ;
  102.     { | oTBCol | oTBCol:GoBottom() }, ;
  103.     { | oTBCol | oTBCol:Right() }, ;
  104.     { | oTBCol | oTBCol:Left() }, ;
  105.     { | oTBCol | oTBCol:Home() }, ;
  106.     { | oTBCol | oTBCol:End() }, ;
  107.     { | oTBCol | oTBCol:PanLeft() }, ;
  108.     { | oTBCol | oTBCol:PanRight() }, ;
  109.     { | oTBCol | oTBCol:PanHome() }, ;
  110.     { | oTBCol | oTBCol:PanEnd() } }
  111.  
  112. //  Define index CB
  113. LOCAL bIndex := GT_IndexBlock(0)
  114. LOCAL bWhile := { | | .T. }
  115. LOCAL cRestore := ''
  116. LOCAL cSearch := ''
  117. LOCAL lFault := .F.
  118. LOCAL lAllRecords := .T.
  119. LOCAL nCursor := GT_NoCursor()
  120. LOCAL nIndex := INDEXORD()
  121. LOCAL nKey := 0
  122. LOCAL nLocation := 0
  123. LOCAL nRecord := 0
  124. LOCAL oBrowse := NIL
  125. LOCAL uIndexkey := NIL
  126.  
  127. Default aFields To {}
  128. Default aTitles To {}
  129. Default cHead To ''
  130. Default nTop To 03
  131. Default nLeft To 02
  132. Default nBottom To MAXROW() - 04
  133. Default nRight To MAXCOL() - 02
  134. Default bFind To NIL
  135. Default bFor To NIL
  136. Default nFreeze To 0
  137. Default bKeyEx To { | | LASTKEY() = K_ENTER }
  138. Default bWaitFunc To { | | INKEY(0) }
  139. Default cBox To BOX_DD
  140. Default lRestScreen To .F.
  141.  
  142. //  Pressed Enter too soon !
  143. IF NEXTKEY() = K_ENTER
  144.     KEYBOARD ''
  145. ENDIF
  146.  
  147. //  find OK ?
  148. IF bFind = NIL
  149.     // All
  150.     bWhile := { || .T. }
  151. ELSE
  152.     // Compare find to index
  153.     bWhile := &("{ || " + INDEXKEY() + " = '" + EVAL(bFind) + "' }")
  154.     lAllRecords := .F.
  155. ENDIF
  156.  
  157. IF bFor = NIL
  158.     bFor := { | | .T. }
  159. ELSE
  160.     lAllRecords := .F.
  161. ENDIF
  162.  
  163. //  Restore screen
  164. IF lRestScreen
  165.     cRestore := SAVESCREEN(00,00,MAXROW(),MAXCOL())
  166. ENDIF
  167.  
  168. //  Make new browse object
  169. oBrowse := TBROWSENEW(nTop+1,nLeft+1,nBottom-1,nRight-1)
  170.  
  171. // Define Colours
  172. oBrowse:colorspec := SETCOLOR()
  173.  
  174. // Define Column lines
  175. oBrowse:headsep := REPLICATE(SUBSTR(cBox,2,1),3)
  176.  
  177. //  Move Blocks
  178. oBrowse:gobottomblock := { | | GT_GoBottom(bWhile,bFor,bFind) }
  179. oBrowse:gotopblock := { | | GT_GoTop(bWhile,bFor,bFind) }
  180. oBrowse:skipblock := { | records | GT_Skip(bWhile,bFor,records,.F.) }
  181.  
  182. //  Add columns
  183. AEVAL(aFields, { | data, elem | ;
  184.     data := TBCOLUMNNEW(aTitles[elem],data) ;
  185.     , IF(VALTYPE(EVAL(data:block))=='N' ;
  186.         ,data:colorBlock := { | x | IF(x>0,{1,2},IF(x<0,{5,2},{1,2})) } ;
  187.         ,NIL) ;
  188.     ,data:defcolor := {1,2} ;
  189.     ,oBrowse:AddColumn(data) },1,LEN(aFields))
  190.  
  191. //  Clear and draw box
  192. GT_Window(nTop,nLeft,nBottom,nRight,cBox,SETCOLOR(),cHead)
  193.  
  194. //  Fix cols ?
  195. IF nFreeze > 0
  196.     // Fix columns
  197.     oBrowse:Freeze := nFreeze
  198. ENDIF
  199.  
  200. DO WHILE .T.
  201.  
  202.     // Stabilize the display
  203.     DISPBEGIN()
  204.     DO WHILE ( !oBrowse:Stabilize() )
  205.         nKey := INKEY()
  206.         IF ( nKey != 0 )
  207.             EXIT
  208.         ENDIF
  209.     ENDDO
  210.     DISPEND()
  211.  
  212.     IF ( oBrowse:Stable )
  213.         // Display is Stable
  214.         nKey := EVAL(bWaitFunc)
  215.     ENDIF
  216.  
  217.     IF .NOT. GT_IsData(nKey)
  218.         cSearch := ''
  219.     ENDIF
  220.  
  221.     // Process key
  222.     nLocation := ASCAN(aStdKeys,nKey)
  223.  
  224.     DO CASE
  225.     CASE nLocation > 0
  226.         // Standard Key function
  227.         EVAL(aStdFuncs[nLocation],oBrowse)
  228.  
  229.     CASE (nKey == K_ESC )
  230.         // Exit
  231.         EXIT
  232.  
  233.     CASE IF(nKey<0,SETKEY(nKey)!=NIL,.F.)
  234.         // Other function key
  235.         EVAL(SETKEY(nKey))
  236.         // Force redisplay of current row
  237.         oBrowse:RefreshCurrent()
  238.  
  239.     CASE GT_IsData(nKey) .AND. .NOT. EMPTY(INDEXKEY())
  240.         // Add to search string
  241.         cSearch += UPPER(CHR(nKey))
  242.  
  243.         // Find ?
  244.         nRecord := RECNO()
  245.         DBSEEK(cSearch)
  246.         IF EOF()
  247.             DBGOBOTTOM()
  248.         ENDIF
  249.         lFault := .T.
  250.         DO WHILE EVAL(bWhile) .AND. .NOT. EOF()
  251.             IF EVAL(bFor)
  252.                 lFault := .F.
  253.                 EXIT
  254.             ENDIF
  255.             DBSKIP(1)
  256.         ENDDO
  257.  
  258.         // Refresh screen or go back
  259.         IF .NOT. lFault
  260.             nRecord := RECNO()
  261.             oBrowse:GoTop()
  262.             DBGOTO(nRecord)
  263.             oBrowse:RefreshAll()
  264.         ELSE
  265.             DBGOTO(nRecord)
  266.         ENDIF
  267.  
  268.     OTHERWISE
  269.         // Key exception
  270.         DO WHILE ( !oBrowse:Stabilize() ) ; ENDDO
  271.  
  272.         // Save old index and record
  273.         uIndexkey := EVAL(bIndex)
  274.         nRecord := RECNO()
  275.  
  276.         IF EVAL(bKeyEx,oBrowse)
  277.             // One selected
  278.             EXIT
  279.         ENDIF
  280.  
  281.         // Changed index ?
  282.         IF INDEXORD() != nIndex
  283.             bIndex := GT_IndexBlock(0)
  284.             nIndex := INDEXORD()
  285.             nRecord := -1
  286.         ENDIF
  287.  
  288.         //  Still visible ?
  289.         IF EOF() .OR. .NOT. (EVAL(bWhile) .AND. EVAL(bFor))
  290.             // Find a visible one and ensure refreshall
  291.             oBrowse:Gotop()
  292.         ENDIF
  293.  
  294.         // Refresh all or one ?
  295.         IF !(uIndexkey == EVAL(bIndex)) .OR. RECNO() != nRecord
  296.             oBrowse:RefreshAll()
  297.         ELSE
  298.             oBrowse:RefreshCurrent()
  299.         ENDIF
  300.  
  301.     ENDCASE
  302.  
  303. ENDDO
  304.  
  305. //  restore old cursor
  306. SETCURSOR(nCursor)
  307.  
  308. //  Restore Screen
  309. IF lRestScreen
  310.     RESTSCREEN(00,00,MAXROW(),MAXCOL(),cRestore)
  311. ENDIF
  312.  
  313. /*
  314.     End of GT_Browse()
  315. */
  316. RETURN(nKey != K_ESC) // 
  317.  
  318.