Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : NN0506.ZIP
Filename : SEEKGET.PRG

/***
Test.prg
By: Scott McIntosh
Copyright (c) 1991, Nantucket Corporation
All rights reserved
Test program for "seeker get".
Uses: Test.dbf with a single field: Name, C, 25
Compile: Clipper Test /n /a /w
***/
#include "Readers.ch"


PROCEDURE Test()
FIELD Name
LOCAL cName := SPACE(25)
USE Test NEW

// First we'll try with a "simple" index key on the Field Name
INDEX ON Name TO Test

// Since the index contains the Field Name, we don't have
// to use the FIELD clause
CLS
@ 10,10 SAY "Test with simple key" SEEKER GET cName
READ

// Now we'll try with a "complex" index key by including
// a function with the Field Name
INDEX ON UPPER( Name ) TO Test

// Note: in this example I am indexing on the UPPER() of
// the field to force the Get into uppercase with a
// PICTURE assuring a proper SEEK
// Also, the use of the FIELD clause is required

CLS
cName := SPACE(25)
@ 10,10 SAY "Test with complex key" SEEKER GET ;
cName FIELD "Name" PICTURE "@!"
READ

QUIT

/***
Seekget.prg
By: Scott McIntosh
Copyright (c) 1991, Nantucket Corporation
All Rights Reserved

Custom Reader for displaying an item from an indexed
list as the get is typed in. Usage:

@ ... SEEKER GET [ FIELD ] [ GET options ]

Optional cFieldName is the name of the field to display.
This is required if the index key contains anything other
than the field name. GET options are standard: WHEN,
VALID, etc. If the current key field is of a different type,
or if the database is not indexed, a normal get will take
place.

Example:
#include "Readers.ch"
@ 10,10 SEEKER GET cTest FIELD "Name" PICTURE "@!"
***/

#include "GetExit.ch"
#include "Set.ch"
#include "Readers.ch"

PROCEDURE SeekGetReader( oGet, cField )
LOCAL cIndexKey := INDEXKEY( INDEXORD() )
LOCAL aFieldList := {}
LOCAL nField, nCol, nRow
LOCAL nOldCol, nOldRow
LOCAL nFieldLen
LOCAL cOldScreen
LOCAL lCursor, lSoftSeek

IF cField != NIL
// We were passed a field to display
nField := FIELDPOS( cField )
ELSE
// No field passed, see if index key is a field name
nField := FIELDPOS( cIndexKey )
ENDIF

IF (nField == 0) .OR. ( VALTYPE( FIELDGET(nField) ) != ;
VALTYPE(oGet:type) )
// Can't determine the field, call the default reader
GetReader( oGet )
ELSE
// Read the GET if the WHEN condition is satisfied
lSoftSeek := SET( _SET_SOFTSEEK, .T. )
IF GetPreValidate( oGet )

// Everything's O.K., do the seeker get
oGet:SetFocus()
nFieldLen := LEN( FIELDGET( nField ) )

// Make a display box to show the result of the seek
nRow := ROW()-2 // display is two rows above the get
nCol := COL()
cOldScreen := ;
SAVESCREEN( nRow-1, nCol-1, nRow+1, nCol + nFieldLen )
@ nRow-1, nCol-1 CLEAR TO nRow+1, nCol + nFieldLen
@ nRow-1, nCol-1 TO nRow+1, nCol + nFieldLen

// Reset the cursor position, the box drawing moved it
DEVPOS( nRow+2, nCol )

// Enter the modified read
DO WHILE ( oGet:exitState == GE_NOEXIT )

// Check for initial typeout (no editable positions)
IF oGet:typeOut
oGet:exitState := GE_ENTER
ENDIF
// Apply keystrokes until exit
DO WHILE oGet:exitState == GE_NOEXIT

// Get a single key
GetApplyKey( oGet, Inkey(0) )

// Show search string
nOldCol := COL()
nOldRow := ROW()

// Seek on what we have entered so far
SEEK (oGet:buffer)

// Display the record
lCursor := SET( _SET_CURSOR, .F. )
@ nRow, nCol SAY FIELDGET( nField )
lCursor := SET( _SET_CURSOR, lCursor )

// Reset the cursor position
DEVPOS( nOldRow, nOldCol )
ENDDO

IF oGet:exitState == GE_ENTER
// If get was exited normally, replace the buffer with
// the current value of the field
oGet:buffer := LEFT( FieldGet( nField ), LEN( oGet:buffer ) )
ENDIF

// Disallow exit if the VALID condition is not satisfied
IF ! GetPostValidate( oGet )
oGet:exitState := GE_NOEXIT
ENDIF
ENDDO

// De-activate the GET
oGet:KillFocus()
ENDIF

// Restore the environment
SET SOFTSEEK OFF
RESTSCREEN( nRow-1, nCol-1, nRow+1, nCol + ;
nFieldLen, cOldScreen )
ENDIF

RETURN
/*_ EOF: Seekget.prg _____________*/