Software Du Jour/SoftwareDuJour.iso/BUSINESS/DBASE/VIEWGEN.ARC/SAM_PROC.PRG

Text File | 1985-11-05 | 7.6 KB | 340 lines

* Program.: SAM_PROC.PRG
* Author..: Your Name
* Date....: 11/05/85
* Notice..: Copyright 1985, Your Company, All Rights Reserved
* Version.: dBASE III, version 1.1
* Notes...: PROCEDURE file for NAMES.DBF
*

PROCEDURE SAYFORM
   CLEAR
   SET COLOR TO &StatusAtr
   @  0, 0 SAY SPACE(80)
   @  0, 0 SAY "Record:"
   @  0,72 SAY DATE()
   SET COLOR TO &PromptAtr
   @ 20,0 SAY PromptBar
   SET COLOR TO &WindowAtr
   @  2,31 SAY "EMPLOYEE DATABASE"
   @  4, 0 SAY "First name "
   @  5, 0 SAY "Last name  "
   @  8, 4 SAY "Job title       "
   @  9, 4 SAY "Department code "
   @ 10, 4 SAY "Current Salary  "
   @ 11, 4 SAY "Starting date   "
   @ 13,50 SAY "Area "
   @ 13,55 SAY "Phone "
   @ 14, 9 SAY "Address "
   @ 15, 9 SAY "City    "
   @ 16, 9 SAY "State   "
   @ 17, 9 SAY "Zip     "
RETURN


PROCEDURE GETFORM
   SET COLOR TO &WindowAtr
   @  4,11 GET Firstname
   @  5,11 GET Lastname
   @  8,20 GET Jobtitle
   @  9,20 GET Deptcode
   @ 10,20 GET Salary PICTURE '999,999.99' RANGE 5000,250000
   @ 11,20 GET Startdate RANGE CTOD('05/15/82'),DATE()
   @ 14,50 GET Areacode PICTURE '999'
   @ 14,55 GET Phone PICTURE '999-9999'
   @ 14,17 GET Address
   @ 15,17 GET City
   @ 16,17 GET State PICTURE '@!A'
   @ 17,17 GET Zip PICTURE '99999'
RETURN


PROCEDURE OpenFile
   * ---Open database file.
   USE NAMES
   GOTO BOTTOM
   IF EOF()
      LastRec = 0
   ELSE
      LastRec = RECNO()
   ENDIF
   GOTO TOP
   * ---Open index file.
   SET INDEX TO NAMES
RETURN


PROCEDURE GetKey
PARAMETER choice,values
PRIVATE currow,curcol
   SET INTENSITY OFF
   currow = ROW()
   curcol = COL()
   choice = "*"
   DO WHILE .NOT. (choice $ values)
      choice = " "
      @ currow,curcol GET choice PICTURE "!"
      READ
   ENDDO
   SET INTENSITY ON
RETURN


PROCEDURE StatLine
PARAMETER recnum
   SET COLOR TO &StatusAtr
   @ 0, 8 SAY SUBSTR( STR( recnum + 1000000,7 ),2 )
   IF DELETED()
      @ 0,55 SAY "*DEL*"
   ELSE
      @ 0,55 SAY "     "
   ENDIF
RETURN


PROCEDURE DoEDIT
PARAMETER row
   DO WHILE .T.
      SET COLOR TO &PromptAtr
      @ row,0 CLEAR
      @ row,0 SAY "Press <Ctrl-End> to Exit"
      DO StatLine WITH RECNO()
      DO GETFORM
      READ
      SET COLOR TO &PromptAtr
      @ row,0 CLEAR
      @ row,0 SAY "EDIT:  Re-edit  <Return> "
      DO GetKey WITH choice,"R"+CtrlEnd+Returnkey
      IF choice $ Returnkey+CtrlEnd
         EXIT
      ENDIF
   ENDDO
RETURN


PROCEDURE SayRec
   DO StatLine WITH RECNO()
   * ---Display the FIELDS with GETs.
   DO GETFORM
   CLEAR GETS
   oldrecnum = RECNO()
RETURN


PROCEDURE SayEOF
PARAMETER row
   @ row,0 CLEAR
   IF BOF()
      @ row,0 SAY "BEGINNING-OF-FILE encountered"
   ELSE
      @ row,0 SAY "END-OF-FILE encountered"
   ENDIF
   WAIT
   @ row,0 CLEAR
   GOTO oldrecnum
RETURN


PROCEDURE DoSEEK
PARAMETER row,prompt
   SET COLOR TO &PromptAtr
   @ row,0 CLEAR
   @ row-1,0 SAY ""
   ACCEPT prompt TO expr
   IF "" = expr
      RETURN
   ENDIF
   SEEK expr
   IF EOF()
      DO SayEOF WITH row
   ELSE
      DO SayRec
   ENDIF
RETURN


PROCEDURE DoGOTO
PARAMETER row
PRIVATE recnum
   SET COLOR TO &PromptAtr
   @ row,0 CLEAR
   @ row,0 SAY "GOTO:  Top  Bottom  Record#  <Return> "
   DO GetKey WITH choice,"TBR"+Returnkey
   @ row,0 CLEAR
   DO CASE
   CASE choice = Returnkey
      RETURN
   CASE choice = "T"
      GOTO TOP
      DO SayRec
   CASE choice = "B"
      GOTO BOTTOM
      DO SayRec
   CASE choice = "R"
      recnum = 0
      @ row,0 SAY "Enter RECORD number" GET recnum;
              PICTURE "@Z 9999999" RANGE 0,LastRec
      READ
      IF recnum > 0
         @ row,0 CLEAR
         GOTO recnum
         DO SayRec
      ENDIF
   ENDCASE
RETURN


PROCEDURE DoLOCATE
PARAMETER row
   DO GetExpr WITH 22,"LOCATE FOR ",expr
   DO SAYFORM
   DO SayRec
   IF "" = expr .OR. TYPE( [&expr] ) = "U"
      RETURN
   ENDIF
   SET COLOR TO &PromptAtr
   @ row,0 SAY "Locating..."
   LOCATE FOR &expr
   IF EOF()
      DO SayEOF WITH row
   ELSE
      DO SayRec
      SET COLOR TO &PromptAtr
      @ row,0 CLEAR
      @ row,0 SAY "LOCATE FOR" GET expr
      CLEAR GETS
      DO DoCONT WITH row
   ENDIF
RETURN


PROCEDURE DoCONT
PARAMETER row
   choice = "Y"
   DO WHILE choice = "Y"
      @ row+1,0 CLEAR
      SET COLOR TO &PromptAtr
      @ row+1,0 SAY "Continue? (y/n)"
      DO GetKey WITH choice,"YN"+Returnkey
      @ row+1,0 CLEAR
      IF choice = "Y"
         CONTINUE
         IF EOF()
            DO SayEOF WITH row
            choice = "N"
         ELSE
            DO SayRec
         ENDIF
      ENDIF
   ENDDO
RETURN


PROCEDURE GetExpr
PARAMETER row,prompt,expr
PRIVATE getcol,getlen,phrase,fldnum
   * ---Pass row by value.
   DO FldScrn WITH (row)
   getcol = LEN( prompt )
   getlen = 80 - getcol
   expr = SPACE( getlen )
   SET COLOR TO &PromptAtr
   @ row,0 CLEAR
   @ row,0 SAY prompt
   SET INTENSITY OFF
   @ row,getcol GET expr
   CLEAR GETS
   SET INTENSITY ON
   expr = ""
   phrase = ""
   fldnum = 0
   * ---Build the FOR <exp>.
   DO WHILE .T.
      * ---Pass row by value.
      DO GetPhras WITH (row),fldnum,phrase
      IF fldnum = 0 .OR. LEN( expr + phrase ) > getlen * 2
         EXIT
      ENDIF
      IF "" = expr
         expr = SUBSTR( phrase,8 )
      ELSE
         expr = expr + phrase
      ENDIF
      SET INTENSITY OFF
      @ row,getcol GET expr
      CLEAR GETS
      SET INTENSITY ON
   ENDDO
   * ---Final edit on the <exp>.
   expr = expr + SPACE( getlen - LEN( expr ) )
   @ row,getcol GET expr
   READ
   * ---Return TRIMmed <exp>.
   expr = TRIM( expr )
RETURN


PROCEDURE FldScrn
PARAMETER row
   row = row - 14
   SET COLOR TO &PromptAtr
   @ row, 0 CLEAR
   @ row+13,0 SAY PromptBar
   @ row+ 2,0 SAY "Enter field #"
   @ row+ 3,0 SAY "┌───┬────────────┬───────────────────────────────────┐"
   @ row+ 4,0 SAY "│ # │ Field      │    Field Contents                 │"
   @ row+ 5,0 SAY "├───┼────────────┼───────────────────────────────────┤"
   @ row+ 6,0 SAY "│ 1 │ Firstname  │  =                                │"
   @ row+ 7,0 SAY "│ 2 │ Lastname   │  =                                │"
   @ row+ 8,0 SAY "│ 3 │ Jobtitle   │  =                                │"
   @ row+ 9,0 SAY "│ 4 │ Deptcode   │  =                                │"
   @ row+10,0 SAY "│ 5 │ Salary     │ >=                                │"
   @ row+11,0 SAY "└───┴────────────┴───────────────────────────────────┘"
RETURN


PROCEDURE GetPhras
PARAMETER row,fldnum,phrase
PRIVATE Cvar,Nvar,Dvar,Lvar
   row = row - 12
   fldnum = 0
   phrase = ""
   SET INTENSITY OFF
   @ row,14 GET fldnum PICTURE "@Z 9" RANGE 0,5
   READ
   SET INTENSITY ON
   DO CASE
   CASE fldnum = 1
      * ---Firstname field.
      Cvar = SPACE( 15 )
      @ row+4,22 GET Cvar
      READ
      phrase = [ .AND. Firstname="] + TRIM(Cvar) + ["]
   CASE fldnum = 2
      * ---Lastname field.
      Cvar = SPACE( 20 )
      @ row+5,22 GET Cvar
      READ
      phrase = [ .AND. Lastname="] + TRIM(Cvar) + ["]
   CASE fldnum = 3
      * ---Jobtitle field.
      Cvar = SPACE( 30 )
      @ row+6,22 GET Cvar
      READ
      phrase = [ .AND. Jobtitle="] + TRIM(Cvar) + ["]
   CASE fldnum = 4
      * ---Deptcode field.
      Cvar = SPACE( 3 )
      @ row+7,22 GET Cvar
      READ
      phrase = [ .AND. Deptcode="] + TRIM(Cvar) + ["]
   CASE fldnum = 5
      * ---Salary field.
      Nvar = 0.0
      @ row+8,22 GET Nvar PICTURE "9999999.99"
      READ
      phrase = [ .AND. Salary>=] + STR( Nvar,10,2 )
   ENDCASE
RETURN

* EOF: SAM_PROC.PRG