Liren Large Software Subsidy 5/05.iso/a/a070/3.ddi/FOXPRO/SAMPLE/CUSTOMER.PRG

Text File | 1989-11-07 | 5.8 KB | 237 lines

* ┌─────────────────────────────────────────────────────────────────────┐ *
* │  PROG NAME: CUSTOMER.PRG - Customer file maintenance.               │ *
* │  Copyright (c) 1989 Tech III, Inc. All rights reserved.             │ *
* │  Tech III of San Pedro, California      [phone].             │ *
* │  "The bridge connecting people and technology."(tm)                 │ *
* └─────────────────────────────────────────────────────────────────────┘ *

DO set_cus
STORE SPACE(6) TO mcust_id
SELECT customer
SET ORDER TO cus_cus
IF EOF()
  GO TOP
ENDIF
STORE cust_id TO mcust_id
DO disp_cus
DO show_cus
STORE .t. TO in_cus
DO WHILE in_cus
  ACTIVATE MENU customer PAD search
  IF .NOT. in_prodemo
      DEACTIVATE MENU
  ENDIF
ENDDO
DO shutdn_cus
RETURN

PROCEDURE add_cus
  DO disp_cus
  STORE SPACE(6) TO mcust_id
  ACTIVATE WINDOW custwind
  @ 01,12 GET mcust_id PICT '!!!!!!'
  READ
  SEEK mcust_id
  IF FOUND()
    DO show_cus
    DO standby WITH "Can't add this record: it's already on file."
    RETURN
  ELSE
    APPEND BLANK
    REPLACE NEXT 1 cust_id WITH mcust_id
  ENDIF
  DO edit_cus
  RETURN

PROCEDURE del_cus
  STORE .f. TO do_it
  ACTIVATE WINDOW msg2user
  @ 1,2 SAY 'Are you sure you want to delete this record? ' GET do_it PICT 'Y'
  READ
  DEACTIVATE WINDOW msg2user
  IF .NOT. do_it
    RETURN
  ENDIF
  DELETE
  IF .NOT. EOF()
    SKIP
  ENDIF
  IF EOF()
    GO BOTTOM
  ENDIF
  DO show_cus
  RETURN

PROCEDURE disp_cus
  ACTIVATE WINDOW custwind
  CLEAR
  @ 01,02 SAY "Customer:"
  @ 03,02 SAY " Company:"
  @ 04,02 SAY " Contact:"
  @ 05,02 SAY " Address:"
  @ 08,02 SAY "Tax Rate:"
  RETURN

PROCEDURE edit_com
  ON KEY LABEL F10 KEYBOARD CHR(23)
  ACTIVATE WINDOW screensim BOTTOM
  SHOW WINDOW comm_help
  MODIFY MEMO comments WINDOW memowind SAVE
  MODIFY MEMO comments WINDOW memowind NOWAIT
  HIDE WINDOW comm_help
  RETURN

PROCEDURE edit_cus
  ACTIVATE WINDOW custwind
  @ 01,12 GET cust_id PICT '!!!!!!'
  CLEAR GETS
  @ 03,12 GET company
  @ 04,12 GET contact
  @ 05,12 GET address1
  @ 06,12 GET city
  @ 06,37 GET state    PICTURE '!!'  VALID V_STATE(state)
  @ 06,42 GET zip      PICTURE  '99999'
  @ 08,12 GET taxrate  PICTURE '9.99'
  READ
  DO show_cus
  RETURN

PROCEDURE last_cus
  GO BOTTOM
  DO show_cus
  RETURN

PROCEDURE next_cus
  SKIP
  IF EOF()
    GO BOTTOM
    DO standby WITH "End of file: there is no NEXT customer."
  ELSE
    DO show_cus
  ENDIF
  RETURN

PROCEDURE prev_cus
  SKIP -1
  IF BOF()
    GO TOP
    DO standby WITH "Beginning of file: there is no PREVIOUS customer."
  ELSE
    DO show_cus
  ENDIF
  RETURN

PROCEDURE quit_cus
  STORE .f. TO in_cus
  DEACTIVATE MENU
  RETURN

PROCEDURE set_cus
  SELECT 0
  USE states INDEX states ALIAS states
  SELECT customer

  ACTIVATE WINDOW screensim
  CLEAR

  DEFINE WINDOW custwind FROM 02,02 TO 13,77 TITLE '< Customer >' COLOR SCHEME 10
  DEFINE WINDOW memowind FROM 14,02 TO 21,77 TITLE '< Comments >' ;
  ZOOM system COLOR SCHEME 10 && for editing comments

  DEFINE WINDOW comm_help FROM 09,17 TO 12,63 DOUBLE CLOSE COLOR SCHEME 7
  ACTIVATE WINDOW comm_help NOSHOW
  @ 00,01 SAY 'When finished editing, press [F10].'
  HIDE WINDOW comm_help

  SET MEMOWIDTH TO 70

  DEFINE POPUP states FROM 01,35 TO 10,40 PROMPT FIELD state COLOR SCHEME 11
  ON SELECTION POPUP states DEACTIVATE POPUP

  DEFINE MENU customer COLOR SCHEME 3
  DEFINE PAD pnext   OF customer PROMPT '\<Next'   AT 21,01
  DEFINE PAD pprev   OF customer PROMPT '\<Prev'   AT 21,08
  DEFINE PAD pfirst  OF customer PROMPT '\<First'  AT 21,15
  DEFINE PAD plast   OF customer PROMPT '\<Last'   AT 21,23
  DEFINE PAD psearch OF customer PROMPT '\<Search' AT 21,30
  DEFINE PAD pedit   OF customer PROMPT '\<Edit'   AT 21,39
  DEFINE PAD pappend OF customer PROMPT '\<Add'    AT 21,46
  DEFINE PAD pdelete OF customer PROMPT '\<Delete' AT 21,52
  DEFINE PAD pcomm   OF customer PROMPT '\<Comment' AT 21,61
  DEFINE PAD pquit   OF customer PROMPT '\<Quit'   AT 21,71
  ON SELECTION PAD pnext      OF customer DO next_cus
  ON SELECTION PAD pprev      OF customer DO prev_cus
  ON SELECTION PAD pfirst     OF customer DO top_cus
  ON SELECTION PAD plast      OF customer DO last_cus
  ON SELECTION PAD psearch    OF customer DO srch_cus
  ON SELECTION PAD pedit      OF customer DO edit_cus
  ON SELECTION PAD pappend    OF customer DO add_cus
  ON SELECTION PAD pdelete    OF customer DO del_cus
  ON SELECTION PAD pcomm      OF customer DO edit_com
  ON SELECTION PAD pquit      OF customer DO quit_cus
  RETURN

PROCEDURE shutdn_cus
  DEACTIVATE WINDOW screensim
  RELEASE    WINDOW custwind
  CLOSE      MEMO   comments
  RELEASE    WINDOW memowind
  RELEASE    POPUP  states
  RELEASE    MENU   customer
  SELECT states
  USE
  SELECT customer
  ACTIVATE SCREEN
  RETURN

PROCEDURE show_cus
  ACTIVATE WINDOW custwind
  @ 1, 12 SAY cust_id PICT '!!!!!!'
  @ 3, 12 SAY company
  @ 4, 12 SAY contact
  @ 5, 12 SAY address1
  @ 6, 12 SAY city
  @ 6, 37 SAY state
  @ 06,42 SAY zip
  @ 08,12 SAY taxrate PICTURE '9.99'
  ACTIVATE WINDOW screensim BOTTOM
  MODIFY MEMO comments WINDOW memowind NOWAIT
  RETURN

PROCEDURE srch_cus
  ACTIVATE WINDOW custwind
  last_rec=RECNO()
  DO disp_cus
  STORE SPACE(6) TO mcust_id
  @ 1,12 GET mcust_id PICT '!!!!!!'
  READ
  SEEK mcust_id
  IF .NOT. FOUND()
    DO standby WITH "There is no such customer"
    GO last_rec
  ENDIF
  DO show_cus
  RETURN

PROCEDURE top_cus
  GO TOP
  DO show_cus
  RETURN

FUNCTION v_state
  PARAMETER state
  SELECT states
  SEEK customer->state
  IF FOUND()
    SELECT customer
    RETURN .t.
  ENDIF
  DO WHILE .NOT. FOUND()
    ACTIVATE POPUP states
    SEEK PROMPT()
  ENDDO
  SELECT customer
  REPLACE customer->state WITH PROMPT()
  RETURN .t.
  * EOF