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

Text File | 1989-11-07 | 4.4 KB | 179 lines

* ┌─────────────────────────────────────────────────────────────────────┐ *
* │  PROG NAME: INVENTRY.PRG - Inventory 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)                 │ *
* └─────────────────────────────────────────────────────────────────────┘ *

ACTIVATE WINDOW working
DO set_itm
SELECT items
SET ORDER TO itm_itm
IF EOF()
  GO TOP
ENDIF
STORE item TO mitem
DO disp_itm
DO show_itm
STORE .t. TO inventing
DO WHILE inventing
  ACTIVATE MENU inventry PAD search
  IF .NOT. in_prodemo
      DEACTIVATE MENU
  ENDIF
ENDDO
RELEASE MENU inventry
CLEAR
DEACTIVATE WINDOW working
RETURN

PROCEDURE add_itm
  DO disp_itm
  STORE SPACE(6) TO mitem
  @ 01,08 GET mitem PICT '!!!!!!'
  READ
  SEEK mitem
  IF FOUND()
    DO show_itm
    DO standby WITH "Can't add this record: it's already on file."
    RETURN
  ELSE
    APPEND BLANK
    REPLACE NEXT 1 item WITH mitem
  ENDIF
  DO edit_itm
  RETURN

PROCEDURE del_itm
  STORE .f. TO do_it
  ACTIVATE WINDOW msg2user
  @ 01,02 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 NEXT 1
  IF .NOT. EOF()
    SKIP
  ENDIF
  IF EOF()
    GO BOTTOM
  ENDIF
  DO show_itm
  RETURN

PROCEDURE disp_itm
  CLEAR
  @ 00,01 TO 02,18
  @ 01,03 SAY "Item"
  @ 02,01 TO 21,76
  @ 02,01 SAY "├"
  @ 02,18 SAY "┴"
  @ 07,10 SAY "            On Hand: "
  @ 08,10 SAY "      Cost per unit: "
  @ 09,10 SAY "     Price per unit: "
  @ 10,10 SAY "          Taxable ?: "
  @ 12,10 SAY "  Cost of Inventory: "
  @ 14,10 SAY " Value of Inventory: "
  RETURN

PROCEDURE edit_itm
  @ 01,08 GET item
  CLEAR GETS
  @ 04,04 GET descript
  @ 07,31 GET quantity PICTURE '9999999'
  @ 08,31 GET cost     PICTURE '999,999.99'
  @ 09,31 GET price    PICTURE '999,999.99'
  @ 10,31 GET taxable  PICTURE 'Y'
  READ
  DO show_itm
  RETURN

PROCEDURE last_itm
  GO BOTTOM
  DO show_itm
  RETURN

PROCEDURE next_itm
  SKIP
  IF EOF()
    GO BOTTOM
    DO standby WITH "End of file: there is no NEXT inventory item."
  ELSE
    DO show_itm
  ENDIF
  RETURN

PROCEDURE prev_itm
  SKIP -1
  IF BOF()
    GO TOP
    DO standby WITH "Beginning of file: there is no PREVIOUS inventory item."
  ELSE
    DO show_itm
  ENDIF
  RETURN

PROCEDURE quit_itm
  STORE .f. TO inventing
  DEACTIVATE MENU
  RETURN

PROCEDURE set_itm
  DEFINE MENU inventry COLOR SCHEME 3
  DEFINE PAD NEXT   OF inventry PROMPT '\<Next'   AT 17,03
  DEFINE PAD prev   OF inventry PROMPT '\<Prev'   AT 17,10
  DEFINE PAD first  OF inventry PROMPT '\<First'  AT 17,17
  DEFINE PAD LAST   OF inventry PROMPT '\<Last'   AT 17,25
  DEFINE PAD search OF inventry PROMPT '\<Search' AT 17,32
  DEFINE PAD EDIT   OF inventry PROMPT '\<Edit'   AT 17,41
  DEFINE PAD APPEND OF inventry PROMPT '\<Add'    AT 17,48
  DEFINE PAD DELETE OF inventry PROMPT '\<Delete' AT 17,54
  DEFINE PAD QUIT   OF inventry PROMPT '\<Quit'   AT 17,63
  ON SELECTION PAD NEXT      OF inventry DO next_itm
  ON SELECTION PAD prev      OF inventry DO prev_itm
  ON SELECTION PAD first     OF inventry DO top_itm
  ON SELECTION PAD LAST      OF inventry DO last_itm
  ON SELECTION PAD search    OF inventry DO srch_itm
  ON SELECTION PAD EDIT      OF inventry DO edit_itm
  ON SELECTION PAD APPEND    OF inventry DO add_itm
  ON SELECTION PAD DELETE    OF inventry DO del_itm
  ON SELECTION PAD QUIT      OF inventry DO quit_itm
  RETURN

PROCEDURE show_itm
  @ 01,08 SAY item
  @ 04,04 SAY descript
  @ 07,31 SAY quantity PICTURE '9999999'
  @ 08,31 SAY cost     PICTURE '999,999.99'
  @ 09,31 SAY price    PICTURE '999,999.99'
  @ 10,31 SAY taxable  PICTURE 'Y'
  *calculate the total value and total cost
  mcvalue=quantity*cost
  mpvalue=quantity*price
  *paint these totals on the screen
  @ 12,31 SAY mcvalue  PICTURE '999,999.99'
  @ 14,31 SAY mpvalue  PICTURE '999,999.99'
  RETURN

PROCEDURE srch_itm
  last_rec=RECNO()
  STORE SPACE(6) TO mitem
  DO disp_itm
  @ 1,08 GET mitem PICTURE '!!!!!!'
  READ
  SEEK mitem
  IF .NOT. FOUND()
    DO standby WITH "There is no such inventory item."
    GO last_rec
  ENDIF
  DO show_itm
  RETURN

PROCEDURE top_itm
  GO TOP
  DO show_itm
  RETURN
  * EOF