Language :
Visual Foxpro
Sample coding:
*----------------------------------------------- ENQR01.PRG
* DA WISE PENDING VOUCHER LIST
*------------------------------------------------------------
set colo to bg+
@ 5,01 clear to 23,79
@ 5,01 to 05,78 double
@03,30 CLEAR TO 03,48
SET COLOR TO GR+
CDESP=' ** DA Wise Total Payment Vouchers **'
CLEN = LEN(CDESP)
CPOS=(80-CLEN) / 2
@03,CPOS say CDESP
set color to BG+
*----------variables
fl_name = space(12)
K_esc = 27
msys_type=space(2)
p_width = 0
PG_CTR=0
P_ANS=SPACE(1)
LN_CTR = 0
CNTR = 0
SET DATE FRENCH
*---------------------------------
sele 10
use DEALASST inde DEALASST
ele = 1
d_items=0
d_lncd=0
declare a_da[ele]
declare a_name[ele]
a_name = space(30)
a_da = space(02)
go top
DO WHILE (.NOT. EOF())
d_items = d_items + 1
if d_items > 1
declare a_name[d_items]
declare a_da[d_items]
endif
a_name[d_items] = name
a_da[d_items] = da_cd
skip
ENDDO
IF D_ITEMS = 0
User_msg1 = 'Dealing Asst. Master File is Empty !! Please Enter Data!!'
User_msg2= 'Please Press Any Key to Continue'
MSRL_NO = '889'
do USEMSG
CLOSE ALL
RETURN
ENDIF
*----------------------------------------------
set cent on
pans = space(1)
LN_CTR = 0
m_cntr = 0
mr_date = { / / }
mda=space(2)
MDA=SPACE(2)
mda_name = space(30)
mr_date1 = { / / }
mr_date2 = { / / }
mans = space(1)
@10,1 say 'Enter From Date .........:' get mr_date1 pict '{ / / }'
@12,1 say 'Enter To Date .........:' get mr_date2 pict '{ / / }'
read
sele 20
use VOUCMAST inde VOUCMAST
copy to TEMP for despatch # { / / } .and. r_date >= Mr_date1 .and. r_date <= mr_date2
use
do JOBGOING
use TEMP
inde on da+str(slno,5) to TEMP
GO TOP
Fl_name = 'ENQR01.TXT'
P_width = 80
set alte to &fl_name
SET ALTE ON
SET CONSOLE OFF
DO PAGE_HD
SELE TEMP
g_cntr = 0
gg_cntr = 0
m_cntr = 0
samt = 0
p_amount = 0
g_amount = 0
gg_amount = 0
p_samt = 0
g_samt = 0
mda_name = space(30)
mda = space(2)
DO WHILE .NOT. EOF()
mda = da
sele DEALASST
seek mda
mda_name = space(30)
if found()
mda_name = name
endif
?mda,mda_name
?'---------------------------'
sele TEMP
do while da = mda .and. .not. eof()
m_cntr = m_cntr + 1
samt = 0
if stype = 'BRICKS'
samt = bricks
else
if stype = 'INTEREST'
samt = int
endif
endif
?slno,bill_no,substr(supplier,1,20),amount,type,est_no,unit
?space(35),samt,stype,SUBSTR(remarks,1,15),lot_no,despatch
?
p_amount = p_amount + amount
p_samt = p_samt + samt
ln_ctr = ln_ctr + 3
if ln_ctr > 45
ln_ctr = 0
??chr(12)
do PAGE_HD
endif
skip
enddo
do DA_TOT
ln_ctr = 0
pg_ctr = 0
??chr(12)
do PAGE_HD
ENDDO
do DA_TOT
?replicate('=',90)
?'Total Vouchers:',g_cntr,space(08),g_amount
?space(35),g_samt
?replicate('=',90)
??chr(12)
LN_CTR = 0
PG_CTR = 0
do PAGE_HD1
do DA_SUMMARY
SET CONSOLE ON
SET COLOR TO BG+
CLOSE ALTE
do F_ALLREPT
close all
Erase TEMP.DBF
Erase TEMP.IDX
SET COLO TO BG+
RETURN
*-----------------------------------------------------------
PROCEDURE DA_TOT
?replicate('-',90)
?'No of Vouchers:',m_cntr,space(8),p_amount
?space(35),p_samt
?replicate('-',90)
g_cntr = g_cntr + m_cntr
m_cntr = 0
g_amount = g_amount + p_amount
p_amount = 0
g_samt = g_samt + p_samt
p_samt = 0
RETURN
*-----------------------------------------------------------
PROCEDURE PAGE_HD
mdate=dtoc(date())
PG_CTR = PG_CTR + 1
CD=alltrim(MCLNT_NAME)
cdesp='Date:'+mdate+SPACE(5)+CD+space(10)+'Page No:'+str(pg_ctr,4)
CLEN = LEN(CDESP)
CPOS=((90-CLEN) / 2)
?space(cpos),cdesp
CDESP=' DA WISE TOTAL PAYMENT BILLS LIST FOR THE PERIOD '+DTOC(MR_DATE1)+'-'+DTOC(MR_DATE2)
CLEN = LEN(CDESP)
CPOS=(90-CLEN) / 2
?SPACE(CPOS),CDESP
?REPLICATE("-",90)
?'INW NO BILL NO SUPPLIER NAME...... BIL AMT TYPE EST NO UNIT'
?' BRK/INT STYPE REMARKS LOT-NO & DESPATCH'
?REPLICATE("-",90)
LN_CTR = 0
RETURN
*----------------------------------------------------------
PROCEDURE SHOW_DA
main_scr = space(1)
save screen to main_scr
set confirm on
set colo to w/gr+
DO WHILE .T.
@12,57 MENU A_name,d_items TITLE 'Dealing Asst. Names'
READ MENU TO d_lncd
IF LASTKEY() = K_ESC
EXIT
ENDIF
IF LASTKEY() # 13
LOOP
ELSE
EXIT
ENDIF
ENDDO
if lastkey() # k_esc
mda = a_da[d_lncd]
mda_name = a_name[d_lncd]
endif
restore screen from main_scr
set confirm off
set colo to bg+
RETURN
*----------------------------------------------------------------
PROCEDURE DA_SUMMARY
sele TEMP
inde on da+ccyymm to temp
go top
mda=da
p_amount = 0
g_amount = 0
mccyymm = ccyymm
m_cntr = 0
g_cntr = 0
do while .not. eof()
mda=da
mda_name = space(30)
sele DEALASST
seek mda
if found()
mda_name = name
endif
?mda,mda_name
?'------------------------------'
sele TEMP
do while da = mda .and. .not. eof()
mccyymm = ccyymm
do while da = mda .and. ccyymm = mccyymm .and. .not. eof()
p_amount = p_amount + amount
m_cntr = m_cntr + 1
skip
enddo
?mccyymm,m_cntr,space(10),p_amount
ln_ctr = ln_ctr + 1
if ln_ctr > 45
ln_ctr = 0
do PAGE_HD1
endif
g_amount = g_amount + p_amount
g_cntr = g_cntr + m_cntr
p_amount = 0
m_cntr = 0
enddo
?replicate('=',90)
?space(6),g_cntr,space(10),g_amount
gg_cntr = gg_cntr + g_cntr
gg_amount = gg_amount + g_amount
g_amount = 0
g_cntr = 0
?replicate('=',90)
enddo
?space(6),gg_cntr,space(10),gg_amount
RETURN
*---------------------------
PROCEDURE PAGE_HD1
mdate=dtoc(date())
PG_CTR = PG_CTR + 1
CD=alltrim(MCLNT_NAME)
cdesp='Date:'+mdate+SPACE(5)+CD+space(10)+'Page No:'+str(pg_ctr,4)
CLEN = LEN(CDESP)
CPOS=((90-CLEN) / 2)
?space(cpos),cdesp
CDESP='DA WISE TOTAL PAYMENT BILLS SUMMARY FOR THE PERIOD :'+DTOC(MR_DATE1)+'-'+DTOC(MR_DATE2)
CLEN = LEN(CDESP)
CPOS=(90-CLEN) / 2
?SPACE(CPOS),CDESP
?REPLICATE("-",90)
?'CCYYMM NO OF VOUCHERS AMOUNT'
?REPLICATE("-",90)
LN_CTR = 0
RETURN
*----------------------------------------------------------
============================================
*-----------------------------------------------ENQR-02.PRG
* TYPE WISE TOTAL PAYMENT VOUCHER LIST
*------------------------------------------------------------
set colo to bg+
@ 5,01 clear to 23,79
@ 5,01 to 05,78 double
@03,30 CLEAR TO 03,48
SET COLOR TO GR+
CDESP=' ** Type Wise Total Payment Vouchers **'
CLEN = LEN(CDESP)
CPOS=(80-CLEN) / 2
@03,CPOS say CDESP
set color to BG+
*----------variables
fl_name = space(12)
K_esc = 27
msys_type=space(2)
p_width = 0
PG_CTR=0
P_ANS=SPACE(1)
LN_CTR = 0
CNTR = 0
SET DATE FRENCH
*---------------------------------
set cent on
pans = space(1)
LN_CTR = 0
m_cntr = 0
mr_date = { / / }
mda=space(2)
sele 20
use VOUCMAST inde VOUCMAST
copy to TEMP for despatch # { / / }
use
do JOBGOING
use TEMP
inde on type+str(slno,5) to TEMP
GO TOP
Fl_name = 'ENQR02.TXT'
P_width = 80
set alte to &fl_name
SET ALTE ON
SET CONSOLE OFF
DO PAGE_HD
SELE TEMP
g_cntr = 0
gg_cntr = 0
m_cntr = 0
samt = 0
p_amount = 0
g_amount = 0
gg_amount = 0
p_samt = 0
g_samt = 0
mda_name = space(30)
mtype = space(10)
DO WHILE .NOT. EOF()
mtype=type
?mtype
?'---------------------------'
sele TEMP
do while type = mtype .and. .not. eof()
m_cntr = m_cntr + 1
samt = 0
if stype = 'BRICKS'
samt = bricks
else
if stype = 'INTEREST'
samt = int
endif
endif
?slno,r_date,bill_no,substr(supplier,1,20),amount,est_no,unit
?space(46),samt,SUBSTR(remarks,1,20)
?
p_amount = p_amount + amount
p_samt = p_samt + samt
ln_ctr = ln_ctr + 3
if ln_ctr > 35
ln_ctr = 0
??chr(12)
do PAGE_HD
endif
skip
enddo
do TYPE_TOT
ln_ctr = 0
pg_ctr = 0
??chr(12)
do PAGE_HD
ENDDO
do TYPE_TOT
?replicate('=',80)
?'Total Vouchers:',g_cntr,space(19),g_amount
?space(46),g_samt
?replicate('=',80)
??chr(12)
LN_CTR = 0
PG_CTR = 0
do PAGE_HD1
do TYPE_SUMRY
SET CONSOLE ON
SET COLOR TO BG+
CLOSE ALTE
do F_ALLREPT
close all
Erase TEMP.DBF
Erase TEMP.IDX
SET COLO TO BG+
RETURN
*-----------------------------------------------------------
PROCEDURE TYPE_TOT
?replicate('-',80)
?'No of Vouchers:',m_cntr,space(19),p_amount
?space(46),p_samt
?replicate('-',80)
g_cntr = g_cntr + m_cntr
m_cntr = 0
g_amount = g_amount + p_amount
p_amount = 0
g_samt = g_samt + p_samt
p_samt = 0
RETURN
*-----------------------------------------------------------
PROCEDURE PAGE_HD
mdate=dtoc(date())
PG_CTR = PG_CTR + 1
CD=alltrim(MCLNT_NAME)
cdesp='Date:'+mdate+SPACE(5)+CD+space(10)+'Page No:'+str(pg_ctr,4)
CLEN = LEN(CDESP)
CPOS=((80-CLEN) / 2)
?space(cpos),cdesp
CDESP=' TYPE WISE PENDING BILLS LIST :'
CLEN = LEN(CDESP)
CPOS=(80-CLEN) / 2
?SPACE(CPOS),CDESP
?REPLICATE("-",80)
?'INW NO I.DATE BILL NO SUPPLIER NAME..... BIL AMT EST NO UNIT'
?' AMOUNT REMARKS '
?REPLICATE("-",80)
LN_CTR = 0
RETURN
*----------------------------------------------------------
PROCEDURE TYPE_SUMRY
sele TEMP
inde on type+ccyymm to temp
go top
mtype=type
p_amount = 0
g_amount = 0
mccyymm = ccyymm
m_cntr = 0
g_cntr = 0
do while .not. eof()
mtype=type
?mtype
?'------------------------------'
sele TEMP
do while type=mtype .and. .not. eof()
mccyymm = ccyymm
do while type = mtype .and. ccyymm = mccyymm .and. .not. eof()
p_amount = p_amount + amount
m_cntr = m_cntr + 1
skip
enddo
?mccyymm,m_cntr,space(10),p_amount
ln_ctr = ln_ctr + 1
if ln_ctr > 45
ln_ctr = 0
do PAGE_HD1
endif
g_amount = g_amount + p_amount
g_cntr = g_cntr + m_cntr
p_amount = 0
m_cntr = 0
enddo
?replicate('=',80)
?space(6),g_cntr,space(10),g_amount
gg_cntr = gg_cntr + g_cntr
gg_amount = gg_amount + g_amount
g_amount = 0
g_cntr = 0
?replicate('=',80)
enddo
?space(6),gg_cntr,space(10),gg_amount
RETURN
*---------------------------
PROCEDURE PAGE_HD1
mdate=dtoc(date())
PG_CTR = PG_CTR + 1
CD=alltrim(MCLNT_NAME)
cdesp='Date:'+mdate+SPACE(5)+CD+space(10)+'Page No:'+str(pg_ctr,4)
CLEN = LEN(CDESP)
CPOS=((80-CLEN) / 2)
?space(cpos),cdesp
CDESP='TYPE WISE TOTAL PAYMENT BILLS SUMMARY :'
CLEN = LEN(CDESP)
CPOS=(80-CLEN) / 2
?SPACE(CPOS),CDESP
?REPLICATE("-",80)
?'CCYYMM NO OF VOUCHERS AMOUNT'
?REPLICATE("-",80)
LN_CTR = 0
RETURN
*----------------------------------------------------------
==============================================
*-----------------------------------------------ENQR03.PRG
* SUPPLIER WISE TOTAL PAYMENT VOUCHER LIST
*------------------------------------------------------------
set colo to bg+
@ 5,01 clear to 23,79
@ 5,01 to 05,78 double
@03,30 CLEAR TO 03,48
SET COLOR TO GR+
CDESP=' ** Supplier Wise Total Payment Vouchers **'
CLEN = LEN(CDESP)
CPOS=(80-CLEN) / 2
@03,CPOS say CDESP
set color to BG+
*----------variables
fl_name = space(12)
K_esc = 27
msys_type=space(2)
p_width = 0
PG_CTR=0
P_ANS=SPACE(1)
LN_CTR = 0
CNTR = 0
SET DATE FRENCH
*---------------------------------
* ARRAY FOR CONSUMER MASTER
ele=1
declare ap_name[ele]
declare ap_code[ele]
ap_code = 0
ap_name=space(30)
*---------------------------------------
set cent on
pans = space(1)
cl_cntr = 0
LN_CTR = 0
m_cntr = 0
mr_date = { / / }
mda=space(2)
MDA=SPACE(2)
msupplier = space(30)
mp_code = 0
mai = space(1)
DO WHILE .T.
@10,10 say '[A]ll Suppliers / [I]ndividual Supplier :' get mai pict '@!'
read
if .not. (mai $'AI')
loop
else
exit
endif
ENDDO
if mai = 'I'
sele 01
use PARTYMST inde PARTYMST
do SHOW_SUPP
set colo to gr+
@10,10 clear to 10,79
@10,10 say msupplier
wait''
set colo to bg+
endif
msupplier = alltrim(msupplier)
sele 20
use VOUCMAST inde VOUCMAST
if mai = 'A'
copy to TEMP for despatch # { / / }
else
copy to TEMP for supplier = msupplier .and. despatch # { / / }
endif
use
do JOBGOING
use TEMP
inde on supplier+str(slno,5) to TEMP
GO TOP
Fl_name = 'ENQR03.TXT'
P_width = 80
set alte to &fl_name
SET ALTE ON
SET CONSOLE OFF
DO PAGE_HD
sele TEMP
g_cntr = 0
gg_cntr = 0
m_cntr = 0
samt = 0
p_amount = 0
g_amount = 0
gg_amount = 0
p_samt = 0
g_samt = 0
DO WHILE .NOT. EOF()
msupplier = supplier
?msupplier
?'---------------------------'
sele TEMP
do while supplier = msupplier .and. .not. eof()
m_cntr = m_cntr + 1
samt = 0
if stype = 'BRICKS'
samt = bricks
else
if stype = 'INTEREST'
samt = int
endif
endif
?slno,r_date,bill_no,bill_date,amount,type,est_no,unit
?space(36),samt,stype,substr(remarks,1,20)
?
p_amount = p_amount + amount
p_samt = p_samt + samt
ln_ctr = ln_ctr + 3
if ln_ctr > 45
ln_ctr = 0
??chr(12)
do PAGE_HD
endif
skip
enddo
do SUPP_TOT
ln_ctr = ln_ctr + 3
if ln_ctr > 45
ln_ctr = 0
do PAGE_HD
endif
ENDDO
do SUPP_TOT
?replicate('=',80)
?'Total Voucher:',g_cntr,space(10),g_amount
?space(36),g_samt
?replicate('=',80)
??chr(12)
LN_CTR = 0
PG_CTR = 0
do PAGE_HD1
do SUPP_SUMRY
SET CONSOLE ON
SET COLOR TO BG+
CLOSE ALTE
do F_ALLREPT
close all
Erase TEMP.DBF
Erase TEMP.IDX
SET COLO TO BG+
RETURN
*-----------------------------------------------------------
PROCEDURE SUPP_TOT
?replicate('-',80)
?'No of Voucher:',m_cntr,space(10),p_amount
?space(36),p_samt
?replicate('-',80)
g_cntr = g_cntr + m_cntr
m_cntr = 0
g_amount = g_amount + p_amount
p_amount = 0
g_samt = g_samt + p_samt
p_samt = 0
RETURN
*-----------------------------------------------------------
PROCEDURE PAGE_HD
mdate=dtoc(date())
PG_CTR = PG_CTR + 1
CD=alltrim(MCLNT_NAME)
cdesp='Date:'+mdate+SPACE(5)+CD+space(10)+'Page No:'+str(pg_ctr,4)
CLEN = LEN(CDESP)
CPOS=((80-CLEN) / 2)
*?space(cpos),cdesp
CDESP=' SUPPLIER WISE TOTAL PAYMENT BILLS LIST :'
CLEN = LEN(CDESP)
CPOS=(80-CLEN) / 2
?SPACE(CPOS),CDESP
?REPLICATE("-",80)
?'INW NO DATE BILL NO BILL DATE BILL AMT TYPE EST NO UNIT'
?' BRK/INT STYPE REMARKS'
?REPLICATE("-",80)
LN_CTR = 0
RETURN
*----------------------------------------------------------
PROCEDURE SUPP_SUMRY
sele TEMP
inde on supplier+ccyymm to temp
go top
mda=da
p_amount = 0
g_amount = 0
mccyymm = ccyymm
m_cntr = 0
g_cntr = 0
do while .not. eof()
msupplier = supplier
?msupplier
?'------------------------------'
sele TEMP
do while supplier = msupplier .and. .not. eof()
mccyymm = ccyymm
do while supplier = msupplier .and. ccyymm = mccyymm .and. .not. eof()
p_amount = p_amount + amount
m_cntr = m_cntr + 1
skip
enddo
?mccyymm,m_cntr,space(10),p_amount
ln_ctr = ln_ctr + 1
if ln_ctr > 45
ln_ctr = 0
do PAGE_HD1
endif
g_amount = g_amount + p_amount
g_cntr = g_cntr + m_cntr
p_amount = 0
m_cntr = 0
enddo
?replicate('=',80)
?space(6),g_cntr,space(10),g_amount
gg_cntr = gg_cntr + g_cntr
gg_amount = gg_amount + g_amount
g_amount = 0
g_cntr = 0
?replicate('=',80)
enddo
?space(6),gg_cntr,space(10),gg_amount
RETURN
*---------------------------
PROCEDURE PAGE_HD1
mdate=dtoc(date())
PG_CTR = PG_CTR + 1
CD=alltrim(MCLNT_NAME)
cdesp='Date:'+mdate+SPACE(5)+CD+space(10)+'Page No:'+str(pg_ctr,4)
CLEN = LEN(CDESP)
CPOS=((80-CLEN) / 2)
*?space(cpos),cdesp
CDESP='SUPPLIER WISE TOTAL PAYMENT BILLS SUMMARY :'
CLEN = LEN(CDESP)
CPOS=(80-CLEN) / 2
?SPACE(CPOS),CDESP
?REPLICATE("-",80)
?'CCYYMM NO OF VOUCHERS AMOUNT'
?REPLICATE("-",80)
LN_CTR = 0
RETURN
*----------------------------------------------------------
PROCEDURE ARRAY_NAME
SELE 01
USE PARTYMST
INDE ON P_NAME TO PARTYNAM
GO TOP
ap_name = space(30)
MNAME = RTRIM(MNAME)
CL_CNTR = 0
MLEN = LEN(MNAME)
IF MNAME = SPACE(30)
MNAME = RTRIM(P_NAME)
MLEN= LEN(MNAME)
ENDIF
MP_NAME = SPACE(30)
SEEK MNAME
IF FOUND()
DO WHILE .NOT. EOF()
IF substr(MNAME,1,mlen) = substr(P_NAME,1,mlen)
CL_CNTR = CL_CNTR + 1
IF CL_CNTR > ELE
DECLARE AP_NAME[CL_CNTR]
DECLARE AP_CODE[CL_CNTR]
ENDIF
AP_NAME[CL_CNTR] = P_NAME
AP_CODE[CL_CNTR] = P_CODE
@23,04 SAY "PLEASE WAIT !! PROCESSING IS GOING ON "
ENDIF
SKIP
ENDDO
ELSE
user_msg1 = 'No Such SUPPLIER ! Please Update SUPPLIER MASTER '
msrl_no = '889'
do usemsg
ENDIF
@23,1 CLEAR TO 23,79
SET COLOR TO bg+
use PARTYMST inde PARTYMST
go top
RETURN
*---------------------------------------------------------
PROCEDURE SHOW_SUPP
set confirm on
DO WHILE .T.
msupplier= space(30)
mp_code = 0
mname=space(30)
DO ARRAY_NAME
N_CLCD = 0
IF CL_CNTR > 0
SET COLO TO bg+/GR
@09,47 MENU AP_NAME,CL_CNTR TITLE 'Supplier Names'
READ MENU TO N_CLCD
SET COLO TO BG
IF LASTKEY() # 13
loop
else
exit
endif
ELSE
@23,01 CLEAR TO 23,77
@23,04 SAY "NO SELECTION PLEASE ADD SUPPLIER AND THEN GO"
exit
ENDIF
ENDDO
if cl_cntr > 0
msupplier = ap_name[n_clcd]
mp_code = ap_code[n_clcd]
endif
cl_cntr = 0
return
*---------------------------------
=================================================================
*-----------------------------------------------ENQR07.PRG
* DA WISE VOUCHERS ANALYSIS
*------------------------------------------------------------
set colo to bg+
@ 5,01 clear to 23,79
@ 5,01 to 05,78 double
@03,30 CLEAR TO 03,48
SET COLOR TO GR+
CDESP=' ** DA Wise Vouchers Analysis **'
CLEN = LEN(CDESP)
CPOS=(80-CLEN) / 2
@03,CPOS say CDESP
set color to BG+
*----------variables
fl_name = space(12)
K_esc = 27
msys_type=space(2)
p_width = 0
PG_CTR=0
P_ANS=SPACE(1)
LN_CTR = 0
CNTR = 0
SET DATE FRENCH
*---------------------------------
sele 10
use DEALASST inde DEALASST
ele = 1
d_items=0
d_lncd=0
declare a_da[ele]
declare a_name[ele]
a_name = space(30)
a_da = space(02)
go top
DO WHILE (.NOT. EOF())
d_items = d_items + 1
if d_items > 1
declare a_name[d_items]
declare a_da[d_items]
endif
a_name[d_items] = name
a_da[d_items] = da_cd
skip
ENDDO
IF D_ITEMS = 0
User_msg1 = 'Dealing Asst. Master File is Empty !! Please Enter Data!!'
User_msg2= 'Please Press Any Key to Continue'
MSRL_NO = '889'
do USEMSG
CLOSE ALL
RETURN
ENDIF
*----------------------------------------------
set cent on
pans = space(1)
LN_CTR = 0
mda=space(2)
m_cntr = 0
mr_date = { / / }
mda=space(2)
mda_name = space(30)
mai = space(1)
DO WHILE .T.
set colo to w/rb+
@10,10 say '[A]'
set colo to bg+
@10,13 say 'll DA / '
set colo to w/rb+
@10,29 say '[I]'
set colo to bg+
@10,32 say 'ndividual DA :' get mai pict '@!'
* @10,10 say '[A]ll DA / [I]ndividual DA :' get mai pict '@!'
read
if .not. (mai $'AI')
loop
else
exit
endif
ENDDO
if mai = 'I'
do SHOW_DA
endif
sele 20
use VOUCMAST inde VOUCMAST
if mai = 'I'
copy to TEMP for mda = da
else
copy to TEMP
endif
USE
do JOBGOING
use TEMP
inde on da+ccyymm+str(slno,5) to TEMP
GO TOP
Fl_name = 'ENQR07.TXT'
P_width = 80
set alte to &fl_name
SET ALTE ON
SET CONSOLE OFF
DO PAGE_HD
SELE TEMP
p_srl = 0
c_srl = 0
t_srl = 0
p_amount = 0
gp_amount = 0
ggp_amount = 0
c_amount = 0
gc_amount = 0
ggc_amount = 0
t_amount = 0
gt_amount = 0
ggt_amount =0
gp_srl = 0
gc_srl = 0
gt_srl = 0
ggp_srl = 0
ggc_srl = 0
ggt_srl = 0
mda_name = space(30)
mda = space(2)
DO WHILE .NOT. EOF()
mda = da
sele DEALASST
seek mda
mda_name = space(30)
if found()
mda_name = name
endif
?mda,mda_name
?'---------------------------'
sele TEMP
do while da = mda .and. .not. eof()
mccyymm = ccyymm
do while da = mda .and. ccyymm = mccyymm .and. .not. eof()
if despatch = { / / }
p_srl = p_srl + 1
p_amount = p_amount + amount
else
c_srl = c_srl + 1
c_amount = c_amount + amount
endif
skip
enddo
t_srl = c_srl + p_srl
t_amount = c_amount + p_amount
?mccyymm,space(1),c_srl,c_amount,space(2),p_srl,p_amount,space(2),t_srl,t_amount
gc_srl = gc_srl + c_srl
gp_srl = gp_srl + p_srl
gc_amount = gc_amount + c_amount
gp_amount = gp_amount + p_amount
gt_srl = gt_srl + t_srl
gt_amount = gt_amount + t_amount
c_srl = 0
p_srl = 0
t_srl = 0
c_amount = 0
p_amount = 0
t_amount = 0
enddo
do DA_TOT
ENDDO
?replicate('=',80)
?space(8),ggc_srl,ggc_amount,space(2),ggp_srl,ggp_amount,space(2),ggt_srl,ggt_amount
?replicate('=',80)
??chr(12)
LN_CTR = 0
PG_CTR = 0
SET CONSOLE ON
SET COLOR TO BG+
CLOSE ALTE
do F_ALLREPT
close all
Erase TEMP.DBF
Erase TEMP.IDX
SET COLO TO BG+
RETURN
*-----------------------------------------------------------
PROCEDURE DA_TOT
?replicate('-',80)
?space(08),gc_srl,gc_amount,space(2),gp_srl,gp_amount,space(2),gt_srl,gt_amount
?replicate('-',80)
LN_CTR = LN_CTR + 3
IF LN_CTR > 55
LN_CTR = 0
DO PAGE_HD
ENDIF
ggc_srl = ggc_srl + gc_srl
ggp_srl = ggp_srl + gp_srl
ggc_amount = ggc_amount + gc_amount
ggp_amount = ggp_amount + gp_amount
ggt_srl = ggt_srl + gt_srl
ggt_amount = ggt_amount + gt_amount
gc_srl = 0
gp_srl = 0
gt_srl = 0
gc_amount = 0
gp_amount = 0
gt_amount = 0
RETURN
*-----------------------------------------------------------
PROCEDURE PAGE_HD
mdate=dtoc(date())
PG_CTR = PG_CTR + 1
CD=alltrim(MCLNT_NAME)
cdesp='Date:'+mdate+SPACE(5)+CD+space(10)+'Page No:'+str(pg_ctr,4)
CLEN = LEN(CDESP)
CPOS=((80-CLEN) / 2)
*?space(cpos),cdesp
CDESP=' DA WISE / MONTH WISE VOUCHERS ANALYSIS AS ON DATE :'+dtoc(DATE())
CLEN = LEN(CDESP)
CPOS=(80-CLEN) / 2
*?SPACE(CPOS),CDESP
?REPLICATE("-",80)
?'DA NAME.......................'
?' CLEARED VOUCHERS PENDING VOUCHERS TOTAL VOUCHERS'
?'CCYYMM NO OF AMOUNT NO OF AMOUNT NO OF AMOUNT'
?' VOUCHERS VOUCHERS VOUCHERS'
?REPLICATE("-",80)
LN_CTR = 0
RETURN
*----------------------------------------------------------
PROCEDURE SHOW_DA
main_scr = space(1)
save screen to main_scr
set confirm on
set colo to w/gr+
DO WHILE .T.
@12,57 MENU A_name,d_items TITLE 'Dealing Asst. Names'
READ MENU TO d_lncd
IF LASTKEY() = K_ESC
EXIT
ENDIF
IF LASTKEY() # 13
LOOP
ELSE
EXIT
ENDIF
ENDDO
if lastkey() # k_esc
mda = a_da[d_lncd]
mda_name = a_name[d_lncd]
endif
restore screen from main_scr
set confirm off
set colo to bg+
RETURN
*----------------------------------------------------------------
PROCEDURE SHOW_DA
main_scr = space(1)
save screen to main_scr
set confirm on
set colo to w/gr+
DO WHILE .T.
@12,57 MENU A_name,d_items TITLE 'Dealing Asst. Names'
READ MENU TO d_lncd
IF LASTKEY() = K_ESC
EXIT
ENDIF
IF LASTKEY() # 13
LOOP
ELSE
EXIT
ENDIF
ENDDO
if lastkey() # k_esc
mda = a_da[d_lncd]
mda_name = a_name[d_lncd]
endif
restore screen from main_scr
set confirm off
set colo to bg+
RETURN
*----------------------------------------------------------------
==================================================================================
*para pm_setup
*-----------------------------------------------ENTRY.prg
* Entry Screen
* This routine is called before entering in the system
*------------------------------------------------------------
close all
*PUBL user_id
@03,30 CLEAR TO 03,48
*SET COLOR TO GR
SET COLO TO gr+
CDESP=' ** Password Entry **'
CLEN = LEN(CDESP)
CPOS=(80-CLEN) / 2
@03,CPOS say CDESP
K_ESC=27
*@ 4,00 clear to 24,79
*----------Variables
msrl_no = space(3)
ans_msg=space(1)
*
mname = SPAC(8)
mans = 'N'
sp = space(78)
mpass = SPAC(8)
mtimes = 0
superpass = space(8)
mloc_code = '001'
pm_setup = .T.
con1pass = .T.
muser_id = space(8)
*
*set colo to n/w+
*@ 3, 65 say "<Esc to Exit..>"
*set colo to bg+
*
sele b
*51
USE LOGUSER
INDE on name to LOGUSER
SAVE SCRE TO pass1
LOCA FOR Level = '@'
*
IF FOUN()
superpass = Notouse
ELSE
MSRL_NO = "050"
DO USEMSG
RETU
ENDIF
*
sele b
* 51
GO TOP
levelsuper = .f.
con1pass = .t.
*
M_RETU = .T.
DO WHIL con1pass
go top
mname = SPAC(8)
mans = 'N'
set colo to bg+
@ 07,01 SAY "User Name ........:"
@ 07,21 get mname pict "@!" FUNC 'A'
READ
IF LAST() = 27
* con1pass = .f.
* LOOP
m_retu = .f.
exit
ENDI
SEEK mname
IF !FOUN()
MSRL_NO = "052"
DO USEMSG
REST SCRE FROM pass1
LOOP
ELSE
mopass = notouse
ENDI
mpass = ' '
* SET COLO TO
@ 08,01 SAY "Password..........: "
SET COLO TO n
SET INTE OFF
@ 08,21 GET mpass PICT "@!" func 'N'
READ
SET INTE ON
SET COLO TO
IF LAST() = 27
REST SCRE FROM pass1
LOOP
ENDI
mlogin = mname
muser_id = mname
mlogpass = mpass
mlevel=level
*
mpass = chrt(mpass,;
'ABCDEFGHIJKLMNOPQRSTUVWXYZ~!@#$%^&*()-=+_<>?|./\{}[] 0123456789',;
'9876543210P~!@#$%^&*()-=+_<>?|./\{}[]ABCDEFGHIJKLMNO QRSTUVWXYZ')
IF mopass # mpass
MSRL_NO = '053'
DO USEMSG
REST SCRE FROM pass1
mtimes = mtimes + 1
if mtimes < 3
LOOP
else
msrl_no = '054'
do usemsg
* mlevel = level
M_RETU = .F.
exit
endif
ENDI
REST SCRE FROM pass1
con1pass = .f.
ENDD
*
set colo to bg+
@03,00 to 03,79
sele b
* 51
use
retu M_RETU
======================================
*-----------------------------------------------ENTRY01.prg
* Voucher Creation
*------------------------------------------------------------
USE
use PARTYMST
pack
*inde on str(p_code,6) to PARTYMST
INDE on p_name to PARTYNAM
*index on p_code to PARTYMST
use
@03,30 CLEAR TO 03,48
SET COLOR TO GR+
CDESP='** Daily Voucher Entry Screen **'
CLEN = LEN(CDESP)
CPOS=(80-CLEN) / 2
@03,CPOS say CDESP
set color to bg+
K_ESC=27
n_clcd = 0
z_lncd = 0
*m_zone = space(4)
a_type = space(1)
mest = space(10)
mname = space(30)
mp_name = space(30)
mtype_desc = space(15)
mtned_type = space(10)
sdesc=space(15)
msde_shnm = space(15)
mde_shnm = space(15)
mdgm_shnm = space(15)
mexcg_name = space(30)
mex_shname = space(15)
mamt = 0
mkey=''
m1amt = 0
mbill_amt = 0
sslno = 0
madv_amt = 0
mrmx = space(10)
mur_cd = space(1)
murb_rul = space(1)
*--------------------
mssurch = 0.00
msitax = 0.00
mssertax = 0.00
mssaletax= 0.00
msedcess=0.00
mshedcess=0.00
sde=.f.
de=.f.
dgm=.f.
gm=.f.
maint_ac = .f.
msurch = 0.00
mitax = 0.00
msertax = 0.00
msaletax= 0.00
msd = 0.00
mpartv = 0
moctroi = 0
CL_CNTR = 0
L_CNTR = 0
@ 4,00 clear to 24,79
@ 5,00 to 05,79
*----------Variables
cansel_rec = .f.
mcap_amt1 = 0
manu_amt1 = 0
mcap_amt2 = 0
manu_amt2 = 0
mcap_exp2 = 0
manu_exp2 = 0
ok_flag = .T.
excess_exp =.T.
mr_date = { / / }
mslno = 0
mbill_no = space(8)
mbill_date = { / / }
mamount = 0
msupplier = space(30)
mp_code = 0
munit = space(15)
mmunit = space(15)
mda = space(2)
mda_name = space(30)
mjsdt = { / / }
mdespatch = { / / }
mremarks = space(30)
mtype = space(10)
mstype = space(10)
mest_no = space(6)
mesfx_cd = space(3)
mest_amt = 0
mcabledrum = 0
mi_tax = 0
ms_charge = 0
mstax = 0
mnamount = 0
mbricks = 0
mint = 0
machead = space(6)
mpgm_no = space(2)
mgm_no = space(2)
mdgm_no = space(2)
mexcg_no = space(2)
mde_no = space(2)
msde_no = space(2)
mv_no = space(15)
mv_desig = space(15)
mv_month = space(6)
mv_km = 0
mg_no = 0
mg_month = space(6)
mg_no = 0
mld = 0
mo_charge = 0
mtender_no = space(40)
mtend_amt = 0.00
mtend_cost = 0
mest_cost = 0
mtend_exp = 0.00
mremark_2 = space(20)
mremark_3 = space(20)
masset_rmk = space(60)
mcmts_ac = space(7)
mcmts_desc = space(60)
***
msd = 0
mnc_sd = 0
mbank_fd = space(60)
mval_date = { / / }
mperiod = 0
mpartv = 0
mcompl_date = { / / }
mcomm_date = { / / }
mbill_type = space(15)
mwork = space(120)
magmt_no = space(40)
mmbno = space(15)
moctroi = 0
memd = 0
memd_date = { / / }
mdate_tag = space(1)
**********************************
* ARRAY FOR CONSUMER MASTER
ele=1
declare ap_name[ele]
declare ap_code[ele]
ap_code = 0
ap_name=space(30)
*---------------------------------------
declare aadv_no[ele]
declare aadv_date[ele]
declare abill_no[ele]
declare abill_date[ele]
declare adv_amt[ele]
declare ax_desc[ele]
aadv_no = space(10)
aadv_date = { / / }
abill_no = space(10)
abill_date ={ / / }
adv_amt = 0
ax_items = 0
ax_lncd = 0
ax_desc = space(35)
xd_items = 0
xd_lncd = 0
*-----------------------------------------
OPTION = SPACE(1)
DECLARE OPT[4]
*---------------------------------------------
sele 24
use BILLTYPE
inde on bill_ty to BILTYPE
ele = 1
r_items=0
r_lncd=0
declare abill_type[ele]
declare adate_tag[ele]
adate_tag = space(1)
abill_type = space(15)
go top
DO WHILE (.NOT. EOF())
r_items = r_items + 1
if r_items > 1
declare abill_type[r_items]
declare adate_tag[r_items]
endif
abill_type[r_items] = bill_ty
adate_tag[r_items] = date_tag
skip
ENDDO
IF r_items = 0
User_msg1 = 'BILLTYPE Master File is Empty !! Please Enter Data!!'
User_msg2= 'Please Press Any Key to Continue'
MSRL_NO = '889'
do USEMSG
CLOSE ALL
RETURN
ENDIF
close all
*----------------------------------------------
sele 04
use EXCHANGE
inde on sh_name to EXCGSHNM
ele = 1
x_items=0
x_lncd=0
declare aexcg_no[ele]
declare aex_name[ele]
declare aex_shname[ele]
aexcg_no = space(2)
aex_name=space(30)
aex_shname=space(10)
go top
DO WHILE (.NOT. EOF())
x_items = x_items + 1
if x_items > 1
declare aexcg_no[x_items]
declare aex_name[x_items]
declare aex_shname[x_items]
endif
aexcg_no[x_items] = excg_no
aex_name[x_items] = name
aex_shname[x_items] = sh_name
skip
ENDDO
IF x_items = 0
User_msg1 = 'EXCHANGE Master File is Empty !! Please Enter Data!!'
User_msg2= 'Please Press Any Key to Continue'
MSRL_NO = '889'
do USEMSG
CLOSE ALL
RETURN
ENDIF
close all
*----------------------------------------------
sele 13
use GMMAST
inde on sh_name to GMNAME
ele = 1
j_items=0
j_lncd=0
declare apgm_no[ele]
declare agm_no[ele]
declare agm_shname[ele]
DECLARE A_ZONE[ELE]
apgm_no = space(2)
agm_no = space(2)
agm_shname=space(15)
a_zone = space(4)
go top
DO WHILE (.NOT. EOF())
j_items = j_items + 1
if j_items > 1
declare apgm_no[j_items]
declare agm_no[j_items]
declare agm_shname[j_items]
declare a_zone[j_items]
endif
apgm_no[j_items] = pgm_no
agm_no[j_items] = gm_no
agm_shname[j_items] = sh_name
a_zone[j_items] = zone
skip
ENDDO
IF j_items = 0
User_msg1 = 'GM Master File is Empty !! Please Enter Data!!'
User_msg2= 'Please Press Any Key to Continue'
MSRL_NO = '889'
do USEMSG
CLOSE ALL
RETURN
ENDIF
close all
*----------------------------------------------
sele 10
use DEALASST inde DEALASST
ele = 1
d_items=0
d_lncd=0
declare a_da[ele]
declare a_name[ele]
a_name = space(30)
a_da = space(02)
go top
DO WHILE (.NOT. EOF())
d_items = d_items + 1
if d_items > 1
declare a_name[d_items]
declare a_da[d_items]
endif
a_name[d_items] = da_cd + ' '+name
a_da[d_items] = da_cd
skip
ENDDO
IF D_ITEMS = 0
User_msg1 = 'Dealing Asst. Master File is Empty !! Please Enter Data!!'
User_msg2= 'Please Press Any Key to Continue'
MSRL_NO = '889'
do USEMSG
CLOSE ALL
RETURN
ENDIF
close all
*----------------------------------------------
sele 11
use GUARDS
inde on ex_shnm to GURDSHNM
ele = 1
g_items=0
g_lncd=0
declare a_gno[ele]
declare a_exname[ele]
declare a_exshnm[ele]
a_exname = space(30)
a_gno = 0
a_exshnm = space(10)
go top
DO WHILE (.NOT. EOF())
g_items = g_items + 1
if g_items > 1
declare a_exname[g_items]
declare a_exshnm[g_items]
declare a_gno[g_items]
endif
a_exname[g_items] = ex_name
a_exshnm[g_items] = ex_shnm
a_gno[g_items] = no_guards
skip
ENDDO
IF g_ITEMS = 0
User_msg1 = 'Sec.Guard Master File is Empty !! Please Enter Data!!'
User_msg2= 'Please Press Any Key to Continue'
MSRL_NO = '889'
do USEMSG
CLOSE ALL
RETURN
ENDIF
close all
*----------------------------------------------
sele 12
use LIMITS
go top
mmsde_amt1 = msde_amt1
mmsde_amt2 = msde_amt2
mmde_amt1 = mde_amt1
mmde_amt2 = mde_amt2
mmdgm_amt1 = mdgm_amt1
mmdgm_amt2 = mdgm_amt2
mmgm_amt1 = mgm_amt1
mmgm_amt2 = mgm_amt2
* Capital amoints
mcsde_amt1 = csde_amt1
mcsde_amt2 = csde_amt2
mcde_amt1 = cde_amt1
mcde_amt2 = cde_amt2
mcdgm_amt1 = cdgm_amt1
mcdgm_amt2 = cdgm_amt2
mcgm_amt1 = cgm_amt1
mcgm_amt2 = cgm_amt2
mocc_limit = occ_limit
********************
sele 22
use TENDTYPE
inde on type to TENDTYPE
ele = 1
n_items=0
n_lncd=0
mtend_type = space(10)
declare atend_type[ele]
atend_type = space(10)
go top
DO WHILE (.NOT. EOF())
n_items = n_items + 1
if n_items > 1
declare atend_type[n_items]
endif
atend_type[n_items] = type
skip
ENDDO
IF n_items = 0
User_msg1 = 'TENDTYPE Master File is Empty !! Please Enter Data!!'
User_msg2= 'Please Press Any Key to Continue'
MSRL_NO = '889'
do USEMSG
CLOSE ALL
RETURN
ENDIF
close all
*----------------------------------------------
close all
erase EXCGSHNM.IDX
erase GURDSHNM.IDX
erase GMNAME.IDX
**************
t_items = 0
t_lncd = 0
sele 14
use TENDER
inde on type+tender_no to TENDER
declare atender_no[ele]
declare atend_disp[ele]
atender_no = space(40)
atend_amt = 0
sele 13
use GMMAST inde GMMAST
sele 02
use TYPEMAST INDE TYPEMAST
ele = 1
a_items=0
a_lncd=0
declare a_type_cd[ele]
declare a_desc[ele]
declare a_accode[ele]
a_desc = space(30)
a_type_cd = space(10)
a_accode=space(7)
go top
DO WHILE (.NOT. EOF())
a_items = a_items + 1
if a_items > 1
declare a_desc[a_items]
declare a_type_cd[a_items]
declare a_accode[a_items]
endif
a_desc[a_items] = desc
a_type_cd[a_items] = type_cd
a_accode[a_items] = accode
skip
ENDDO
IF A_ITEMS = 0
User_msg1 = 'Type Code Master File is Empty !! Please Enter Data!!'
User_msg2= 'Please Press Any Key to Continue'
MSRL_NO = '889'
do USEMSG
CLOSE ALL
RETURN
ENDIF
*----------------------------------------------
sele 09
use VEHICLE INDE VEHICLE
ele = 1
v_items=0
v_lncd=0
declare a_vno[ele]
declare a_vdesig[ele]
declare a_unit[ele]
a_unit = space(30)
a_vno = space(15)
a_vdesig = space(15)
*----------------------------------------------
sele 08
use SDEMAST
inde on sh_name to SDESHNM
inde on pgm_no+gm_no+dgm_no+excg_no+de_no+sde_no to SDEMAST
ele = 1
e_items=0
e_lncd=0
declare apgm_no[ele]
declare agm_no[ele]
declare adgm_no[ele]
declare ade_no[ele]
declare asde_no[ele]
declare asde_name[ele]
declare asde_shnm[ele]
apgm_no = space(2)
agm_no = space(2)
adgm_no = space(2)
ade_no = space(2)
asde_no = space(2)
asde_name=space(30)
asde_shnm = space(15)
*----------------------------------------------
sele 06
use DEMAST
inde on sh_name to DESHNM
inde on pgm_no+gm_no+dgm_no+excg_no+de_no to DEMAST
ele = 1
de_items=0
de_lncd=0
declare xpgm_no[ele]
declare xgm_no[ele]
declare xdgm_no[ele]
declare xde_no[ele]
declare xde_name[ele]
declare xde_shnm[ele]
xpgm_no = space(2)
xgm_no = space(2)
xdgm_no = space(2)
xde_no = space(2)
xde_name=space(30)
xde_shnm = space(15)
*----------------------------------------------
sele 05
use DGMEXCG
inde on excg_name + dgm_name to DGMSHNM
ele = 1
y_items=0
y_lncd=0
declare ypgm_no[ele]
declare ygm_no[ele]
declare ydgm_no[ele]
declare yexcg_no[ele]
declare ydgm_name[ele]
declare ydgm_shnm[ele]
ypgm_no = space(2)
ygm_no = space(2)
ydgm_no = space(2)
yexcg_no = space(2)
ydgm_name=space(30)
ydgm_shnm = space(15)
*----------------------------------------------
sele 04
use DGMMAST inde DGMMAST
sele 03
use SUBTYPE inde SUBTYPE
as_items=0
as_lncd=0
declare astype_cd[ele]
declare as_desc[ele]
as_desc = space(30)
astype_cd = space(10)
*-----------------------------------------------
SELE 01
USE PARTYMST
*inde on str(p_code,6) to PARTYMST
INDE on p_name to PARTYNAM
sele 15
use ADVCMAST
INDE on str(p_code,6)+adv_no to ADVC
sele 16
use ADVCTRAN
sele 17
use ESTMMAST inde ESTMMAST
sele 18
use ACHEAD inde ACHEAD
sele 19
use BILLNO inde BILLNO
m1=str(mfrom_year,4)
m2=str(mto_year,4)
pefile='PE'+m1+substr(m2,3,2)
pp=pefile+'.dbf'
*if .not. file (pp)
* msrl_no = '163'
* do USEMSG
* close all
* return
*endif
sele 21
use &PEFILE
inde on bill_no+dtoc(bill_date)+str(amount,10) to &PEFILE
sele 20
use VOUCMAST inde VOUCMAST
rein
GO BOTT
declare eopt[3]
eopt=space(3)
eopt[1] = 'DGM'
eopt[2] = 'DE'
eopt[3] = 'SDE'
mslno = slno
go top
DO WHILE (option # 'E')
@ 5,00 clear to 24,79
@ 5,00 to 05,79
@4,01 clear TO 04,78
@ 4, 10 PROMPT '\<Add'
opt[ 1] = 'A'
@ 4, 40 PROMPT '\<Delete'
opt[ 2] = 'D'
@ 4, 55 PROMPT '\<View'
opt[ 3] = 'V'
@ 4, 70 PROMPT '\<Exit'
opt[ 4] = 'E'
@ 4, 75 SAY SPACE(3)
set intensity on
nopt = 1
menu to nopt
set intensity off
if nopt >= 1 .and. nopt <= 4
option = opt[nopt]
else
option = space(1)
endif
if option = 'E'
exit
else
if option = 'V'
do VIEWFLDS
@ 5,01 to 05,78
else
set filter to
@ 5,00 clear to 24,79
@ 5,00 to 05,79
set colo to n/w+
@ 5, 65 say '<Esc to Exit..>'
set colo to bg+
mr_date = date()
if option = 'A'
mr_date=date()
* do while .t.
@ 10,10 say 'Enter Bills Received Date :' get mr_date pict '{ / / }'
read
* if year(mr_date) < mfrom_year .or. year(mr_date) > mto_year
* msrl_no = '155'
* do USEMSG
* loop
* else
* exit
* endif
* enddo
endif
DO WHILE LASTKEY() != K_ESC
@ 5,00 clear to 24,79
@ 5,00 to 05,79
do DISPSCRE
do CLOSE_OPEN
if option = 'A'
mslno = mslno + 1
endif
do GETKEY
if LASTKEY() = K_ESC
exit
else
sele voucmast
inde on str(slno,5) to voucmast
seek (STR(mslno,5))
DO CASE
case option = 'A'
do ADD_OPT
case option = 'D'
do DELETE_OPT
ENDCASE
endif
ENDDO ( mslno = 0)
endif
endif
ENDDO (option # 'E')
CLOSE ALL
Erase GURDSHNM.IDX
Erase DESHNM.IDX
Erase SDESHNM.IDX
Erase DGMSHNM.IDX
Erase EXCGSHNM.IDX
Erase ADVC.IDX
@ 5,00 clear to 24,79
@ 5,00 to 05,79
@4,00 clear to 24,79
set colo to bg+
RETURN
*---------------------------------------------------
PROCEDURE ADD_OPT
if found()
MSRL_NO = '001'
DO USEMSG
else
do INITFLDS
DO WHILE .t.
do GETFLDS
ans_msg = 'S'
if cansel_rec
ans_msg = 'C'
exit
endif
if lastkey() = K_ESC
ans_msg = 'C'
endif
DO WHILE .T.
MSRL_NO = '080'
do USEMSG
if .not. (ans_msg $ 'SMC')
loop
else
exit
endif
ENDDO
DO CASE
case ans_msg = 'S'
sele VOUCMAST
append blank
do replFLD
exit
case ans_msg = 'C'
mslno = mslno - 1
exit
case ans_msg = 'M'
sele VOUCMAST
loop
ENDCASE
ENDDO
endif
cansel_rec = .f.
RETURN
*------------------------------------------------------
PROCEDURE DELETE_OPT
ans=SPACE(1)
if found()
BROW FIELDS slno,BILL_NO,BILL_DATE,UNIT,AMOUNT,supplier,despatch for slno = mslno
mp_code = p_code
mbill_no = bill_no
mbill_date = bill_date
mamount = amount
if despatch = { / / }
DO WHILE .T.
MSRL_NO = '081'
DO USEMSG
if ans_msg = 'D'
sele VOUCMAST
delete
sele BILLNO
seek str(mp_code,6)+mbill_no+dtoc(mbill_date)+str(mamount,10)
if found()
delete
endif
sele VOUCMAST
MSRL_NO = '004'
DO USEMSG
exit
else
if ans_msg = 'R'
MSRL_NO = '999'
DO USEMSG
exit
else
loop
endif
endif
ENDDO
else
msrl_no = '140'
DO USEMSG
endif
else
msrl_no = '003'
do USEMSG
endif
RETURN
*----------------------------------------------------------
PROCEDURE REPLFLD
sele VOUCMAST
repl zone with m_zone
repl slno with mslno
repl r_date with mr_date
repl bill_no with mbill_no
repl bill_date with mbill_date
repl amount with mamount
repl p_code with mp_code
repl supplier with mp_name
*repl unit with mmunit
repl unit with mex_shname
repl da with mda
repl type with mtype
repl stype with mstype
repl est_no with mest_no
repl esfx_cd with mesfx_cd
repl est_amt with mest_amt
repl achead with machead
repl cmts_ac with mcmts_ac
repl pgm_no with mpgm_no
repl gm_no with mgm_no
repl dgm_no with mdgm_no
repl excg_no with mexcg_no
repl de_no with mde_no
repl sde_no with msde_no
repl emd with memd
repl emd_date with memd_date
repl v_no with mv_no
repl v_desig with mv_desig
repl v_month with mv_month
repl v_km with mv_km
repl g_no with mg_no
repl g_month with mg_month
repl ld with mld
repl item with ltrim(str(mslno))
*mur_cd
repl o_charge with mo_charge
repl cabledrum with mcabledrum
repl urb_rul with murb_rul
repl amount with mamount
repl tend_type with mtend_type
repl tender_no with mtender_no
repl remark_2 with mremark_2
repl remark_3 with mremark_3
repl asset_rmk with masset_rmk
repl tend_cost with mtend_cost
repl est_cost with mest_cost
if soption = 1
repl sec with 'CAP'
else
repl sec with 'MTCE'
endif
sele TYPEMAST
seek mtype
if found()
msurch = surch
mitax = itax
msertax = sertax
msaletax= saletax
msedcess= edcess
mshedcess= hedcess
* mcmts_ac = accode
endif
sele SUBTYPE
seek mtype+mstype
if found()
mssurch = surch
msitax = itax
mssertax = sertax
mssaletax= saletax
endif
sele VOUCMAST
if SUBSTR(machead,1,2) = '13'
*OR '130910'
repl cmts_ac with mcmts_ac
endif
*--------------------TAXES
mi_tax = (amount - moctroi ) * mitax / 100
repl i_tax with mi_tax
ms_charge = i_tax * msurch / 100
repl s_charge with ms_charge
mstax = (amount - moctroi ) * msaletax / 100
*-----------EDUCATIONAL CESS .. Tax
if msedcess>0
msedcess= (mi_tax+ms_charge) * 0.02
mshedcess=(mi_tax+ms_charge) * 0.01
endif
*-------------------
if mstype = 'BRICKS'
mbricks = mamt
mstax = mbricks * mssaletax / 100
endif
if mstype = 'INTEREST'
mi_tax = mint * msitax / 100
repl i_tax with mi_tax
ms_charge = i_tax * mssurch / 100
repl s_charge with ms_charge
mstax = mint * msaletax / 100
endif
repl stax with mstax
repl bricks with mbricks
repl int with mint
***** changes for elect & civil zone **** 11-02-2004
repl sd with msd
repl nc_sd with mnc_sd
repl bank_fd with mbank_fd
repl val_date with mval_date
repl partv with mpartv
repl compl_date with mcompl_date
repl comm_date with mcomm_date
repl bill_ty with mbill_type
repl agmt_no with magmt_no
IF MTEND_AMT= 9999999
repl agmt_amt with 0
ELSE
repl agmt_amt with mtend_amt
ENDIF
repl MBNO with mMBNO
repl work with mwork
repl octroi with moctroi
repl edcess with msedcess
repl hedcess with mshedcess
*********
sele VOUCMAST
mnamount = amount - (i_tax + s_charge + edcess + stax + ld + o_charge+cabledrum+sd+partv+hedcess)
repl namount with mnamount
repl remarks with mremarks
repl rmx with mrmx
sele BILLNO
seek str(mp_code,6)+mbill_no+dtoc(mbill_date)+str(mamount,10)
if .not. found()
appe blank
repl p_code with mp_code
repl bill_no with mbill_no
repl bill_date with mbill_date
repl amount with mamount
repl slno with mslno
* do UPDTUSER
endif
sele VOUCMAST
repl ccyymm with dtoc((r_date),7,4)+dtoc((r_date),4,2)
sele VOUCMAST
do UPDTUSER
RETURN
*---------------------------------------------------------
PROCEDURE DISPSCRE
@ 6, 0 clear to 24, 79
@06, 1 SAY 'Inward_No.& Date.:'
@08, 1 SAY 'Bill No & Date ..:'
@09, 1 SAY 'Party Name.......:'
@10, 1 say 'Bill Amount .....:'
@10, 35 say 'Tender Cost :'
@10, 60 say 'Est. Cost :'
*if m_zone = 'CVI'
* @10, 40 say 'Octroi Amount :'
*else
* @10, 40 say 'Advance Amount :'
*endif
@11,1 TO 11,79
@12, 1 SAY 'Type Of Bill ....:'
@13, 1 say 'Estimate No .....:'
@13, 30 say 'Esimate Suffix ..:'
@13, 58 say 'Est Amt:'
@14, 1 say 'Head Of Account .:'
@15, 1 say 'Signing Authority:'
@16,1 TO 16,79
@17, 1 say 'Liquidity Damage.:'
@17, 40 say 'Urban / Rural '
@18, 1 say 'Other Advances ..:'
@18,40 say 'EMD & Date:'
@19, 1 say 'Tender Type & No.:'
RETURN
*----------------------------------------------------
PROCEDURE GETKEY
set colo to n/w+
@ 5, 65 say '<Esc to Exit..>'
set colo to bg+
mr_date=date()
DO WHILE .T.
set colo to w+/rb
@ 06,50 say mr_date pict '{ / / }'
set colo to bg+
@ 6,19 SAY mslno
* pict '99999'
read
if lastkey() = k_esc
exit
endif
if mslno = 0
loop
else
exit
endif
ENDDO
*@05,0 to 05,79
set colo to bg+
RETURN
*------------------------------------------------------
PROCEDURE GETFLDS
user_msg1 = space(60)
user_msg2 = space(60)
mans = space(1)
*if ans_msg # 'M'
* mp_name = space(30)
*endif
DO WHILE .T.
do while .t.
mbill_date=date()
* MBILL_NO= STR(mslno)
@08, 19 get mbill_no pict '@!'
@08, 50 get mbill_date pict '{ / / }'
read
if last() = K_ESC
return
endif
if mbill_no = space(8) .or. mbill_date = { / / }
msrl_no = '113'
do USEMSG
loop
else
exit
endif
enddo
if last() = K_ESC
return
endif
user_msg1 = space(60)
user_msg2 = space(60)
do while .t.
name_found = .f.
do SHOWCONS
if .not. name_found
@09,19 get mp_name pict '@!'
read
if last() = K_ESC
return
endif
if mp_name = space(30)
loop
else
use PARTYMST inde PARTYNAM
rein
seek mp_name
if found()
name_found = .t.
exit
else
User_msg1 = 'Do You Want to ADD Supplier in Master [Y/N/S]'
User_msg2= 'Please Enter Y= ADD N= No ADD S= Show List'
@ 22,01 say user_msg1
@ 23,01 say user_msg2
@ 22,65 get mans pict '@!'
read
if .not. (mans $'YNS')
loop
endif
endif
endif
if mans = 'Y'
USE PARTYMST INDE PARTYMST
go bott
mp_code = p_code + 1
go top
appe blank
repl p_code with mp_code
repl p_name with mp_name
exit
else
if mans = 'S'
loop
else
exit
endif
endif
endif
enddo
if last() = K_ESC
return
endif
@22,1 clear to 24,79
set colo to gr+
@09,20 say mp_name
set colo to bg+
do while .t.
@10, 19 get mamount pict '9999999999999'
@10, 48 get mtend_cost pict '99999999'
@10, 70 get mest_cost pict '99999999'
read
if last() = K_ESC
return
endif
if mamount = 0
loop
else
exit
endif
enddo
sele BILLNO
seek str(mp_code,6)+mbill_no+dtoc(mbill_date)+str(mamount,10)
if found()
mbill_amt = amount
sslno = slno
msrl_no = '887'
aa=space(60)
aa= 'Please Check Bill with Computer Inw. No.:'
user_msg2 =aa+ ' '+str(sslno,5)
do USEMSG
loop
else
exit
endif
ENDDO
sele &PEFILE
seek mbill_no+dtoc(mbill_date)+str(mamount,10)
if found()
msrl_no = '160'
do USEMSG
endif
if last() = K_ESC
return
endif
m1amt=mamount
mo_charge = 0
madv_date = { / / }
madv_amt = 0
do while lastkey() != K_ESC
do GET_ADVC
if lastkey() = K_ESC .or. ax_lncd = 0
exit
endif
if m1amt = adv_amt[ax_lncd]
m1amt = m1amt - adv_amt[ax_lncd]
sele ADVCMAST
seek str(mp_code,6)+aadv_no[ax_lncd]
if found()
madv_amt = adv_amt[ax_lncd]
mo_charge = mo_charge + adv_amt[ax_lncd]
repl balance with 0
madv_date = adv_date
mp_code = p_code
endif
sele ADVCTRAN
appe blank
repl adv_no with aadv_no[ax_lncd]
repl bill_no with mbill_no
repl bill_date with mbill_date
repl bill_amt with mamount
repl adv_amt with madv_amt
repl p_code with mp_code
m1amt = 0
@10,40 say 'Balance Bill Amount:'
@10,60 say m1amt
msrl_no = '999'
do USEMSG
do UPDTUSER
exit
else
if m1amt < adv_amt[ax_lncd]
sele ADVCMAST
seek str(mp_code,6)+aadv_no[ax_lncd]
if found()
madv_amt = m1amt
mo_charge = mo_charge + m1amt
repl balance with (adv_amt[ax_lncd] - m1amt)
endif
sele ADVCTRAN
appe blank
repl adv_no with aadv_no[ax_lncd]
repl bill_no with mbill_no
repl bill_date with mbill_date
repl bill_amt with mamount
repl adv_amt with madv_amt
repl p_code with mp_code
m1amt = 0
@10,40 say 'Balance Bill Amount:'
@10,60 say m1amt
msrl_no = '999'
do USEMSG
do UPDTUSER
exit
else
if m1amt > adv_amt[ax_lncd]
sele ADVCMAST
seek str(mp_code,6)+aadv_no[ax_lncd]
if found()
madv_amt = adv_amt[ax_lncd]
m1amt = m1amt - adv_amt[ax_lncd]
mo_charge = mo_charge + (adv_amt[ax_lncd] )
repl balance with 0
endif
sele ADVCTRAN
appe blank
repl adv_no with aadv_no[ax_lncd]
repl bill_no with mbill_no
repl bill_date with mbill_date
repl bill_amt with mamount
repl adv_amt with madv_amt
repl p_code with mp_code
do UPDTUSER
@10,40 say 'Balance Bill Amount:'
@10,60 say m1amt
msrl_no = '999'
do USEMSG
loop
endif
endif
endif
enddo
@22,1 clear to 24,79
user_msg1 = space(60)
user_msg2 = space(60)
@12, 19 get mtype pict '@!'
read
if last() = K_ESC
return
endif
mtype_desc = space(15)
sele TYPEMAST
seek mtype
if found()
mtype = type_cd
mcmts_ac = accode
else
do SHOW_TYPE
endif
set colo to gr+
@12,20 say mtype
mstype = space(10)
@12,32 clear to 12,78
set colo to bg+
if option = 'A'
mamt = 0
endif
sele SUBTYPE
seek mtype
murb_rul = space(1)
if found()
do SHOW_STYPE
set colo to gr+
@12,35 say mstype
set colo to bg+
@12,47 SAY 'Amount:'
@12,55 get mamt pict '9999999999'
read
set colo to bg+
endif
mbricks = 0
mint = 0
mcabledrum = 0
if mamt = 0
mstype = space(10)
endif
if mstype = 'BRICKS'
mbricks = mamt
endif
if mstype = 'INTEREST'
mint = mamt
endif
dgm =.f.
de = .f.
sde= .f.
gm=.f.
maint_ac = .f.
estm_found = .f.
mans = space(1)
pans_msg = space(1)
if soption = 1
do while .t.
set colo to bg+
mans = space(1)
@13, 19 get mest_no pict '@!'
read
sele ESTMMAST
seek mest_no
if found()
estm_found = .t.
mesfx_cd = esfx_cd
machead = achead
exit
else
@21,00 clear to 24,79
set colo to +r
set colo to rgb(255,0,0)
@21,00 to 24,79
do while .t.
@22,1 say 'Estimate Not In Master Do You Want to ADD [Y/N]' get pans_msg pict '@!'
read
if .not. (pans_msg $'YN')
loop
else
exit
endif
enddo
if pans_msg = 'N'
loop
else
exit
endif
endif
enddo
endif
@21,0 clear to 24,79
if mest_no = space(06)
maint_ac = .t.
endif
set colo to bg+
do while .t.
if mest_no # space(6)
@13,50 get mesfx_cd pict '@!'
read
endif
@13,68 get mest_amt pict '99999999'
@14, 19 get machead pict '@!'
read
mac_desc = space(30)
sele ACHEAD
seek machead
if found()
mac_desc = desc
exit
else
msrl_no = '114'
do USEMSG
loop
endif
enddo
set colo to gr+
@14,30 say substr(mac_desc,1,40)
@14,60 clear to 14,79
if SUBSTR(machead,1,2) = '13'
@14,60 say 'Cmts Head:'
@14,70 get mcmts_ac pict '@!'
read
endif
set colo to bg+
user_msg1 = space(60)
user_msg2 = space(60)
if pans_msg = 'Y' .and. soption = 1
sele ESTMMAST
appe blank
repl estm_no with mest_no
repl esfx_cd with mesfx_cd
repl achead with machead
endif
if estm_found .and. soption = 1
sele ESTMMAST
repl esfx_cd with mesfx_cd
repl achead with machead
endif
mremarks = space(30)
* do GET_SIGAUT
do SHOW_SDE
user_msg1 = space(60)
user_msg2 = space(60)
set colo to gr+
@15, 20 say munit pict '@!'
set colo to bg+
ok_flag = .F.
user_msg1 = space(60)
user_msg2 = space(60)
sele VOUCMAST
do while .t.
@17, 19 get mld pict '9999999999'
read
if mld > 0
@17,60 get mur_cd pict '@!'
read
if .not. (mur_cd $'UR')
loop
else
exit
endif
else
exit
endif
enddo
@18, 19 get mo_charge pict '9999999999'
@18, 53 get memd pict '9999999999'
@18, 67 get memd_date pict '{ / / }'
read
*if mtype = 'CABLE LAY'
do while .t.
@19,01 say 'Water charges ..:'
@19, 19 get mcabledrum pict '9999999999'
@19,32 say '[U/R]'
@19,40 get murb_rul pict '@!'
read
if mcabledrum > 0
if .not. (murb_rul $'UR')
loop
else
exit
endif
else
exit
endif
enddo
*endif
set colo to bg+
do SHOW_TEND
set colo to gr+
@19,20 say mtend_type
@19,31 say mtender_no pict '@!'
set colo to BG+
sele VOUCMAST
SUM amount for mtend_type = type .and. mtender_no = tender_no to mtend_exp
mtend_exp = mtend_exp + mamount
if mtend_exp > mtend_amt
msrl_no = '165'
do USEMSG
mremarks = 'TENDER AMOUNT LIMIT EXCEDDS'
mrmx = 'TENDER EXCD'
endif
@20,01 say 'Dealing Asstt :'
do SHOW_DA
set colo to gr+
@20,20 say mda pict '@!'
@20,25 say substr(mda_name,1,18) pict '@!'
set colo to bg+
@20,40 say 'Part-V Amount:'
@20,60 get mpartv pict '9999999999'
read
@21,01 say 'Cash SD Amount :'
@21,40 say 'Non Cash SD Amount:'
msd = INT(mamount * 10 /100)
@21,19 get msd pict '9999999999'
@21,60 get mnc_sd pict '9999999999'
read
if mnc_sd > 0
@22,01 get mbank_fd pict '@!'
@22,65 get mval_date pict '{ / / }'
read
endif
if mtype = 'D VEHI DIS' .or. MTYPE = 'D VEHI REP' .OR. MTYPE = 'H VEHICLE'
@20,1 clear to 22,79
@20,1 TO 20,79
set colo to gr+
@20,1 say '** Vehicle Information **'
set colo to bg+
@21,1 say 'Vehicle No......:'
@21,40 say 'Designation..:'
@22,1 say 'Year /Month ....:'
@23,1 say 'Vehicle KM .....:'
do SHOW_VNO
if v_items > 0
set colo to gr+
@21,19 say mv_no pict '@!'
@21,55 say mv_desig pict'@!'
set colo to bg+
else
@21,19 get mv_no pict '@!'
@21,55 say mv_desig pict'@!'
endif
@21,55 get mv_desig pict'@!'
@22,19 get mv_month pict '@!'
@23,19 get mv_km pict '999999'
read
set colo to bg+
endif
sele VEHICLE
seek mv_no
if found()
repl v_desig with mv_desig
endif
sele VOUCMAST
if mtype = 'SGUARDS'
@20,1 clear to 22,79
set colo to gr+
@20,1 say '** Sec. Guards Information **'
set colo to bg+
@21,1 clear to 23,79
@21,1 say 'Unit Name ......:'
@22,1 say 'No Of Guards ...:'
@23,1 say 'Year / Month....:'
do SHOW_GUARD
set colo to gr+
@21,20 say mexcg_name pict '@!'
@22,20 say mg_no pict '999999'
set colo to bg+
@23,19 get mg_month pict '@!'
read
endif
main_scr = space(1)
save screen to main_scr
@21,1 clear to 23,79
@20,1 TO 20,79
set colo to gr+
@20,1 say '** Remarks **'
set colo to bg+
@21,1 say 'Bill_type......:'
mwork_1 = space(60)
mwork_2 = space(60)
do SHOW_BILTY
set colo to gr+
@21,19 get mbill_type pict '@'
set colo to bg+
if mdate_tag = 'F'
@21,40 say 'Completion Date:'
@21,55 get mcompl_date pict '{ / / }'
endif
@22,1 SAY 'Commencement Date:'
@22,20 get mcomm_date pict '{ / / }'
read
@22,1 clear to 24,79
@22,1 say 'Agmt No.:'
@22,55 say 'MBNO:'
@23,1 say 'Work :'
@24,1 say 'Work :'
if m_zone # 'ELEC'
mmbno = ' '
endif
magmt_no=mtender_no
@22,10 get magmt_no pict '@!'
@22,60 get mmbno pict '@!'
@23,10 get mwork_1 pict '@!'
@24,10 get mwork_2 pict '@!'
read
mwork = ALLTRIM(mwork_1)+' ' +ALLTRIM(mwork_2)
@23,1 clear to 24,79
@23,1 say 'Asset Rmks:'
@23,13 get masset_rmk pict '@!'
read
set colo to bg+
RETURN
*------------------------------------------------------
PROCEDURE INITFLDS
mbill_no = space(8)
*mbill_date = { / / }
mamount = 0
munit=space(15)
mmunit = space(15)
mda=space(2)
mjsdt = { / / }
mdespatch = { / / }
mremarks= space(30)
mrmx = space(10)
mtype = space(10)
mstype = space(10)
mest_no = space(6)
mesfx_cd = space(3)
mnamount = 0
*****
msd = 0
mnc_sd = 0
mbank_fd = space(60)
mval_date = { / / }
mpartv = 0
mcompl_date = { / / }
mcomm_date = { / / }
mbill_type = space(15)
mwork = space(120)
magmt_no = space(40)
mMBNO = space(15)
moctroi = 0
memd=0
memd_date = { / / }
******
*machead = space(6)
mld = 0
mo_charge = 0
mcabledrum = 0
mv_month = space(6)
mg_month= space(6)
mv_no = space(15)
mg_no = 0
mgm_no = space(2)
mdgm_no = space(2)
mde_no = space(2)
msde_no = space(2)
mexcg_no = space(2)
mdgm_shnm = space(15)
mde_shnm = space(15)
msde_shnm = space(15)
mur_cd = space(1)
mv_desig = space(15)
mremark_2 = space(20)
mremark_3 = space(20)
masset_rmk = space(60)
*--------------------------------------------------
PROCEDURE VIEWFLDS
sele VOUCMAST
go top
BROWSE NOEDIT
@05, 00 clear to 24,79
RETURN
*---------------------------------------------------
PROCEDURE CLOSE_OPEN
sele 20
use VOUCMAST index VOUCMAST
RETURN
*--------------------------------------------------
PROCEDURE ARRAY_NAME
sele 01
use PARTYMST inde PARTYNAM
go top
ap_name = space(30)
mname = RTRIM(mname)
cl_cntr = 0
if mname = space(30)
mname = RTRIM(p_name)
endif
mlen = LEN(mname)
seek mname
IF FOUND()
DO WHILE .NOT. EOF()
if SUBSTR(mname,1,mlen) = SUBSTR(p_name,1,mlen)
cl_cntr = cl_cntr + 1
if cl_cntr > ele
DECLARE ap_name[cl_cntr]
DECLARE ap_code[cl_cntr]
endif
ap_name[cl_cntr] = p_name
ap_code[cl_cntr] = p_code
@23,04 SAY "Please Wait !! Processing is Going On "
endif
skip
ENDDO
ELSE
name_found = .f.
user_msg1 = 'No Such SUPPLIER ! Please Update SUPPLIER MASTER '
msrl_no = '889'
do usemsg
ENDIF
@23,1 CLEAR TO 24,79
SET COLOR TO bg+
sele 01
use PARTYMST inde PARTYMST
go top
RETURN
*---------------------------------------------------------
PROCEDURE SHOWCONS
set confirm on
DO WHILE .T.
IF M_ZONE = 'ELEC'
mp_name = 'M/S '+SPACE(26)
else
mp_name = space(30)
ENDIF
mname = space(30)
mname = mp_name
mp_code = 0
@ 09, 19 get mname pict '@!'
read
do ARRAY_NAME
n_clcd = 0
if cl_cntr > 0
set colo to bg+/gr
@09,47 MENU AP_NAME,CL_CNTR TITLE 'Supplier Names'
READ MENU TO N_CLCD
set colo to bg+
if lastkey() = 27
cl_cntr = 0
name_found = .f.
exit
endif
if lastkey() # 13
loop
else
exit
endif
else
name_found = .f.
@23,01 CLEAR TO 23,77
@23,01 SAY 'No Selection !! Please ADD Supplier '
exit
endif
ENDDO
if cl_cntr # 0
mp_name = ap_name[n_clcd]
mp_code = ap_code[n_clcd]
endif
cl_cntr = 0
return
*---------------------------------
PROCEDURE SHOW_TYPE
main_scr = space(1)
save screen to main_scr
set confirm on
set colo to w/gr+
DO WHILE .T.
@10,57 MENU A_type_cd,A_ITEMS TITLE 'Voucher Type Codes '
READ MENU TO A_LNCD
IF LASTKEY() # 13
LOOP
ELSE
EXIT
ENDIF
ENDDO
sdesc = a_desc[a_lncd]
mtype = a_type_cd[a_lncd]
mcmts_ac = a_accode[a_lncd]
restore screen from main_scr
set confirm off
set colo to bg+
RETURN
*----------------------------------------------------------------
PROCEDURE SHOW_STYPE
do GET_STYPE
if as_items > 0
main_scr = space(1)
save screen to main_scr
set confirm on
set colo to w/gr+
DO WHILE .T.
@10,57 MENU Astype_cd,As_ITEMS TITLE 'Voucher Sub Type Codes '
READ MENU TO As_LNCD
IF LASTKEY() # 13
LOOP
ELSE
EXIT
ENDIF
ENDDO
sdesc = as_desc[as_lncd]
mstype = astype_cd[as_lncd]
restore screen from main_scr
endif
set confirm off
set colo to bg+
RETURN
*----------------------------------------------------------------
PROCEDURE GET_STYPE
sele 03
as_items=0
as_lncd=0
declare astype_cd[ele]
declare as_desc[ele]
as_desc = space(30)
astype_cd = space(10)
go top
DO WHILE (.NOT. EOF())
if mtype= type_cd
as_items = as_items + 1
if as_items > 1
declare as_desc[as_items]
declare astype_cd[as_items]
endif
as_desc[as_items] = desc
astype_cd[as_items] = stype_cd
endif
skip
ENDDO
RETURN
*-----------------------------------------------
PROCEDURE SHOW_GUARD
main_scr = space(1)
save screen to main_scr
set confirm on
set colo to w/gr+
DO WHILE .T.
@10,57 MENU A_EXSHNM,G_ITEMS TITLE 'Sec.Guards Unit'
READ MENU TO g_LNCD
IF LASTKEY() # 13
LOOP
ELSE
EXIT
ENDIF
ENDDO
mexcg_name = a_exname[g_lncd]
m_exshnm = a_exshnm[g_lncd]
mg_no = a_gno[g_lncd]
restore screen from main_scr
set confirm off
set colo to bg+
RETURN
*----------------------------------------------------------------
PROCEDURE SHOW_VNO
do GET_VNO
main_scr = space(1)
save screen to main_scr
set confirm on
set colo to w/gr+
DO WHILE .T.
@10,57 MENU A_vno,v_ITEMS TITLE 'Vehicle Numbers'
READ MENU TO V_LNCD
IF LASTKEY() # 13
LOOP
ELSE
EXIT
ENDIF
ENDDO
if v_items > 0
vdesc = a_unit[v_lncd]
mv_no = a_vno[v_lncd]
mv_desig = a_vdesig[v_lncd]
endif
restore screen from main_scr
set confirm off
set colo to bg+
RETURN
*----------------------------------------------------------------
PROCEDURE SHOW_DA
main_scr = space(1)
save screen to main_scr
set confirm on
set colo to w/gr+
DO WHILE .T.
@19,57 MENU A_name,d_items TITLE 'Dealing Asst. Names'
READ MENU TO d_lncd
IF LASTKEY() = K_ESC
EXIT
ENDIF
IF LASTKEY() # 13
LOOP
ELSE
EXIT
ENDIF
ENDDO
if lastkey() # k_esc
mda = a_da[d_lncd]
mda_name = a_name[d_lncd]
endif
restore screen from main_scr
set confirm off
set colo to bg+
RETURN
*----------------------------------------------------------------
PROCEDURE GET_SIGAUT
*main_scr = space(1)
*save screen to main_scr
*set confirm on
*set colo to w/gr+
*z_lncd =0
*DO WHILE .T.
* @13,57 MENU eopt,3 TITLE 'Select Signing Authority'
* READ MENU TO z_lncd
* IF LASTKEY() = K_ESC
* EXIT
* ENDIF
* IF LASTKEY() = 13
* EXIT
* ELSE
* LOOP
* ENDIF
*ENDDO
Z_LNCD = 0
IF MEST_NO = SPACE(6) .AND. MAMOUNT <= mmsde_amt2
Z_LNCD = 3
ENDIF
*
IF MEST_NO = SPACE(6) .AND. MAMOUNT > mmde_amt1 .AND. MAMOUNT <= mmde_amt2
Z_LNCD = 2
ENDIF
*
IF MEST_NO = SPACE(6) .AND. MAMOUNT > mmdgm_amt1 .AND. MAMOUNT <= mmdgm_amt2
Z_LNCD = 1
ENDIF
IF MEST_NO = SPACE(6) .AND. MAMOUNT > mmgm_amt1 .AND. MAMOUNT <= mmgm_amt2
Z_LNCD = 4
ENDIF
*--------------- for capital conditions -------------------
IF MEST_NO # SPACE(6) .AND. MAMOUNT <= mcsde_amt2
Z_LNCD = 3
ENDIF
*
IF MEST_NO # SPACE(6) .AND. MAMOUNT > mcde_amt1 .AND. MAMOUNT <= mcde_amt2
Z_LNCD = 2
ENDIF
*
IF MEST_NO # SPACE(6) .AND. MAMOUNT > mcdgm_amt1 .AND. MAMOUNT <= mcdgm_amt2
Z_LNCD = 1
ENDIF
IF MEST_NO # SPACE(6) .AND. MAMOUNT > mcgm_amt1 .AND. MAMOUNT <= mcgm_amt2
Z_LNCD = 4
ENDIF
if z_lncd = 1
do SHOW_DGM
dgm = .t.
else
if z_lncd = 2
do SHOW_DE
de = .t.
else
if z_lncd = 3
do SHOW_SDE
sde = .t.
else
if z_lncd = 4
do SHOW_GM
gm = .t.
endif
endif
endif
endif
RETURN
*-------------------------------------
PROCEDURE SHOW_GM
main_scr = space(1)
save screen to main_scr
if j_items > 0
set confirm on
set colo to w/gr+
DO WHILE .T.
@13,57 MENU agm_shname,j_items TITLE 'GM Names'
READ MENU TO j_lncd
IF LASTKEY() = K_ESC
EXIT
ENDIF
IF LASTKEY() = 13
EXIT
ELSE
LOOP
ENDIF
ENDDO
if lastkey() # k_esc
mpgm_no = apgm_no[j_lncd]
mgm_no = agm_no[j_lncd]
mgm_shnm = agm_shname[j_lncd]
munit = agm_shname[j_lncd]
mmunit = munit
*m_zone = a_zone[j_lncd]
endif
endif
restore screen from main_scr
set confirm off
set colo to bg+
RETURN
*----------------------------------------------------------------
PROCEDURE SHOW_DGM
do GET_DGM
main_scr = space(1)
save screen to main_scr
if y_items > 0
set confirm on
set colo to w/gr+
DO WHILE .T.
@13,57 MENU ydgm_name,y_items TITLE 'DGM Names'
READ MENU TO y_lncd
IF LASTKEY() = K_ESC
EXIT
ENDIF
IF LASTKEY() = 13
EXIT
ELSE
LOOP
ENDIF
ENDDO
if lastkey() # k_esc
mpgm_no = ypgm_no[y_lncd]
mgm_no = ygm_no[y_lncd]
mdgm_no = ydgm_no[y_lncd]
mexcg_no = yexcg_no[y_lncd]
mdgm_shnm = ydgm_shnm[y_lncd]
munit = ydgm_name[y_lncd]
mmunit = substr(munit,17,15)
endif
endif
restore screen from main_scr
set confirm off
set colo to bg+
RETURN
*----------------------------------------------------------------
PROCEDURE SHOW_DE
do SHOW_EXCG
do GET_DE
main_scr = space(1)
save screen to main_scr
if xd_items > 0
set confirm on
set colo to w/gr+
DO WHILE .T.
@13,57 MENU xde_shnm,xd_items TITLE 'DE Names'
READ MENU TO xd_lncd
IF LASTKEY() = K_ESC
EXIT
ENDIF
IF LASTKEY() = 13
EXIT
ELSE
LOOP
ENDIF
ENDDO
if lastkey() # k_esc
mpgm_no = xpgm_no[xd_lncd]
mgm_no = xgm_no[xd_lncd]
mdgm_no = xdgm_no[xd_lncd]
mde_no = xde_no[xd_lncd]
mde_shnm = xde_shnm[xd_lncd]
munit = xde_shnm[xd_lncd]
mmunit = munit
endif
endif
restore screen from main_scr
set confirm off
set colo to bg+
RETURN
*----------------------------------------------------------------
PROCEDURE SHOW_SDE
do SHOW_EXCG
do GET_SDE
main_scr = space(1)
save screen to main_scr
if e_items > 0
set confirm on
set colo to w/gr+
DO WHILE .T.
@13,57 MENU asde_shnm,e_items TITLE 'SDE Names'
READ MENU TO e_lncd
IF LASTKEY() = K_ESC
EXIT
ENDIF
IF LASTKEY() = 13
EXIT
ELSE
LOOP
ENDIF
ENDDO
if lastkey() # k_esc
mpgm_no = apgm_no[e_lncd]
mgm_no = agm_no[e_lncd]
mdgm_no = adgm_no[e_lncd]
mde_no = ade_no[e_lncd]
msde_no = asde_no[e_lncd]
msde_shnm = asde_shnm[e_lncd]
munit = asde_shnm[e_lncd]
mmunit = munit
endif
endif
restore screen from main_scr
set confirm off
set colo to bg+
RETURN
*----------------------------------------------------------------
PROCEDURE SHOW_EXCG
main_scr = space(1)
save screen to main_scr
set confirm on
set colo to w/gr+
DO WHILE .T.
@13,57 MENU Aex_shname,x_items TITLE 'EXCHANGE Name'
READ MENU TO x_lncd
IF LASTKEY() = K_ESC
EXIT
ENDIF
IF LASTKEY() # 13
LOOP
ELSE
EXIT
ENDIF
ENDDO
if lastkey() # k_esc
mexcg_no = aexcg_no[x_lncd]
mex_name = aex_name[x_lncd]
mex_shname = aex_shname[x_lncd]
endif
restore screen from main_scr
set confirm off
set colo to bg+
RETURN
*----------------------------------------------------------------
PROCEDURE GET_SDE
ele = 1
e_items=0
e_lncd=0
declare apgm_no[ele]
declare agm_no[ele]
declare adgm_no[ele]
declare ade_no[ele]
declare asde_no[ele]
declare asde_name[ele]
declare asde_shnm[ele]
apgm_no = space(2)
agm_no = space(2)
adgm_no = space(2)
ade_no = space(2)
asde_no = space(2)
asde_name=space(30)
asde_shnm = space(15)
sele SDEMAST
go top
DO WHILE (.NOT. EOF())
if mexcg_no = excg_no
e_items = e_items + 1
if e_items > 1
declare apgm_no[e_items]
declare agm_no[e_items]
declare adgm_no[e_items]
declare ade_no[e_items]
declare asde_no[e_items]
declare asde_name[e_items]
declare asde_shnm[e_items]
endif
apgm_no[e_items] = pgm_no
agm_no[e_items] = gm_no
adgm_no[e_items] = dgm_no
ade_no[e_items] = de_no
asde_no[e_items] = sde_no
asde_name[e_items]= name
asde_shnm[e_items]= sh_name
endif
skip
ENDDO
IF e_ITEMS = 0
User_msg1 = 'SDEMAST File is Empty !! Please Enter Data!!'
User_msg2= 'Please Press <Esc> Key to Continue'
MSRL_NO = '889'
do USEMSG
cansel_rec = .t.
ENDIF
RETURN
*-------------------------------------------------------
PROCEDURE GET_DE
ele = 1
xd_items=0
xd_lncd=0
declare xpgm_no[ele]
declare xgm_no[ele]
declare xdgm_no[ele]
declare xde_no[ele]
declare xde_name[ele]
declare xde_shnm[ele]
xpgm_no = space(2)
xgm_no = space(2)
xdgm_no = space(2)
xde_no = space(2)
xde_name=space(30)
xde_shnm = space(15)
sele DEMAST
go top
DO WHILE (.NOT. EOF())
if mexcg_no = excg_no
xd_items = xd_items + 1
if xd_items > 1
declare xpgm_no[xd_items]
declare xgm_no[xd_items]
declare xdgm_no[xd_items]
declare xde_no[xd_items]
declare xde_name[xd_items]
declare xde_shnm[xd_items]
endif
xpgm_no[xd_items] = pgm_no
xgm_no[xd_items] = gm_no
xdgm_no[xd_items] = dgm_no
xde_no[xd_items] = de_no
xde_name[xd_items] = name
xde_shnm[xd_items] = sh_name
endif
skip
ENDDO
IF xd_ITEMS = 0
User_msg1 = 'DEMAST File is Empty !! Please Enter Data!!'
User_msg2= 'Please Press <Esc> Key to Continue'
MSRL_NO = '889'
do USEMSG
cansel_rec = .t.
ENDIF
RETURN
*-------------------------------------------------------
PROCEDURE GET_DGM
ele = 1
y_items=0
y_lncd=0
declare ypgm_no[ele]
declare ygm_no[ele]
declare ydgm_no[ele]
declare ydgm_name[ele]
declare ydgm_shnm[ele]
ypgm_no = space(2)
ygm_no = space(2)
ydgm_no = space(2)
ydgm_name=space(30)
ydgm_shnm = space(15)
sele DGMEXCG
go top
DO WHILE (.NOT. EOF())
y_items = y_items + 1
if y_items > 1
declare ypgm_no[y_items]
declare ygm_no[y_items]
declare ydgm_no[y_items]
declare yexcg_no[y_items]
declare ydgm_name[y_items]
declare ydgm_shnm[y_items]
endif
ypgm_no[y_items] = pgm_no
ygm_no[y_items] = gm_no
ydgm_no[y_items] = dgm_no
yexcg_no[y_items] = excg_no
ydgm_name[y_items] = excg_name + ' ' + dgm_name
ydgm_shnm[y_items] = excg_name
skip
ENDDO
IF y_ITEMS = 0
User_msg1 = 'DGMEXCG File is Empty !! Please Enter Data!!'
User_msg2= 'Please Press <Esc> Key to Continue'
MSRL_NO = '889'
do USEMSG
cansel_rec = .t.
ENDIF
RETURN
*-------------------------------------------------------
PROCEDURE GET_ADVC
main_scr = space(1)
save screen to main_scr
set confirm on
set colo to w/gr+
ele = 1
declare aadv_no[ele]
declare aadv_date[ele]
declare abill_no[ele]
declare abill_date[ele]
declare adv_amt[ele]
declare ax_desc[ele]
aadv_no = space(10)
aadv_date = { / / }
abill_no = space(10)
abill_date ={ / / }
adv_amt = 0
ax_items = 0
ax_lncd = 0
ax_desc = space(35)
sele ADVCMAST
seek str(mp_code,6)
if found()
do while mp_code = p_code .and. .not. eof()
if balance > 0
ax_items = ax_items + 1
if ax_items > 1
declare aadv_no[ax_items]
declare aadv_date[ax_items]
declare abill_no[ax_items]
declare abill_date[ax_items]
declare adv_amt[ax_items]
declare ax_desc[ax_items]
endif
aadv_no[ax_items] = adv_no
aadv_date[ax_items] = adv_date
abill_no[ax_items] = mbill_no
abill_date[ax_items] = mbill_date
adv_amt[ax_items] = balance
ax_desc[ax_items] = aadv_no[ax_items]+dtoc(aadv_date[ax_items])+str(adv_amt[ax_items],10)
endif
skip
enddo
main_scr = space(1)
save screen to main_scr
set confirm on
set colo to w/gr+
DO WHILE .T.
@10,57 MENU ax_desc,ax_items TITLE '<Esc To Exit..>'
READ MENU TO Ax_lncd
IF LASTKEY() = K_ESC
EXIT
ENDIF
IF LASTKEY() # 13
LOOP
ELSE
EXIT
ENDIF
ENDDO
ENDIF
restore screen from main_scr
set confirm off
set colo to bg+
RETURN
*----------------------------------
PROCEDURE GET_VNO
v_items=0
v_lncd=0
ele = 1
declare a_vno[ele]
declare a_vdesig[ele]
declare a_unit[ele]
a_unit = space(30)
a_vno = space(15)
a_vdesig = space(15)
if MTYPE = 'H VEHICLE'
A_TYPE = 'H'
else
A_TYPE = 'D'
endif
sele VEHICLE
go top
DO WHILE (.NOT. EOF())
if a_type = type
v_items = v_items + 1
if v_items > 1
declare a_unit[v_items]
declare a_vno[v_items]
declare a_vdesig[v_items]
endif
A_unit[v_items] = unit
A_vno[v_items] = v_no
a_vdesig[v_items] = v_desig
endif
skip
ENDDO
IF V_ITEMS = 0
User_msg1 = 'Vehicle Master File is Empty !! Please Enter Data!!'
User_msg2= 'Please Press Any Key to Continue'
MSRL_NO = '889'
do USEMSG
RETURN
ENDIF
*----------------------------------------------
PROCEDURE UPDT_LIMITS
if dgm
sele DGMMAST
seek mpgm_no+mgm_no+mdgm_no
if found()
if maint_ac
repl anu_exp2 with anu_exp2 + mamount
else
repl cap_exp2 with cap_exp2 + mamount
endif
endif
endif
if de
sele DEMAST
seek mdgm_no+mexcg_no+mde_no
if found()
if maint_ac
repl anu_exp2 with anu_exp2 + mamount
else
repl cap_exp2 with cap_exp2 + mamount
endif
endif
endif
if sde
sele SDEMAST
seek mdgm_no+mexcg_no+mde_no+msde_no
if found()
if maint_ac
repl anu_exp2 with anu_exp2 + mamount
else
repl cap_exp2 with cap_exp2 + mamount
endif
endif
endif
if gm
sele GMMAST
seek pgm_no+mgm_no
if found()
if maint_ac
repl anu_exp2 with anu_exp2 + mamount
else
repl cap_exp2 with cap_exp2 + mamount
endif
endif
endif
RETURN
*-----------------------------------------------------
PROCEDURE SHOW_TEND
do SHOW_TTYPE
do GET_TENDNO
if t_items > 0
main_scr = space(1)
save screen to main_scr
set confirm on
set colo to w/gr+
DO WHILE .T.
@17,47 MENU Atend_disp,t_items TITLE 'TENDER NOS'
READ MENU TO t_lncd
IF LASTKEY() = K_ESC
EXIT
ENDIF
IF LASTKEY() # 13
LOOP
ELSE
EXIT
ENDIF
ENDDO
if lastkey() # k_esc
mtender_no = atender_no[t_lncd]
mtend_amt = atend_amt[t_lncd]
endif
endif
******>><<<<<<<<< %%%%
restore screen from main_scr
set confirm off
set colo to bg+
RETURN
*----------------------------------------------------------------
PROCEDURE SHOW_TTYPE
main_scr = space(1)
save screen to main_scr
set confirm on
set colo to w/gr+
DO WHILE .T.
@15,57 MENU Atend_type,n_items TITLE 'TENDER TYPES'
READ MENU TO n_lncd
IF LASTKEY() = K_ESC
EXIT
ENDIF
IF LASTKEY() # 13
LOOP
ELSE
EXIT
ENDIF
ENDDO
if lastkey() # k_esc
mtend_type = atend_type[n_lncd]
endif
restore screen from main_scr
set confirm off
set colo to bg+
RETURN
*----------------------------------------------------------------
PROCEDURE GET_TENDNO
sele TENDER
t_items= 0
t_lncd = 0
declare atend_disp[ele]
declare atender_no[ele]
declare atend_amt[ele]
atend_disp=space(60)
atender_no = space(40)
atend_amt = 0
go top
DO WHILE (.NOT. EOF())
if type = mtend_type
t_items = t_items + 1
if t_items > 1
declare atend_disp[t_items]
declare atender_no[t_items]
declare atend_amt[t_items]
endif
atend_disp[t_items] = ALLTRIM(tender_no) + ' '+ str(amount)
atender_no[t_items] = ALLTRIM(tender_no)
atend_amt[t_items] = amount
endif
skip
ENDDO
IF t_items = 0
User_msg1 = 'TENDER Master File is Empty !! Please Enter Data!!'
User_msg2= 'Please Press Any Key to Continue'
MSRL_NO = '889'
do USEMSG
RETURN
ENDIF
RETURN
*----------------------------
PROCEDURE SHOW_BILTY
main_scr = space(1)
save screen to main_scr
set confirm on
set colo to w/gr+
DO WHILE .T.
@15,57 MENU Abill_type,r_items TITLE 'BILL TYPES'
READ MENU TO r_lncd
IF LASTKEY() = K_ESC
EXIT
ENDIF
IF LASTKEY() # 13
LOOP
ELSE
EXIT
ENDIF
ENDDO
if lastkey() # k_esc
mbill_type = abill_type[r_lncd]
mdate_tag = adate_tag[r_lncd]
endif
restore screen from main_scr
set confirm off
set colo to bg+
RETURN
*----------------------------------------------------------------
======================================================================================
do cl
do date
set safety off
mCq_dt = ctod(' / / ')
mcq_dt1 = ctod(' / / ')
mcq_dt = {01/09/2005}
mcq_dt1 = {30/09/2005}
mstype='C'
@ 14,12 SAY "PAY ....... DATE from " get mcq_dt
@ 16,12 SAY "PAY ....... DATE to " get mcq_dt1
read
*---------
sele a
use contra
index on debit to debit
sele b
use voucmast
SET FILTER TO (cheq_date>= mcq_dt .and. cheq_dAtE <= mcq_dt1)
index on namount to n
*------------
do while .not. eof()
sele b
seek a->debit
clear
if found()
?'found cases are............'
?
?a->debit
?a->details
?a->chequeno
?
?
?b->supplier
?b->namount
?b->cheq_no
* wait
* repl B->CHEQ_NO with A->CHEQUENO
* REPL B->CHEQ_DATE WITH A->CHQDATE
* repl b->details with a->details
REPL B->DEBIT WITH A->DEBIT
REPL B->CREDIT WITH A->CREDIT
REPL B->VRNO WITH A->VRNO
endif
sele a
skip
enddo
*---------------------NOT FOUND
do cl
do date
set safety off
*---------
sele a
use contra
index on debit to debit
sele b
use voucmast
set filter to month(despatch)=9
index on namount to n
*------------
do while .not. eof()
sele A
seek B->debit
clear
if .not. found()
?
?'NOT FOUND........'
?
?'SL NO. :'+STR(B->SLNO)
?'supplier :'+ltrim(b->supplier)
?'Namount :'+str(b->namount)
?'cheq.no. :'+ltrim(b->cheq_no)
wait
* repl a->jsno with vrno
endif
sele a
if eof()
exit
else
skip
endif
enddo
DO CL
use voucmast
set filter to month(despatch)=9
BROW FIELD DETAILS,DEBIT,CREDIT,VRNO,NAMOUNT,CHEQ_NO,CHEQ_DATE,SUPPLIER,AMOUNT,achead,work
=============================
SET SAFETY OFF
set colo to bg+
@ 5,01 clear to 23,79
@ 5,01 to 05,78 double
@03,30 CLEAR TO 03,48
SET COLOR TO GR+
CDESP=' ** FUNDS Requisition Form **'
CLEN = LEN(CDESP)
CPOS=(80-CLEN) / 2
@03,CPOS say CDESP
set color to BG+
*----------variables
do findsd1
SET ESCAPE OFF
set exact On
SET FUNC 5 TO "683158"
SET FUNC 4 TO '31/03/2009'
*do cl
do date
clear
ans='Y'
*----------------
DO WHILE ans='Y'
mname=spac(8)
*mname='MANIL'
@ 12, 12 say "ENTER NAME of supplier" GET mname pict '@!'
read
clear
*----------
if mname=' '
exit
return
endif
mname = ltrim(substr(mname,1,17))
?mname
wait
use voucmast
PACK
go top
set filter to atc(m->mname,supplier) >0 AND EMD+SD > 0
GO TOP
mcnt=0
count to mcnt
if mcnt>0
brow field supplier,SD,PARTV,EMD,SLNO,ITEM,bill_date,work,DESP_SD,SD_CHQNO,SD_CHQDT,DESP_EMD,EMD_CHQNO,EMD_CHQDT,DESP_PARTV,PV_CHQNO,PV_CHQDT,comm_date,compl_date
GO TOP
BROW
COPY TO tempdep
use tempdep
DO REF1
else
wait wind "NOT FOUND"
endif
@ 21,12 say "continue to find more" get ans
read
clear
if upper(ans)='Y'
loop
clear
else
exit
return
endif
enddo
*--------------------
===============================================
** Total funds details
close all
clear
hide menu all
hide popup all
erase funds.txt
clear
sele a
use funds
set console off
repo form funds to funds
mans = space(1)
@ 5,15 say "*** FUND'S DETAILS ***"
@ 9,18 say "DISPLAY/PRINT" get mans pict "@!x"
read
if mans = "P"
wait window "Set printer on.."
!type funds.txt >prn
else
define window wshow from 1,1 to 23,76 title ""
modi comm funds.txt window wshow noedit
endif
clear
return .t.
*-------------------------------
==============================
*
* GENMENU - Menu code generator.
*
* Copyright (c) 1990 - 1993 Microsoft Corp.
* 1 Microsoft Way
* Redmond, WA 98052
*
* Description:
* This program generates menu code which was designed in the
* FoxPro 2.5 MENU BUILDER.
*
* Notes:
* In this program, for clarity/readability reasons, we use variable
* names that are longer than 10 characters. Note, however, that only
* the first 10 characters are significant.
*
* Modification History:
* December 13, 1990 JAC Program Created
*
* Modifed for FoxPro 2.5 by WJK.
*
PARAMETER m.projdbf, m.recno
PRIVATE ALL
IF SET("TALK") = "ON"
SET TALK OFF
m.talkstate = "ON"
ELSE
m.talkstate = "OFF"
ENDIF
m.escape = SET("ESCAPE")
*SET ESCAPE OFF
m.trbetween = SET("TRBET")
SET TRBET OFF
m.comp = SET("COMPATIBLE")
SET COMPATIBLE OFF
mdevice = SET("DEVICE")
SET DEVICE TO SCREEN
*
* Declare Constants
*
#DEFINE c_esc CHR(27)
#DEFINE c_null CHR(0)
#DEFINE c_aliaslen 10
*
* Possible values of Objtype field in SCX database.
*
#DEFINE c_menu 1
#DEFINE c_submenu 2
#DEFINE c_item 3
*
* Some of the values of Objcode field in SCX database.
*
#DEFINE c_global 1
#DEFINE c_proc 80
#DEFINE c_maxsnippets 25
#DEFINE c_maxpads 25
#DEFINE c_pjx20flds 33
#DEFINE c_pjxflds 31
#DEFINE c_mnxflds 23
#DEFINE c_20mnxflds 22
#DEFINE c_authorlen 45
#DEFINE c_complen 45
#DEFINE c_addrlen 45
#DEFINE c_citylen 20
#DEFINE c_statlen 5
#DEFINE c_ziplen 10
#DEFINE c_countrylen 40
#DEFINE c_error_1 "Minor"
#DEFINE c_error_2 "Serious"
#DEFINE c_error_3 "Fatal"
IF _MAC
m.g_dlgface = "Geneva"
m.g_dlgsize = 10.000
m.g_dlgstyle = ""
ELSE
m.g_dlgface = "MS Sans Serif"
m.g_dlgsize = 8.000
m.g_dlgstyle = "B"
ENDIF
#DEFINE c_replace 0
#DEFINE c_append 1
#DEFINE c_before 2
#DEFINE c_after 3
#DEFINE c_pathsep "\"
*
* Declare Variables
*
STORE "" TO m.cursor, m.consol, m.bell, m.onerror, ;
m.exact, m.print, m.fixed, m.delimiters, m.mpoint, m.mcollate,m.mmacdesk
STORE 0 TO m.deci, m.memowidth
m.g_error = .F.
m.g_errlog = ""
m.g_homedir = ""
m.g_location = 0
m.g_menucolor = 0
m.g_menumark = ""
m.g_nohandle = .T.
m.g_nsnippets = 0
m.g_outfile = ""
m.g_padloca = ""
m.g_projalias = ""
m.g_projdbf = m.projdbf
m.g_projpath = ""
m.g_status = 0
m.g_snippcnt = 0
m.g_thermwidth = 0
m.g_workarea = 0
m.g_graphic = .F.
m.g_20mnx = .F.
m.g_devauthor = PADR("Author's Name",45," ")
m.g_devcompany = PADR("Company Name",45, " ")
m.g_devaddress = PADR("Address",45," ")
m.g_devcity = PADR("City",20," ")
m.g_devstate = " "
m.g_devzip = PADR("Zip",10," ")
m.g_devctry = PADR("Country",40," ")
m.g_boxstrg = ['Ä','Ä','³','³','Ú','¿','À','Ù','Ä','Ä','³','³','Ú','¿','À','Ù']
STORE "" TO m.g_corn1, m.g_corn2, m.g_corn3, m.g_corn4, m.g_corn5, ;
m.g_corn6, m.g_verti2
STORE "*" TO m.g_horiz, m.g_verti1
*
* Array Declarations
*
* g_mnxfile [1] - Normalized path + name
* g_mnxfile [2] - Basename
* g_mnxfile [3] - Opened originally?
* g_mnxfile [4] - Alias
*
DIMENSION g_mnxfile[4]
g_mnxfile[1] = ""
g_mnxfile[2] = ""
g_mnxfile[3] = .F.
g_mnxfile[4] = ""
*
* g_pads - names of generated menu pads
*
DIMENSION g_pads(c_maxpads)
*
* g_snippets [*,1] - generated snippet procedure name
* g_snippets [*,2] - recno()
*
DIMENSION g_snippets (c_maxsnippets,2)
g_snippets = ""
IF AT("WINDOWS", UPPER(VERSION())) <> 0 OR ;
AT("MAC", UPPER(VERSION())) <> 0
m.g_graphic = .T.
ELSE
m.g_graphic = .F.
ENDIF
*
* Main program
*
m.onerror = ON("ERROR")
ON ERROR DO errorhandler WITH MESSAGE(), LINENO(), c_error_3
IF PARAMETERS()=2
DO setup
IF validparams()
ON ESCAPE DO eschandler
SET ESCAPE ON
DO refreshprefs
DO BUILD
ENDIF
DO cleanup
ELSE
DO errorhandler WITH "Invalid number of parameters passed to"+;
" the generator",LINENO(),c_error_3
ENDIF
ON ERROR &onerror
RETURN m.g_status
**
** Setup, Cleanup, Validparams, and Refreshprefs of Main Program
**
*
* STARTUP - Create program's environment.
*
* Description:
* Save the user's environment so that we can set it back when
* we are done, then issue various SET commands. The only state
* we cannot conveniently save is SET TALK, because storing the
* state involves an assignment statement, and assignments
* generate unwanted output if TALK is set ON.
*
* Side Effects:
* Creates a temporary file which is deleted in the Cleanup
* procedure executed at the end of MENUGEN.
*
PROCEDURE setup
CLEAR PROGRAM
CLEAR GETS
m.g_workarea = SELECT()
m.delimiters = SET('TEXTMERGE',1)
SET TEXTMERGE DELIMITERS TO
SET UDFPARMS TO VALUE
m.bell = SET("BELL")
SET BELL OFF
m.consol = SET("CONSOLE")
SET CONSOLE OFF
m.cursor = SET("CURSOR")
SET CURSOR OFF
m.deci = SET("DECIMALS")
SET DECIMALS TO 0
mdevice = SET("DEVICE")
SET DEVICE TO SCREEN
m.memowidth = SET("MEMOWIDTH")
SET MEMOWIDTH TO 256
m.exact = SET("EXACT")
SET EXACT ON
m.print = SET("PRINT")
SET PRINT OFF
m.fixed = SET("FIXED")
SET FIXED ON
mpoint = SET("POINT")
SET POINT TO "."
mcollate = SET("COLLATE")
SET COLLATE TO "machine"
#if "MAC" $ UPPER(VERSION(1))
IF _MAC
m.mmacdesk = SET("MACDESKTOP")
SET MACDESKTOP ON
ENDIF
#endif
*
* CLEANUP - restore environment to pre-execution state.
*
* Description:
* Close all databases opened in the course of the execution of MENUGEN.
* Restore the environment to the pre-execution of MENUGEN. Delete
* the VIEW file since there is no further use for it.
*
* Side Effects:
* Closes databases.
* Deletes the temporary view file.
*
PROCEDURE cleanup
PRIVATE m.delilen, m.ldelimi, m.rdelimi
IF EMPTY(m.g_projalias)
RETURN
ENDIF
SELECT (m.g_projalias)
USE
IF NOT EMPTY(g_mnxfile[3])
IF USED(g_mnxfile[4])
SELECT (g_mnxfile[4])
USE
ENDIF
ENDIF
SELECT (m.g_workarea)
m.delilen = LEN(m.delimiters)
m.ldelimi = SUBSTR(m.delimiters,1,;
IIF(MOD(m.delilen,2)=0,m.delilen/2,CEILING(m.delilen/2)))
m.rdelimi = SUBSTR(m.delimiters,;
IIF(MOD(m.delilen,2)=0,m.delilen/2+1,CEILING(m.delilen/2)+1))
SET TEXTMERGE DELIMITERS TO m.ldelimi, m.rdelimi
IF m.bell = "ON"
SET BELL ON
ENDIF
IF m.cursor = "ON"
SET CURSOR ON
ELSE
SET CURSOR OFF
ENDIF
IF m.consol = "ON"
SET CONSOLE ON
ENDIF
IF m.escape = "ON"
SET ESCAPE ON
ELSE
SET ESCAPE OFF
ENDIF
IF m.print = "ON"
SET PRINT ON
ENDIF
IF m.exact = "OFF"
SET EXACT OFF
ENDIF
IF m.fixed = "OFF"
SET FIXED OFF
ENDIF
SET DECIMALS TO m.deci
SET MEMOWIDTH TO m.memowidth
SET DEVICE TO &mdevice
IF m.trbetween = "ON"
SET TRBET ON
ENDIF
IF m.comp = "ON"
SET COMPATIBLE ON
ENDIF
IF m.talkstate = "ON"
SET TALK ON
ENDIF
SET POINT TO "&mpoint"
SET COLLATE TO "&mcollate"
SET MESSAGE TO
#if "MAC" $ UPPER(VERSION(1))
IF _MAC
SET MACDESKTOP &mmacdesk
ENDIF
#endif
ON ERROR &onerror
*
* VALIDPARAMS - Validate generator parameters.
*
* Description:
* Attempt to open the project database. If error encountered then
* on error routine takes over and issues 'CANCEL'. The output file
* cannot be erased, name not known.
*
FUNCTION validparams
SELECT 0
m.g_projalias = IIF(USED("projdbf"),"P"+;
SUBSTR(LOWER(SYS(3)),2,8),"projdbf")
USE (m.projdbf) ALIAS (m.g_projalias)
IF versnum() > "2.5"
SET NOCPTRANS TO devinfo, arranged, symbols, object
ENDIF
m.g_errlog = stripext(m.projdbf)
m.g_projpath = SUBSTR(m.projdbf,1,RAT("\",m.projdbf))
IF FCOUNT() <> c_pjxflds
DO errorhandler WITH "Generator out of date.",;
LINENO(), c_error_2
RETURN .F.
ENDIF
GOTO RECORD m.recno
m.g_outfile = ALLTRIM(SUBSTR(outfile,1,AT(c_null,outfile)-1))
m.g_outfile = FULLPATH(m.g_outfile, m.g_projpath)
IF _MAC AND RIGHT(m.g_outfile,1) = ":"
m.g_outfile = m.g_outfile + justfname(SUBSTR(outfile,1,AT(c_null,outfile)-1))
ENDIF
g_mnxfile[1] = FULLPATH(ALLTRIM(name), m.g_projpath)
IF _MAC AND RIGHT(g_mnxfile[1],1) = ":"
g_mnxfile[1] = g_mnxfile[1] + justfname(name)
ENDIF
g_mnxfile[2] = basename(g_mnxfile[1])
*
* REFRESHPREFS - Refresh comment style and developer preferences.
*
* Description:
* Get the newest preferences for documentation style and developer
* data from the project database.
*
PROCEDURE refreshprefs
PRIVATE m.start, m.savrecno
m.savrecno = RECNO()
LOCATE FOR TYPE = "H"
IF NOT FOUND ()
DO errorhandler WITH "Missing header record in "+m.g_projdbf,;
LINENO(), c_error_2
GOTO RECORD m.savrecno
RETURN
ENDIF
m.g_homedir = ALLTRIM(SUBSTR(homedir,1,AT(c_null,homedir)-1))
m.start = 1
m.g_devauthor = subdevinfo(m.start,c_authorlen,m.g_devauthor)
m.start = m.start + c_authorlen + 1
m.g_devcompany = subdevinfo(m.start,c_complen,m.g_devcompany)
m.start = m.start + c_complen + 1
m.g_devaddress = subdevinfo(m.start,c_addrlen,m.g_devaddress)
m.start = m.start + c_addrlen + 1
m.g_devcity = subdevinfo(m.start,c_citylen,m.g_devcity)
m.start = m.start + c_citylen + 1
m.g_devstate = subdevinfo(m.start,c_statlen,m.g_devstate)
m.start = m.start + c_statlen + 1
m.g_devzip = subdevinfo(m.start,c_ziplen,m.g_devzip)
m.start = m.start + c_ziplen + 1
m.g_devctry = subdevinfo(m.start,c_countrylen,m.g_devctry)
IF cmntstyle = 0
m.g_corn1 = "Ö"
m.g_corn2 = "·"
m.g_corn3 = "Ó"
m.g_corn4 = "½"
m.g_corn5 = "Ç"
m.g_corn6 = "¶"
m.g_horiz = "Ä"
m.g_verti1 = "º"
m.g_verti2 = "º"
ENDIF
GOTO RECORD m.savrecno
*
* SUBDEVINFO - Substring the DEVINFO memo filed.
*
FUNCTION subdevinfo
PARAMETER m.start, m.stop, m.default
PRIVATE m.string
m.string = SUBSTR(devinfo, m.start, m.stop+1)
m.string = SUBSTR(m.string, 1, AT(c_null,m.string)-1)
RETURN IIF(EMPTY(m.string), m.default, m.string)
**
** Menu Code Generator's Main Module.
**
*
* BUILD - Generate code for a menu.
*
* Description:
* Call BUILDENABLE to open .MNX database specified by the user.
* If the above is successfully accomplished, then proceed to generate
* the menu code. After the menu code is generated, call BUILDDISABLE
* to disable code generation between SET TEXTMERGE ON and
* SET TEXTMERGE OFF.
*
PROCEDURE BUILD
IF NOT buildenable()
RETURN
ENDIF
DO acttherm WITH "Generating Menu Code..."
DO updtherm WITH 10
DO HEADER
DO gensetupcleanup WITH "setup"
DO definemenu
DO definepopups
DO updtherm WITH 75
DO globaldefaults
DO updtherm WITH 95
DO gensetupcleanup WITH "cleanup"
DO genprocedures
IF m.g_graphic
SET MESSAGE TO 'Generation Complete'
ENDIF
DO builddisable
DO updtherm WITH 100
DO deactthermo
*
* BUILDENABLE - Enable code generation.
*
* Description:
* Call opendb to open .MNX database.
* Call openfile to open file to hold the generated program.
* If error(s) encountered in opendb or openfile then don't do
* anything and exit, otherwise enable code generation with the
* SET TEXTMERGE ON command.
*
* Returns:
* .T. on success; .F. on failure
*
FUNCTION buildenable
PRIVATE m.stat
m.stat = opendb(g_mnxfile[1]) AND openfile()
IF m.stat
SET TEXTMERGE ON
ENDIF
RETURN m.stat
*
* BUILDDISABLE - Disable code generation.
*
* Description:
* Issue the command SET TEXTMERGE OFF.
* Close the generated menu code output file.
* If anything goes wrong display appropriate message to the user.
*
PROCEDURE builddisable
SET ESCAPE OFF
ON ESCAPE
SET TEXTMERGE OFF
IF NOT FCLOSE(_TEXT)
DO errorhandler WITH "Unable to Close the Application File",;
LINENO(), c_error_2
ENDIF
*
* OPENDB - Prepare database for processing.
*
* Description:
* Attempt to USE a database. If attempt fails and error is reported
* call ERRORHANDLER routine to display a friendly message. Return
* with a status of .F.. If attempt succeeds, return with status of .T.
*
* Returns:
* .T. on success; .F. on failure
*
FUNCTION opendb
PARAMETER m.dbname
PRIVATE m.dbalias
ON ERROR DO errorhandler WITH MESSAGE(), LINENO(), c_error_2
m.dbalias = LEFT(basename(m.dbname),c_aliaslen)
IF USED (m.dbalias)
SELECT (m.dbalias)
IF RAT(".MNX",DBF())<>0
g_mnxfile[3] = .F.
g_mnxfile[4] = m.dbalias
ELSE
g_mnxfile[4] = "M"+SUBSTR(LOWER(SYS(3)),2,8)
SELECT 0
USE (m.dbname) AGAIN ALIAS (g_mnxfile[4])
g_mnxfile[3] = .T.
ENDIF
ELSE
IF illegalname(m.dbalias)
g_mnxfile[4] = "M"+SUBSTR(LOWER(SYS(3)),2,8)
ELSE
g_mnxfile[4] = m.dbalias
ENDIF
SELECT 0
USE (m.dbname) AGAIN ALIAS (g_mnxfile[4])
g_mnxfile[3] = .T.
ENDIF
IF FCOUNT() <> c_mnxflds
IF FCOUNT() = c_20mnxflds
m.g_20mnx = .T.
ELSE
DO errorhandler WITH "Menu "+m.dbalias+" is invalid",LINENO(),;
c_error_2
RETURN .F.
ENDIF
ELSE
m.g_20mnx = .F.
ENDIF
ON ERROR DO errorhandler WITH MESSAGE(), LINENO(), c_error_3
IF m.g_error = .T.
RETURN .F.
ENDIF
*
* ILLEGALNAME - Check if default alias will be used when this
* database is USEd. (i.e., 1st letter is not A-Z,
* a-z or '_', or any one of ramaining letters is not
* alphanumeric.)
*
FUNCTION illegalname
PARAMETER m.menuname
PRIVATE m.start, m.aschar, m.length
m.length = LEN(m.menuname)
m.start = 0
IF m.length = 1
*
* If length 1, then check if default alias can be used,
* i.e., name is different than A-J and a-j.
*
m.aschar = ASC(m.menuname)
IF (m.aschar >= 65 AND m.aschar <= 74) OR ;
(m.aschar >= 97 AND m.aschar <= 106)
RETURN .T.
ENDIF
ENDIF
DO WHILE m.start < m.length
m.start = m.start + 1
m.aschar = ASC(SUBSTR(m.menuname, m.start, 1))
IF m.start<>1 AND (m.aschar >= 48 AND m.aschar <= 57)
LOOP
ENDIF
IF NOT ((m.aschar >= 65 AND m.aschar <= 90) OR ;
(m.aschar >= 97 AND m.aschar <= 122) OR m.aschar = 95)
RETURN .T.
ENDIF
ENDDO
RETURN .F.
*
* OPENFILE - Create and open the application output file.
*
* Description:
* Create a file that will hold the generated menu code.
* Open the newly created file. If error(s) encountered
* at any time issue an error message and return .F.
*
* Returns:
* .T. on success; .F. on failure
*
FUNCTION openfile
PRIVATE m.msg
_TEXT = FCREATE(m.g_outfile)
IF (_TEXT = -1)
m.msg = "Cannot open file "+m.g_outfile
DO errorhandler WITH m.msg, LINENO(), c_error_3
m.g_nohandle = .T.
RETURN .F.
ENDIF
m.g_nohandle = .F.
*
* DEFINEMENU - Define main menu and its pads.
*
* Description:
* Issue DEFINE MENU ... command.
* Call a procedure to define all menu pads.
* Call a procedure to generate ON PAD statements when appropriate.
*
PROCEDURE definemenu
IF m.g_graphic
SET MESSAGE TO 'Generating menu definitions...'
ENDIF
DO commentblock WITH "menu"
SELECT (g_mnxfile[4])
LOCATE FOR objtype = c_menu
m.g_location = location
m.g_padloca = ALLTRIM(name)
LOCATE FOR objtype = c_submenu AND objcode = c_global
m.g_menucolor = SCHEME
m.g_menumark = MARK
IF m.g_location = c_replace
\SET SYSMENU TO
\
ENDIF
\SET SYSMENU AUTOMATIC
\
DO updtherm WITH 25
DO defmenupads
DO updtherm WITH 35
DO defonpad
\
DO updtherm WITH 45
*
* DEFMENUPADS - Define all pads for the menu bar.
*
* Description:
* Scan the menu database for all objects of the type item which
* have the levelname=_MSYSMENU.
* For each such item, generate a statement DEFINE PAD... where
* the name of the pad is the contents of NAME field or (if Name
* field is empty) an automatically generated name.
* Call procedures addkey, addskipfor, and mark to generate
* KEY, SKIPFOR, or MARK clauses when appropriate.
*
PROCEDURE defmenupads
PRIVATE m.padname, m.prompt
SCAN FOR objtype=c_item AND UPPER(levelname)="_MSYSMENU"
IF NOT EMPTY(ALLTRIM(name))
g_pads[VAL(Itemnum)] = name
ELSE
g_pads[VAL(Itemnum)] = LOWER(SYS(2015))
ENDIF
\DEFINE PAD <<g_pads[VAL(Itemnum)]>> OF _MSYSMENU
IF MOD(VAL(itemnum),25)=0
DIMENSION g_pads[VAL(Itemnum)+25]
ENDIF
m.prompt = SUBSTR(PROMPT,1,LEN(PROMPT))
\\ PROMPT "<<m.prompt>>"
\\ COLOR SCHEME <<m.g_menucolor>>
IF m.g_menumark<>c_null AND m.g_menumark<>""
\\ ;
\ MARK "<<m.g_menumark>>"
ENDIF
DO CASE
CASE m.g_location = c_before
\\ ;
\ BEFORE <<m.g_padloca>>
CASE m.g_location = c_after
\\ ;
\ AFTER
IF VAL(itemnum) = 1
\\ <<m.g_padloca>>
ELSE
\\ <<g_pads[VAL(Itemnum)-1]>>
ENDIF
ENDCASE
DO addkey
DO addskipfor
DO addmessage
ENDSCAN
*
* DEFONPAD - Generate ON PAD... statements.
*
* Description:
* Generate ON PAD statements for each pad off of the main menu which
* has a submenu associated with it.
* For pads which have no submenus, but there is a command associated
* with them, issue ON SELECTION PAD... statements. If the code
* associated with a pad is a snippet, then issue a call to the
* generated procedure and place the snippet code in it.
*
PROCEDURE defonpad
PRIVATE m.padname
SCAN FOR objtype=c_item AND UPPER(levelname)="_MSYSMENU"
IF NOT EMPTY(ALLTRIM(name))
m.padname = name
ELSE
m.padname = g_pads[VAL(Itemnum)]
ENDIF
m.therec = RECNO()
SKIP
IF objtype=c_submenu AND numitems<>0
\ON PAD <<m.padname>> OF _MSYSMENU
\\ ACTIVATE POPUP <<LOWER(Name)>>
GOTO m.therec
ELSE
GOTO m.therec
DO onselection WITH "pad", m.padname, '_MSYSMENU'
ENDIF
ENDSCAN
*
* DEFINEPOPUPS - Define popups and their bars.
*
* Description:
* Scan the Menu database to find all objecttypes = submenu.
* They all correspond to popups. For each such object found, issue
* command DEFINE POPUP.... Add MARK, KEY, and SKIP FOR clauses
* if appropriate by calling procedures to handle these tasks. Call
* procedure Defbars to define all bars of each popup.
*
PROCEDURE definepopups
PRIVATE m.savrecno, m.popname, m.sch
IF m.g_graphic
SET MESSAGE TO 'Generating popup definitions...'
ENDIF
SCAN FOR objtype=c_submenu AND UPPER(levelname)<>"_MSYSMENU" ;
AND numitems <> 0
m.savrecno = RECNO()
m.popname = ALLTRIM(LOWER(levelname))
m.sch = SCHEME
\DEFINE POPUP <<LOWER(Name)>> MARGIN RELATIVE SHADOW
\\ COLOR SCHEME <<m.sch>>
DO addmark
DO addkey
DO defbars WITH m.popname, numitems
DO defonbar WITH m.popname
\
GOTO RECORD m.savrecno
ENDSCAN
*
* DEFBARS - Define bars for each popup.
*
* Description:
* Scan the menu database for all objects of the type item whose
* name equals to the current popup name.
* For each such item, generate a statement DEFINE BAR....
* Call procedures addkey, addskipfor, and addmark to generate
* KEY, SKIPFOR, or MARK clauses when appropriate.
*
PROCEDURE defbars
PARAMETER m.popname, m.howmany, m.name
PRIVATE m.itemno, m.prompt
SCAN FOR objtype=c_item AND LOWER(levelname)=m.popname
m.itemno = ALLTRIM(itemnum)
IF NOT EMPTY(ALLTRIM(name))
m.name = name
\DEFINE BAR <<m.name>> OF <<LOWER(m.popname)>>
ELSE
\DEFINE BAR <<m.itemno>> OF <<LOWER(m.popname)>>
ENDIF
m.prompt = SUBSTR(PROMPT, 1,LEN(PROMPT))
\\ PROMPT "<<m.prompt>>"
DO addmark
DO addkey
DO addskipfor
DO addmessage
IF VAL(m.itemno)=m.howmany
RETURN
ENDIF
ENDSCAN
*
* DEFONBAR - Generate ON BAR... statements.
*
* Description:
* Generate ON BAR statements for each popup.
* For bars which have no submenus, but there is a command associated
* with them, issue ON SELECTION BAR... statements. If a snippet is
* associated with the code then generate a call statement to the
* generated procedure containing the snippet code.
*
PROCEDURE defonbar
PARAMETER m.popname
PRIVATE m.itemno
SCAN FOR objtype=c_item AND LOWER(levelname)=m.popname
IF EMPTY(ALLTRIM(name))
m.itemno = ALLTRIM(itemnum)
ELSE
m.itemno = name
ENDIF
SKIP
IF objtype=c_submenu AND numitems<>0
\ON BAR <<m.itemno>> OF <<LOWER(m.popname)>>
\\ ACTIVATE POPUP <<LOWER(Name)>>
SKIP -1
ELSE
SKIP -1
DO onselection WITH "BAR", m.itemno, m.popname
ENDIF
ENDSCAN
*
* GLOBALDEFAULTS - Generate global default statements
*
* Description:
* Search the menu database for information needed to generate any of
* the following commands:
* ON SELECTION MENU <name> DO <action>
* ON SELECTION POPUP ALL DO <action>
* ON SELECTION POPUP <name> DO <action>
* It is possible that none of the above mentioned statements will be
* generated. It is also possible that the action is a snippet of
* code and a call to the generated procedure containing the snippet
* will be generated.
*
* First try to generate ON SELECTION MENU...
* Then try to generate ON POPUP ALL...
* Lastly, try to generate ON SELECTION POPUP...
*
PROCEDURE globaldefaults
LOCATE FOR objtype = c_menu
m.mrk = MARK
IF FOUND() AND MARK <> ""
IF MARK = c_null
\SET MARK OF MENU _MSYSMENU TO " "
ELSE
\SET MARK OF MENU _MSYSMENU TO "<<Mark>>"
ENDIF
ENDIF
IF FOUND() AND NOT EMPTY(PROCEDURE)
\ON SELECTION MENU _MSYSMENU
DO genproccall
ENDIF
LOCATE FOR objtype = c_submenu AND objcode = c_global
IF FOUND() AND NOT EMPTY(PROCEDURE)
\ON SELECTION POPUP ALL
DO genproccall
ENDIF
SCAN FOR (objtype=c_submenu AND UPPER(levelname)<>"_MSYSMENU";
AND NOT EMPTY(PROCEDURE))
\ON SELECTION POPUP <<ALLTRIM(LOWER(Levelname))>>
DO genproccall
ENDSCAN
**
** Subroutines for processing menu clause options.
**
*
* ADDMARK - Generate a MARK clause whenever appropriate.
*
* Description:
* Add a MARK clause to the current PAD or BAR definition.
* If a field named Mark is not empty, then add the continuation
* character, ";", to the previous line, and then add the MARK... clause.
*
PROCEDURE addmark
IF MARK<>c_null AND MARK<>""
\\ ;
\ MARK "<<Mark>>"
ENDIF
*
* ADDKEY - Generate KEY... clause whenever appropriate.
*
* Description:
* Add a KEY clause to the current PAD or BAR definition.
* If a field named Keyname is not empty, then add the continuation
* character, ";", to the previous line, and then add the KEY... clause.
*
PROCEDURE addkey
IF NOT EMPTY(keyname)
\\ ;
\ KEY <<Keyname>>, "<<Keylabel>>"
ENDIF
*
* ADDSKIPFOR - Generate SKIP FOR... clause whenever appropriate.
*
* Description:
* Add a ADDSKIPFOR clause to the current PAD or BAR definition.
* If a field named Addskipfor is not empty, then add the continuation
* character, ";", to the previous line, and then add the SKIP FOR...
* clause.
*
PROCEDURE addskipfor
PRIVATE m.skip
m.skip = skipfor
IF NOT EMPTY(skipfor)
\\ ;
\ SKIP FOR <<m.skip>>
ENDIF
*
* ADDMESSAGE - Generate MESSAGE clause whenever appropriate.
*
* Description:
* Add a MESSAGE clause to the current PAD or BAR definition.
* If a field named MESSAGE is not empty and it is not a 2.0 menu,
* then add the continuation character, ";", to the previous line,
* and then add the MESSAGE clause.
*
PROCEDURE addmessage
IF !m.g_20mnx AND NOT EMPTY(MESSAGE)
\\ ;
\ MESSAGE <<Message>>
ENDIF
*
* HEADER - Generate generated program's header.
*
* Description:
* As a part of the automatically generated program's header generate
* program name, name of the author of the program, copyright notice,
* company name and address, and the word 'Description:' which will be
* followed with a short description of the generated code.
*
PROCEDURE HEADER
\\* <<m.g_corn1>><<REPLICATE(m.g_horiz,57)>><<m.g_corn2>>
\* <<m.g_verti1>><<REPLICATE(" ",57)>><<m.g_verti2>>
\* <<m.g_verti1>> <<DATE()>>
\\<<PADC(UPPER(ALLTRIM(strippath(m.g_outfile))),IIF(SET("CENTURY")="ON",35,37))," ")>>
\\ <<TIME()>> <<m.g_verti2>>
\* <<m.g_verti1>><<REPLICATE(" ",57)>><<m.g_verti2>>
\* <<m.g_corn5>><<REPLICATE(m.g_horiz,57)>><<m.g_corn6>>
\* <<m.g_verti1>><<REPLICATE(" ",57)>><<m.g_verti2>>
\* <<m.g_verti1>> <<m.g_devauthor>>
\\<<REPLICATE(" ",56-LEN(m.g_devauthor))>><<m.g_verti2>>
\* <<m.g_verti1>><<REPLICATE(" ",57)>><<m.g_verti2>>
\* <<m.g_verti1>>
\\ Copyright (c) <<YEAR(DATE())>>
IF LEN(ALLTRIM(m.g_devcompany)) <= 36
\\ <<ALLTRIM(m.g_devcompany)>>
\\<<REPLICATE(" ",37-LEN(ALLTRIM(m.g_devcompany)))>>
\\<<m.g_verti2>>
ELSE
\\ <<REPLICATE(" ",37)>><<m.g_verti2>>
\* <<m.g_verti1>> <<m.g_devcompany>>
\\<<REPLICATE(" ",56-LEN(m.g_devcompany))>><<m.g_verti2>>
ENDIF
\* <<m.g_verti1>> <<m.g_devaddress>>
\\<<REPLICATE(" ",56-LEN(m.g_devaddress))>><<m.g_verti2>>
\* <<m.g_verti1>> <<ALLTRIM(m.g_devcity)>>, <<m.g_devstate>>
\\ <<ALLTRIM(m.g_devzip)>>
\\<<REPLICATE(" ",50-(LEN(ALLTRIM(m.g_devcity)+ALLTRIM(m.g_devzip))))>>
\\<<m.g_verti2>>
IF !INLIST(ALLTRIM(UPPER(m.g_devctry)),"USA","COUNTRY") AND !EMPTY(m.g_devctry)
\* <<m.g_verti1>> <<ALLTRIM(m.g_devctry)>>
\\<<REPLICATE(" ",50-(LEN(ALLTRIM(m.g_devctry))))>>
\\<<m.g_verti2>>
ENDIF
\* <<m.g_verti1>><<REPLICATE(" ",57)>><<m.g_verti2>>
\* <<m.g_verti1>> Description:
\\ <<m.g_verti2>>
\* <<m.g_verti1>>
\\ This program was automatically generated by GENMENU.
\\ <<m.g_verti2>>
\* <<m.g_verti1>><<REPLICATE(" ",57)>><<m.g_verti2>>
\* <<m.g_corn3>><<REPLICATE(m.g_horiz,57)>><<m.g_corn4>>
\
*
* GENFUNCHEADER - Generate Comment for Function/Procedure.
*
PROCEDURE genfuncheader
PARAMETER m.procname
PRIVATE m.place, m.prompt
m.g_snippcnt = m.g_snippcnt + 1
DO CASE
CASE objtype = c_menu
m.place = "ON SELECTION MENU _MSYSMENU"
CASE objtype = c_submenu AND objcode = c_global
m.place = "ON SELECTION POPUP ALL"
CASE objtype = c_submenu AND objcode <> c_global
m.place = "ON SELECTION POPUP "+LOWER(ALLTRIM(name))
CASE objtype = c_item AND UPPER(levelname) = "_MSYSMENU"
m.place = "ON SELECTION PAD "
CASE objtype = c_item AND UPPER(levelname) <> "_MSYSMENU"
m.place = "ON SELECTION BAR "+ALLTRIM(itemnum)+;
+" OF POPUP "+LOWER(ALLTRIM(levelname))
OTHERWISE
m.place = ""
ENDCASE
\
\* <<m.g_corn1>><<REPLICATE(m.g_horiz,57)>><<m.g_corn2>>
\* <<m.g_verti1>><<REPLICATE(" ",57)>><<m.g_verti2>>
\* <<m.g_verti1>> <<UPPER(PADR(m.procname,10))>> <<m.place>>
\\<<REPLICATE(" ",44-LEN(m.place))>><<m.g_verti2>>
\* <<m.g_verti1>><<REPLICATE(" ",57)>><<m.g_verti2>>
\* <<m.g_verti1>> Procedure Origin:
\\<<REPLICATE(" ",39)>><<m.g_verti2>>
\* <<m.g_verti1>><<REPLICATE(" ",57)>><<m.g_verti2>>
\* <<m.g_verti1>> From Menu:
\\ <<ALLTRIM(strippath(m.g_outfile))>>
\\, Record: <<STR(RECNO(),3)>>
\\<<REPLICATE(" ",22-LEN(ALLTRIM(strippath(m.g_outfile))+STR(RECNO(),3))))>>
\\<<m.g_verti2>>
\* <<m.g_verti1>> Called By: <<m.place>>
\\<<REPLICATE(" ",44-LEN(m.place))>><<m.g_verti2>>
IF NOT EMPTY(PROMPT)
m.prompt = removemeta()
\* <<m.g_verti1>> Prompt: <<ALLTRIM(m.prompt)>>
\\<<REPLICATE(" ",44-LEN(ALLTRIM(m.prompt)))>><<m.g_verti2>>
ENDIF
\* <<m.g_verti1>> Snippet:
\\ <<ALLTRIM(STR(m.g_snippcnt,2))>>
\\<<REPLICATE(" ",44-LEN(ALLTRIM(STR(m.g_snippcnt,2))))>><<m.g_verti2>>
\* <<m.g_verti1>><<REPLICATE(" ",57)>><<m.g_verti2>>
\* <<m.g_corn3>><<REPLICATE(m.g_horiz,57)>><<m.g_corn4>>
\*
*
* REMOVEMETA - Remove meta characters for documentation.
*
FUNCTION removemeta
PRIVATE m.prompt, m.hotkey
m.prompt = PROMPT
m.hotkey = AT("\<",m.prompt)
IF m.hotkey <> 0
m.prompt = STUFF(m.prompt,m.hotkey,2,"")
ENDIF
m.disabl = AT("\",m.prompt)
IF m.disabl <> 0
m.prompt = STUFF(m.prompt,m.disabl,1,"")
ENDIF
RETURN m.prompt
*
* COMMENTBLOCK - Generate a comment block.
*
PROCEDURE commentblock
PARAMETER m.snippet
\
\* <<m.g_corn1>><<REPLICATE(m.g_horiz,57)>><<m.g_corn2>>
\* <<m.g_verti1>><<REPLICATE(" ",57)>><<m.g_verti2>>
DO CASE
CASE m.snippet == "setup"
\* <<m.g_verti1>>
\\ <<PADC(" Setup Code",56," ")>>
CASE m.snippet == "cleanup"
\* <<m.g_verti1>>
\\ <<PADC(" Cleanup Code & Procedures",56," ")>>
CASE m.snippet == "init"
\* <<m.g_verti1>>
\\ <<PADC(" Initializing Code",56," ")>>
CASE m.snippet == "menu"
\* <<m.g_verti1>>
\\ <<PADC(" Menu Definition",56," ")>>
ENDCASE
\\<<m.g_verti2>>
\* <<m.g_verti1>><<REPLICATE(" ",57)>><<m.g_verti2>>
\* <<m.g_corn3>><<REPLICATE(m.g_horiz,57)>><<m.g_corn4>>
\*
\
**
** Supporting routines
**
*
* ONSELECTION - Generate ON SELECTION... statements for menu items.
*
* Description:
* For pads and bars which have no submenu associated with them but
* instead have a non-empty Command field in the database, issue
* the ON SELECTION <command> statements. If a snippet is associated
* with a pad then issue a call statement to the generated procedure
* containing the snippet. Generated snippet procedure will be
* appended to the end of the output file.
*
PROCEDURE onselection
PARAMETER m.which, m.name, m.ofname, m.commd
PRIVATE m.trimname, m.basename
IF EMPTY(PROCEDURE) AND EMPTY(COMMAND)
RETURN
ENDIF
DO CASE
CASE m.which == "pad"
\ON SELECTION PAD <<m.name>>
CASE m.which == "BAR"
\ON SELECTION <<m.which+" "+m.name>>
ENDCASE
\\ OF <<m.ofname>>
IF objcode = c_proc
DO gensnippname
m.trimname = SYS(2014,UPPER(m.g_outfile),UPPER(m.g_homedir))
m.trimname = stripext(m.trimname)
m.basename = basename(m.trimname)
\\ ;
\ DO <<g_snippets[g_nsnippets,1]>> ;
\ IN LOCFILE("<<m.trimname>>"
\\ ,"MPX;MPR|FXP;PRG"
\\ ,"Where is <<m.basename>>?")
ELSE
m.commd = COMMAND
\\ <<m.commd>>
ENDIF
*
* GENSNIPPNAME - Generate a unique name for snippet procedure.
*
* Description:
* Lookup the #NAME name of this snippet, or alternatively
* provide a unique name for a snippet of code associated with the
* generated menu. Save this name in an array g_snippets.
*
PROCEDURE gensnippname
g_nsnippets = g_nsnippets + 1
g_snippets[g_nsnippets,1] = getcname(procedure)
g_snippets[g_nsnippets,2] = RECNO()
IF MOD(g_nsnippets,25) = 0
DIMENSION g_snippets [g_nsnippets+25,2]
ENDIF
*
* GENPROCCALL - Generate a call statement to snippet procedure.
*
* Description:
* Generate a call to the snippet procedure in the menu definition
* code.
*
PROCEDURE genproccall
PRIVATE m.trimname, m.basename, m.proc
IF singleline()
m.proc = PROCEDURE
\\ <<MLINE(m.proc,1)>>
ELSE
DO gensnippname
m.trimname = SYS(2014,UPPER(m.g_outfile),UPPER(m.g_homedir))
m.trimname = stripext(m.trimname)
m.basename = basename(m.trimname)
\\ ;
\ DO <<g_snippets[m.g_nsnippets,1]>> ;
\ IN LOCFILE("<<m.trimname>>"
\\ ,"MPX;MPR|FXP;PRG"
\\ ,"Where is <<m.basename>>?")
ENDIF
*
* SINGLELINE - Determine if Memo contains only one line.
*
* Description:
* This procedure is used to decide if an ON SELECTION... statement
* and a snippet procedure will be needed (i.e., if more than one
* line of snippet code then its a snippet, otherwise its a command)
*
FUNCTION singleline
PRIVATE m.size, m.i
m.size = MEMLINES(PROCEDURE)
IF m.size = 1
RETURN .T.
ENDIF
m.i = m.size
DO WHILE m.i > 1
m.line = MLINE(PROCEDURE, m.i)
IF NOT EMPTY(m.line)
RETURN .F.
ENDIF
m.i = m.i - 1
ENDDO
*
* GENPROCEDURES - Generate procedure/snippet code.
*
* Description:
* Generate 'PROCEDURE procedurename' statement and its body.
*
PROCEDURE genprocedures
PRIVATE m.i
IF m.g_graphic
SET MESSAGE TO 'Generating procedures...'
ENDIF
FOR m.i = 1 TO m.g_nsnippets
GOTO RECORD (g_snippets[m.i,2])
DO genfuncheader WITH g_snippets[m.i,1]
\PROCEDURE <<g_snippets[m.i,1]>>
DO writecode WITH procedure
\
ENDFOR
*
* WRITECODE - Write contents of a memo to a low level file.
*
* Description:
* Receive a memo field as a parameter and write its contents out
* to the currently opened low level file whose handle is stored
* in the system memory variable _TEXT. Contents of the system
* memory variable _pretext will affect the positioning of the
* generated text.
*
PROCEDURE writecode
PARAMETER m.memo
PRIVATE m.lines, m.i, m.thisline
m.lines = MEMLINES(m.memo)
_MLINE = 0
FOR m.i = 1 TO m.lines
m.thisline = MLINE(m.memo, 1, _MLINE)
IF LEFT(UPPER(LTRIM(m.thisline)),5) == "#INSE" && #INSERT
DO GenInsertCode WITH m.thisline
ELSE
IF LEFT(UPPER(LTRIM(m.thisline)),5) <> "#NAME"
\<<m.thisline>>
ENDIF
ENDIF
ENDFOR
*
* GENSETUPCLEANUP - Generate setup/cleanup code.
*
PROCEDURE gensetupcleanup
PARAMETER m.choice
LOCATE FOR objtype = c_menu
DO CASE
CASE m.choice == "setup"
IF EMPTY(setup)
RETURN
ENDIF
IF m.g_graphic
SET MESSAGE TO 'Generating Menu Setup Code...'
ENDIF
DO commentblock WITH m.choice
DO writecode WITH setup
CASE m.choice == "cleanup"
IF EMPTY(cleanup)
RETURN
ENDIF
IF m.g_graphic
SET MESSAGE TO 'Generating Menu Cleanup Code...'
ENDIF
DO commentblock WITH m.choice
DO writecode WITH cleanup
ENDCASE
*
* STRIPEXT - Strip the extension from a file name.
*
* Description:
* Use the algorithm employed by FoxPRO itself to strip a
* file of an extension (if any): Find the rightmost dot in
* the filename. If this dot occurs to the right of a "\"
* or ":", then treat everything from the dot rightward
* as an extension. Of course, if we found no dot,
* we just hand back the filename unchanged.
*
* Parameters:
* filename - character string representing a file name
*
* Return value:
* The string "filename" with any extension removed
*
FUNCTION stripext
PARAMETER m.filename
PRIVATE m.dotpos, m.terminator
m.dotpos = RAT(".", m.filename)
m.terminator = MAX(RAT("\", m.filename), RAT(":", m.filename))
IF m.dotpos > m.terminator
m.filename = LEFT(m.filename, m.dotpos-1)
ENDIF
RETURN m.filename
*
* STRIPPATH - Strip the path from a file name.
*
* Description:
* Find positions of backslash in the name of the file. If there is one
* take everything to the right of its position and make it the new file
* name. If there is no slash look for colon. Again if found, take
* everything to the right of it as the new name. If neither slash
* nor colon are found then return the name unchanged.
*
* Parameters:
* filename - character string representing a file name
*
* Return value:
* The string "filename" with any path removed
*
FUNCTION strippath
PARAMETER m.filename
PRIVATE m.slashpos, m.namelen, m.colonpos
m.slashpos = RAT("\", m.filename)
IF m.slashpos > 0
m.namelen = LEN(m.filename) - m.slashpos
m.filename = RIGHT(m.filename, m.namelen)
ELSE
m.colonpos = RAT(":", m.filename)
IF m.colonpos > 0
m.namelen = LEN(m.filename) - m.colonpos
m.filename = RIGHT(m.filename, m.namelen)
ENDIF
ENDIF
RETURN m.filename
*
* BASENAME - returns strippath(stripext(filespec))
*
FUNCTION basename
PARAMETER m.filespec
RETURN strippath(stripext(m.filespec))
*
* GENINSERTCODE - Emit code from the #insert file, if any
*
PROCEDURE GenInsertCode
PARAMETER strg
PRIVATE m.word1, m.filname, m.ins_fp, m.buffer
IF UPPER(LEFT(LTRIM(m.strg),5)) == "#INSE"
m.word1 = wordnum(m.strg,1)
m.filname = SUBSTR(m.strg,LEN(m.word1)+1)
m.filname = ALLTRIM(CHRTRAN(m.filname,CHR(9),""))
* Bail out if we can't find the file either explicitly or on the DOS path
IF !FILE(m.filname)
filname = FULLPATH(m.filname,1)
IF !FILE(m.filname)
\*Insert file <<m.filname>> could not be found
RETURN
ENDIF
ENDIF
ins_fp = FOPEN(m.filname)
IF ins_fp > 0
\* Inserted from <<strippath(m.filname)>>
DO WHILE !feof(ins_fp)
m.buffer = fgets(ins_fp)
\<<m.buffer>>
ENDDO
=fclose(m.ins_fp)
\* End of inserted lines
ENDIF
ENDIF
*!*****************************************************************************
*!
*! Function: JUSTPATH
*!
*! Called by: FORCEEXT() (function in GENSCRN.PRG)
*!
*!*****************************************************************************
FUNCTION justpath
* Return just the path name from "filname"
PARAMETERS m.filname
PRIVATE ALL
m.filname = ALLTRIM(UPPER(m.filname))
IF '\' $ m.filname
m.filname = SUBSTR(m.filname,1,RAT('\',m.filname))
IF RIGHT(m.filname,1) = '\' AND LEN(m.filname) > 1 ;
AND SUBSTR(m.filname,LEN(m.filname)-1,1) <> ':'
filname = SUBSTR(m.filname,1,LEN(m.filname)-1)
ENDIF
RETURN m.filname
ELSE
RETURN ''
ENDIF
**
** Code Associated with the Thermometer
**
*
* ACTTHERM(<text>) - Activate thermometer.
*
* Description:
* Activates thermometer. Update the thermometer with UPDTHERM().
* Thermometer window is named "thermometer." Be sure to RELEASE
* this window when done with thermometer. Creates the global
* m.g_thermwidth.
*
PROCEDURE acttherm
PARAMETER m.text
PRIVATE m.prompt
IF m.g_graphic
m.prompt = m.g_outfile
m.prompt = thermfname(m.prompt)
DO CASE
CASE _WINDOWS
DEFINE WINDOW thermomete ;
AT INT((SROW() - (( 5.615 * ;
FONTMETRIC(1, m.g_dlgface, m.g_dlgsize, m.g_dlgstyle )) / ;
FONTMETRIC(1, WFONT(1,""), WFONT( 2,""), WFONT(3,"")))) / 2), ;
INT((SCOL() - (( 63.833 * ;
FONTMETRIC(6, m.g_dlgface, m.g_dlgsize, m.g_dlgstyle )) / ;
FONTMETRIC(6, WFONT(1,""), WFONT( 2,""), WFONT(3,"")))) / 2) ;
SIZE 5.615,63.833 ;
FONT m.g_dlgface, m.g_dlgsize ;
STYLE m.g_dlgstyle ;
NOFLOAT ;
NOCLOSE ;
NONE ;
COLOR RGB(0, 0, 0, 192, 192, 192)
MOVE WINDOW thermomete CENTER
ACTIVATE WINDOW thermomete NOSHOW
@ 0.5,3 SAY m.text FONT m.g_dlgface, m.g_dlgsize STYLE m.g_dlgstyle
@ 1.5,3 SAY m.prompt FONT m.g_dlgface, m.g_dlgsize STYLE m.g_dlgstyle
@ 0.000,0.000 TO 0.000,63.833 ;
COLOR RGB(255, 255, 255, 255, 255, 255)
@ 0.000,0.000 TO 5.615,0.000 ;
COLOR RGB(255, 255, 255, 255, 255, 255)
@ 0.385,0.667 TO 5.231,0.667 ;
COLOR RGB(128, 128, 128, 128, 128, 128)
@ 0.308,0.667 TO 0.308,63.167 ;
COLOR RGB(128, 128, 128, 128, 128, 128)
@ 0.385,63.000 TO 5.308,63.000 ;
COLOR RGB(255, 255, 255, 255, 255, 255)
@ 5.231,0.667 TO 5.231,63.167 ;
COLOR RGB(255, 255, 255, 255, 255, 255)
@ 5.538,0.000 TO 5.538,63.833 ;
COLOR RGB(128, 128, 128, 128, 128, 128)
@ 0.000,63.667 TO 5.615,63.667 ;
COLOR RGB(128, 128, 128, 128, 128, 128)
@ 3.000,3.333 TO 4.231,3.333 ;
COLOR RGB(128, 128, 128, 128, 128, 128)
@ 3.000,60.333 TO 4.308,60.333 ;
COLOR RGB(255, 255, 255, 255, 255, 255)
@ 3.000,3.333 TO 3.000,60.333 ;
COLOR RGB(128, 128, 128, 128, 128, 128)
@ 4.231,3.333 TO 4.231,60.333 ;
COLOR RGB(255, 255, 255, 255, 255, 255)
m.g_thermwidth = 56.269
CASE _MAC
DEFINE WINDOW thermomete ;
AT INT((SROW() - (( 5.62 * ;
FONTMETRIC(1, m.g_dlgface, m.g_dlgsize, m.g_dlgstyle )) / ;
FONTMETRIC(1, WFONT(1,""), WFONT( 2,""), WFONT(3,"")))) / 2), ;
INT((SCOL() - (( 63.83 * ;
FONTMETRIC(6, m.g_dlgface, m.g_dlgsize, m.g_dlgstyle )) / ;
FONTMETRIC(6, WFONT(1,""), WFONT( 2,""), WFONT(3,"")))) / 2) ;
SIZE 5.62,63.83 ;
FONT m.g_dlgface, m.g_dlgsize ;
STYLE m.g_dlgstyle ;
NOFLOAT ;
NOCLOSE ;
NONE ;
COLOR RGB(0, 0, 0, 192, 192, 192)
MOVE WINDOW thermomete CENTER
ACTIVATE WINDOW thermomete NOSHOW
@ 0.000,0.000 TO 5.62,63.83 PATTERN 1;
COLOR RGB(192, 192, 192, 192, 192, 192)
IF ISCOLOR()
@ 0.000,0.000 TO 5.62,63.83 PATTERN 1;
COLOR RGB(192, 192, 192, 192, 192, 192)
@ 0.000,0.000 TO 0.000,63.83 ;
COLOR RGB(255, 255, 255, 255, 255, 255)
@ 0.000,0.000 TO 5.62,0.000 ;
COLOR RGB(255, 255, 255, 255, 255, 255)
@ 0.385,0.67 TO 5.23,0.67 ;
COLOR RGB(128, 128, 128, 128, 128, 128)
@ 0.31,0.67 TO 0.31,63.17 ;
COLOR RGB(128, 128, 128, 128, 128, 128)
@ 0.385,63.000 TO 5.31,63.000 ;
COLOR RGB(255, 255, 255, 255, 255, 255)
@ 5.23,0.67 TO 5.23,63.17 ;
COLOR RGB(255, 255, 255, 255, 255, 255)
@ 5.54,0.000 TO 5.54,63.83 ;
COLOR RGB(128, 128, 128, 128, 128, 128)
@ 0.000,63.67 TO 5.62,63.67 ;
COLOR RGB(128, 128, 128, 128, 128, 128)
@ 3.000,3.33 TO 4.23,3.33 ;
COLOR RGB(128, 128, 128, 128, 128, 128)
@ 3.000,60.33 TO 4.31,60.33 ;
COLOR RGB(255, 255, 255, 255, 255, 255)
@ 3.000,3.33 TO 3.000,60.33 ;
COLOR RGB(128, 128, 128, 128, 128, 128)
@ 4.23,3.33 TO 4.23,60.33 ;
COLOR RGB(255, 255, 255, 255, 255, 255)
ELSE
@ 0.000, 0.000 TO 5.62, 63.830 PEN 2
@ 0.230, 0.500 TO 5.39, 63.333 PEN 1
ENDIF
@ 0.5,3 SAY m.text FONT m.g_dlgface, m.g_dlgsize STYLE m.g_dlgstyle+"T" ;
COLOR RGB(0,0,0,192,192,192)
@ 1.5,3 SAY m.prompt FONT m.g_dlgface, m.g_dlgsize STYLE m.g_dlgstyle+"T" ;
COLOR RGB(0,0,0,192,192,192)
m.g_thermwidth = 56.27
IF !ISCOLOR()
@ 3.000,3.33 TO 4.23, (m.g_thermwidth + 1) + 3.33
ENDIF
ENDCASE
SHOW WINDOW thermomete TOP
ELSE
m.prompt = SUBSTR(SYS(2014,UPPER(m.g_outfile)),1,48)+;
IIF(LEN(m.g_outfile)>48,"...","")
DEFINE WINDOW thermomete;
FROM INT((SROW()-6)/2), INT((SCOL()-57)/2) ;
TO INT((SROW()-6)/2) + 6, INT((SCOL()-57)/2) + 57;
DOUBLE COLOR SCHEME 5
ACTIVATE WINDOW thermomete NOSHOW
m.g_thermwidth = 50
@ 0,3 SAY m.text
@ 1,3 SAY UPPER(m.prompt)
@ 2,1 TO 4,m.g_thermwidth+4 &g_boxstrg
SHOW WINDOW thermomete TOP
ENDIF
*
* UPDTHERM(<percent>) - Update thermometer.
*
PROCEDURE updtherm
PARAMETER m.percent
PRIVATE m.nblocks, m.percent
ACTIVATE WINDOW thermomete
m.nblocks = (m.percent/100) * (m.g_thermwidth)
DO CASE
CASE _WINDOWS
@ 3.000,3.333 TO 4.231,m.nblocks + 3.333 ;
PATTERN 1 COLOR RGB(128, 128, 128, 128, 128, 128)
CASE _MAC
@ 3.000,3.33 TO 4.23,m.nblocks + 3.33 ;
PATTERN 1 COLOR RGB(0, 0, 128, 0, 0, 128)
OTHERWISE
@ 3,3 SAY REPLICATE("Û",m.nblocks)
ENDCASE
*
* DEACTTHERMO - Deactivate and Release thermometer window.
*
PROCEDURE deactthermo
RELEASE WINDOW thermomete
*!*****************************************************************************
*!
*! Procedure: THERMFNAME
*!
*!*****************************************************************************
FUNCTION thermfname
PARAMETER m.fname
PRIVATE m.addelipse, m.g_pathsep, m.g_thermfface, m.g_thermfsize, m.g_thermfstyle
#define c_space 40
IF _MAC
m.g_thermfface = "Geneva"
m.g_thermfsize = 10
m.g_thermfstyle = "B"
ELSE
m.g_thermfface = "MS Sans Serif"
m.g_thermfsize = 8
m.g_thermfstyle = "B"
ENDIF
* Translate the filename into Mac native format
IF _MAC
m.g_pathsep = ":"
m.fname = LOWER(SYS(2027, m.fname))
ELSE
m.g_pathsep = "\"
ENDIF
IF TXTWIDTH(m.fname,m.g_thermfface,m.g_thermfsize,m.g_thermfstyle) > c_space
* Make it fit in c_space
m.fname = partialfname(m.fname, c_space - 1)
m.addelipse = .F.
DO WHILE TXTWIDTH(m.fname+'...',m.g_thermfface,m.g_thermfsize,m.g_thermfstyle) > c_space
m.fname = LEFT(m.fname, LEN(m.fname) - 1)
m.addelipse = .T.
ENDDO
IF m.addelipse
m.fname = m.fname + "..."
ENDIF
ENDIF
RETURN m.fname
*!*****************************************************************************
*!
*! Procedure: PARTIALFNAME
*!
*!*****************************************************************************
FUNCTION partialfname
PARAMETER m.filname, m.fillen
* Return a filname no longer than m.fillen characters. Take some chars
* out of the middle if necessary. No matter what m.fillen is, this function
* always returns at least the file stem and extension.
PRIVATE m.bname, m.elipse, m.remain
m.elipse = "..." + m.g_pathsep
IF _MAC
m.bname = SUBSTR(m.filname, RAT(":",m.filname)+1)
ELSE
m.bname = justfname(m.filname)
ENDIF
DO CASE
CASE LEN(m.filname) <= m.fillen
m.retstr = m.filname
CASE LEN(m.bname) + LEN(m.elipse) >= m.fillen
m.retstr = m.bname
OTHERWISE
m.remain = MAX(m.fillen - LEN(m.bname) - LEN(m.elipse), 0)
IF _MAC
m.retstr = LEFT(SUBSTR(m.filname,1,RAT(":",m.filname)-1),m.remain) ;
+m.elipse+m.bname
ELSE
m.retstr = LEFT(justpath(m.filname),m.remain)+m.elipse+m.bname
ENDIF
ENDCASE
RETURN m.retstr
**
** Error Handling Code
**
*
* ERRORHANDLER - Error Processing Center.
*
PROCEDURE errorhandler
PARAMETERS m.messg, m.lineno, m.code
IF ERROR() = 22
ON ERROR &onerror
DO cleanup
CANCEL
ENDIF
DO CASE
CASE m.code == "Minor"
DO errlog WITH m.messg, m.lineno
m.g_status = 1
CASE m.code == "Serious"
DO errlog WITH m.messg, m.lineno
DO errshow WITH m.messg, m.lineno
m.g_error = .T.
m.g_status = 2
ON ERROR
CASE m.code == "Fatal"
IF NOT m.g_nohandle
DO errlog WITH m.messg, m.lineno
ENDIF
DO errshow WITH m.messg, m.lineno
IF WEXIST("Thermomete") AND WVISIBLE("Thermomete")
RELEASE WINDOW thermometer
ENDIF
ON ERROR
DO cleanup
CANCEL
ENDCASE
*
* ESCHANDLER - Escape handler.
*
PROCEDURE eschandler
ON ERROR
WAIT WINDOW "Generation process stopped." NOWAIT
DO builddisable
IF m.g_status > 0
ERASE (m.g_outfile)
ENDIF
IF WEXIST("Thermomete") AND WVISIBLE("Thermomete")
RELEASE WINDOW thermometer
ENDIF
DO cleanup
CANCEL
*
* ERRLOG - Insert error message into the error log.
*
PROCEDURE errlog
PARAMETER m.messg, m.lineno
PRIVATE m.savehandle
m.savehandle = _TEXT
DO openerrfile
SET CONSOLE OFF
\\GENERATOR: <<ALLTRIM(m.messg)>>
IF NOT EMPTY(m.lineno)
\\ LINE NUMBER: <<m.lineno>>
ENDIF
\
= FCLOSE(_TEXT)
_TEXT = m.savehandle
*
* ERRSHOW - Display error message in the alert box.
*
PROCEDURE errshow
PARAMETER m.msg, m.lineno
PRIVATE m.curcursor
IF m.g_graphic
DEFINE WINDOW alert ;
AT INT((SROW() - (( 5.615 * ;
fontmetric(1, m.g_dlgface, m.g_dlgsize, m.g_dlgstyle )) / ;
fontmetric(1, wfont(1,""), wfont(2,""), wfont(3,"")))) / 2), ;
INT((SCOL() - (( 63.833 * ;
fontmetric(6, m.g_dlgface, m.g_dlgsize, m.g_dlgstyle )) / ;
fontmetric(6, wfont(1,""), wfont(2,""), wfont(3,"")))) / 2) ;
SIZE 5.615,63.833 ;
font m.g_dlgface, m.g_dlgsize ;
STYLE m.g_dlgstyle ;
NOCLOSE ;
DOUBLE ;
TITLE "Genmenu Error" ;
COLOR rgb(0, 0, 0, 255, 255, 255)
ACTIVATE WINDOW alert NOSHOW
m.msg = SUBSTR(m.msg,1,44)+IIF(LEN(m.msg)>44,"...","")
@ 1,(WCOLS()-txtwidth( m.msg ))/2 SAY m.msg
m.msg = "Line Number: "+STR(m.lineno, 4)
@ 2,(WCOLS()-txtwidth( m.msg ))/2 SAY m.msg
m.msg = "Press any key to cleanup and exit..."
@ 3,(WCOLS()-txtwidth( m.msg ))/2 SAY m.msg
SHOW WINDOW alert
ELSE
DEFINE WINDOW alert;
FROM INT((SROW()-6)/2), INT((SCOL()-50)/2) TO INT((SROW()-6)/2) + 6, INT((SCOL()-50)/2) + 50 ;
FLOAT NOGROW NOCLOSE NOZOOM SHADOW DOUBLE;
COLOR SCHEME 7
ACTIVATE WINDOW alert
@ 0,0 CLEAR
@ 1,0 SAY PADC(SUBSTR(m.msg,1,44)+;
IIF(LEN(m.msg)>44,"...",""), WCOLS())
@ 2,0 SAY PADC("Line Number: "+STR(m.lineno, 4), WCOLS())
@ 3,0 SAY PADC("Press any key to cleanup and exit...", WCOLS())
ENDIF
m.curcursor = SET( "CURSOR" )
SET CURSOR OFF
WAIT ""
RELEASE WINDOW alert
SET CURSOR &curcursor
RELEASE WINDOW alert
*
* OPENERRFILE - Open error file.
*
PROCEDURE openerrfile
PRIVATE m.errfile, m.errhandle
m.errfile = m.g_errlog+".ERR"
m.errhandle = FOPEN(m.errfile,2)
IF m.errhandle < 0
m.errhandle = FCREATE(m.errfile)
IF m.errhandle < 0
DO errshow WITH ".ERR could not be opened...", LINENO()
m.g_status = 2
IF WEXIST("Thermomete") AND WVISIBLE("Thermomete")
RELEASE WINDOW thermometer
ENDIF
ON ERROR
RETURN TO MASTER
ENDIF
ELSE
= FSEEK(m.errhandle,0,2)
ENDIF
IF SET("TEXTMERGE") = "OFF"
SET TEXTMERGE ON
ENDIF
_TEXT = m.errhandle
*
* GETCNAME - Manufacture a procedure name, unless there is a #NAME directive
*
FUNCTION getcname
PARAMETERS snippet
PRIVATE ALL
IF proctype = 1
numlines = MEMLINES(snippet)
IF m.numlines > 0
_MLINE = 0
m.i = 1
DO WHILE m.i <= m.numlines
m.thisline = UPPER(ALLTRIM(MLINE(snippet,1, _MLINE)))
DO CASE
CASE LEFT(m.thisline,5) == "#NAME"
RETURN ALLTRIM(SUBSTR(m.thisline,6))
CASE EMPTY(m.thisline) OR iscomment(m.thisline)
* Do nothing. Get next line.
OTHERWISE
EXIT
ENDCASE
m.i = m.i + 1
ENDDO
ENDIF
ENDIF
RETURN LOWER(SYS(2015))
*
* ISCOMMENT - Determine if textline is a comment line.
*
FUNCTION IsComment
PARAMETER m.textline
PRIVATE m.asterisk, m.isnote, m.ampersand, m.statement
IF EMPTY(m.textline)
RETURN .F.
ENDIF
m.statement = UPPER(ALLTRIM(m.textline))
m.asterisk = AT("*", LEFT(m.statement,1))
m.ampersand = AT(CHR(38)+CHR(38), LEFT(m.statement,2))
m.isnote = AT("NOTE", LEFT(m.statement,4))
DO CASE
CASE (m.asterisk = 1 OR m.ampersand = 1)
RETURN .T.
CASE (m.isnote = 1 ;
AND (LEN(m.statement) <= 4 OR SUBSTR(m.statement,5,1) = ' '))
* Don't be fooled by something like "notebook = 7"
RETURN .T.
ENDCASE
RETURN .F.
*
* WORDNUM - Returns w_num-th word from string strg
*
FUNCTION wordnum
PARAMETERS strg,w_num
PRIVATE strg,s1,w_num,ret_str
m.s1 = ALLTRIM(m.strg)
* Replace tabs with spaces
m.s1 = CHRTRAN(m.s1,CHR(9)," ")
* Reduce multiple spaces to a single space
DO WHILE AT(' ',m.s1) > 0
m.s1 = STRTRAN(m.s1,' ',' ')
ENDDO
ret_str = ""
DO CASE
CASE m.w_num > 1
DO CASE
CASE AT(" ",m.s1,m.w_num-1) = 0 && No word w_num. Past end of string.
m.ret_str = ""
CASE AT(" ",m.s1,m.w_num) = 0 && Word w_num is last word in string.
m.ret_str = SUBSTR(m.s1,AT(" ",m.s1,m.w_num-1)+1,255)
OTHERWISE && Word w_num is in the middle.
m.strt_pos = AT(" ",m.s1,m.w_num-1)
m.ret_str = SUBSTR(m.s1,strt_pos,AT(" ",m.s1,m.w_num)+1 - strt_pos)
ENDCASE
CASE m.w_num = 1
IF AT(" ",m.s1) > 0 && Get first word.
m.ret_str = SUBSTR(m.s1,1,AT(" ",m.s1)-1)
ELSE && There is only one word. Get it.
m.ret_str = m.s1
ENDIF
ENDCASE
RETURN ALLTRIM(m.ret_str)
*!*****************************************************************************
*!
*! Function: VERSNUM
*!
*!*****************************************************************************
FUNCTION versnum
* Return string corresponding to FoxPro version number
RETURN wordnum(vers(),2)
*!*****************************************************************************
*!
*! Function: JUSTFNAME
*!
*! Called by: FORCEEXT() (function in GENSCRN.PRG)
*!
*!*****************************************************************************
FUNCTION justfname
PARAMETERS m.filname
PRIVATE ALL
IF RAT('\',m.filname) > 0
m.filname = SUBSTR(m.filname,RAT('\',m.filname)+1,255)
ENDIF
IF AT(':',m.filname) > 0
m.filname = SUBSTR(m.filname,AT(':',m.filname)+1,255)
ENDIF
RETURN ALLTRIM(UPPER(m.filname))
===================
*:*****************************************************************************
*:
*: Program:
*:
*: System:
*: Author:
*: Copyright (c) 1998,
*: Last modified: 11/18/98 16:57
*:
*: Called by: MANTMENU.PRG
*:
*: Calls: LASTKEY() (function in ?)
*:
*: Documented 11/19/98 at 10:19 FoxDoc version 2.10f
*:*****************************************************************************
*-------------------------------------------------imEXMENU.prg
* import - Export routine
*--------------------------------------------------
@03,30 CLEAR TO 03,48
SET COLOR TO GR+
CDESP='** Import / Export Menu **'
CLEN = LEN(CDESP)
CPOS=(80-CLEN) / 2
@03,CPOS say CDESP
set color to BG+
k_esc =27
set date french
set colo to W+/B+
declare itbl[2]
itbl[1] = "\<1 Back Up "
itbl[2] = "\<2 Restore"
i_choice = 0
do while .t.
set colo to W+/B+
@08,34 menu itbl,02 title 'Import/Export'
read menu to r_choice save
save screen to impexp
if lastkey() = K_ESC
@05,00 clear to 24,79
exit
endif
do case
case r_choice = 1
DO EXPORTFL
case r_choice = 2
*DO IMPORTFL
otherwise
loop
endcase
restore screen from impexp
enddo
*SET COLOR TO BG+
return
*: EOF: IMEXMENU.PRG
=======================================================
*--------------------------------------------------INDXFILE.PRG
* Index files
*--------------------------------------------------
set safety off
CLOSE ALL
DO REPLPAN
CLOSE ALL
set colo to bg+
@ 5,00 clear to 23,79
@ 5,00 to 05,79
*----------variables
@03,30 clear to 03,48
set colo to gr+
CDESP=' ** Reindexing File **'
CLEN = LEN(CDESP)
CPOS=(80-CLEN) / 2
@03,CPOS say CDESP
set date french
SET CENT ON
set colo to bg/gr+
@06,59 clear to 23,76
@06,59 to 23,77
@06,61 say 'Indexed File'
@23,02 CLEAR TO 23,70
@23,02 say 'Wait !! Indexing PARTYMST '
sele 01
use PARTYMST
pack
inde on str(p_code,6) to PARTYMST
INDE on p_name to PARTYNAM
index on p_code to PARTYMST
use
sele 01
use PARTYMST
pack
index on p_name to PARTYNAM
@07,60 say 'PARTYMST'
@23,02 CLEAR TO 23,70
@23,02 say 'Wait !! Indexing TYPEMAST'
sele 02
use TYPEMAST
pack
index on type_cd to TYPEMAST
@08,60 say 'TYPEMAST'
use
@23,02 CLEAR TO 23,70
@23,02 say 'Wait !! Indexing SUBTYPE'
sele 03
use SUBTYPE
pack
index on type_cd+stype_cd to SUBTYPE
@09,60 say 'SUBTYPE '
use
@23,02 CLEAR TO 23,70
@23,02 say 'Wait !! Indexing SUBTYPE'
sele 04
use EXCHANGE
pack
index on excg_no to EXCHANGE
@010,60 say 'EXCHANGE'
use
@23,02 CLEAR TO 23,70
@23,02 say 'Wait !! Indexing DGMMAST '
sele 05
use GMMAST
inde on pgm_no+gm_no to GMMAST
use
sele 05
use PGMMAST
inde on pgm_no to PGMMAST
use
sele 05
use DGMMAST
pack
index on pgm_no+gm_no+dgm_no to DGMMAST
use
SELE 05
USE dgmexcg
pack
index on pgm_no+gm_no+dgm_no+excg_no to DGMEXCG
use
@11,60 say 'DGMMAST '
@23,02 CLEAR TO 23,70
@23,02 say 'Wait !! Indexing DEMAST '
sele 06
use DEMAST
pack
index on pgm_no+gm_no+dgm_no+excg_No+de_no to DEMAST
use
@12,60 say 'DEMAST '
@23,02 CLEAR TO 23,70
@23,02 say 'Wait !! Indexing SDEMAST '
sele 07
use SDEMAST
pack
index on pgm_no+gm_no+dgm_no+excg_no+de_no+sde_no to SDEMAST
use
sele 07
use MESSAGES
inde on file_type+srl_no to MESSAGES
use
@13,60 say 'MESSAGES'
@23,02 CLEAR TO 23,70
@23,02 say 'Wait !! Indexing VEHICLE '
sele 08
use VEHICLE
pack
index on v_no to VEHICLE
use
@14,60 say 'VEHICLE '
@23,02 CLEAR TO 23,70
@23,02 say 'Wait !! Indexing DEALASST '
sele 09
use DEALASST
pack
index on da_cd to DEALASST
use
@15,60 say 'DEALASST'
@23,02 CLEAR TO 23,70
@23,02 say 'Wait !! Indexing GUARDS '
sele 11
use GUARDS
pack
index on excg_no to GUARDS
use
@16,60 say 'GUARDS '
@23,02 CLEAR TO 23,70
@23,02 say 'Wait !! Indexing PEREASON '
sele 12
use PEREASON
pack
index on reas_no to PEREASON
use
@17,60 say 'PEREASON'
@23,02 CLEAR TO 23,70
@23,02 say 'Wait !! Indexing VOUCMAST '
USE VOUCDEL
APPE FROM VOUCMAST FOR DELETED()
USE
sele 20
use VOUCMAST
repl all remarks with ' '
pack
index on str(slno,5) to VOUCMAST
use
sele 21
use BILLNO
pack
inde on str(p_code,6)+bill_no+dtoc(bill_date)+str(amount,10) to BILLNO
use
@18,60 say 'VOUCMAST'
@23,02 CLEAR TO 23,70
@23,02 say 'Wait !! Indexing ADVCMAST '
sele 23
use ADVCMAST
pack
index on unit+adv_no to ADVCMAST
use
@19,60 say 'ADVCMAST'
@23,02 CLEAR TO 23,70
@23,02 say 'Wait !! Indexing TENDER '
sele 18
use TENDER
pack
index on type+tender_no to TENDER
use
sele 18
use TENDTYPE
inde on type to TENDTYPE
@20,60 say 'TENDER'
use achead
index on accode to achead
use
use billtype
inde on bill_ty to BILTYPE
msrl_no = '999'
do usemsg
@06,59 clear to 23,76
set color to bg+
close all
return
*: EOF: INDXFILE.PRG
======================================
*------------------------------------------- : install.prg
* install Program for payroll System
*--------------------------------------------
set escape off
SET COLOR TO BG+
SET TALK OFF
SET STAT OFF
SET ALTERNATE OFF
SET BELL OFF
SET CONFIRM OFF
SET CONSOLE ON
SET DELETED ON
SET DELIMITERS TO "[]"
SET DELIMITERS ON
SET DEVICE TO SCREEN
SET EXACT OFF
SET INTENSITY ON
SET MARGIN TO 0
SET PRINT OFF
SET UNIQUE OFF
SET CENTURY OFF
SET DATE FRENCH
set score off
SET SAFETY OFF
=INSMODE(.f.)
SET DATE FRENCH
CLEAR
CLOSE DATABASES
user_msg1 = space(60)
user_msg2 = space(60)
ans_msg = space(1)
mdesp=space(40)
MCL_SHRT=SPACE(20)
maddr1=space(30)
maddr2 = space(30)
maddr3 = space(30)
maddr4 = space(30)
mpincode = space(6)
mtel_o = space(8)
mtel_o_2 = space(8)
msign = space(20)
mpass = space(6)
SET COLOR TO W/RB+
@12,25 SAY "***************************"
@13,25 SAY "* ---------------*"
@14,25 say "* --------------- *"
@15,25 say "* ------------ *"
@16,25 SAY "***************************"
*------------------------ variables
mflnm=space(12)
mfield=space(10)
flen=0
mrecno=0
wrecno=0
mcode=0
mloc_code = space(3)
mloc_desc = space(20)
mbran_code = space(3)
mbran_desc = space(20)
CLOSE ALL
SET COLO TO RB+
sdesp = " TOM SYSTEM "
*--------------------------------------------------------
do bigchars with 1,10," TOM |SYSTEM"
WAIT WINDOW ('Please Wait!!') TIMEOUT 1
clear
*o CLNTADD
DO USERSUP
close all
clear all
return
===========================================================
Visual FoxPro (VFP) is a data-centric procedural programming language and relational database management system (RDBMS) that was developed by Microsoft. It is known for its strong data handling capabilities and its rapid application development (RAD) features. Although Microsoft officially ended support for Visual FoxPro in 2015, it remains a powerful tool for maintaining and developing legacy applications.
Here's a basic overview of coding in Visual FoxPro, including its main features and some examples to get you started.
### Basic Concepts
1. **Database and Table Management:**
- **Tables:** Store data in rows and columns.
- **Indexes:** Improve the performance of queries.
- **Views:** Provide a virtual table based on a query.
2. **Data Manipulation:**
- **Commands:** `SELECT`, `INSERT`, `UPDATE`, `DELETE`.
- **Functions:** Built-in functions for data manipulation.
3. **Procedural Programming:**
- **Commands and Functions:** Similar to other procedural languages.
- **Error Handling:** Using `TRY...CATCH` blocks.
### Basic Syntax and Examples
#### 1. **Creating and Using Tables**
- **Creating a Table:**
```foxpro
CREATE TABLE employees ( ;
emp_id I NOT NULL, ;
emp_name C(100), ;
emp_salary N(10,2), ;
hire_date D )
```
- **Inserting Data:**
```foxpro
INSERT INTO employees (emp_id, emp_name, emp_salary, hire_date) ;
VALUES (1, 'John Doe', 50000.00, DATE())
```
- **Selecting Data:**
```foxpro
SELECT * FROM employees
```
- **Updating Data:**
```foxpro
UPDATE employees SET emp_salary = 55000.00 WHERE emp_id = 1
```
- **Deleting Data:**
```foxpro
DELETE FROM employees WHERE emp_id = 1
```
#### 2. **Indexing and Views**
- **Creating an Index:**
```foxpro
INDEX ON emp_salary TAG salary_index
```
- **Creating a View:**
```foxpro
CREATE VIEW high_salary AS ;
SELECT * FROM employees ;
WHERE emp_salary > 50000
```
#### 3. **Procedural Programming**
- **Simple Procedure:**
```foxpro
PROCEDURE ShowEmployee(emp_id)
LOCAL lcName, lnSalary, ldHireDate
SELECT emp_name, emp_salary, hire_date ;
FROM employees ;
WHERE emp_id = emp_id INTO CURSOR csrEmployee
IF RECCOUNT('csrEmployee') > 0
lcName = csrEmployee.emp_name
lnSalary = csrEmployee.emp_salary
ldHireDate = csrEmployee.hire_date
? "Name: " + lcName
? "Salary: " + TRANSFORM(lnSalary)
? "Hire Date: " + DTOC(ldHireDate)
ELSE
? "Employee not found."
ENDIF
ENDPROC
```
- **Error Handling with TRY...CATCH:**
```foxpro
TRY
DELETE FROM employees WHERE emp_id = 999
IF _TALLY = 0
? "No records deleted."
ENDIF
CATCH TO loException
? "An error occurred: " + loException.Message
ENDTRY
```
#### 4. **Forms and Controls**
Visual FoxPro provides a graphical interface to create forms with various controls.
- **Creating a Form:**
```foxpro
CREATE FORM employeeForm
```
- **Adding Controls:**
You can drag and drop controls like text boxes, buttons, and grids onto the form. Here’s a simple example of how you might set up a button click event:
```foxpro
* In the form's button click event
PROCEDURE cmdSave.Click
IF EMPTY(thisform.txtEmpName.Value) OR EMPTY(thisform.txtEmpSalary.Value)
MESSAGEBOX("Name and Salary must be filled out.")
ELSE
INSERT INTO employees (emp_name, emp_salary) ;
VALUES (thisform.txtEmpName.Value, thisform.txtEmpSalary.Value)
MESSAGEBOX("Employee saved.")
ENDIF
ENDPROC
```
### Key Points
- **Data Handling:** VFP excels at data handling and allows for rapid development of data-centric applications.
- **Forms and Reports:** Visual FoxPro includes tools for designing user interfaces and generating reports.
- **Legacy Code:** Despite being outdated, VFP codebases are still in use, particularly in legacy systems.
### Summary
Visual FoxPro is a powerful tool for building database applications with a strong focus on data manipulation and rapid development. Although it's no longer officially supported, many organizations continue to use it for maintaining legacy systems. The examples provided cover basic table operations, procedural programming, and form creation to help you get started with Visual FoxPro coding.
If you have specific questions or need further assistance with Visual FoxPro, feel free to ask!
======
Visual
FoxPro is a data-centric, object-oriented, and procedural programming language
that offers a wide range of commands for database manipulation, user interface
design, and general programming tasks. Below is a categorized list of some key
commands commonly used in Visual FoxPro:
# 1. File
Handling Commands
- OPEN
DATABASE: Opens a database file.
```foxpro
OPEN DATABASE myDatabase
```
- CLOSE
DATABASES: Closes all open databases.
```foxpro
CLOSE DATABASES
```
- USE: Opens
a table for use.
```foxpro
USE myTable
```
- CLOSE:
Closes the currently open table or all tables.
```foxpro
CLOSE ALL
```
- COPY TO:
Copies a table to a new file.
```foxpro
COPY TO newTable.dbf
```
- DELETE FILE:
Deletes a specified file.
```foxpro
DELETE FILE myFile.dbf
```
# 2. Data
Manipulation Commands
- APPEND:
Adds a new record to the table.
```foxpro
APPEND BLANK
```
- DELETE:
Marks records for deletion.
```foxpro
DELETE FOR condition
```
- RECALL:
Restores deleted records.
```foxpro
RECALL FOR condition
```
- REPLACE:
Replaces the contents of a field in the current record or records.
```foxpro
REPLACE fieldName WITH newValue
```
- BROWSE:
Opens a browse window to view and edit records.
```foxpro
BROWSE
```
- INDEX:
Creates an index for a table.
```foxpro
INDEX ON fieldName TAG tagName
```
# 3. Table
and Database Commands
- CREATE
TABLE: Creates a new table.
```foxpro
CREATE TABLE myTable (id INT, name CHAR(30))
```
- ALTER
TABLE: Modifies the structure of an existing table.
```foxpro
ALTER TABLE myTable ADD COLUMN newField INT
```
- DROP TABLE:
Deletes a table from the database.
```foxpro
DROP TABLE myTable
```
- PACK:
Permanently removes records marked for deletion.
```foxpro
PACK
```
# 4. Programming
Flow Control Commands
- IF...ENDIF:
Conditional branching.
```foxpro
IF condition
* Statements
ENDIF
```
- DO
WHILE...ENDDO: Loops while a condition is true.
```foxpro
DO WHILE condition
* Statements
ENDDO
```
- FOR...ENDFOR:
Iterates a block of code for a defined range.
```foxpro
FOR i = 1 TO 10
* Statements
ENDFOR
```
# 5. Error
Handling Commands
- TRY...CATCH...FINALLY:
Handles errors in a block of code.
```foxpro
TRY
* Code that may cause an error
CATCH TO oError
* Error handling code
FINALLY
* Code to execute after TRY or CATCH
ENDTRY
```
# 6. Report
and Output Commands
- REPORT
FORM: Generates a report from a specified form.
```foxpro
REPORT FORM reportName TO PRINTER
```
- LIST:
Lists records or fields to the screen or a file.
```foxpro
LIST
```
- DISPLAY:
Displays records in a formatted output.
```foxpro
DISPLAY ALL
```
# 7. Form
and User Interface Commands
- CREATE
FORM: Creates a form to be used in an application.
```foxpro
CREATE FORM myForm
```
- DO FORM:
Runs an existing form.
```foxpro
DO FORM myForm
```
# 8. Miscellaneous
Commands
- SET:
Changes environment settings such as view options or behavior.
```foxpro
SET TALK OFF
```
- WAIT:
Pauses program execution for a specified time or until the user presses a key.
```foxpro
WAIT WINDOW "Processing..."
These are just a few commands in Visual FoxPro. The language is quite rich and allows for the creation of robust database applications with a blend of procedural and object-oriented approaches.
=====
Here are some sample
cases with commands in Visual FoxPro, demonstrating how to handle various
common tasks such as database manipulation, user interface creation, and file
management. Each case includes a brief scenario and corresponding commands.
---
# Case 1: Creating a
Database and Table
Scenario: You want to
create a new database and a table that stores employee details (ID, name, and
salary).
```foxpro
* Creating the
database
CREATE DATABASE
EmployeeDB
* Open the database
OPEN DATABASE
EmployeeDB
* Create the Employee
table with fields: ID, Name, Salary
CREATE TABLE
Employees (ID INT, Name CHAR(30), Salary FLOAT)
* Add some sample
data
INSERT INTO Employees
(ID, Name, Salary) VALUES (1, 'John Doe', 50000)
INSERT INTO Employees
(ID, Name, Salary) VALUES (2, 'Jane Smith', 55000)
* View the data in a
browse window
BROWSE
```
---
# Case 2: Inserting
and Deleting Records in a Table
Scenario: You want to
add a few more records to the Employees table and delete one of the records.
```foxpro
* Open the Employee
table
USE Employees
* Insert new records
INSERT INTO Employees
(ID, Name, Salary) VALUES (3, 'Mike Johnson', 60000)
INSERT INTO Employees
(ID, Name, Salary) VALUES (4, 'Anna Lee', 48000)
* Display the current
data
LIST
* Mark the record for
deletion where the employee name is 'Mike Johnson'
DELETE FOR Name =
'Mike Johnson'
* Recall the record
in case the deletion was a mistake
RECALL FOR Name =
'Mike Johnson'
* Finally, remove the
record permanently
DELETE FOR Name =
'Mike Johnson'
PACK
```
---
# Case 3: Updating
Data in a Table
Scenario: You need to
increase the salary of all employees earning less than $50,000 by 10%.
```foxpro
* Open the Employee
table
USE Employees
* Update the salary
for employees earning less than $50,000
REPLACE ALL Salary
WITH Salary * 1.1 FOR Salary < 50000
* Display updated
records
LIST
```
---
# Case 4: Creating an
Index for a Table
Scenario: You need to
create an index on the `Salary` field to optimize queries based on salary.
```foxpro
* Open the Employee
table
USE Employees
* Create an index on
the Salary field
INDEX ON Salary TAG
SalaryIndex
* Verify that the
index is active by sorting the records using the index
SET ORDER TO
SalaryIndex
BROWSE
```
---
# Case 5: Creating a
Simple Form
Scenario: You want to
create a simple form that allows the user to view and add employee records.
```foxpro
* Create a new form
CREATE FORM
EmployeeForm
* Inside the form,
add text boxes for ID, Name, and Salary fields
* Add buttons to
navigate through the records (Next, Previous)
* Add a button to
append a new record
* Save the form and
run it
DO FORM EmployeeForm
```
---
# Case 6: Querying
Data
Scenario: You need to
query all employees who have a salary greater than $50,000 and display them.
```foxpro
* Open the Employee
table
USE Employees
* Query employees
with salary greater than 50000
SELECT * FROM
Employees WHERE Salary > 50000 INTO CURSOR HighEarners
* Display the results
BROWSE
# Case 7: Error
Handling with TRY...CATCH
Scenario: You are
working with file operations and want to handle any potential errors gracefully
(e.g., file not found).
```foxpro
* Open a file with
error handling
TRY
USE NonExistentFile
CATCH TO oError
* Display the error message
WAIT WINDOW "Error: " +
oError.Message
ENDTRY
```
---
# Case 8: Exporting
Data to a CSV File
Scenario: You want to
export the `Employees` table to a CSV file for use in another program.
```foxpro
* Open the Employee
table
USE Employees
* Export the data to
a CSV file
COPY TO
EmployeeData.csv TYPE CSV
```
---
# Case 9: Deleting a
File
Scenario: You need to
delete an obsolete table file from the directory.
```foxpro
* Ensure the file is
closed
CLOSE ALL
* Delete the file
DELETE FILE
oldEmployeeTable.dbf
* Confirm the file is
deleted
IF
!FILE('oldEmployeeTable.dbf')
WAIT WINDOW "File deleted
successfully."
ENDIF
```
---
# Case 10: Reporting
and Printing
Scenario: You need to
generate and print a report of all employees.
```foxpro
* Create a report in
the Report Designer (done visually)
CREATE REPORT
EmployeeReport
* Once the report
design is done, print the report
REPORT FORM
EmployeeReport TO PRINTER
* To preview the
report before printing
REPORT FORM
EmployeeReport PREVIEW
These examples
demonstrate various basic operations in Visual FoxPro, from creating tables and
querying data to error handling, UI design, and reporting. These commands form
the foundation for more complex application development in FoxPro.
=====
Designing, analyzing, and documenting FoxPro applications involves several key steps and best practices. Visual FoxPro (VFP) is a data-centric programming environment, and understanding its architecture and functionality is essential for effective application development. Here’s a comprehensive guide on how to approach these tasks:
## 1. **Designing FoxPro Applications**
### a. Requirements Gathering
- **Identify Stakeholders**: Work with users and stakeholders to gather requirements.
- **Understand Business Processes**: Analyze current processes and identify pain points.
- **Document Requirements**: Create a detailed list of functional and non-functional requirements.
### b. System Architecture
- **Define the Architecture**: Choose between a client-server architecture or a standalone application based on requirements.
- **Data Model Design**:
- Create an Entity-Relationship Diagram (ERD) to represent the data model.
- Define tables, relationships, and normalization.
- **User Interface Design**:
- Design intuitive user interfaces using forms and controls.
- Consider usability principles, such as consistency and accessibility.
### c. Data Structures
- **Define Tables and Fields**: Create tables in the VFP database, defining the necessary fields, data types, and constraints.
- **Indexes**: Design appropriate indexing strategies to optimize query performance.
### d. Application Logic
- **Procedures and Functions**: Organize business logic into reusable procedures and functions.
- **Modular Design**: Structure the application into modules or components for easier maintenance and scalability.
## 2. **Analyzing FoxPro Applications**
### a. Code Analysis
- **Review Existing Code**: Examine the current FoxPro codebase for logic, structure, and efficiency.
- **Identify Bottlenecks**: Use profiling tools to identify performance bottlenecks or inefficient queries.
### b. User Feedback
- **Conduct User Testing**: Gather feedback from users to understand usability issues or feature requests.
- **Analyze Support Tickets**: Review support tickets and issue logs to identify common problems.
### c. Performance Metrics
- **Monitor Performance**: Measure application performance (e.g., response times, resource usage) to identify areas for improvement.
- **Evaluate Database Performance**: Analyze query execution times, and check for locking and blocking issues in the database.
### d. Compliance and Security
- **Evaluate Security**: Ensure that the application adheres to security best practices (e.g., data encryption, user authentication).
- **Compliance**: Confirm that the application complies with relevant regulations (e.g., GDPR, HIPAA).
## 3. **Documenting FoxPro Applications**
### a. Code Documentation
- **Inline Comments**: Use comments within the code to explain complex logic or important decisions.
- **Function and Procedure Documentation**: Create documentation for all procedures and functions, including parameters, return values, and usage examples.
### b. User Documentation
- **User Manuals**: Develop comprehensive user manuals that explain how to use the application, including screenshots and examples.
- **FAQs and Troubleshooting Guides**: Provide users with FAQs and troubleshooting guides to address common issues.
### c. Technical Documentation
- **Architecture Diagrams**: Create architecture diagrams that depict the overall system architecture, including data flow and integration points.
- **Data Model Documentation**: Document the data model, including table structures, field definitions, and relationships.
- **API Documentation**: If the application interacts with external services, document the APIs, including endpoints and data formats.
### d. Version Control and Change Logs
- **Maintain Version Control**: Use version control systems (e.g., Git) to track changes to the codebase and manage releases.
- **Change Logs**: Document changes made in each version, including new features, bug fixes, and improvements.
## 4. **Best Practices**
- **Consistent Naming Conventions**: Use clear and consistent naming conventions for variables, tables, and procedures to improve code readability.
- **Regular Backups**: Implement a backup strategy to protect data and application code.
- **Testing**: Conduct thorough testing (unit testing, integration testing) before deploying changes to production.
- **User Training**: Provide training sessions for users to familiarize them with new features and workflows.
## Conclusion
Designing, analyzing, and documenting FoxPro applications requires a structured approach to ensure clarity, maintainability, and usability. By following best practices in requirements gathering, system architecture, performance analysis, and thorough documentation, you can create robust FoxPro applications that meet user needs and facilitate future enhancements.
===
Being excellent in coding, testing, installation, and maintenance of FoxPro software applications requires a deep understanding of Visual FoxPro (VFP) and its capabilities, as well as adherence to best practices throughout the software development lifecycle. Below is an outline that encapsulates key strategies and tips for each aspect of working with FoxPro applications:
## 1. Coding
### a. Coding Best Practices
- **Modular Programming**: Break down your application into smaller, manageable modules or functions to improve readability and maintainability.
- **Consistent Naming Conventions**: Use descriptive and consistent naming conventions for variables, tables, and functions (e.g., prefix function names with "fn_" for clarity).
- **Commenting**: Write clear comments and documentation within your code to explain complex logic, algorithms, and any non-obvious choices made during development.
### b. Use of Object-Oriented Principles
- **Encapsulation**: Create classes to encapsulate related data and functionality, which helps organize the code better.
- **Inheritance**: Utilize inheritance for reusing code in classes, reducing redundancy.
- **Polymorphism**: Implement polymorphism to enhance flexibility and allow different data types to be treated as instances of the same class.
### c. Effective Use of Built-in Functions
- Leverage VFP's built-in functions (e.g., string manipulation, date handling) to simplify coding and improve performance.
### d. Error Handling
- Implement robust error handling using `TRY...CATCH` blocks to manage exceptions gracefully and log errors for future analysis.
---
## 2. Testing
### a. Unit Testing
- **Automated Tests**: Create automated unit tests for individual functions and modules to ensure they work as intended.
- **Test Cases**: Develop comprehensive test cases that cover various scenarios, including edge cases.
### b. Integration Testing
- **Module Interaction**: Test how different modules interact with each other to ensure that data flows correctly throughout the application.
- **Database Interaction**: Verify that all database transactions (CRUD operations) work as expected.
### c. User Acceptance Testing (UAT)
- **Involve End Users**: Collaborate with end users during UAT to validate that the application meets their requirements and expectations.
- **Feedback Mechanism**: Implement a feedback mechanism to capture user experiences and suggestions for improvement.
### d. Performance Testing
- Assess the application under load to identify potential bottlenecks and ensure it can handle expected user volumes.
---
## 3. Installation
### a. Packaging the Application
- **Installation Scripts**: Create installation scripts or programs that automate the installation process for users.
- **Dependencies**: Ensure that all necessary dependencies (e.g., database drivers, configuration files) are included in the installation package.
### b. Configuration Management
- **Configuration Files**: Use configuration files to allow easy adjustments of parameters without modifying code (e.g., database connections, paths).
- **Environment Setup**: Clearly document how to set up different environments (development, testing, production) to ensure consistency.
### c. Documentation
- Provide installation documentation that outlines system requirements, installation steps, and troubleshooting tips for users.
---
## 4. Maintenance
### a. Regular Updates
- **Bug Fixes**: Monitor for bugs reported by users and prioritize fixes based on severity and impact.
- **Feature Enhancements**: Gather user feedback to identify opportunities for enhancements and new features.
### b. Version Control
- **Source Control**: Utilize a version control system (e.g., Git) to manage code changes, track history, and collaborate effectively.
- **Release Management**: Maintain a clear release management process, documenting changes and ensuring smooth transitions between versions.
### c. Backup and Recovery
- **Regular Backups**: Implement a regular backup strategy for both code and data to prevent data loss.
- **Recovery Plans**: Develop recovery plans to quickly restore functionality in case of failure or data corruption.
### d. Monitoring and Support
- **Monitoring Tools**: Use monitoring tools to track application performance and error rates.
- **Help Desk Support**: Establish a help desk or support channel for users to report issues or seek assistance.
---
## Conclusion
Excelling in coding, testing, installation, and maintenance of FoxPro applications involves a combination of best practices, thorough testing, and effective user communication. By following these guidelines, developers can create robust, efficient, and user-friendly applications while ensuring that they remain maintainable and scalable over time. This comprehensive approach not only enhances the quality of the software but also improves the overall user experience and satisfaction.
====
Dynamic Link Libraries (DLLs) play a significant role in extending the functionality of applications built with Visual FoxPro (VFP). Here’s a detailed overview of DLLs, including their purpose, how they can be used in VFP, and some best practices.
### What is a Dynamic Link Library (DLL)?
- **Definition**: A DLL is a collection of reusable functions and procedures that can be used by multiple applications simultaneously. It allows for modularization of code, enabling easier updates and maintenance.
- **Purpose**: DLLs help reduce the memory footprint of applications by allowing multiple programs to share the same code. They can contain code, data, and resources such as icons or images.
### How to Use DLLs in Visual FoxPro
#### 1. **Declaring Functions from a DLL**
To use functions from a DLL in Visual FoxPro, you need to declare them first. This is done using the `DECLARE` statement.
**Syntax**:
```foxpro
DECLARE <function name> FROM <DLL name> AS <return type> [WITH <parameter types>]
```
**Example**:
```foxpro
* Declare a function from a DLL
DECLARE INTEGER MessageBox IN user32;
STRING lpText, STRING lpCaption, INTEGER uType
```
In this example, the `MessageBox` function from the `user32.dll` is declared. This function creates a pop-up message box.
#### 2. **Calling Functions from a DLL**
After declaring a function, you can call it like a regular FoxPro function.
**Example**:
```foxpro
* Call the MessageBox function
MessageBox("Hello, World!", "Greetings", 0)
```
### 3. **Creating and Using Custom DLLs**
You can create custom DLLs using languages like C, C++, or C#. These DLLs can then be called from Visual FoxPro applications.
- **Steps to Create a DLL**:
1. **Write the Code**: Write the functions you want in your preferred programming language.
2. **Export Functions**: Use appropriate keywords or attributes to export the functions you want to make available (e.g., `__declspec(dllexport)` in C/C++).
3. **Compile the Code**: Compile the code into a DLL file.
- **Using Custom DLLs in VFP**: Similar to using system DLLs, declare and call your custom functions using the `DECLARE` statement.
### 4. **Handling Parameters and Return Types**
When declaring functions, it is crucial to specify the correct data types for parameters and return values. Mismatches can lead to errors or unexpected behavior.
- **Common Data Types**:
- **INTEGER**: 32-bit integer.
- **STRING**: A string value.
- **VOID**: Indicates no return value.
### 5. **Working with COM DLLs**
Visual FoxPro can also interact with Component Object Model (COM) DLLs. This is common for libraries that expose objects and methods to be used in other applications.
- **Creating an Instance**:
```foxpro
* Create an instance of a COM object
oExcel = CREATEOBJECT("Excel.Application")
```
- **Calling Methods**: After creating an instance, you can call methods and properties on the object:
```foxpro
oExcel.Visible = .T. && Make Excel visible
```
### Best Practices for Using DLLs in Visual FoxPro
1. **Error Handling**: Always implement error handling when calling DLL functions. This is essential for diagnosing issues.
2. **Documentation**: Document the functions and parameters used from the DLL to aid in maintenance and debugging.
3. **Testing**: Test the integration of DLL functions thoroughly to ensure they work as expected in all scenarios.
4. **Version Control**: Keep track of DLL versions to prevent compatibility issues when updating or deploying applications.
5. **Security Considerations**: Be cautious when using third-party DLLs. Ensure they are from a trusted source to avoid security vulnerabilities.
### Conclusion
Dynamic Link Libraries are powerful tools in Visual FoxPro that allow developers to extend application functionality by leveraging existing system libraries or creating custom code. By understanding how to declare, call, and manage DLLs, developers can enhance the performance and capabilities of their FoxPro applications significantly. With best practices in place, using DLLs can lead to more efficient, modular, and maintainable code.
===
Developing forms in Visual FoxPro (VFP) is a key aspect of creating user interfaces for applications. Forms allow users to interact with the application, input data, and display information. Below is a detailed guide on how to develop forms in VFP, including planning, creating, designing, and programming forms.
### Steps to Develop a Form in Visual FoxPro
#### 1. **Planning the Form**
Before you start building a form, it’s essential to plan its structure and functionality:
- **Identify the Purpose**: Determine the primary purpose of the form (e.g., data entry, reporting, user interaction).
- **Gather Requirements**: Collect user requirements to understand what fields, buttons, and functionalities are needed.
- **Sketch the Layout**: Create a rough sketch of the form layout, indicating where fields, labels, buttons, and other controls will be placed.
#### 2. **Creating a New Form**
To create a new form in VFP:
1. **Open Visual FoxPro**: Launch the VFP IDE (Integrated Development Environment).
2. **Create New Form**:
- Go to the **File** menu.
- Select **New** and then choose **Form**.
- This opens the Form Designer window.
#### 3. **Designing the Form**
In the Form Designer, you can add various controls to the form:
- **Adding Controls**:
- Use the **Toolbox** to drag and drop controls onto the form. Common controls include:
- **Text Box**: For user input.
- **Label**: To describe the purpose of a field.
- **Combo Box**: For selection from a predefined list.
- **Command Button**: For actions like Save, Cancel, or Close.
- **Grid**: To display data from a table or cursor.
- **Setting Control Properties**:
- Each control has properties that can be set in the **Properties Window**. Common properties include:
- **Name**: A unique identifier for the control.
- **Caption**: The text displayed on labels or buttons.
- **Control Source**: Specifies which field in the database the control is bound to (for input fields).
- **Visible**: Determines whether the control is displayed.
- **Arranging Controls**:
- Use alignment and layout options in the Form Designer to organize controls neatly.
#### 4. **Binding Data to the Form**
To display or enter data using the form, you’ll need to bind the controls to a data source:
- **Set the DataSource**:
- If the form is bound to a table or view, set the `DataSource` property of the form to the appropriate cursor or table.
- **Control Binding**:
- Set the `ControlSource` property of text boxes and other input controls to the corresponding fields in the data source.
#### 5. **Writing Form Logic**
Once the form is designed, you’ll need to add logic to handle events and user interactions:
- **Form Events**: Visual FoxPro provides several event triggers for forms, such as:
- **Init**: Fires when the form is initialized.
- **Load**: Fires when the form is loaded.
- **Unload**: Fires when the form is closed.
- **Click**: Fires when a button or control is clicked.
- **Writing Event Handlers**:
- Open the Code window for the form by clicking the **View Code** button in the Form Designer.
- Write the appropriate event handlers in the code window. For example, to handle the click event of a "Save" button, you might write:
```foxpro
PROCEDURE btnSave.Click
IF NOT EMPTY(thisform.txtName.Value)
INSERT INTO myTable (Name, Age) VALUES (thisform.txtName.Value, thisform.txtAge.Value)
MESSAGEBOX("Record Saved!")
ELSE
MESSAGEBOX("Please enter a name.")
ENDIF
ENDPROC
```
#### 6. **Testing the Form**
- **Run the Form**: Use the **Run** button in the Form Designer to test the form.
- **Check Functionality**: Verify that all controls function as expected and that data can be entered, saved, and retrieved correctly.
#### 7. **Refining the Form**
- **User Feedback**: If possible, gather feedback from users to identify any usability issues or additional features needed.
- **Debugging**: Use the VFP debugger to identify and fix any bugs or issues encountered during testing.
#### 8. **Deployment**
- **Create an EXE**: Once the form is finalized and tested, you can compile the project into an executable (EXE) file.
- **Distribute**: Share the executable and any necessary supporting files with users.
### Conclusion
Developing forms in Visual FoxPro involves a structured approach, from planning and designing to coding and testing. By following the steps outlined above, developers can create effective and user-friendly forms that facilitate interaction with the application and data. Leveraging the capabilities of VFP allows for the creation of robust desktop applications tailored to user needs.
==
Creating reports in Visual FoxPro (VFP) is a vital aspect of many applications, enabling users to generate, format, and present data in a structured manner. Below is a comprehensive guide on how to develop reports in VFP, including steps from planning and designing to generating and exporting reports.
### Steps to Develop a Report in Visual FoxPro
#### 1. **Planning the Report**
Before creating a report, it's essential to plan its content and layout:
- **Define the Purpose**: Determine what data the report will present and its intended audience.
- **Identify Data Sources**: Specify which tables, views, or cursors will provide the data for the report.
- **Outline the Structure**: Decide on the sections of the report (e.g., header, detail, footer) and any grouping or sorting requirements.
#### 2. **Creating a New Report**
To create a report in VFP:
1. **Open Visual FoxPro**: Start the VFP IDE.
2. **Create New Report**:
- Go to the **File** menu.
- Select **New**, and then choose **Report**.
- This opens the **Report Designer** window.
#### 3. **Designing the Report**
In the Report Designer, you can add and configure various elements of the report:
- **Report Sections**:
- **Header**: Contains the report title and any static information (e.g., date, company name).
- **Group Header**: Optional sections that appear before detail records based on specific grouping criteria.
- **Detail**: The main section where data records are displayed.
- **Group Footer**: Optional sections that summarize data for each group.
- **Footer**: Contains summary information for the entire report.
- **Adding Controls**:
- Use the **Toolbox** to drag and drop controls into the report sections. Common controls include:
- **Text Box**: For displaying data fields.
- **Label**: For titles and descriptions.
- **Line**: For horizontal or vertical lines to separate sections.
- **Image**: To add logos or other images.
- **Setting Properties**:
- Select each control and set its properties in the **Properties Window**. Common properties include:
- **ControlSource**: Specifies the data field the control will display.
- **Caption**: The text displayed on labels.
- **Font**: To set the font style, size, and color.
#### 4. **Binding Data to the Report**
To display data in the report, you need to set the data source:
- **Setting the Data Environment**:
- In the **Report Designer**, right-click on the report and select **Data Environment** to specify the data source.
- You can use a **Table**, **Cursor**, or **View** as the data source.
- **Defining SQL Queries** (optional):
- If you need to filter or aggregate data, you can define a SQL query to retrieve the desired dataset. This is done in the **Data Environment** by adding a query object.
#### 5. **Adding Calculated Fields and Summaries**
You may want to add calculations or summaries within the report:
- **Calculated Fields**: Use expressions to perform calculations. For example, to calculate a total price:
```foxpro
= Quantity * UnitPrice
```
- **Summary Fields**: Use the **Group Footer** to add summary fields, such as totals or averages for grouped data. For example, to calculate a total for a group, you can use:
```foxpro
SUM(FieldName)
```
#### 6. **Programming Report Logic (Optional)**
In some cases, you may want to add additional logic to the report generation process. This can be done using the **Report Properties** and event handlers:
- **Before/After Output**: You can write code in the **Before Output** or **After Output** events to manipulate data before or after the report is generated.
#### 7. **Testing the Report**
- **Preview the Report**: Use the **Preview** button in the Report Designer to generate a preview of the report and check for accuracy and formatting.
- **Check Layout**: Ensure that all controls are correctly aligned and that the report displays the data as expected.
#### 8. **Generating and Printing the Report**
Once the report is designed and tested, you can generate and print it:
- **Run the Report**: You can run the report from the **Report Designer** or through code in a VFP program.
**Example**:
```foxpro
REPORT FORM MyReport TO PRINTER
```
- **Export Options**: VFP allows you to export reports in various formats (e.g., PDF, Excel). You can specify the output format when generating the report:
```foxpro
REPORT FORM MyReport TO FILE "output.pdf" TYPE PDF
```
#### 9. **Deploying the Report**
- **Distribute the Report**: Once finalized, ensure that the report files and necessary resources are included when distributing your application.
### Conclusion
Developing reports in Visual FoxPro is a systematic process that involves planning, designing, and testing. By following the steps outlined above, developers can create effective and professional reports that meet user needs. VFP's reporting capabilities allow for extensive customization, enabling the presentation of data in a clear and visually appealing manner. Whether for internal use or external distribution, well-designed reports can enhance the value of any application.
===
Visual FoxPro (VFP) is a powerful development tool for building database applications, but it has several limitations when compared to modern technologies and development practices. Here’s a detailed overview of the limitations of Visual FoxPro in the context of contemporary technology:
### 1. **End of Support**
- **No Active Development**: Microsoft discontinued support for Visual FoxPro in 2010, meaning there are no new updates, features, or official patches available. This lack of support makes it increasingly difficult to maintain applications as environments and technologies evolve.
- **Compatibility Issues**: As operating systems and hardware change, VFP applications may face compatibility challenges, particularly with 64-bit systems and newer versions of Windows.
### 2. **Limited Integration with Modern Technologies**
- **Web Development**: VFP is primarily a desktop application development environment and lacks robust tools for creating modern web applications. While there are workarounds (like using VFP as a backend for web services), this requires significant effort and does not provide the flexibility found in modern web frameworks.
- **Mobile Development**: VFP does not support mobile application development directly, which limits the ability to create apps for smartphones and tablets. In contrast, modern frameworks like React Native or Flutter provide native mobile application capabilities.
### 3. **Database Limitations**
- **Single-User Limitations**: VFP's database file format (DBF) is designed for single-user access, making it less suitable for high-transaction environments or applications requiring robust multi-user capabilities.
- **Scalability**: As applications grow, VFP's performance can degrade, especially with larger datasets. Modern databases (like SQL Server, MySQL, or PostgreSQL) are designed to handle large volumes of data and concurrent user access more efficiently.
- **Lack of Advanced Database Features**: VFP lacks support for advanced database features such as stored procedures, triggers, and foreign key constraints, which are standard in modern relational database management systems.
### 4. **User Interface Limitations**
- **Aging UI Components**: VFP's built-in controls and UI components appear dated compared to modern user interface frameworks (like WPF, WinForms, or web-based UI frameworks). This can result in a less appealing user experience.
- **Responsive Design**: VFP does not support responsive design principles, making it challenging to create applications that work well on different screen sizes and resolutions.
### 5. **Limited Development Tools and Frameworks**
- **Toolset Limitations**: The development environment and tools available for VFP are limited compared to modern IDEs like Visual Studio, which offer advanced features like integrated debugging, code analysis, and modern language support.
- **Lack of Modern Language Features**: VFP does not support modern programming paradigms and features such as asynchronous programming, lambda expressions, or extensive library support that are available in languages like C#, Java, or Python.
### 6. **Community and Resources**
- **Decreasing Community Support**: As the user base for VFP continues to decline, the community support, resources, and knowledge sharing are also diminishing. Finding solutions, examples, or expertise in VFP has become more challenging compared to more widely used technologies.
- **Limited Documentation and Learning Resources**: With the discontinuation of support, there are fewer updated learning materials or documentation available, making it harder for new developers to learn VFP effectively.
### 7. **Version Control and Collaboration**
- **Version Control Integration**: VFP lacks seamless integration with modern version control systems (like Git). This complicates collaborative development, especially in teams that adopt agile practices or continuous integration/continuous deployment (CI/CD) methodologies.
- **Code Sharing**: Sharing code between developers can be cumbersome due to the nature of VFP projects, which do not lend themselves well to modularization and reuse compared to modern programming practices.
### 8. **Security Concerns**
- **Outdated Security Practices**: VFP does not inherently provide modern security features, making it challenging to implement contemporary security best practices. This includes secure authentication, authorization, and data encryption mechanisms.
- **Vulnerability to Attacks**: As with any older technology, VFP applications may be more susceptible to security vulnerabilities and attacks, especially if not maintained or updated to address emerging threats.
### Conclusion
While Visual FoxPro was a robust tool for its time, its limitations in the face of modern technology present significant challenges for current development needs. Organizations using VFP may find themselves at a crossroads, needing to evaluate the potential benefits of migrating to newer technologies and platforms that offer better support, integration, scalability, and user experience. Transitioning to modern development environments can help ensure applications remain relevant and secure in today's fast-paced technological landscape.
===
Despite the limitations and the end of official support for Visual FoxPro (VFP) by Microsoft, many organizations and developers continue to use it for various reasons. Here are some key factors contributing to the ongoing use of VFP:
### 1. **Legacy Systems and Applications**
- **Existing Investments**: Many businesses have significant investments in applications built with VFP. Rewriting or migrating these applications to newer platforms can be costly and time-consuming.
- **Stability and Reliability**: VFP applications, once developed, tend to be stable and reliable. Organizations often prefer to continue using these systems rather than risk disruptions associated with migrating to new technology.
### 2. **Familiarity and Expertise**
- **Skilled Workforce**: There are still many developers and IT professionals who are experienced in VFP. Their familiarity with the language and environment allows for efficient maintenance and updates to existing applications.
- **Rapid Development**: VFP is known for its rapid application development capabilities, enabling developers to create forms and reports quickly. This speed can be an advantage for maintaining legacy systems.
### 3. **Simplicity and Productivity**
- **Ease of Use**: VFP provides a straightforward environment for database management and application development. Its integrated tools allow developers to perform a range of tasks without needing to switch between different applications.
- **Integrated Development Environment**: The built-in IDE in VFP allows for easy design, testing, and debugging of applications, which can enhance productivity, especially for small to medium-sized applications.
### 4. **Cost-Effectiveness**
- **Low Overhead**: Organizations with existing VFP applications do not incur additional costs associated with migrating to a new platform, such as training, new software licenses, or infrastructure changes.
- **Free to Use**: VFP can still be downloaded and used without licensing fees, making it accessible for small businesses or startups that need a cost-effective solution.
### 5. **Data Management Capabilities**
- **Strong Data Handling**: VFP is adept at handling data, making it suitable for applications focused on data entry, reporting, and manipulation. It offers efficient data processing and management tools that some organizations find sufficient for their needs.
- **Built-in Support for DBF Files**: Many businesses still use DBF file formats for their data storage. VFP's native support for these files allows for straightforward management of existing data.
### 6. **Community and Third-Party Support**
- **Active User Community**: Although the official support has ended, there are still active user groups and online communities that provide resources, forums, and support for VFP developers.
- **Third-Party Tools**: Some third-party tools and libraries continue to enhance VFP's functionality, offering solutions for integrating modern features into existing applications (e.g., web services, newer database systems).
### 7. **Migration Options**
- **Incremental Migration**: Some organizations use VFP for specific tasks while gradually migrating other functionalities to modern systems. This hybrid approach allows businesses to leverage existing VFP applications while exploring modern alternatives.
- **Interfacing with Modern Systems**: VFP can be integrated with newer technologies and systems (such as .NET applications or web services) to extend its functionality, enabling organizations to maintain VFP while benefiting from modern capabilities.
### 8. **Use in Niche Applications**
- **Specific Use Cases**: Some industries or specific applications (like small businesses, accounting systems, or point-of-sale systems) have found that VFP meets their needs effectively without requiring the complexity of modern solutions.
- **Customization and Specificity**: VFP is often tailored for particular business processes or workflows, making it valuable for organizations with unique requirements that are well-served by existing VFP solutions.
### Conclusion
While Visual FoxPro may not be a front-runner in modern application development, its ongoing use in many organizations is a testament to its reliability, ease of use, and the strong existing investments made in VFP applications. As long as there is a need for rapid application development and the management of legacy systems, VFP will likely continue to find its place in the software landscape, albeit in a niche capacity. Organizations may need to consider a future transition strategy, but for now, VFP remains a viable option for specific use cases.
==
Yes, Visual FoxPro (VFP) can be downloaded for free, but there are some important considerations to keep in mind:
### 1. **Availability of Visual FoxPro**
- **Last Version**: The last released version of Visual FoxPro was **Visual FoxPro 9.0**, which was made available in 2004. While Microsoft discontinued support for it in 2010, the software itself remains available for download from various sources.
- **Microsoft Download Center**: Microsoft no longer provides direct downloads for VFP from its official website, but you can still find the installation files through other repositories or archives.
### 2. **Open Source Alternatives**
- **Community Contributions**: Some members of the VFP community have created tools and frameworks that enhance or extend the functionality of Visual FoxPro. These may also be available for free download and can be used in conjunction with VFP.
### 3. **Legal Considerations**
- **Licensing**: While you can find downloads for VFP, it is important to ensure that you are obtaining it from a reputable source and that you comply with any licensing agreements. Since VFP is no longer supported, Microsoft does not actively enforce its licensing policies, but it is always best to check the legality of the source from which you are downloading.
### 4. **Installation Files**
- **Third-Party Sources**: There are various online forums, community sites, and repositories where you can find installation files for Visual FoxPro. Some popular places to check include:
- **GitHub**: Occasionally, developers share old software for community use.
- **Developer Forums**: Sites like Stack Overflow or specialized VFP community forums may have links to download VFP.
### 5. **Installation Process**
- **Running the Installer**: Once you have downloaded the installation files, running the installer typically requires administrative privileges on your computer. Follow the prompts to complete the installation.
- **Compatibility**: Be aware that Visual FoxPro was originally designed for older versions of Windows. If you are running a newer operating system (like Windows 10 or 11), you may need to adjust compatibility settings to install and run VFP successfully.
### Conclusion
Visual FoxPro can still be downloaded and used for free, especially for those looking to maintain or develop legacy applications. However, users should ensure they obtain it from legitimate sources and be aware of the limitations and potential compatibility issues with modern operating systems.
===
Visual FoxPro (VFP) is a procedural programming
language and development environment from Microsoft, ideal for creating
data-driven applications. Here's an overview of some simple programming
concepts in VFP:
---
1. Hello,
World!
```foxpro
? "Hello, World!"
```
The `?` command displays text in the output window.
---
2. Variables
and Basic Operations
```foxpro
LOCAL num1, num2, result
num1 = 10
num2 = 20
result = num1 + num2
? "The sum is: " +
TRANSFORM(result)
```
- `LOCAL` declares variables.
- `TRANSFORM()` converts numeric values to strings for
concatenation.
---
3. Creating a
Simple Table
```foxpro
CREATE TABLE Test (ID INT, Name CHAR(50))
INSERT INTO Test VALUES (1,
"Alice")
INSERT INTO Test VALUES (2, "Bob")
```
- `CREATE TABLE` creates a new table.
- `INSERT INTO` adds records.
---
4. Reading Data
from a Table
```foxpro
USE Test
SCAN
?
"ID: " + TRANSFORM(ID) + ", Name: " + Name
ENDSCAN
```
- `USE` opens a table.
- `SCAN...ENDSCAN` loops through records.
---
5. Conditional
Statements
```foxpro
LOCAL age
age = 18
IF age >= 18
?
"You are eligible to vote."
ELSE
?
"You are not eligible to vote."
ENDIF
```
---
6. Simple Loops
```foxpro
LOCAL i
FOR i = 1 TO 5
?
"Number: " + TRANSFORM(i)
NEXT
```
- `FOR...NEXT` is used for looping.
---
7. Simple
Function
```foxpro
FUNCTION Greet(name)
RETURN "Hello, " + name + "!"
ENDFUNC
? Greet("Alice")
```
---
8. Basic Form
Creation
You can use the Form Designer, but programmatically:
```foxpro
oForm = CREATEOBJECT("Form")
oForm.Caption = "My First Form"
oForm.Width = 300
oForm.Height = 200
oLabel = CREATEOBJECT("Label")
oLabel.Caption = "Hello, Visual
FoxPro!"
oLabel.Top = 50
oLabel.Left = 50
oForm.AddObject("myLabel", oLabel)
oForm.Show()
READ EVENTS
```
---These examples demonstrate foundational concepts. Visual FoxPro also supports database operations, reports, and advanced user interface development. If you're starting, focus on understanding table manipulations and simple user interface programming.
===
*-----------------------------------------------To run
set colo to bg+
@03,00 TO 03,79
SET COLOR TO GR+
hed= "User Addition"
lhed = LEN(hed)
SET COLOR TO GR+
@03,(79-lhed)/2 say hed
set color to BG+
K_ESC=27
@ 4,00 clear to 24,79
@ 3,00 to 03,79
@24,00 TO 24,79 '°'
*----------Variables
msrl_no =
space(3)
ans_msg =
space(1)
mname =
spac(8)
sp =
space(78)
mpass =
spac(8)
mspass =
spac(8)
mnm =
spac(08)
superpass = space(8)
authpass1 = space(8)
mrole =
'Operator '
mloc_code = '001'
mans = 'N'
pm_setup = .t.
mchksup = .t.
msupvisor = .t.
msfound = .f.
*
set colo to n/w+
@ 3, 65 say "<Esc to Exit..>"
set colo to bg+
*
sele 26
USE LOGUSER INDE LOGUSER
save scre to
pass1
loca for level = '@'
*
if foun()
mnm = name
superpass =
notouse
else
msrl_no =
"050"
do usemsg
retu
endif
loca for level = '$'
if found()
mnm1 = name
authpass1 =
notouse
mchksup = .t.
msupvisor =
.t.
else
mchksup = .f.
msupvisor =
.f.
endif
*
con1pass = .t.
*
set colo to bg+
do whil con1pass
msuper = 'Y'
@ 06,01 say
"Authorisation Password: "
set colo to n
@ 06, 25 get
mspass pict "@!" func 'N'
read
set colo to
bg+
if
last() = 27
* restore
scre from pass1
return
endif
if mspass =
space(8)
loop
else
mspass =
chrt(mspass,;
'ABCDEFGHIJKLMNOPQRSTUVWXYZ~!@#$%^&*()-=+_<>?|./\{}[]
0123456789',;
'9876543210P~!@#$%^&*()-=+_<>?|./\{}[]ABCDEFGHIJKLMNO
QRSTUVWXYZ')
*
sele 26
set filt to
level = '@'
go top
do while
!eof()
if
mspass # notouse
sele
26
skip
loop
else
mnm = name
superpass = notouse
msfound = .t.
exit
endif
enddo
endif
*
if mspass #
superpass
mchksup =
.t.
else
* @ 06, 30
say name
mrole =
'Super User'
@ 06,01
clea to 06,78
@ 06, 01
say mrole
mchksup =
.f.
endif
*
sele 26
set filt to
if mchksup =
.t.
sele 26
set filt
to level = '$'
go top
do while
!eof()
if
mspass # notouse
sele
26
skip
loop
else
msfound = .t.
@
06, 30 say name
mrole = 'Supervisor'
@
06, 40 say mrole
exit
endif
enddo
sele 26
set filt
to
go top
*
if msfound
# .t.
msrl_no
= '053'
do
usemsg
exit
endif
endif
*
mname = spac(8)
mspass =
spac(8)
mlevel = '^'
@ 08,01 say
'User Role ............:'
@ 08,25 get
mrole when acc_role(mrole) pict '@!' valid val_role(mrole)
read
if
last() = 27
rest scre
from pass1
exit
endi
set colo to
bg+
do case
case
mrole = 'SUPER USER'
mlevel =
'0'
case
mrole = 'SUPERVISOR'
mlevel =
'1'
case
mrole = 'USERS'
mlevel =
'2'
case
mrole = 'OPERATOR'
mlevel =
'3'
endcase
*
@ 10,01 say
"User Name ............:"
@ 10,25 get
mname pict "@!" func 'A'
read
if
last() = 27
rest scre
from pass1
exit
endi
*
sele 26
seek mname
if found()
msrl_no =
"001"
do usemsg
@ 06,00
clea to 24,79
loop
endif
*
@ 11,01 say
"User Password.........: "
set colo to n
set inte off
@ 11,25 get
mspass pict "@!" func 'N'
read
set colo to
bg+
if
last() = 27
rest scre
from pass1
exit
endi
mspass =
chrt(mspass,;
'ABCDEFGHIJKLMNOPQRSTUVWXYZ~!@#$%^&*()-=+_<>?|./\{}[]
0123456789',;
'9876543210P~!@#$%^&*()-=+_<>?|./\{}[]ABCDEFGHIJKLMNO
QRSTUVWXYZ')
sele 26
appe blank
replace
name with mname
replace
notouse with mspass
do case
case
mlevel = '0'
mlevel = '@'
case
mlevel = '1'
mlevel = '$'
case
mlevel = '2'
mlevel = '~'
case
mlevel = '3'
mlevel = '^'
endcase
repl
level with mlevel
msrl_no =
'006'
do usemsg
exit
enddo
retu
*
func acc_role
para p_role
*
*if msupvisor = .F.
if mchksup = .f.
set colo to
w+/rb
defi popu
rolepop from 07,49 to 13,79 ;
footer
"<ENTER>-Select <ESC>-Exit"
defi bar 1 of
rolepop prom " Super User "
defi bar 2 of
rolepop prom " Supervisor "
defi bar 3 of
rolepop prom " Users "
defi bar 4 of
rolepop prom " Operator "
on sele popu
rolepop do rolepop with prom()
activ popu
rolepop
else
defi popu rolepop from 07,49 to 10,79 ;
footer
"<ENTER>-Select <ESC>-Exit"
defi bar 1 of
rolepop prom " Users "
defi bar 2 of
rolepop prom " Operator "
on sele popu
rolepop do rolepop with prom()
activ popu
rolepop
endif
set colo to bg+
retu p_role
*
func rolepop
para mprom
*mrole = uppe(subs(mprom,6,10))
mrole = allt(uppe(mprom))
deactivate popu rolepop
return
*
func val_role
para mrole
if mrole # "SUPER USER" and mrole #
"SUPERVISOR" and mrole # "USERS" and mrole #
"OPERATOR"
retu .F.
else
retu .T.
endif
retu
===
close all
clear
set dele on
hide menu all
hide popup all
sele a
use cheqreg
set order to tag cheqno
sele b
use funds
mcheqno = 0
mans = space(1)
m.part = space(35)
m.cheqdt = ctod("//")
m.cheqamt = 0
fdate = ctod("//")
@ 5,10 say " ** CANCEL CHEQUE **"
@ 7,10 say "CHEQUE NO. : " get mcheqno valid cheqno()
read
@ 9,10 say
"CHEQ-DATE :" get
m.cheqdt
@ 11,10 say "PARTICULARS :" get m.part
@ 13,10 say "AMOUNT :" get m.cheqamt pict
"9999999999.99"
@ 15,10 say "CHEQUE CANCEL...? (Y/N)" get
mans pict "@!x"
read
if lastkey()
= 27
close all
clear
return
endif
if mans =
"Y"
sele
cheqreg
repl stat
with "C"
delete
fdate =
f_Date
sele funds
set order
to tag fundsa
seek fdate
repl
curbal with curbal+m.cheqamt
endif
close all
clear
return
*-------------------------------
function cheqno
sele cheqreg
seek str(mcheqno,10)
if found()
m.part =
part
m.cheqdt
= cheqdt
m.cheqamt
= cheqamt
else
wait
window "Please check Cheque Number..." timeout 3
_curobj =
objnum(mcheqno)
endif
*----------------------------------------
clear
set stat off
sele a
use cheqreg
define window wshow from 3,3 to 23,73 double title "CHEQUE NO. ENTRY"
define window wshow1 from 3,3 to 23,80 double title "CHEQUE DATE ENTRY"
*brow fields part :H = 'PARTICULARS',cheqamt :H = 'AMOUNT',cheqno :H = 'CHEQ.NO' freeze cheqno for cheqno = 0 window wshow
*brow fields part :H = 'PARTICULARS',cheqamt :H = 'AMOUNT',cheqno :H = ' CHEQ.NO',cheqdt :H ='CHEQ.DT' FREEZE cheqdt for cheqdt = ctod("//") window wshow1
brow fields part :H = 'PARTICULARS',cheqamt :H = 'AMOUNT',cheqno :H = 'CHEQ.NO' for cheqno = 0 window wshow
brow fields part :H = 'PARTICULARS',cheqamt :H = 'AMOUNT',cheqno :H = ' CHEQ.NO',cheqdt :H ='CHEQ.DT' FREEZE cheqdt for cheqdt = ctod("//") window wshow1
*BROWSE FIELDS ytdpurch :H = 'Purchases:' , ;
* company :H = 'Company:' ;
* FREEZE ytdpurch
close all
===
close
all
clear
hide
menu all
hide
popup all
sele
a
use
cheqreg
sele
b
use
chq
copy
stru to cheque
sele
c
use
cheque
mfr
= 0
mto
= 0
ans
= space(1)
@
5,10 say "** CHEQUE PRINTING **"
@
7,10 say "CHEQUE RANGE"
@
7,25 say "FROM : " get mfr
@
7,45 say "TO : " get mto
read
@
9,10 say "PRINT ? (Y/N).." get ans pict "@!x"
read
if ans = "Y"
do getrec
brow
wait window "Please check the
Printer & Cheque Stationary.."
do chqprn
else
close all
clear
return to menu1
endif
close
all
clear
return
to menu1
*-------------------------------------------------------------------
proc
getrec
sele
* from cheqreg where cheqno >= mfr and cheqno <= mto into table tmp
sele
tmp
do while !eof()
sele cheque
appe blank
repl br_name with tmp.part,;
dwamt with tmp.cheqamt,;
cheq_no with tmp.cheqno,;
dt with tmp.cheqdt
sele tmp
if !eof()
skip
loop
endif
enddo
sele
cheque
GO
TOP
do
while !eof()
do newnum
sele cheque
if !eof()
skip
loop
endif
enddo
*--------------------------
PROC
NEWNUM
PARA
NUM
num
= cheque.dwamt
PUBLIC
ALL
GLOBAL_STRING
= ""
NOTOWORD_STRING
= ""
DIME
NUMNO(27)
NUMNO(1)
= 1
NUMNO(2)
= 2
NUMNO(3)
= 3
NUMNO(4)
= 4
NUMNO(5)
= 5
NUMNO(6)
= 6
NUMNO(7)
= 7
NUMNO(8)
= 8
NUMNO(9)
= 9
NUMNO(10)
= 10
NUMNO(11)
= 11
NUMNO(12)
= 12
NUMNO(13)
= 13
NUMNO(14)
= 14
NUMNO(15)
= 15
NUMNO(16)
= 16
NUMNO(17)
= 17
NUMNO(18)
= 18
NUMNO(19)
= 19
NUMNO(20)
= 20
NUMNO(21)
= 30
NUMNO(22)
= 40
NUMNO(23)
= 50
NUMNO(24)
= 60
NUMNO(25)
= 70
NUMNO(26)
= 80
NUMNO(27)
= 90
DIME
WORD(32)
WORD(1)
= "One"
WORD(2)
= "Two"
WORD(3)
= "Three"
WORD(4)
= "Four"
WORD(5)
= "Five"
WORD(6)
= "Six"
WORD(7)
= "Seven"
WORD(8)
= "Eight"
WORD(9)
= "Nine"
WORD(10)
= "Ten"
WORD(11)
= "Eleven"
WORD(12)
= "Twelve"
WORD(13)
= "Thirteen"
WORD(14)
= "Fourteen"
WORD(15)
= "Fifteen"
WORD(16)
= "Sixteen"
WORD(17)
= "Seventeen"
WORD(18)
= "Eighteen"
WORD(19)
= "Ninteen"
WORD(20)
= "Twenty"
WORD(21)
= "Thirty"
WORD(22)
= "Forty"
WORD(23)
= "Fifty"
WORD(24)
= "Sixty"
WORD(25)
= "Seventy"
WORD(26)
= "Eighty"
WORD(27)
= "Ninty"
WORD(28)
= "Paise"
WORD(29)
= ""
WORD(30)
= "Hundred"
WORD(31)
= "Thousand"
WORD(32)
= "Lakh"
STRNUM
= STR(NUM,10,2)
DECI
= VAL(SUBSTR(STRNUM,6,2))
HUND
= VAL(SUBSTR(STRNUM,5,1))
THOU
= VAL(SUBSTR(STRNUM,3,2))
LACK
= VAL(SUBSTR(STRNUM,1,2))
PAIS
= VAL(SUBSTR(STRNUM,9,2))
DIME
SPLIT(5)
SPLIT(5)
= PAIS
SPLIT(4)
= DECI
SPLIT(3)
= HUND
SPLIT(2)
= THOU
SPLIT(1)
= LACK
J
= 1
DO
WHILE J <= 5
IF RETWORD(SPLIT(J)) == .T.
NOTOWORD_STRING = NOTOWORD_STRING+ " "+GLOBAL_STRING+"
"+WORD(33-j)
ENDIF
j = j+1
ENDDO
NEW=
ALLTRIM(NOTOWORD_STRING)+" ONLY"
I
= LEN(NEW)
IF I > 40
SELE CHEQUE
REPL AMOUNT1 WITH
UPPER(LEFT(ALLTRIM(NEW),39))+ "-";
AMOUNT2 WITH "-"+
UPPER(RIGHT(ALLTRIM(NEW),I-39))
else
sele cheque
repl amount1 with upper(alltrim(NEW))
ENDIF
*-----------------------------------------
PROCEDURE
RETWORD20
PARA
NO
I
= 1
DO
WHILE I<=27
IF NUMNO(I) == NO
GLOBAL_STRING = WORD(I)
RETURN .T.
ENDIF
I=I+1
ENDDO
RETURN
.F.
PROCEDURE
RETWORD
PARA
NO
WRD1
= ""
IF
RETWORD20(NO) == .F.
ST = STR(NO,2)
NO1 = VAL(LEFT(ST,1))*10
NO2 = VAL(RIGHT(ST,1))
IF RETWORD20(NO1) == .T.
WRD1 = GLOBAL_STRING
IF RETWORD20(NO2) == .T.
GLOBAL_STRING
= WRD1 + " "+GLOBAL_STRING
RETURN .T.
ENDIF
ENDIF
RETURN .F.
ENDIF
RETURN
.T.
*--------------------------------
*-----------------------------------------------CLNTMAST.prg
* CLIENT Master Creation
*------------------------------------------------------------
@03,30 CLEAR TO 03,48
SET COLOR TO GR+
CDESP='** Client Master Change **'
CLEN = LEN(CDESP)
CPOS=(80-CLEN) / 2
@03,CPOS say CDESP
set color to BG+
K_ESC=27
@ 4,00 clear to 24,79
@ 5,00 to 05,79
@24,00 TO 24,79 '°'
*----------variables
M_CL_NM_OUT = SPACE(60)
mshrt_name = space(20)
msrl_no = space(3)
mclnt_code = '001'
m_cl_name = space(50)
m_add1 = space(40)
m_add2 = space(40)
m_add3 = space(40)
m_city = space(15)
m_state = space(20)
m_pin = space(8)
m_tanno = space(20)
m_tel_r = space(15)
m_tel_o = space(15)
mcont_per = space(20)
mi_date = space(8)
m_fax = space(40)
m_email = space(50)
m_sign = space(15)
mfrom_year = 0
mto_year = 0
mf_add1 = space(40)
mf_add2 = space(40)
mbill_auth = space(40)
mcdl_prd = 90
ans_msg=space(1)
declare opt[5]
option = space(1)
*---------------------------------------------
sele 1
use CLIENT
INDEX ON CLNT_CODE TO CLIENT
sele 1
DO WHILE (option # 'E')
@ 5,00 clear to 24,79
@ 5,00 to 05,79
@4,01 clear TO 04,78
@ 4, 10 PROMPT '\<Change'
opt[ 1] = 'C'
@ 4, 55 PROMPT '\<View'
opt[ 2] = 'V'
@ 4, 70 PROMPT '\<Exit'
opt[ 3] = 'E'
@ 4, 75 SAY SPACE(3)
set intensity on
nopt = 1
menu to nopt
set intensity off
if nopt >= 1 .and. nopt <= 3
option = opt[nopt]
else
option = space(1)
endif
if option = 'E'
exit
else
if option = 'V'
do VIEWFLDS
@ 5,01 to 05,78
else
set filter to
@ 5,00 clear to 24,79
@ 5,00 to 05,79
mclnt_code = '001'
do DISPSCRE && Display Screen
DO WHILE LASTKEY() != K_ESC
do CLOSE_OPEN
do GETKEY
if LASTKEY() = K_ESC
exit
else
sele CLIENT
seek (mclnt_code)
DO CASE
case option = 'C'
do CHANGE_OPT
case option = 'D'
do DELETE_OPT
ENDCASE
endif
ENDDO ( mclnt_code # '0')
endif
endif
ENDDO (option # 'E')
CLOSE ALL
@6,00 clear to 20,79
RETURN
*---------------------------------------------------
PROCEDURE CHANGE_OPT
if found()
do TRAFFLD
do DISPFLDS
do GETFLDS
*read
do REPLFLD
MSRL_NO = '007'
DO USEMSG
else
MSRL_NO = '002'
DO USEMSG
endif
set color to BG+
RETURN
*---------------------------------------------------------
PROCEDURE REPLFLD
sele CLIENT
repl clnt_code with mclnt_code
repl clnt_name with m_cl_name
repl short_name with mshrt_name
repl clnt_add1 with m_add1
repl clnt_add2 with m_add2
repl clnt_add3 with m_add3
repl clnt_city with m_city
repl clnt_state with m_state
repl clnt_pin with m_pin
repl clnt_telr with m_tel_r
repl clnt_telo with m_tel_o
repl clnt_tanno with m_tanno
repl clnt_contr with mcont_per
repl clnt_sign with m_sign
repl clnt_fax with m_fax
repl clnt_email with m_email
repl from_year with mfrom_year
repl to_year with mto_year
repl f_add1 with mf_add1
repl f_add2 with mf_add2
repl bill_auth with mbill_auth
do updtuser
RETURN
*---------------------------------------------------------
PROCEDURE DISPSCRE
@ 6, 0 clear to 24, 79
set colo to n/w+
@ 05, 65 say '<Esc to Exit..>'
set colo to bg+
@ 6, 1 SAY 'Tele. Office Code.:'
@ 8, 1 SAY 'Name .............:'
@ 09, 1 SAY 'Short Name.......:'
@ 10, 1 SAY 'Address line1....:'
@ 11, 1 SAY 'Address line2....:'
@ 12, 1 SAY 'Address line3....:'
@ 13, 1 SAY 'City Name........:'
@ 13, 45 SAY 'State..:'
@ 14, 1 SAY 'Pin code.........:'
@15,1 to 15,78
@ 16, 1 SAY 'Contact Person...:'
@ 17, 1 SAY 'Phone (Res) (Off):'
@ 18, 1 SAY 'Fax No...........:'
@ 19, 1 SAY 'E_Mail Address ..:'
@ 20, 1 SAY 'Fin.From-To Years:'
@ 21, 1 SAY 'From Name.& Addr.:'
@ 22, 1 SAY 'Address-2........:'
@ 23, 1 SAY 'Billing Authority:'
RETURN
*----------------------------------------------------
PROCEDURE GETKEY
DO WHILE .T.
@ 6, 19 get mclnt_code pict '@!'
read
if lastkey() = k_esc
exit
endif
if mclnt_code # clnt_code
msrl_no = '002'
do USEMSG
loop
else
exit
endif
ENDDO
RETURN
*------------------------------------------------------
PROCEDURE GETFLDS
@ 8, 19 get m_cl_name pict '@!'
@ 09, 19 get mshrt_name pict '@!'
@ 10, 19 get m_add1 pict '@!'
@ 11, 19 get m_add2 pict '@!'
@ 12, 19 get m_add3 pict '@!'
@ 13, 19 get m_city pict '@!'
@ 13, 55 get m_state pict '@!'
@ 14, 19 get m_pin pict '@!'
@ 16, 19 GET mcont_per
@ 17, 19 GET m_tel_r pict '@!'
@ 17, 39 GET m_tel_o pict '@!'
@ 18, 19 GET m_fax
@ 19, 19 GET m_email
do while .t.
@ 20, 19 get mfrom_year pict '9999'
@ 20, 40 get mto_year pict '9999'
read
if mto_year < mfrom_year
loop
else
exit
endif
enddo
@21, 19 get mf_add1 pict '@!'
@22, 19 get mf_add2 pict '@!'
@23, 19 get mbill_auth pict '@!'
read
SET COLO TO BG+
RETURN
*------------------------------------------------------
PROCEDURE DISPFLDS
@ 8, 20 say m_cl_name pict '@!'
@ 09, 20 say mshrt_name pict '@!'
@ 10, 20 say m_add1 pict '@!'
@ 11, 20 say m_add2 pict '@!'
@ 12, 20 say m_add3 pict '@!'
@ 13, 20 say m_city pict '@!'
@ 13, 56 say m_state pict '@!'
@ 14, 20 say m_pin pict '@!'
@ 16, 20 say mcont_per pict '@!'
@ 17, 20 say m_tel_r pict '@!'
@ 17, 40 say m_tel_o pict '@!'
@ 18, 20 say m_fax
@ 19, 20 say m_email
@ 20,20 say mfrom_year pict '9999'
@ 20, 41 say mto_year pict '9999'
@21, 20 say mf_add1 pict '@!'
@22, 20 say mf_add2 pict '@!'
@23, 20 say mbill_auth pict '@!'
RETURN
*------------------------------------------------------
PROCEDURE INITFLDS
m_cl_name = space(50)
mshrt_name = space(20)
m_add1 = space(40)
m_add2 = space(40)
m_add3 = space(40)
m_city = space(15)
m_state = space(20)
m_pin = space(8)
m_tel_r = space(15)
m_tel_o = space(15)
m_fax = space(40)
m_email = space(50)
mcont_per = space(10)
m_tanno = space(20)
m_sign = space(15)
mfrom_year = 0
mto_year = 0
mf_add1 = space(40)
mf_add2 = space(40)
mbill_auth = space(40)
RETURN
*--------------------------------------------------
PROCEDURE TRAFFLD
m_cl_name = clnt_name
mshrt_name = short_name
m_add1 = clnt_add1
m_add2 = clnt_add2
m_add3 = clnt_add3
m_city = clnt_city
m_state= clnt_state
m_pin = clnt_pin
m_tel_r = clnt_telr
m_tel_o = clnt_telo
mcont_per = clnt_contr
m_fax = clnt_fax
m_email = clnt_email
mfrom_year = from_year
mto_year = to_year
mf_add1 = f_add1
mf_add2 = f_add2
mbill_auth = bill_auth
RETURN
*--------------------------------------------------
PROCEDURE VIEWFLDS
SELE CLIENT
go top
do TRAFFLD
do DISPSCRE
do DISPFLDS
WAIT""
*BROWSE NOEDIT
@05, 00 clear to 24, 79
RETURN
*---------------------------------------------------
PROCEDURE CLOSE_OPEN
sele 1
use
sele 1
use CLIENT index CLIENT
RETURN
*--------------------------------------------------
PROCEDURE GET_SNAME
l=len(m_cl_name)
ms_name = ''
ms_name= substr(m_cl_name,1,1)+' '
spc_pos1 = AT(' ',m_cl_name)
ms_name = ms_name+substr(m_cl_name,spc_pos1+1,1)
x=substr(m_cl_name,spc_pos1+1,l)
l=len(x)
spc_pos2 = AT(' ',x)
ms_name=ms_name+substr(x,spc_pos2,spc_pos2+1)
mshrt_name = ms_name
RETURN
====
In Visual
FoxPro (VFP), SET commands are used to configure the environment and
control the behavior of the system. These commands allow developers to
customize settings such as data handling, user interface properties, and system
behavior. Below is a categorized overview of some commonly used SET commands
in Visual FoxPro:
1. Data
Handling Commands
- SET ALTERNATE
Controls whether output is sent to an alternate file.
·
SET
ALTERNATE ON
·
SET
ALTERNATE TO log.txt
- SET DATE
Specifies the date format.
·
SET DATE
TO DMY && Day-Month-Year
- SET CENTURY
Determines whether a four-digit year is used.
·
SET
CENTURY ON
- SET DELETED
Specifies whether records marked for deletion are included in the result set.
·
SET
DELETED ON
- SET EXACT
Determines whether string comparisons must be exact.
·
SET EXACT
ON
2.
Display and Formatting Commands
- SET COLOR
Sets the color scheme for the interface.
·
SET COLOR
TO N/W && Normal text is white
on black
- SET BELL
Enables or disables the system bell.
·
SET BELL
OFF
- SET ECHO
Determines whether commands in a program are displayed on the screen.
·
SET ECHO
OFF
- SET FORMAT
Controls how fields are displayed in output.
·
SET
FORMAT TO
- SET TALK
Controls whether command results are displayed.
·
SET TALK
OFF
3. File
and Memory Management
- SET DEFAULT
Specifies the default directory.
·
SET
DEFAULT TO C:\Projects
- SET PATH
Specifies the search path for files.
·
SET PATH
TO C:\Data
- SET SAFETY
Determines whether confirmation is required when overwriting files.
·
SET
SAFETY OFF
4.
Indexing and Sorting
- SET ORDER
Specifies the active index tag in the currently selected work area.
·
SET ORDER
TO TAG CustomerID
- SET COLLATE
Sets the collation sequence for string comparisons.
·
SET
COLLATE TO "MACHINE"
5. SQL
and Query Settings
- SET ANSI
Controls how SQL queries treat string comparisons.
·
SET ANSI
OFF
- SET ENGINEBEHAVIOR
Configures how the SQL engine processes commands.
·
SET
ENGINEBEHAVIOR 70
6.
Environment Configuration
- SET EXCLUSIVE
Determines whether a table is opened exclusively or shared.
·
SET
EXCLUSIVE OFF
- SET MULTILOCKS
Enables or disables record locking for multiple records.
·
SET
MULTILOCKS ON
- SET CURRENCY
Specifies the currency symbol.
·
SET
CURRENCY TO "$"
7.
Debugging and Development
- SET STEP ON
Enables the debugger during program execution.
·
SET STEP
ON
- SET DEBUG
Turns the Debug Window on or off.
·
SET DEBUG
ON
8.
Miscellaneous
- SET SYSFORMATS
Controls whether system formats are used.
·
SET
SYSFORMATS ON
- SET PRINTER
Directs output to the printer.
·
SET
PRINTER ON
·
SET
PRINTER TO NAME "HP_LaserJet"
Example:
Combining SET Commands
SET DATE TO DMY
SET CENTURY ON
SET DELETED ON
SET EXCLUSIVE OFF
SET PATH TO C:\MyApp\Data
SET TALK OFF
This
configuration ensures:
- Date formats use
day-month-year with a four-digit year.
- Deleted records are excluded
from results.
- Tables are opened in shared
mode.
- The data path is set to a
specific directory.
- Command results are not
displayed.
Conclusion
SET
commands in Visual FoxPro are powerful tools for customizing the application
environment. Proper usage ensures smoother operations, better debugging, and
adherence to project requirements.
.png)
.png)
No comments:
Post a Comment