Hello!
Here goes the entire code again. Please, compare with your version and merge them or make a backup of yours and replace with this.
This version enlarges the field where we store the names we find in the search process (42 bytes now). It also encompasses the suggestions we've gathered until now in this epic journey.
Tried to comment key points. You can keep asking if you need.
Código: Selecionar todos
PROCEDURE REC_FND
PRIVATE REC2FIND, SAV_REC
PRIVATE cOldArea, cOldScreen
PRIVATE cPath
* Box border characters
PRIVATE cBorder = CHR(218) + CHR(196) + CHR(191) + CHR(179) +;
CHR(217) + CHR(196) + CHR(192) + CHR(179)
* Save current position in database if search fails
*--------------------------------------------------
SAV_REC = recno()
set color to &GET_CLR
read
* Continue if escape wasn't pressed
*----------------------------------
IF LASTKEY()#ESC_KEY
*--------------------------------
REC2FIND = space(40)
do DISP_MSG with 'Client (include punctuation): '
@row(),col() get REC2FIND
read
* Continue if the escape key was not pressed
*-------------------------------------------
IF lastkey() # ESC_KEY
* Remove trailing spaces
*-----------------------
REC2FIND = UPPER(trim(REC2FIND))
*-- AlxSts - Start ---------------------*
* Save current work area
cOldArea = Select()
* In this version, temporary files are created
* in the local C drive root to avoid duplicate
* file names on a network environment
cPath = "C:\"
* iF tmpTable exists, delete it and it's index file
cString = "tmpTable"
IF File(cPath + cString + ".dbf")
ERASE (cPath + cString + ".dbf")
ERASE (cPath + cString + IndexExt() )
ENDIF
* Summer'87 offers no support for multidimensional arrays.
* Use a temporary table instead...
* Create a name to a second temporary Table
* used to hold the tmpTable structure definitions
cString = Left( cString, Len( cString ) - 1 ) + "_"
* select an empty work area
SELECT 0
* Create an empty table to store tmpTable structure info in the new work area...
* The Create command leaves the newly created file open...
CREATE (cPath + cString)
* insert struct info...
* field # 1
APPEND BLANK
REPLACE Field_name WITH "COMPNY_NAM"
REPLACE Field_type WITH "C"
REPLACE Field_len WITH 25
REPLACE Field_dec WITH 0
* field # 2
APPEND BLANK
REPLACE Field_name WITH "CASE_LNAME"
REPLACE Field_type WITH "C"
REPLACE Field_len WITH 40
REPLACE Field_dec WITH 0
* close struct table
USE
* Create tmpTable in the current work area using
* structure definition FROM the other table...
* The Create command leaves the newly created file open...
CREATE (cPath + "tmpTable" ) FROM (cPath + cString)
* tmpTable is now the currently selected work area...
* loop the entire main table (cases->)...
DO WHILE cases->( ! Eof() )
cString = ""
* search LNAME first because if REC2FIND exists in both fields, LNAME takes precedence
IF (REC2FIND $ UPPER(cases->CASE_LNAME))
* Person's last and first names
cString = Trim( cases->CASE_LNAME ) + ", " + cases->CASE_FNAME && assuming there is a field named CASE_FNAME (first name)
ELSEIF (REC2FIND $ UPPER(cases->COMPNY_NAM))
* Company name
cString = cases->COMPNY_NAM
ENDIF
IF Len( cString) > 0
* something was found. Save it...
APPEND BLANK
IF .Not. NetErr()
tmpTable->COMPNY_NAM = cases->COMPNY_NAM
tmpTable->CASE_LNAME = Upper( cString )
ELSE
* Error. Display some message and Exit
do DISP_MSG with [Error writing temporary file. Press a key to exit.]
SELECT Cases
go SAV_REC
RETURN
ENDIF
ENDIF
cases->( DbSkip() )
ENDDO
* If anything was found...
IF tmpTable->( LastRec() ) > 0
* tmpTable is still the current selected work area. Create an index
INDEX ON CASE_LNAME TO tmpTable
GO TOP
* Save the screen area used by popup window
*---------------------
cOldScreen = SAVESCREEN(5, 18, 20, 61)
* Draw a box with single border
*---------------------
@ 5, 18, 20, 61 BOX cBorder
* Browse records in tmp table until user
* cancels browsing (ESC) or a record is selected (ENTER)
*---------------------
DBEDIT(6, 19, 19, 60, {"tmpTable->CASE_LNAME"} , "_REC_FND_", NIL, {" Select a name "})
* Restore screen region
*---------------------
RESTSCREEN(5, 18, 20, 61, cOldScreen)
* Restore previous work area
*---------------------
Select( cOldArea )
* now, the cases table is the currently selected area
IF LASTKEY() # ESC_KEY
* User selected someone.
* Save company name from tmp table...
* This field is the index key in order # 7
*---------------------
REC2FIND = TRIM(tmpTable->COMPNY_NAM)
* Seek for selected company name
* in the original table...
*---------------------
* Get client index 7, ordered by company name key field
*--------------------
set order to 7
* Search using the key
*---------------------
set exact off
seek REC2FIND
set exact on
* Return to the first index
*--------------------------
* set order 1 as current (probably a company id field...)
set order to 1
* If found, put the highlight bar on the record
*----------------------------------------------
if !eof()
do SCRL_TOS
else
* If not found, tell the user
*----------------------------
do DISP_MSG with [Client, ]+trim(REC2FIND)+[, not found. Press a key.]
inkey(0)
go SAV_REC
endif
ELSE
* user cancelled...
go SAV_REC
ENDIF
ELSE
* no matches found...
Select( cOldArea )
do DISP_MSG with [Client, ]+trim(REC2FIND)+[, not found. Press a key.]
inkey(0)
go SAV_REC
ENDIF
* delete tmpTable...
SELECT( "tmpTable" )
USE
cString = "tmpTable"
ERASE (cPath + cString + ".dbf")
ERASE (cPath + cString + IndexExt() )
* delete structure info Table...
cString = Left( cString, Len( cString ) - 1 ) + "_"
ERASE (cPath + cString + ".dbf")
* restore the cases table as currently selected work area
SELECT( cOldArea )
ENDIF
*-- AlxSts - End ---------------------*
ENDIF
RETURN
*----------------------------
* User function for DbEdit()
*----------------------------
FUNCTION _REC_FND_
PARAMETERS status, fld_ptr
PRIVATE request
*
key_stroke = LASTKEY()
*
*Table: Requests to DBEDIT() from User Function
*----------------------------------------------------------
*Value Description
*----------------------------------------------------------
* 0 Quit DBEDIT()
* 1 Continue DBEDIT()
* 2 Force reread/repaint and continue;
* after repaint, process keys, and go to idle
* 3 Append mode (not recommended)
*----------------------------------------------------------
DO CASE
CASE status = 0
* Idle. Continue
request = 1
CASE status = 1
* Beginning-of-file.
request = 1
CASE status = 2
* End-of-file.
request = 1
CASE status = 3
* Empty database file.
request = 0
CASE status = 4
* Key exception.
IF key_stroke = 27
* Exit
request = 0
ELSEIF key_stroke = 13
* Record selected...
* exit with temp table file pointer over selected record
request = 0
ENDIF
OTHERWISE
request = 1
ENDCASE
*
RETURN request*
* Eof --------------------------------------------------------------------------
PS: warning: not compiled or tested.
Edited: adjust sav and restscreen coordinates