home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / xbase / library / dbase / duflp / eds1.prg < prev    next >
Text File  |  1992-08-07  |  10KB  |  212 lines
  1. FUNCTION SeeMatch
  2. *-------------------------------------------------------------------------------
  3. *-- Programmer..: Dan Madoni (Borland)
  4. *-- Date........: 09/xx/1991
  5. *-- Notes.......: Can be included in format screen to display an instant
  6. *--               lookup match on a particular field. A shadowed box will
  7. *--               appear with the matching value ... Taken from TECHNOTES.
  8. *-- Written for.: dBASE IV, 1.1
  9. *-- Rev. History: 06/12/1992 -- Minor -- added call to RECOLOR
  10. *-- Calls.......: RECOLOR              Procedure in PROC.PRG
  11. *-- Called by...: None
  12. *-- Usage.......: SeeMatch("<cFile>",<cSeekExp>,"<cReturn>",<nULRow>,<nULCol>,;
  13. *--                        <nBRRow>,<nBRCol>,"<cColor>)
  14. *-- Example.....: SeeMatch("TRAVEL",LASTNAME,"TRAVELCODE",2,40,4,60,"w+/r")
  15. *-- Returns.....: .t.
  16. *-- Parameters..: cFile    = Database alias in which lookup will be performed.
  17. *--                          -- this file must already be USEd in some area.
  18. *--               cSeekExp = Expression which will be SEEKed.
  19. *--               cReturn  = Name of field to contain the 'return' value.
  20. *--               nULRow   = Upper Left Row for box
  21. *--               nULCol   = Upper Left Column for box
  22. *--               nBRRow   = Bottom Right Row
  23. *--               nBRCol   = Bottom Right Column
  24. *--               cColor   = Color of box
  25. *-------------------------------------------------------------------------------
  26.         
  27.         parameters cFile,cSeeExp,cReturn,nULRow,nULCol,nBRRow,nBRCol,cColor
  28.         private cRetVal, cAttr, cStartFile
  29.         
  30.         *-- store starting position ...
  31.         cStartFile = alias()
  32.         select &cFile
  33.         
  34.         *-- look for a matching expression
  35.         seek cSeekExp
  36.         if found()
  37.                 cRetVal = &cReturn
  38.         else
  39.                 cRetVal = "<Not Found>"
  40.         endif
  41.         
  42.         *-- Store current color and draw a box
  43.         cAttr = set("ATTRIBUTES")
  44.         @nULRow+1,nULCol+1 fill to nBRRow+1,nBRCol+1 color w/n  && shadow
  45.         set color to &cColor
  46.         @nULRow,nULCol clear to nBRRow,nBRCol  && clear out area text will go in
  47.         @nULRow,nULCol To       nBRRow,nBRCol  && draw box
  48.         
  49.         *-- display matching expresion, and return to initial area ...
  50.         @nULRow+1,nULCol+2 say cRetVal
  51.         do ReColor with cAttr
  52.         select cStartFile
  53.         
  54. RETURN .t.
  55. *-- EoF: SeeMatch()
  56.  
  57.  
  58. PROCEDURE FileMove
  59. *-------------------------------------------------------------------------------
  60. *-- Programmer..: David Frankenbach (FRNKNBCH)
  61. *--               DF Software Development, Inc.
  62. *--               PO Box 87
  63. *--               Forest, VA, 24551
  64. *--               (804) 237-2342
  65. *-- Date........: 02/11/1992
  66. *-- Notes.......: This procedure gives the record movement allowed with EDIT
  67. *--               when you use a simple @SAY/GET..READ. It allows you to
  68. *--               pre/post process each record during editing, something you
  69. *--               can't do with EDIT. This works best with a single file,
  70. *--               although it would work with a parent->child relation. You
  71. *--               should:  SELECT child and SET SKIP to child. This will
  72. *--               allow the user to change the parent record pointer though!
  73. *--               If you want to limit the child record movement to a single
  74. *--               parent record, you can use a conditional index, or add logic
  75. *--               to the routine to limit the record pointer movement. For these
  76. *--               cases I have a seperate FileMove procedure, but they are not
  77. *--               generic enough for public consumption.
  78. *--
  79. *--               These keys are trapped:
  80. *--               UpArw, Shift-Tab, LeftArw, Ctrl-LeftArw, PgUp = 
  81. *--                                                         backward one record
  82. *--               DnArw, Tab, RightArw, Ctrl-RightArw, PgDn, Enter, Ctrl-End = 
  83. *--                                                         forward one record
  84. *--               Ctrl-PgUp = top of database or active index
  85. *--               Ctrl-PgDn = bottom of database or active index
  86. *-- Written for.: dBASE IV, 1.1
  87. *-- Rev. History: 06/17/1991 - original routine.
  88. *--               02/07/1992 -- Ken Mayer, brought into one PROCEDURE,
  89. *--               rather than a function and a procedure ...
  90. *--               02/11/1992 -- Author, additional documentation
  91. *--                             Released into Public Domain
  92. *-- Calls.......: None
  93. *-- Called by...: None
  94. *-- Usage.......: do FileMove with <nKey>
  95. *--               where: <nKey> is the return value of readkey()
  96. *-- Example.....: lMove = .t.  && if you want the user to be able to move the 
  97. *--                            && record pointer in my applications if the user
  98. *--                            && is adding a new record I usually lMove = .f.,
  99. *--                            && for editing I allow them to move through the
  100. *--                            && records.
  101. *--               lOk = .t.
  102. *--               do while ( lOk )
  103. *--                  do Mem_Load               && load memvars from record
  104. *--                  @say/gets                 && display/get the memvars
  105. *--                  read
  106. *--                  i = readkey()             && grab last key ...
  107. *--                  lOk = ( i <> 27 )         && if Esc was pressed lOK is false
  108. *--                  if ( lOk )
  109. *--                     if ( i > 256 )         && if record is changed
  110. *--                        do Mem_Unload       && replace dbf fields from memvars
  111. *--                     endif  && ( i > 256 )
  112. *--                     if ( lMove )           && if ok to move record pointer
  113. *--                        do FileMove with i  && <----- Move it
  114. *--                     else
  115. *--                        lOk = .f.            && terminate loop if .not. lMove
  116. *--                     endif  && ( lMove )
  117. *--                  endif && (lOK)
  118. *--               enddo && while (lOK)
  119. *-- Parameters..: nKey = last keystroke from a READKEY() call ...
  120. *-- Returns.....: None
  121. *-- Side Effects: Moves record pointer in current file if lMove = .t.
  122. *-------------------------------------------------------------------------------
  123.         parameter nKey
  124.         private n
  125.         
  126.         m->n = m->nKey
  127.         if ( m->n > 255 )     && if value is > 256, record has changed, but we want
  128.            m->n = m->n - 256  && values < 256 to figure out which direction to move
  129.         endif                 && from the readkey() table
  130.         
  131.         do case
  132.         
  133.            *-- keys to move backward through database 1 record at a time ...
  134.            *--  LeftArw, Ctrl-LeftArw, UpArw, Shift-Tab, PgUp
  135.            case ( m->n = 0 ) .or. ( m->n = 2 ) .or. ( m->n = 4 ) .or. ( m->n = 6 )
  136.               if ( .not. bof() )                && if not at beginning of file
  137.                  skip -1                        && move backward one record
  138.               endif
  139.         
  140.            *-- keys to move forward through database 1 record at a time ...
  141.            *--  RightArw, Ctrl-RightArw, DownArw, Tab, PgDn, Ctrl-End, Enter
  142.            case ( m->n = 1 ) .or. ( m->n = 3 ) .or. ( m->n = 5 ) .or. ( m->n = 7 );
  143.                          .or. ( m->n = 14) .or. ( m->n = 15)
  144.               if ( .not. eof() )                && if not end of file
  145.                  skip 1                         && move forward one record
  146.               endif
  147.               if ( eof() )                      && if we're now at the EOF,
  148.                  goto bottom                    && go back to last record ...
  149.               endif
  150.         
  151.            *-- go to toP of database, Ctrl-PgUp
  152.            case ( m->n = 34 )
  153.               goto top
  154.         
  155.            *-- go to BOTtoM of database, Ctrl-PgDn
  156.            case ( m->n = 35 )
  157.               goto bottom
  158.         
  159.         endcase
  160.  
  161. RETURN
  162. *-- EoP: FileMove
  163.  
  164.  
  165. PROCEDURE DosShell
  166. *-------------------------------------------------------------------------------
  167. *-- Programmer..: Bowen Moursund
  168. *-- Date........: 06-10-1992
  169. *-- Notes.......: Swaps out dBASE from memory, loads a DOS shell
  170. *-- Written for.: dBASE IV v1.5
  171. *-- Rev. History: none
  172. *-- Calls.......: None
  173. *-- Called by...: Any
  174. *-- Usage.......: do DosShell with <cAppName>
  175. *-- Example.....: do DosShell with "MyApp"
  176. *-- Parameters..: cAppName - the name of the application
  177. *-------------------------------------------------------------------------------
  178.  
  179.     parameter cAppName
  180.          private cDir, lCursOff, cBatFile, nFH, nResult
  181.     cAppName = iif(pcount() = 0, "the application", cAppName)
  182.     private all
  183.     cDir = set("directory")
  184.     lCursOff = ( set("cursor") = "OFF" )
  185.     cBatFile = tempname("bat") + ".bat"
  186.     nFH = fcreate(cBatFile)
  187.     if nFH > 0
  188.         nBytes = fputs(nFH,"echo off")
  189.         nBytes = fputs(nFH,"cls")
  190.         nBytes = fputs(nFH,"echo " + chr(255))  && echo a blank line
  191.         nBytes = fputs(nFH,"echo NOTE: Enter EXIT to resume " + cAppName + ".")
  192.         nBytes = fwrite(nFH,getenv("comspec"))
  193.         null = fclose(nFH)
  194.         set cursor on
  195.         nResult = run(.f., cBatFile, .t.)
  196.         if nResult # 0
  197.             run &cBatFile
  198.         endif
  199.         erase (cBatFile)
  200.     else
  201.         cComSpec = getenv("comspec")
  202.         set cursor on
  203.         run &cComSpec.
  204.     endif
  205.     if lCursOff
  206.         set cursor off
  207.     endif
  208.     set directory to &cDir
  209.  
  210. RETURN
  211. *-- EoP: DosShell
  212.