home *** CD-ROM | disk | FTP | other *** search
/ Power CD-ROM!! 7 / POWERCD7.ISO / prgmming / clipper / gt_getli.prg < prev    next >
Text File  |  1993-10-14  |  7KB  |  260 lines
  1. /*
  2.     File......: GT_GetList.prg
  3.     Author....: Martin Bryant
  4.     BBS.......: The Dark Knight Returns
  5.     Net/Node..: 050/069
  6.     User Name.: Martin Bryant
  7.     Date......: 09/03/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 09/03/93
  17.     PD Revision.
  18. */
  19. /*  $DOC$
  20.  *  $FUNCNAME$
  21.  *      GT_GETLIST()
  22.  *  $CATEGORY$
  23.  *      General
  24.  *  $ONELINER$
  25.  *      User list for a Get.
  26.  *  $SYNTAX$
  27.  *      GT_GetList(<oGet>,<cType>,<bReturn>,<bValid>, ;
  28.  *          [<bFind>],[<bFor>],[<nTop>],[<nLeft>]) -> lSuccess
  29.  *  $ARGUMENTS$
  30.  *      <oGet> is the Get Object passed to the post block.
  31.  *
  32.  *      <cType> is the type of window to use. 'A' uses an
  33.  *      array list and 'D' uses a Browse on a DBF file.
  34.  *
  35.  *      <bReturn> block to extract the information to put
  36.  *      into the Get field. It will be passed the element
  37.  *      of the array or the record number (current) in the
  38.  *      Browse case.
  39.  *
  40.  *      <bValid> the block stating whether the result in the
  41.  *      Get field is valid.
  42.  *
  43.  *      <bFind> defines which option to start on. Should
  44.  *      return a number for 'A' windows or a value to seek
  45.  *      with the browse. For Browses this will act as a
  46.  *      while clause against the index.
  47.  *
  48.  *      <bFor> for clause. Only for Browse lists.
  49.  *
  50.  *      <nTop> and <nLeft> specify the top left corner of
  51.  *      the window.
  52.  *  $RETURNS$
  53.  *      Logical valid status.
  54.  *  $DESCRIPTION$
  55.  *      Allow a PostBlock on a get to display the user
  56.  *      a list of legal options from an array or an open
  57.  *      datafile. Allows while/for options and displays the
  58.  *      list on screen. When an option is selected the list
  59.  *      is removed.
  60.  *      Requires extra information in :Cargo
  61.  *  $EXAMPLES$
  62.  *      oGet:PostBlock := { | oGet | Suppliers->(Gt_GetList( ;
  63.  *          oGet, ;                         // Get object
  64.  *          'D', ;                          // Datafile
  65.  *          { | | Field->Code }, ;          // Return
  66.  *          { | cData | DBSEEK(cData) }, ;  // Valid
  67.  *          { | cData | RTRIM(cData) }, ;   // Seek/while
  68.  *          { | | Field->Qty > 0 }, ;       // For
  69.  *          02, ;                           // Top
  70.  *          02)) }                          // Left
  71.  *
  72.  *      aGets[01][01]:Cargo := { ;
  73.  *          {'Code','Supplier'}, ;          // Titles
  74.  *          {{ | | Field->SuppCode }, ;
  75.  *              { | | Field->SuppName }}, ; // List fields
  76.  *          {}}                             // Only used with array
  77.  *
  78.  *  $SEEALSO$
  79.  *      Gt_Choose() GT_BROWSE()
  80.  *  $INCLUDE$
  81.  *
  82.  *  $END$
  83.  */
  84.  
  85. #include "GTClippe.ch"
  86. MEMVAR uData
  87. MEMVAR p_highcolours
  88. MEMVAR p_errcolors
  89.  
  90. #define LISTTITLE   01
  91. #define LISTDATA    02
  92. #define LISTVALID   03
  93.  
  94. FUNCTION GT_GetList(oGet,cType,bReturn,bValid,bFind,bFor, ;
  95.     nTop,nLeft)
  96.  
  97. LOCAL aCargoData := {'',{},{}}
  98. LOCAL bIndex := NIL
  99. LOCAL cColour := SETCOLOR()
  100. LOCAL cScreen := SAVESCREEN(00,00,MAXROW(),MAXCOL())
  101. LOCAL lFound := .F.
  102. LOCAL nBottom := -1
  103. LOCAL nCount := -1
  104. LOCAL nRight := -1
  105. LOCAL nSelect := 0
  106. LOCAL nStart := -1
  107.  
  108. PRIVATE uData := NIL
  109.  
  110. Default oGet to NIL
  111. Default cType to ''
  112. Default bReturn to { | uData | uData }
  113. Default bValid to { | uData, nSelect | (nSelect > 0) }
  114. Default bFind to NIL
  115. Default bFor to NIL
  116. Default nTop to 04
  117. Default nLeft to 02
  118.  
  119. //  Any object ?
  120. IF oGet = NIL .OR. EMPTY(cType)
  121.     RETURN(.T.)
  122. ENDIF
  123.  
  124. //  Extract data
  125. uData := EVAL(oGet:Block)
  126.  
  127. //  Set cargo array
  128. aCargoData := oGet:Cargo
  129.  
  130. //  Valid ?
  131. IF EVAL(bValid,uData,0,aCargoData[LISTDATA])
  132.     IF cType = 'A'
  133. //        EVAL(oGet:Block,EVAL(bReturn, ;
  134. //            aCargoData[LISTDATA][nSelect]))
  135.     ELSE
  136.         EVAL(oGet:Block,EVAL(bReturn))
  137.     ENDIF
  138.     RETURN(.T.)
  139. ENDIF
  140.  
  141. //  Which sort of list ?
  142. IF cType = 'A'
  143.  
  144.     // Bottom
  145.     nBottom := MIN(nTop+03+LEN(aCargoData[LISTDATA]), ;
  146.         MAXROW()-04)
  147.  
  148.     // Right
  149.     nRight := MIN(nLeft+01+MAX(LEN(aCargoData[LISTTITLE]), ;
  150.         LEN(aCargoData[LISTDATA][01])),MAXCOL()-02)
  151.  
  152.     // Start ?
  153.     nStart := IF(bFind=NIL,1,EVAL(bFind,uData))
  154.  
  155.     // List array
  156.     SETCOLOR(p_HighColors)
  157.     nSelect := GT_Choose(aCargoData[LISTDATA], ;
  158.         aCargoData[LISTTITLE],nTop,nLeft,nBottom,nRight, ;
  159.         aCargoData[LISTVALID],nStart)
  160.     SETCOLOR(cColour)
  161.  
  162.     // Restore screen
  163.     RESTSCREEN(00,00,MAXROW(),MAXCOL(),cScreen)
  164.  
  165.     // Use ?
  166.     IF nSelect > 0
  167.  
  168.         EVAL(oGet:Block,EVAL(bReturn, ;
  169.             aCargoData[LISTDATA][nSelect]))
  170.  
  171.     ENDIF
  172.  
  173. ELSE
  174.  
  175.     // Bottom
  176.     nBottom := MIN(nTop+LASTREC()+03,MAXROW()-04)
  177.  
  178.     // Right
  179.     nRight := nLeft + LEN(aCargoData[LISTDATA])
  180.     FOR nCount := 1 TO LEN(aCargoData[LISTDATA])
  181.  
  182.         nRight += MAX( ;
  183.             LEN(EVAL(aCargoData[LISTDATA][nCount])), ;
  184.             LEN(aCargoData[LISTTITLE][nCount]))
  185.  
  186.     NEXT
  187.     IF nRight > MAXCOL() - 02
  188.         nRight := MAXCOL() - 02
  189.     ENDIF
  190.  
  191.     // Fix data file
  192.     DO CASE
  193.         CASE bFind = NIL .AND. bFor = NIL
  194.             // All
  195.             DBGOTOP()
  196.             lFound := .NOT. EOF()
  197.  
  198.         CASE bFind = NIL
  199.             // For condition only
  200.             DBGOTOP()
  201.             DBEVAL({ | | NIL },NIL,{ | | .NOT. EVAL(bFor) })
  202.             lFound := EVAL(bFor)
  203.  
  204.         CASE bFor = NIL
  205.             // While condition only
  206.             lFound := DBSEEK(EVAL(bFind,uData))
  207.  
  208.         OTHERWISE
  209.             // Both
  210.             IF DBSEEK(EVAL(bFind,uData))
  211.                 bIndex := GT_IndexBlock(0)
  212.                 DBEVAL({ | | NIL },NIL, ;
  213.                     { | | (EVAL(bIndex)=EVAL(bFind,uData)) .AND. ;
  214.                         .NOT. EVAL(bFor) })
  215.  
  216.                 lFound := EVAL(bFor) .AND. ;
  217.                     (EVAL(bIndex) = EVAL(bFind,uData))
  218.             ELSE
  219.                 lFound := .F.
  220.             ENDIF
  221.  
  222.     ENDCASE
  223.  
  224.     IF lFound
  225.         IF bFind != NIL
  226.             uData := EVAL(bFind,uData)
  227.             IF EMPTY(uData)
  228.                 bFind := NIL
  229.             ELSE
  230.                 bFind := &('{ | | "' + uData + '" }')
  231.             ENDIF
  232.         ENDIF
  233.         SETCOLOR(p_HighColors)
  234.         IF GT_Browse(aCargoData[LISTDATA], ;
  235.             aCargoData[LISTTITLE],'Options:',nTop,nLeft, ;
  236.             nBottom,nRight,bFind,bFor,1)
  237.  
  238.             nSelect := Recno()
  239.         ENDIF
  240.         SETCOLOR(cColour)
  241.     ELSE
  242.         GT_AskUser('No Items found. If you have asked for a selection, please blank the field and try again.',NIL,'Error:000',p_ErrColors)
  243.     ENDIF
  244.  
  245.     // Restore screen
  246.     RESTSCREEN(00,00,MAXROW(),MAXCOL(),cScreen)
  247.     // Use ?
  248.     IF nSelect > 0
  249.  
  250.         EVAL(oGet:Block,EVAL(bReturn,nSelect))
  251.  
  252.     ENDIF
  253.  
  254. ENDIF
  255. /*
  256.     End of GT_GetList()
  257. */
  258. RETURN(nSelect>0) // 
  259.  
  260.