***************************************************
FUNCTION POINTNGO                                 *
** POINTNGO.PRG **  Self positioning              *
** generic validation from table with point/shoot *
** Micromega Systems, 1990 (c)                    *
***************************************************
**  Required Parameter  :
**  pg_alias  : Alias to validate the entry from
**  Optional Parameters :
**  pg_marrow : .T. if variable is SCATTER'd MEMVAR
**  pg_keyord : Index order of key being validated
**  pg_listex : What to show in the pick list
**  pg_alidesc: Alias descrip if alias is cryptic
**  pg_shorows: Show how many data rows in pick list
**  pg_trigger: Trigger char. If parameter is not
**    passed, or null, show pick list automatically
**    if entry is not found.  If it has a value
**    (eg "?") pick list is only displayed if
**    trigger is in the entry.
***************************************************

PARAMETERS pg_alias, pg_marrow, pg_keyord, pg_listex,;
           pg_alidesc, pg_shorows, pg_trigger

PRIVATE ALL LIKE pg_*
** Grab name of entry field
pg_entfld = IIF(pg_marrow,"M->","")+VARREAD()
pg_wasals = ALIAS()
SELECT (pg_alias)

IF PARAMETERS() < 4
  ** default to code + descrip
  pg_listex = FIELD(1)+'+[  ]+'+FIELD(2)
  ENDIF
IF PARAMETERS() < 3
  ** default to primary index
  STORE 1 TO pg_keyord
ENDIF

pg_keyexp = KEY(pg_keyord, pg_alias)
** Store the lookup key index expression
pg_wasord = VAL(SYS(21))
SET ORDER TO pg_keyord
** If the entry is valid, return true ASAP
SEEK &pg_entfld
IF FOUND()
  STORE &pg_keyexp TO &pg_entfld
  SET ORDER TO (pg_wasord)
  SELECT (pg_wasals)
  RETURN .T.
ENDIF
** Below here, the entry wasn't in the table
**store 1 to pg_left, pg_top, pg_botrow, pg_top
IF PARAMETERS() < 7
  pg_trigger = ''       && No trigger was specified
ENDIF
IF PARAMETERS() < 6
  pg_shorows = 7        && A reasonable guess-timate
ENDIF
IF PARAMETERS() < 5
  pg_alidesc = pg_alias && default = alias name
ENDIF

SELECT (pg_alias)
pg_entval = &pg_entfld

IF.NOT.(EMPTY(pg_trigger).OR.pg_trigger $ pg_entval)
  ** There is a trigger, but it isn't in the entry
  WAIT WINDOW pg_entval + " isn't in "+pg_alidesc
  SET ORDER TO (pg_wasord)
  SELECT (pg_wasals)
  RETURN .F.
ENDIF
** Pop up a selection list; first locate it neatly
pg_getrow = ROW()+IIF(WLROW() > 0, WLROW() + 2, 1)
pg_getcol = COL()+IIF(WLCOL() > 0, WLCOL() + 2, 1)

IF pg_shorows+4+pg_getrow > 24 .AND.;
      pg_getrow - (pg_shorows + 4) <= 1 .AND. ;
      pg_getcol+LEN(&pg_listex) + 4 >= 79
     ** lookup box can't fit above or below GET field
   pg_shorows = MAX(24-pg_getrow - 4, pg_getrow - 6)
ENDIF && We've reduced the number of rows of data

DO CASE
  CASE pg_getrow+pg_shorows + 4 <= 24
    ** try to place the lookup box BELOW GET field
    pg_top=pg_getrow
    pg_left=MAX(MIN(78-LEN(&pg_listex)-2,;
      COL()+WLCOL()-LEN(&pg_entfld)),1)
  CASE pg_getcol+LEN(&pg_listex) + 4 < 79
    ** try to place lookup box to the RIGHT of GET
    pg_left=pg_getcol
    pg_top=MIN(24-pg_shorows-3, pg_getrow-1)
  CASE pg_getrow - 4 - pg_shorows > 0
    ** Place lookup box ABOVE the GET field
    pg_top = MAX(1, pg_getrow - pg_shorows - 5)
    pg_left = MAX(MIN(78 - LEN(&pg_listex) - 2,;
     COL() + WLCOL() - LEN(&pg_entfld)),1)
ENDCASE
** Place record pointer near the entry with softseek
IF RECNO(0) <> 0
  GOTO RECNO(0)
ELSE
  GOTO TOP
ENDIF
DEFINE WINDOW ptgo FROM pg_top, pg_left to pg_top+;
  pg_shorows+3,MIN(pg_left+LEN(&pg_listex)+2,79);
  NOFLOAT NOGROW ZOOM SYSTEM TITLE ;
  "Select " + pg_alidesc color scheme 10

ON KEY LABEL ENTER KEYBOARD CHR(23)
ON KEY LABEL RIGHTMOUSE KEYBOARD CHR(23)
BROWSE WINDOW ptgo FIELDS BROWSEFLD=&pg_listex ;
    :H="<Return> or Right Mouse Selects" NOMODIFY
ON KEY LABEL ENTER
ON KEY LABEL RIGHTMOUSE
RELEASE WINDOW ptgo
IF READKEY() = 12
  SET ORDER TO (pg_wasord)
  SELECT (pg_wasals)
  RETURN .F.
ENDIF
** Assign the looked-up key to the entry var;
** FoxPro UDF's automatically display it in GET!
STORE &pg_keyexp TO &pg_entfld
SET ORDER TO (pg_wasord)
SELECT (pg_wasals)
RETURN .T.
