home *** CD-ROM | disk | FTP | other *** search
/ DOS Wares / doswares.zip / doswares / DATABASE / DBASE5 / CUA_SAMP.ZIP / MDIDXKEY.PRG < prev    next >
Encoding:
Text File  |  1994-06-24  |  3.9 KB  |  115 lines
  1.  
  2. *.............................................................................
  3. *
  4. *   Program Name: MDIDXKEY.PRG        Copyright: Borland International
  5. *   Date Created:  7 Apr 94            Language: dBASE 5.0
  6. *   Time Created: 23:04:52               Author: Borland dBASE R&D
  7. *   /brief/library.src
  8. *.............................................................................
  9.  
  10. #define ALLTRIM(kStr) LTRIM(RTRIM(kStr))
  11.  
  12. *............................................................................
  13. * Procedure Name:   MDIdxKey
  14. * Parameters:       None
  15. * Ext Memvars:      None
  16. * Description:      Searches for the first record with the given index value
  17. *............................................................................
  18. PROCEDURE MDIdxKey
  19.     PRIVATE lVoid, cStr, nKLen, nTLen, nLeft, nRec, xValue, lFlag, oForm, nLen
  20.     
  21.     #include "TalkOff.hdb"
  22.     
  23.     IF RECCOUNT() = 0
  24.         DO InfoMsg WITH [This file has no records to search against.]
  25.         #include "Talkon.hdb"
  26.         RETURN
  27.     ENDIF            
  28.     
  29.     oForm = GetForm(This)
  30.     
  31.     lFlag = .F.
  32.  
  33.     IF .NOT. ISBLANK(ALIAS())
  34.         IF .NOT. ISBLANK(ORDER())
  35.             cStr = KEY()
  36.             nKLen = LEN(cStr)
  37.             nTLen = FldLen(cStr)
  38.             
  39.             #include "MDIDXKEY.DFM"
  40.  
  41.             IF nKLen > 40
  42.                 MDIdxKey.txName5.Width = 40     && Key text
  43.                 nKLen = 40
  44.             ENDIF
  45.             
  46.             IF nTLen > 40    
  47.                 MDIdxKey.etName4.Width = 40     && value to search for
  48.                 nTLen = 40
  49.             ELSE 
  50.                 MDIdxKey.etName4.Width = nTLen    
  51.             ENDIF
  52.             
  53.             nLeft = MAX(nKLen, nTLen)
  54.             
  55.             IF nLeft < 40
  56.                 nLeft = 1 + INT((40 - nLeft) / 2)
  57.                 MDIdxKey.txName5.Left = nLeft
  58.                 MDIdxKey.etName4.Left = nLeft
  59.             ENDIF
  60.             
  61.             xValue = EVALUATE(cStr)
  62.             
  63.             DO CASE
  64.                 CASE TYPE("xValue") = "C"
  65.                     nLen = LEN(m->xValue)
  66.                     MDIdxKey.etName4.Value = SPACE(nLen)
  67.                     IF nLen > 40
  68.                         MDIdxKey.etName4.Width = 40
  69.                     ENDIF    
  70.                 CASE (TYPE("xValue") = "F") .OR. (TYPE("xValue") = "N")
  71.                     MDIdxKey.etName4.Value = 0
  72.                 CASE TYPE(cStr) = "D"
  73.                     MDIdxKey.etName4.Value = {}
  74.             ENDCASE            
  75.  
  76.             DO WHILE .NOT. lFlag
  77.                 lVoid = MDIdxKey.etName4.SetFocus()
  78.                 lVoid = MDIdxKey.ReadModal()
  79.             
  80.                 IF MDIdxKey.Action
  81.                     nRec = RECNO()
  82.                     xValue = MDIdxKey.etName4.Value
  83.                     IF .NOT. SEEK(xValue)
  84.                         DO InfoMsg WITH [Search value not found]
  85.                         GOTO nRec
  86.                         MDIdxKey.Action = .F.
  87.                         IF TYPE("oForm.ClassName") = "C"
  88.                             IF oForm.ClassName = "FORM"
  89.                                 lVoid = oForm.Refresh()
  90.                             ENDIF
  91.                         ENDIF    
  92.                     ELSE
  93.                         *-----------------------------------------------
  94.                         *-- This little dance step is a workaround until
  95.                         *-- browse knows about seek()
  96.                         *-----------------------------------------------
  97.                         nRec = RECNO()
  98.                         GOTO nRec
  99.                         lFlag = .T.
  100.                     ENDIF
  101.                 ELSE
  102.                     lFlag = .T.
  103.                 ENDIF
  104.             ENDDO
  105.             
  106.             lVoid = MDIdxKey.Release()
  107.  
  108.         ELSE
  109.             DO InfoMsg WITH [Index not active]
  110.         ENDIF
  111.     ENDIF
  112. #include "Talkon.hdb"
  113. RETURN                                                            
  114.  
  115.