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

 
Output of file : RPRRUNIN.PRG contained in archive : RPRUN.ZIP

#include "rp.ch"
#include "rptrans.ch"


/*ÚÄ Function ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ Function: rpRunnin() ³
³ Description: Load & Set all Bandit Report Defaults from RRUNIN.DBF ³
ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
³ Arguments: RRUNIN FILE, RECORD IN FILE, DATABASE OPEN FLAG ³
³ Return Value: oRP ³
³ Author: Richard Horwitz & John H. Stolte, Sr. ³
³ Date created: 12-15-93 ³
³ Copyright: 1993 by Fieldston Consulting Group Inc. & Omicron Software ³
³ COMMENTS: Distribute Freely ³
³ NOTES: You will have to modify your RRUNIN.DBF to contain a field ³
³ called bPRINTER which should contain the NAME of the ³
³ BANDIT Printer (from Printers.dbf. bPrinter C, 40) ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ*/
/* compile with /DTEST for a standalone test program
-----------------------------------------------------*/
#IFDEF TEST
Function Start
local x:=0
cls
@ 10 , 10 say "Input Report Number to run " GET x VALID x <> 0
read
rpRRUNIN("rrunin.dbf",x,.t.)
Return nil
#ENDIF

// params are RRUNIN FILE, RECORD IN FILE, Whether or not to open databases
/*------------------------------------------------------------------------*/

FUNC rpRRunin(cFile, nRec,lOpenfile )
local nK := 0
local cTmp := ""
local nTmp := 0
local nArea := select()
local cAlias := ""
local cADBF := ""
local cIndex := ""
local cTag := ""
local oDB := NIL
local lReOpen := FALSE
local uVar := NIL
local keepgoing := .t.
local cPaths := GETE("BANDIT")
local cRH1 := rpCurDir()
local cDBF := rpCurDir()
local cNTX := rpCurDir()
local cSWAP := ""
local oRP := NIL

/* use RRUNIN file
--------------------*/
USE (cFile) ALIAS RRFILE NEW

/* go to the record
--------------------*/
GO nRec

/* if paths weren't set, use current directory
------------------------------------------------*/
IF( !empty( cPaths ) )
cRH1 := alltrim( strextract( cPaths, ";", 1 ) )
cDBF := alltrim( strextract( cPaths, ";", 2 ) )
cNTX := alltrim( strextract( cPaths, ";", 3 ) )
cSWAP := alltrim( strextract( cPaths, ";", 4 ) )
ENDIF

/* no swap set? see if it's in the environment
------------------------------------------------*/
IF( empty( cSWAP ) )
cSWAP := GETE("TEMP")
IF( empty( cSWAP ) )
cSWAP := rpCurDir()
ENDIF
ENDIF

/* create new report object
----------------------------*/
oRP := rpNew( 5, 2, lastrow()-2, lastcol()-2, 31, 128, cRH1, cDBF, cNTX, cSWAP )

/* set system rdd info. this func is in RPRDDSUP.PRG
-----------------------------------------------------*/
rpSetRDDs( oRP ) // user has to modify and link rprddsup.prg

/* general CLIPPER stuff
---------------------------*/
set dele on
set scor off
cls(23, chr(177))
readinsert( .t. )
setboxchars( SINGLE )
SETCOLOR( attrtoa( rpColor( oRP ) ) + "," + attrtoa( roloc( rpColor( oRP ) ) ) + ",," + attrtoa( rpColor( oRP ) ))

/* load the report specified in the rrunin file
------------------------------------------------*/

oRP := rpretrieve(orp,rtrim(rrfile->RI_LIBRARY),lOpenFile)

/* changing master file
------------------------*/
IF( !empty( RRFILE->RI_MASTER ) )
rpDBTable( rpGetRDO( oRP, 1 ), trim( RRFILE->RI_MASTER ) )
ENDIF

/* changing master index
-------------------------*/
IF( !empty( RRFILE->RI_MINDEX ) )
rpDBIndex( oRP, rpGetRDO( oRP, 1 ), trim( RRFILE->RI_MINDEX ) )
ENDIF


/* set printer or display or file
----------------------------------*/

DO CASE
CASE upper(RRFILE->RI_PRINTER) == "D" // DISPLAY
rpDestination( oRP, rpDISPLAY )

CASE upper(RRFILE->RI_PRINTER) == " " // default device saved with report
rpDestination( oRP, rpPRINTER )

CASE upper(RRFILE->RI_PRINTER) $"12345678" //Printer
IF !empty(RRFILE->BPRINTER) // set it
rpPrinter( oRP, alltrim(RRFILE->BPRINTER) )
rpDestination( oRP, rpPRINTER )
ELSE
rpPickPrinter( oRP ) // pick one then set it
rpDestination( oRP, rpPRINTER )
ENDIF

CASE upper(RRFILE->RI_PRINTER) == "A" //Ascii Printer for file
rpPrinter( oRP, "ASCII" )
ENDCASE

/* changing output file
------------------------*/
IF( !empty( RRFILE->RI_OUTFILE ) )
rpOutFile( oRP, RRFILE->RI_OUTFILE )
rpDestination( oRP, rpPRINTER_FILE )
ENDIF

/* set overwrite flag - Note: Works Reverse of R&R, hence the IIF()
-------------------------------------------------------------------*/
rpOverMode( oRP, IIF(RRFILE->RI_OUTAPPN,.f.,.t.) )


/* changing starting page
--------------------------*/
IF( RRFILE->RI_BEGPAGE > 0 )
rpStartPage( oRP, RRFILE->RI_BEGPAGE )
ENDIF

/* changing ending page
--------------------------*/
IF( RRFILE->RI_ENDPAGE > 0 )
rpStartPage( oRP, RRFILE->RI_ENDPAGE )
ENDIF

/* if there was a scope defined
--------------------------------*/
IF( !empty( RRFILE->RI_SCOPE ) )

/* clear the scope
--------------------*/
IF( upper( RRFILE->RI_SCOPE ) EQ "E" )
rpScopeType( oRP, " " )

/* override (NOTE: A scope must have previously been defined in oRP)
--------------------------------------------------------------------*/
ELSEIF( upper( RRFILE->RI_SCOPE ) EQ "O" )
DO CASE
CASE( rpScopeType( oRP ) EQ "C" )
rpScopeLow( oRP, trim( RRFILE->RI_LOSCOPE ) )
rpScopeHigh( oRP, trim( RRFILE->RI_HISCOPE ) )
CASE( rpScopeType( oRP ) EQ "N" OR rpScopeType( oRP ) EQ "R" )
rpScopeLow( oRP, val( RRFILE->RI_LOSCOPE ) )
rpScopeHigh( oRP, val( RRFILE->RI_HISCOPE ) )
CASE( rpScopeType( oRP ) EQ "D" )
rpScopeLow( oRP, ctod( RRFILE->RI_LOSCOPE ) )
rpScopeHigh( oRP, ctod( RRFILE->RI_HISCOPE ) )
CASE( rpScopeType( oRP ) EQ "L" )
rpScopeLow( oRP, IIF( "T" $ upper( RRFILE->RI_LOSCOPE ), .t., .f. ) )
rpScopeHigh( oRP, IIF( "T" $ upper( RRFILE->RI_HISCOPE ), .t., .f. ) )
ENDCASE
ENDIF
ENDIF

/* changing number of copies
-----------------------------*/
IF( RRFILE->RI_COPIES > 0 )
rpCopies( oRP, RRFILE->RI_COPIES )
ENDIF

/* changing query
------------------*/
IF( !empty( RRFILE->RI_QUERY ) )

DO CASE

/* clear query
----------------*/
CASE( RRFILE->RI_QUERY EQ "E" )
rpQueryTBlock( oRP, "{||.t.}" )

/* override
-------------*/
CASE( RRFILE->RI_QUERY EQ "O" )

/* no filter set
------------------*/
IF( empty( RRFILE->RI_FILTER ) )
rpQueryTBlock( oRP, "{||.t.}" )
ELSE
rpQueryTBlock( oRP, "{|oRP|"+ trim( RRFILE->RI_FILTER ) +" }" )
ENDIF

/* go into interactive query building
---------------------------------------*/
CASE( RRFILE->RI_QUERY EQ "I" )
rpBuildQuery( oRP )

ENDCASE

ENDIF

/* now check for alias/file modifications
------------------------------------------*/
cTmp := "RI_ALIAS"

FOR nK := 1 to 99

lReOpen := FALSE

/* outta alias fields
-----------------------*/
nTmp := fieldpos( cTmp + ltrim( str( nK, 2 ) ) )
IF( nTmp EQ 0 )
EXIT
ENDIF

/* nothing in the field
-------------------------*/
cTmp := fieldget( nTmp )
IF( empty( cTmp ) )
LOOP
ENDIF

/* get pieces to update
-------------------------*/

cAlias := upper( strextract( cTmp, "=", 1 ) )
cTmp := alltrim( strextract( cTmp, "=", 2 ) )
cADBF := trim( strextract( cTmp, ",", 1 ) )
cIndex := trim( strextract( cTmp, ",", 2 ) )
cTag := trim( strextract( cTmp, ",", 3 ) )

/* no alias to update
----------------------*/
IF( empty( cAlias ) )
LOOP
ENDIF

/* get associated database object
----------------------------------*/
oDB := rpGetRDO( oRP, cAlias )

/* not found?
--------------*/
IF( empty( oDB ) )
LOOP
ENDIF

/* setting a new data file
----------------------------*/
IF( !empty( cADBF ) )
rpDBTable( oDB, trim( cADBF ) )
lReOpen := TRUE
ENDIF

IF( !empty( cIndex ) )
oDB[ rpDATABASE_INDEX ] := cIndex
lReOpen := TRUE
ENDIF

IF( !empty( cTag ) )
oDB[ rpDATABASE_ORDER_NAME ] := cTag
IF( !lReOpen )
dbSelectAr( cAlias )
SET ORDER TO (cTag)
dbSelectAr( "RRFILE" )
ENDIF
ENDIF

IF( lReOpen )
(oDB[ rpDATABASE_ALIAS ])->( dbCloseArea() )
rpDBOpen( oRP, oDB )
ENDIF

NEXT

IF( !empty( RRFILE->RI_MEMO ) )
rpAsciiMemo( oRP, trim( RRFILE->RI_MEMO ) )
ENDIF

/* Tell Bandit whether or not to show the counter at run time
--------------------------------------------------------------*/
rpShowCounter( oRP, RRFILE->RI_STATUS )

IF RRFILE->RI_STATUS //if true, show the screen
cls

/* show the prints screen
---------------------------*/
rpShowPrint( oRP )
ENDIF

/* close the file
-----------------*/
USE

/* back to original area
-----------------------*/
dbSelectAr( nArea )

/* Run the hummer
-----------------*/
rpGenReport( oRP )

/* kill the sorts database
-----------------*/
rpKillSorts( oRP )

cls
return( oRP )

/*------------------------------------------------------------------------*/