The following is an example of the source code so you can see how easy it is
to work with the program.
This sample is the Customer Maintenance program, allowing you to add, delete,
find or modify a customer. The code comes properly formatted (html doesn't
allow this conversion)
*:*********************************************************************
*:
*: Program: DR2.PRG
*:
*: System: Workshop Manager 6.08 GST
*: Author: Colin Gillam
*: Copyright (c) 2001, CAMS Sep 3 2001
*:
*: Procs & Fncts: DR2INIT()
*: : DR2SCR()
*: : DR2SAY()
*: : DR2FIND()
*: : DR2ADD()
*: : DR2EDIT()
*: : DR2MEMO()
*: : DR2MEM()
*: : DR2GET()
*: : DR2REPL()
*:
*: Called by: WORKMENU.PRG
*:
*: Calls: ANET_USE() (function in FUNCLIB.PRG)
*: : REC_LOCK() (function in FUNCLIB.PRG)
*: : RECLOCK (procedure in FUNCLIB.PRG)
*: : LOG_ADD() (function in FUNCLIB.PRG)
*: : SCRNHEAD() (function in FUNCLIB.PRG)
*: : DR2SCR() (function in DR2.PRG)
*: : DR2FIND() (function in DR2.PRG)
*: : DR2SAY() (function in DR2.PRG)
*: : SAYAGED() (function in FUNCLIB.PRG)
*: : DR2ADD() (function in DR2.PRG)
*: : GETAGED() (function in FUNCLIB.PRG)
*: : REPLAGED() (function in FUNCLIB.PRG)
*: : DR2EDIT() (function in DR2.PRG)
*: : DR2MEMO() (function in DR2.PRG)
*: : DR1TRAN() (function in DR1.PRG)
*:
*:*:*********************************************************************
*DR2 ENTRY OF CUSTOMERS
Mcall_prg='DR2'
SELE 1
Dok = Anet_use('customer INDEX custcode,custtel',.F.,0)
GO TOP
IF EMPTY(Acode)
Yn='Y'
IF .NOT. Rec_lock(5)
DO Reclock WITH Yn
ENDIF (.NOT. Rec_lock(5))
IF Yn='Y'
Log_add()
DELETE
ENDIF (Yn='Y')
SKIP 0
UNLOCK
ENDIF (EMPTY(Acode))
SELE 18
Dok = Anet_use('payrect INDEX prcode,pinvno', .F., 0)
SELE Customer
PUBLIC Mtransport
PUBLIC Mcustmemo
Setcolor(Normal)
@ 0,0 CLEAR
Prochead = ' Customer File Maintenance '
Scrnhead()
Dr2scr()
Dr2find()
Mopt=10
DO WHILE .T.
SELE Customer
Mcall_prg='DR2'
Dr2scr()
Dr2say()
Sayaged(0)
@ 22,0 TO 22,79 DOUBLE
Setcolor(Menubar)
@ 24,3 PROMPT ' Add ' MESSAGE 'Add another customer'
@ 24,COL() PROMPT ' Balance ' MESSAGE 'Change account balance'
@ 24,COL() PROMPT ' Delete ' MESSAGE 'Delete this customer'
@ 24,COL() PROMPT ' Edit ' MESSAGE 'Change the customers details'
@ 24,COL() PROMPT ' Find ' MESSAGE 'Find another customer'
@ 24,COL() PROMPT ' Memo ' MESSAGE 'Edit customer memo'
@ 24,COL() PROMPT ' Next ' MESSAGE 'Skip to next customer'
@ 24,COL() PROMPT ' Previous ' MESSAGE 'Skip to previous customer'
@ 24,COL() PROMPT ' Trans ' MESSAGE 'List customer transactions'
@ 24,COL() PROMPT ' Esc to exit ' MESSAGE 'Return to customer menu'
MENU TO Mopt
Setcolor(Normal)
@ 23,0 CLEAR
DO CASE
CASE Mopt=0 .OR. Mopt=10
CLOSE DATA
RETURN
CASE Mopt=1
Dr2add()
CASE Mopt=2
@ 23,0 CLEAR
Setcolor(Boxcol1)
Beep('BOZO')
Msg(' Changing the account balance should only be done when setting up accounts
',' If balance is incorrect, press C to continue or any other key to exit ')
Mcontinue=LASTKEY()
Setcolor(Normal)
IF Mcontinue=67 .OR. Mcontinue=99
Mbtotal=Btotal
Mcurrent=Current
Mterms=Terms
Moverdue=Overdue
Mytd=Ytd
Mcredlim=Credlim
Getaged(0)
Replaged()
ENDIF (Mcontinue=67 .OR. Mcontinue=99)
CASE Mopt=3
IF Btotal<>0
Beep('BOZO')
Msg(' Customer has amounts outstanding ')
LOOP
ENDIF (Btotal<>0)
Msure=.F.
Msure=Messyn("Are you sure you wish to delete this customer?","No","Yes")
IF LASTKEY()=27
LOOP
ENDIF (LASTKEY()=27)
IF .NOT. Msure
Yn='Y'
IF .NOT. Rec_lock(5)
DO Reclock WITH Yn
ENDIF (.NOT. Rec_lock(5))
IF Yn='Y'
Log_add()
DELETE
ENDIF (Yn='Y')
SKIP 0
COMMIT
UNLOCK
SKIP 1
ENDIF (.NOT. Msure)
CASE Mopt=4
Dr2edit()
CASE Mopt=5
Dr2find()
CASE Mopt=6
Dr2memo()
CASE Mopt=7
SKIP
CASE Mopt=8
SKIP-1
CASE Mopt=9
Setcolor(Normal)
@ 3,0 TO 6,79 DOUBLE
Dr1tran()
ENDCASE
ENDDO &&DISPLAY (.T.)
*!*********************************************************************
*!
*! Function: DR2SCR()
*!
*! Called by: DR2.PRG
*! : DR1CDET (procedure in DR1.PRG)
*! : DR2ADD() (function in DR2.PRG)
*! : DR2EDIT() (function in DR2.PRG)
*!
*! Calls: AGEDBOX() (function in FUNCLIB.PRG)
*!
*!*********************************************************************
FUNCTION Dr2scr
Setcolor(Normal)
@ 3,0 CLEAR
@ 4,1 SAY 'Customer Code ABN Type'
@ 5,1 SAY 'Name Contact'
@ 6,1 SAY 'Company Phone Work'
@ 7,1 SAY 'Address Phone Home'
@ 8,1 SAY 'Suburb Mobile'
@ 9,1 SAY 'Postcode Fax'
@ 10,1 SAY 'Courier'
@ 11,1 SAY 'Discount Last Payment'
@ 12,1 SAY 'Buying Price 1-4 Retail'
@ 13,1 SAY 'Bank'
@ 14,1 SAY 'Branch'
Agedbox(0)
RETURN ''
*!*********************************************************************
*!
*! Function: DR2INIT()
*!
*! Called by: DR1.PRG
*! : DR1FIND() (function in DR1.PRG)
*! : DR1ADD() (function in DR1.PRG)
*! : DR2FIND() (function in DR2.PRG)
*! : DR2ADD() (function in DR2.PRG)
*!
*!*********************************************************************
FUNCTION Dr2init
Macode=SPACE(6)
Mabn=SPACE(14)
Mname=SPACE(25)
Mcname=SPACE(15)
Mcomp=SPACE(32)
Maddr=SPACE(25)
Msub=SPACE(23)
Mpc=SPACE(10)
Mph_w=SPACE(15)
Mph_h=SPACE(15)
Mph_mob=SPACE(15)
Mkey=SPACE(5)
Mfax=SPACE(12)
Mtransport=SPACE(20)
Mdisc=0
Mlastpaid=CTOD(' / / ')
Mplevel=1
Mcustmemo=' '
Mbtotal=0
Mcurrent=0
Mterms=0
Moverdue=0
Mytd=0
Mbank=SPACE(10)
Mbranch=SPACE(10)
Mcredlim=0
RETURN ''
*!*********************************************************************
*!
*! Function: DR2MEM()
*!
*! Called by: DR2EDIT() (function in DR2.PRG)
*!
*!*********************************************************************
FUNCTION Dr2mem
Macode=Acode
Mabn=Abn
Mname=Name
Mcname=Cname
Mcomp=Comp
Maddr=Addr
Msub=Sub
Mpc=Pc
Mph_w=Ph_w
Mph_h=Ph_h
Mph_mob=Ph_mob
Mkey=Key
Mfax=Fax
Mtransport=Transport
Mdisc=Disc
Mlastpaid=Lastpaid
Mplevel=Plevel
Mbtotal=Btotal
Mcurrent=Current
Mterms=Terms
Moverdue=Overdue
Mytd=Ytd
Mbank=Bank
Mbranch=Branch
Mcredlim=Credlim
RETURN ''
*!*********************************************************************
*!
*! Function: DR2SAY()
*!
*! Called by: DR2.PRG
*! : DR1CDET (procedure in DR1.PRG)
*!
*!*********************************************************************
FUNCTION Dr2say
Setcolor(Bright)
@ 4,15 SAY Acode
@ 4,30 SAY Abn
@ 4,61 SAY Key
@ 5,15 SAY Name
@ 5,61 SAY Cname
@ 6,15 SAY Comp
@ 7,15 SAY Addr
@ 8,15 SAY Sub PICTURE '@!'
@ 9,15 SAY Pc
@ 10,15 SAY Transport
@ 11,15 SAY Disc
@ 12,15 SAY Plevel
@ 13,15 SAY Bank
@ 14,15 SAY Branch
@ 6,61 SAY Ph_w PICTURE '@X'
@ 7,61 SAY Ph_h PICTURE '@X'
@ 8,61 SAY Ph_mob PICTURE '@X'
@ 9,61 SAY Fax PICTURE '@X'
@ 11,61 SAY Lastpaid
Mrow=15
Mwidth=55
FOR Line=1 TO 2
Print_line=Memoline(Custmemo,Mwidth,Line)
@ Mrow,22 SAY Print_line
Mrow=Mrow+1
NEXT (Line)
RETURN ''
*!*********************************************************************
*!
*! Function: DR2GET()
*!
*! Called by: DR2ADD() (function in DR2.PRG)
*! : DR2EDIT() (function in DR2.PRG)
*!
*! Calls: SUBFIND() (function in FUNCLIB.PRG)
*!
*!*********************************************************************
FUNCTION Dr2get
@ 4,15 SAY Macode
@ 4,30 GET Mabn
@ 4,61 GET Mkey
@ 5,15 GET Mname
@ 5,61 GET Mcname
@ 6,15 GET Mcomp
@ 7,15 GET Maddr
@ 8,15 GET Msub PICTURE '@!' VALID Subfind(8,15,9,15)
@ 9,15 SAY Mpc
@ 10,15 GET Mtransport
@ 11,15 GET Mdisc PICTURE '99.99'
@ 12,15 GET Mplevel PICTURE '9' VALID Mplevel>0 .AND. Mplevel<5
@ 13,15 GET Mbank
@ 14,15 GET Mbranch
@ 6,61 GET Mph_w PICTURE '@X'
@ 7,61 GET Mph_h PICTURE '@X'
@ 8,61 GET Mph_mob PICTURE '@X'
@ 9,61 GET Mfax PICTURE '@X'
@ 11,61 GET Mlastpaid
@ 20,68 GET Mcredlim PICTURE '999,999.99'
READ
RETURN ''
*!*********************************************************************
*!
*! Function: DR2ADD()
*!
*! Called by: DR2.PRG
*! : DR2FIND() (function in DR2.PRG)
*!
*! Calls: DR2SCR() (function in DR2.PRG)
*! : DR2INIT() (function in DR2.PRG)
*! : DR2GET() (function in DR2.PRG)
*! : ADD_REC() (function in FUNCLIB.PRG)
*! : RECLOCK (procedure in FUNCLIB.PRG)
*! : LOG_ADD() (function in FUNCLIB.PRG)
*! : DR2REPL() (function in DR2.PRG)
*!
*!*********************************************************************
FUNCTION Dr2add
Dr2scr()
Macode2=Macode
Dr2init()
Macode=Macode2
@ 4,15 GET Macode PICTURE '@!'
READ
SEEK Macode
IF FOUND()
Beep('BOZO')
Msg('Account code already on file')
RETURN ''
ENDIF (FOUND())
Dr2get()
Yn='Y'
IF .NOT. Add_rec(5)
DO Reclock WITH Yn
ENDIF (.NOT. Add_rec(5))
IF Yn='Y'
Log_add()
Dr2repl()
ENDIF (Yn='Y')
SKIP 0
COMMIT
UNLOCK
RETURN ''
*!*********************************************************************
*!
*! Function: DR2EDIT()
*!
*! Called by: DR2.PRG
*!
*! Calls: DR2SCR() (function in DR2.PRG)
*! : DR2MEM() (function in DR2.PRG)
*! : DR2GET() (function in DR2.PRG)
*! : REC_LOCK() (function in FUNCLIB.PRG)
*! : RECLOCK (procedure in FUNCLIB.PRG)
*! : LOG_ADD() (function in FUNCLIB.PRG)
*! : DR2REPL() (function in DR2.PRG)
*!
*!*********************************************************************
FUNCTION Dr2edit
Dr2scr()
Dr2mem()
Dr2get()
Yn='Y'
IF .NOT. Rec_lock(5)
DO Reclock WITH Yn
ENDIF (.NOT. Rec_lock(5))
IF Yn='Y'
Log_add()
Dr2repl()
ENDIF (Yn='Y')
SKIP 0
COMMIT
UNLOCK
RETURN ''
*!*********************************************************************
*!
*! Function: DR2REPL()
*!
*! Called by: DR2ADD() (function in DR2.PRG)
*! : DR2EDIT() (function in DR2.PRG)
*!
*!*********************************************************************
FUNCTION Dr2repl
REPLACE Acode WITH Macode, ;
Abn WITH Mabn, ;
Plevel WITH Mplevel, ;
Name WITH Mname, ;
Cname WITH Mcname, ;
Comp WITH Mcomp, ;
Addr WITH Maddr, ;
Sub WITH Msub, ;
Pc WITH Mpc, ;
Ph_w WITH Mph_w, ;
Ph_h WITH Mph_h, ;
Ph_mob WITH Mph_mob, ;
Key WITH Mkey, ;
Fax WITH Mfax, ;
Transport WITH Mtransport, ;
Disc WITH Mdisc, ;
Lastpaid WITH Mlastpaid, ;
Bank WITH Mbank, ;
Branch WITH Mbranch, ;
Credlim WITH Mcredlim
RETURN ''
*!*********************************************************************
*!
*! Function: DR2MEMO()
*!
*! Called by: DR2.PRG
*!
*! Calls: TOCENTRE() (function in FUNCLIB.PRG)
*! : REC_LOCK() (function in FUNCLIB.PRG)
*! : RECLOCK (procedure in FUNCLIB.PRG)
*! : LOG_ADD() (function in FUNCLIB.PRG)
*!
*!*********************************************************************
FUNCTION Dr2memo
Setcolor(Boxcol1)
Mwidth=55
Box(13,14,22,14+Mwidth+2,'',-1,3,8)
Setcolor(Reverse)
Tocentre(24,' F10 when finished comments ')
Setcolor(Boxcol1)
Mcustmemo=Custmemo
Mcustmemo=Memoedit(Mcustmemo,14,15,21,15+Mwidth,.T.)
Setcolor(Normal)
Yn='Y'
IF .NOT. Rec_lock(5)
DO Reclock WITH Yn
ENDIF (.NOT. Rec_lock(5))
IF Yn='Y'
REPLACE Custmemo WITH Mcustmemo
Log_add()
ENDIF (Yn='Y')
SKIP 0
COMMIT
UNLOCK
RETURN ''
*!*********************************************************************
*!
*! Function: DR2FIND()
*!
*! Called by: DR2.PRG
*!
*! Calls: DR2INIT() (function in DR2.PRG)
*! : DR1ADD() (function in DR1.PRG)
*! : DR2ADD() (function in DR2.PRG)
*!
*! Indexes: CUSTTEL.NTX
*! : CUSTCODE.NTX
*!
*!*********************************************************************
FUNCTION Dr2find
Dr2init()
@ 4,15 GET Macode PICTURE '@!'
READ
IF EMPTY(Macode)
SET INDEX TO Custtel,Custcode
@ 6,61 GET Mph_w
READ
SEEK Mph_w
Macode=Acode
IF .NOT. FOUND()
SET SOFTSEEK ON
SEEK Mph_w
Smalls("ph_w+' '+SUBSTR(name,1,20)+' '+SUBSTR(comp,1,15)+'
'+SUBSTR(addr,1,15)+' '+SUBSTR(ph_w,1,12)",' Press Enter to select a
Customer, Esc to add or exit ')
IF LASTKEY()=27
Mnew=Messyn("Do you wish to add a new customer?")
SET INDEX TO Custcode,Custtel
IF Mnew
Dr1add()
ENDIF (Mnew)
RETURN ''
ENDIF (LASTKEY()=27)
Macode=Acode
SET SOFTSEEK Off
ENDIF (.NOT. FOUND())
SET INDEX TO Custcode,Custtel
SEEK Macode
ELSE
SEEK Macode
IF .NOT. FOUND()
SET SOFTSEEK ON
SEEK Macode
Smalls("acode+' '+SUBSTR(name,1,20)+' '+SUBSTR(comp,1,15)+'
'+SUBSTR(addr,1,15)+' '+SUBSTR(ph_w,1,12)",' Press Enter to select a
Customer, Esc to add or exit ')
IF LASTKEY()=27
Mnew=Messyn("Do you wish to add a new customer?")
IF Mnew
Dr2add()
ENDIF (Mnew)
RETURN ''
ENDIF (LASTKEY()=27)
Macode=Acode
SET SOFTSEEK Off
ENDIF (.NOT. FOUND())
ENDIF (EMPTY(Macode))
RETURN ''
*: EOF: DR2.PRG
