Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : RRSTUF.ZIP
Filename : RPTMENU.PRG

 
Output of file : RPTMENU.PRG contained in archive : RRSTUF.ZIP

*-----------------------------------------------
* Developed By: Jeff Jarrell CIS 71521,2134
* Last Update: 1/5/89
* Note: Nothing trick, just compile rptmenu.prg
* if you use call_prg be sure module gets linked in
*-------------------------------------------------

set scoreboard off
araypos = 1
key = 0
curelement = 1
drecno = 0

*-- Build report menu from dbf
use rptcntl
if .not. file('rptcntl.ndx')
inde on iif(que=' ','~',que) to rptcntl
else
set index to rptcntl
endif

*---declare arrays for rptmenu------
declare rptnames[reccount()]
declare rptrecno[reccount()]

*---load menu array for reports-----
do load_rpts

do while .t.
if key = 27 .OR. KEY = 17
clear
close databases
return
endif

*-- Display menu header
SET COLOR TO +GR/B
CLEAR
@ 5,8 SAY "Ref Que Dest Report Name"
@ 6,8 SAY "ÄÄÄ ÄÄÄ ÄÄÄÄ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ"
SET COLOR TO +GR/N
@ 0,0,2,79 BOX "ÚÄ¿³ÙÄÀ³"
SET COLOR TO +W/N
@ 1,1,1,78 BOX " "
@ 1,29 SAY "Reports Queing Screen"
SET COLOR TO +GR/N
@ 17,14,23,64 BOX "ÚÄ¿³ÙÄÀ³"
@ 17,16 SAY " Special Keys "
SET COLOR TO +W/N
@ 18,15 CLEAR TO 22,63
@ 19,16 SAY "^P - To Print All Qued Reports"
@ 20,16 SAY " - To Print Selected Report"
@ 21,16 SAY " - To edit Que and Destination Fields"
@ 22,16 SAY " - Return To Previous Screen{j}"

*-- Display & select report
SET COLOR TO +W/b, +w/r,b
achoice(7,8,15,71,rptnames,[dumaray],[rptedit],araypos)
enddo
*-----------------------------------------------------------------


*----------------
function rptedit
*----------------
parameters mode,curelement,relposition
key = lastkey()

set cursor on

do case
case key = 1
* --[home] selected go to first element
araypos = 1

case key = 6
* --[end] selected go to last on screen
araypos = len(rptnames)

case key = 22
* --[ins] selected --- Edit Que & Dest fields
quem = substr(rptnames[curelement],12,1)
desm = substr(rptnames[curelement],22,1)
@ 7+relposition,19 get quem
@ 7+relposition,29 get desm pict '!' && valid vdest(desm)
read
drecno = rptrecno[curelement]
goto drecno

replace que with quem, ri_printer with desm
do load_rpts

case key = 16
* -- [CTRL-P] selected --- Print qued reports
do gorpt with .t.

case key = 13
* --[return] selected --- Print report
drecno = rptrecno[curelement]
goto drecno
do gorpt with .f.
case key = 27
* ---esc just needs to fall through--
otherwise
return 2
endcase
return 0
*-------------------------------------------


*--------------
proc load_rpts
*--------------
dumaray = ' '
dummy = 0
goto top
do while .not. eof()
dummy = dummy + 1
rept = str(dummy,2) + ')' + space(8) + que + space(9) + ri_printer + ;
space(12) + ri_report
rptrecno[dummy] = recno()
rptnames[dummy] = rept
skip
enddo

*---position to proper element-------*
tvalue = ascan(rptrecno,drecno)
araypos = iif(tvalue=0,1,tvalue)
return
*------------------------------------------------------------------------




*----------------
proc gorpt
*-----------------

*---printall is a logical, to print all reports, or current report
parameters printall
save screen to rptscrx
anydisp = .f.
rpts = ''
norpts = .t.
oldmaster = 'xXx'
if printall
go top
endif

do while .not. eof() .and. .not. que = ' '
norpts = .f.
printrec = recno()
rpt = ' '
rpt = ltrim(str(recno()))
rptname = '#' + que + ' '+ rtrim(ri_report)


*---call program, if any in call_prg field---*
if .not. empty(call_prg)
prgtogo = call_prg
do &prgtogo
endif

rptstat = 'Printing . . '

anydisp = iif(ri_printer $ 'dD',.t.,.f.)

do rptstat

close databases

* ---call report writer-------------------
set cursor off
! rruntime rptcntl &rpt
set cursor on

* ---check output status------------------
use rrunout
if ro_ecode = 'n'
rptstat = 'Completed'
else
rptstat = trim(ro_emsg)
endif

use rptcntl index rptcntl

if anydisp
restore screen from rptscrx
endif

do rptstat

set color to w/b
if .not. rptstat = 'Completed'
do delay
endif

goto int(printrec)
if .not. printall
exit
endif
skip
enddo

set color to w/b
if norpts
@20,19 say 'No reports Selected '
do delay
endif

return

*------------------
proc call_gorpt
*------------------
save screen to crpt
do gorpt with .f.
restore screen from crpt
return

*-----------------
function rptstat
*-----------------

SET COLOR TO +GR/B
@ 20,00 CLEAR TO 23,79
@ 20,00 TO 23,79 DOUBLE
@ 21,02 SAY "Report Name =>"
@ 22,09 SAY "Status =>"

set color to +w/b
@21,19 clear to 22,78
@21,19 say rptname
set color to *+w/b
@22,19 say rptstat
set color to &colors
return .t.
*----------------------------------------

*-----------
Proc Delay
*----------

@24,62 say 'Press any key . .'
do while inkey() = 0
enddo
@24,0
return