Liren Large Software Subsidy 5/05.iso/a/a044/3.ddi/MISC/GENERIC.PRG

Text File | 1993-08-31 | 7.3 KB | 316 lines

*Program is generic.prg
*This program was modified as an original dBASE program.  We
*added an event loop, a check box, and some buttons.  A real windows
*app would like some other neat stuff.  Note that this program also
*uses a dBFast VALID clause in a unique way.  dBFast permits the
*key word "CHANGE" in association with a valid clause.  If used,
*the valid clause is only evaluated if the user actually changes
*the data.  Here we use it to determine index order.  If the user
*moves to and enters a social security number, we set the index
*to social security and look up in that index.  If the user changes
*the name, we set up that index (the default).
*
*

#define ACTIVEGETS     1
#define READSAVE     2
#define WAITING     3
#define NORMAL         4

#define NO_EVENT            -1
#define KEYBD_EVENT         1
#define MENU_EVENT             2
#define SELECTWINDOW_EVENT     3
#define CLOSEWINDOW_EVENT     5
#define BUTTON_EVENT         6

#define OUREDIT     1
#define OURNEXT     2
#define OURPREV     3
#define OUREXIT     4
#define OURNEW         5
#define OURDELETE     6



SET PROCEDURE TO generic


set deleted on

PUBLIC begread, mode
STORE 1 TO begread
SET EXIT VIDEO TO 112

CREATE BUTTON ' Next ' AT 19,3
CREATE BUTTON ' Prev ' AT 19,16
CREATE BUTTON 'Delete' AT 19,29
CREATE BUTTON ' New  ' AT 19,42
CREATE BUTTON 'Cancel' AT 19,55
CREATE BUTTON ' Edit ' AT 19,68
mode = OUREDIT

DO PaintScreen
DO dispinfo

set exit video to sayvideo()

DO WHILE .T.
   ENABLE BUTTON ' Next '
   ENABLE BUTTON ' Prev '
   ENABLE BUTTON 'Delete'
   ENABLE BUTTON ' New  '
   ENABLE BUTTON 'Cancel'
   ENABLE BUTTON ' Edit '

   STORE name TO mname
   STORE ssn TO mssn
   *Note the CHANGE clause in these gets.
   @ 4,11 GET mname VALID chkname(mname) CHANGE MESSAGE ;
               'Enter the name to find' ;
               ERROR 'Name not Found'
   @ 4,58 GET mssn VALID chkssn(mssn)     CHANGE MESSAGE ;
             'Enter the Account number to find' ;
             ERROR 'The account number does not exist'

   action = GetEvent(ACTIVEGETS,begread)
   action = TranslateEvent(action)

   IF .NOT. doevent(action,.F.)
      IF action = OUREXIT
         EXIT
      ENDIF
      LOOP
   ENDIF

   firstpass = .t.

   DO WHILE .T.
      IF action = OURNEW
         mode = OURNEW
         APPEND BLANK
         if firstpass
           @ 4,11 GET name
           @ 4,58 GET ssn
         endif
         DISABLE BUTTON ' Next '
         DISABLE BUTTON ' Prev '
         DISABLE BUTTON 'Delete'
         DISABLE BUTTON ' New  '
         DISABLE BUTTON ' Edit '
      ELSE
         DISABLE BUTTON ' Edit '
         DISABLE BUTTON ' New  '
         @ 4,11 SAY name
         @ 4,58 SAY ssn
         mode = OUREDIT
      ENDIF
        if firstpass
            @  8,14 GET address
            @  8,62 GET date MESSAGE 'Enter the date last contacted'
            @ 10,14 GET city
            @ 12,14 GET state
            @ 12,38 GET zip
            @ 10,49 GET notes editbox to 5,15
          @ 16,49 GET active CHECKBOX 'Active'
            @ 14,21 GET busphone  PICTURE '(###)###-####'
            @ 16,21 GET homephone PICTURE '(###)###-####'
         endif

      action = GetEvent(READSAVE,0)
      action = TranslateEvent(action)
      IF doevent(action,.T.)
         EXIT
      ENDIF

      firstpass = .f.
      update gets
   ENDDO
   clear gets
ENDDO

RELEASE begread, mode
CLOSE ALL
RETURN

********************************************
PROCEDURE PaintScreen
********************************************

USE tname
INDEX on ssn to tssn
INDEX on name to tname
use tname index tname, tssn

color = sayvideo()
*Find out the users chosen color, mask our forgrnd, then add 1 to make it blue
color = bitand(240,color) + 1
set say video to color
center('Customer Entry and Modification',1,0,78,10)
set color to

@  4,6  SAY 'Name'
@  4,43 SAY 'Account Number'
@  8,6  SAY 'Address'
@ 10,6  SAY 'City'
@ 12,6  SAY 'State'
@ 12,29 SAY 'Zip Code'
@ 14,6  SAY 'Business Phone'
@ 16,6  SAY 'Home Phone'
@  8,49 SAY 'Last Contact'
@ 12,49 SAY 'Notes'
@  7,4 TO 17,73
return


********************************************
FUNCTION chkname
********************************************
PARAMETER target

   SET INDEX TO tname
   SEEK TRIM(target)
   begread = 1      | As a convenience, Change default get field
   IF .NOT. EOF()
      GETNO(30)        | Anything larger than number of get fields exist read
   ELSE
      GO BOTTOM
      RETURN(.F.)
   ENDIF
RETURN(.T.)


********************************************
FUNCTION chkssn
********************************************
PARAMETER target

   SET INDEX TO tssn
   SEEK TRIM(target)
   begread = 2          | As a convenience, Change default get field
   IF .NOT. EOF()
      GETNO(30)        | Anything larger than number of get fields exist read
   ELSE
      GO BOTTOM
      RETURN(.F.)
   ENDIF
RETURN(.T.)


********************************************
FUNCTION doevent
********************************************
PARAMETER act, dflt

   DO CASE
      CASE act = OUREXIT
         IF mode = OUREDIT
            GOTO CURRENT
         ELSE
            UNPEND
         ENDIF
         RETURN(dflt)
      CASE act = 0              |Incorrect entry
         RETURN(.F.)
      CASE act = OURNEXT
         SKIP
         IF EOF()
            SKIP -1
         ENDIF
         do dispinfo
         RETURN(.f.)
      CASE act = OURPREV
         SKIP -1
         IF BOF()
            SKIP
         ENDIF
         DO dispinfo
         RETURN(.F.)
      CASE act = OURDELETE
         DELETE
         SKIP
         IF EOF()
            SKIP -1
         ENDIF
         DO dispinfo
         RETURN(dflt)
   ENDCASE
RETURN(.T.)


********************************************
PROCEDURE dispinfo
********************************************

 @  8,14 SAY address
 @ 10,14 SAY city
 @ 12,14 SAY state
 @ 12,38 SAY zip PICTURE '99999'
 @ 14,21 SAY busphone PICTURE '(###)###-####'
 @ 16,21 SAY homephone PICTURE '(###)###-####'
 @  8,62 SAY date

RETURN


********************************************
function GetEvent
********************************************
parameter emode, getstart

  do case
    case emode = ACTIVEGETS
      if getstart > 0
        read starting with getstart
      else
        read
      endif
    case emode = READSAVE
      read save
    case emode = WAITING
      @ 0,0 say
      wait ""
    otherwise                      |NORMAL
      return(chkevent())
   endcase
return(event())


********************************************
function TranslateEvent(ievent)
********************************************
parameter ievent

do case
  case ievent = KEYBD_EVENT
    key = LASTKEY()
    DO CASE
      CASE key = 27
        RETURN(OUREXIT)
      CASE key = 530
        RETURN(OURPREV)
      CASE key = 536
        RETURN(OURNEXT)
      OTHERWISE
        RETURN(OUREDIT)
    ENDCASE
  case ievent = BUTTON_EVENT           | button event
    STORE BUTTON() TO btext
    DO CASE
      CASE btext =  ' Next '
        RETURN(OURNEXT)
      CASE btext =  ' Prev '
        RETURN(OURPREV)
      CASE btext =  'Delete'
        RETURN(OURDELETE)
      CASE btext =  ' New  '
        RETURN(OURNEW)
      CASE btext =  'Cancel'
        RETURN(OUREXIT)
      CASE btext =  ' Edit '
    ENDCASE
 otherwise
   BEEP
   RETURN(0)
endcase
RETURN(OUREDIT)