Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Clearing values in EXPR, TAG, TAG2
Message
Information générale
Forum:
Visual FoxPro
Catégorie:
Gestionnaire de rapports & Rapports
Divers
Thread ID:
00672346
Message ID:
00672533
Vues:
15
I use the similar program.
********************************************************************
*  Description.......: RemovePrinterSpecificInfo - Removes printer specific settings in report form
*  Calling Samples...: RemovePrinterSpecificInfo('All')
*  Parameter List....: pRepoForm
*  Created by........: Yuri Rubinov July 2000
*  Modified by.......: Nadya Nosonovsky 01/11/2002 01:51:06 PM
********************************************************************
parameter pRepoForm
local ia
if vartype(pRepoForm)#"C"
	pRepoForm=getfile("frx")
endif

do case
case upper(m.pRepoForm)#"ALL"
	pRepoForm=forceext(m.pRepoForm,"frx")

	if not file(m.pRepoForm)
		=messagebox("Report Form "+ m.pRepoForm +" not found?!",48,'Not found')
		return .f.
	endif
	do iClean
otherwise
	local array aa[1]
	local lcPath, lcFilter, DTitle, lcReportDir, lnFiles
	lcReportDir = '\redp\dbc\jobs\Reports'
	lcPath =''
	DTitle = "Select Report Files to Remove Printer Specific Info..."
* Text (*.txt)|*.txt|Pictures (*.bmp;*.ico)|*.bmp;*.ico
	lcFilter = "Report Files (*.frx)|*.frx|All Files (*.*)|*.*"
	lnFiles = File_Chooser(@aa, @lcPath, m.DTitle, m.lcReportDir, m.lcFilter)
	if m.lnFiles = 0 && User chooses Cancel
		return .f.
	endif
*!*
*!*		if adir(aa,"*.frx")<=0
*!*			=messagebox("No *.frx Report Forms found?!")
*!*			return
*!*		endif
	=asort(aa)
	for ia =1 to m.lnFiles
		pRepoForm=addbs(m.lcPath)+aa[m.ia]
		do iClean
	endfor
endcase

*----------------------------------
procedure iClean
local lcExpr, lnLines, lnI, CR
close table all
use (m.pRepoForm)
wait wind time 0.5 "Report form "+dbf()
=afields(afld)
CR=chr(13)
* the very first record only
if ascan(afld,"TAG")#0 and ascan(afld,"TAG2")#0 and ascan(afld,"EXPR")#0
	go top
*keep orientation and other stuff
    lnLines = alines(laLines,expr,.t.)
    lcExpr = ""
    for lnI = 1 to m.lnLines
        if "DEVICE" $ upper(laLines[m.lnI]) or "DRIVER" $ upper(laLines[m.lnI]) or "OUTPUT" $ upper(laLines[m.lnI])
            && this record should be removed
        else
           if "DEFAULTSOURCE" $ upper(laLines[m.lnI])
               laLines[m.lnI] = "DEFAULTSOURCE=7"   
           endif
           lcExpr = m.lcExpr + laLines[m.lnI]+ m.CR
        endif        
    next
*!*		if "orientation"$lower(expr)
*!*			lcOrient=substr(expr,at("orientation=",lower(expr))) && Remove the begining of the Expr field
*!*		endif	     
	replace tag with "", tag2 with "", expr with m.lcExpr
else
	=messagebox("File "+m.pRepoForm+". Not VFP6 format?!")
endif
use
*-----------------
>Hello,
>
>I have a user who complains that some of the reports are causing errors and crashes with her new printer. I figured I could clear out the DEVICE=, DRIVER=, OUTPUT= lines in the report's EXPR field and also clear out the tag and tag2 fields (the first record in the FRX table -- objtype = 1 AND objcode = 53). Below is the code I will use to do that.
>
>Any comments, warnings, suggestions would be appreciated.
>
>
>** ClearFRXsettings.prg
>** right now gets a single file, will modify to process entire directory
>Close data all
>lcReportFile=getFile('frx','Get Report')
>If not empty(lcReportFile)
>	Use (lcReportFile) in 0 alias frxReport
>	Select frxReport
>	Locate FOR objtype = 1 AND objcode = 53
>	If FOUND()
>	** Find out how many lines in memo field. Find mline for DEVICE, OUTPUT, DRIVER delete these lines
>		m.memolines= memlines(expr)
>		nDeviceline=atcline("DEVICE=",expr)
>		nOutputLine=atcline("OUTPUT=",expr)
>		nDriverline=atcline("DRIVER=",expr)
>		m.NewExpr=""
>		For i = 1 to m.memolines
>			If i#nDeviceline and i#nOutputLine and i#nDriverline
>				m.NewExpr=m.NewExpr + mline(expr,i) +chr(013)
>			Endif
>		Endfor
>		Replace expr with m.NewExpr
>		Replace tag WITH ""
>		Replace tag2 WITH ""
>	Endif   (Found())
>Endif  (not empty(lcReportFile)
>
>Use in frxReport
>
>
>Thanks,
>
>Kevin
If it's not broken, fix it until it is.


My Blog
Précédent
Suivant
Répondre
Fil
Voir

Click here to load this message in the networking platform