Source Code
Home Up

 

Up

 

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


 

 

Workshop Manager, Workshop Apprentice and Workshop Easy are trademarks of C.A.M.S.

All other products mentioned are registered trademarks or trademarks of their respective companies.

Questions or problems regarding this web site should be directed to cams@camsoft.com.au.
Copyright 1998 C.A.M.S. Creative Accounts Management Systems. All rights reserved.
Last modified: Monday, July 17, 2000.

Home Up