Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Updated Sample.prg to include PDF export
Message
General information
Forum:
Visual FoxPro
Category:
FRX2Any
Title:
Updated Sample.prg to include PDF export
Miscellaneous
Thread ID:
00836274
Message ID:
00836274
Views:
136
Good Morning,

I have a report that I want to export to PDF using FRX2Any (latest version). I use a modified version of the Sample.prg as a method (see the end of my message) in my project to include a constant to print to PDF. The output only shows the Header information with no detail.

I can export the report to Word, Excel and HTML and it shows up perfectly. I can send the report if it would be helpful to diagnose the problem.

I call the method in the following manner:
lcFRXAny = "InvestmentReport"
ThisForm.Convertto("rpt_investmentsregister.frx",8,lcFRXAny)
The ConvertTo Method is:
LPARAMETERS tcFrxFile,tnFileType,lcExportFileName,gcExportPath,tnScope,tnRecord,tcForExpr,tcWhileExpr,tcHeading,tlPlain,tlSummary
* DO SAMPLE WITH 'C:\Report\Liste.Frx',2  
* tcFrxFile		: Path+FileName
* tnFileType	: 1-DOC,2-HTM,3=RTF,4-XLS
* tnScope		: 1-All,2-NEXT,3-RECORD,4-REST	
* tnRecord		: Depending on tnScope will represent NEXT n records or RECORD n
* tcForExpr		: FOR condition (Expression)
* tcWhileExpr	: WHILE condition (Expression)
* tlPlain		: Plain report
* tlSummary		: Summary band only
SET STEP ON

tcFrxFile	=IIF(EMPTY(tcFrxFile),'Invoice.frx',tcFrxFile)
tnFileType	=IIF(EMPTY(tnFileType), 8,tnFileType)
tnScope		=IIF(EMPTY(tnScope),1,tnScope)
tnRecord	=IIF(INLIST(tnScope,2,3) AND EMPTY(tnRecord),1,tnRecord)
tcForExpr	=IIF(EMPTY(tcForExpr),'',tcForExpr)
tcWhileExpr	=IIF(EMPTY(tcWhileExpr),'',tcWhileExpr)
tcHeading	=IIF(EMPTY(tcHeading),'',tcHeading)
tlPlain		=IIF(VARTYPE(tlPlain)='L',tlPlain,.F.)
tlSummary	=IIF(VARTYPE(tlSummary)='L',tlSummary,.F.)
gcExportPath = IIF(EMPTY(gcExportPath), gcBankingReportsDirectory,gcExportPath)
*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#DEFINE cnWORD 					         		1
#DEFINE cnHTML               			 		2
#DEFINE cnRTF               			 		3
#DEFINE cnEXCEL               			 		4
#DEFINE cnPREVIEW 								6
#DEFINE cnPDF									8

#DEFINE cnOK 	     				     		0       && Everything is OK.
#DEFINE cnNO_PARAMETERS    				 		1       && No parameter
#DEFINE cnREP_FILE_NOT_FOUND			 		2       && Report file not found
#DEFINE cnNO_BANDS_DEFINED 				 		3       && No bands defined in FRX file (corrupted?)
#DEFINE cnNO_OPEN_TABLE    				 		4       && No open table and no dataenviroment cursors in FRX file
#DEFINE cnEOF           				 		5       && Main alias at EOF() and no dataenvironment cursors
#DEFINE cnNO_HEADER_RECORD 				 		7       && No header record in FRX file (corrupted?)
#DEFINE cnNO_ANY_OBJECTS   				 		8       && No labels, fields, or images.
#DEFINE cnERR_CREATING_FILE				 		9  	 	&& Error creating fle
#DEFINE cnUSER_INTERRUPTED				 		10  	&& User interrupted
#DEFINE cnINVALID_BANDTYPE_PARAMETER	 		11
#DEFINE cnINVALID_ARRAY_REPORT_OBJ_PARAMETER	12
#DEFINE cnINVALID_NUMBER_OF_PARAMETER			13
#DEFINE cnINVALID_TYPE_OF_PARAMETER	 			14
#DEFINE cnINVALID_SPECIFIED_OBJECT_TYPE			15
#DEFINE cnWRONG_EXPORT_FILE_TYPE				16
#DEFINE cnDE_INIT_RETURN_FALSE					17		&& DE Init metod return false

#DEFINE cnSCOPE_CLAUSE_ALL		         		1
#DEFINE cnSCOPE_CLAUSE_NEXT		         		2
#DEFINE cnSCOPE_CLAUSE_RECORD	         		3
#DEFINE cnSCOPE_CLAUSE_REST 	         		4
*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
LOCAL lcDefaultPath
LOCAL lcReportFullName
LOCAL lcReportFile
LOCAL lcExportPath
LOCAL lcErrorMessage

LOCAL lcClassName     
LOCAL lcModule        
LOCAL lcInApplication 

LOCAL loFile


lcDefaultPath = JUSTPATH(SYS(16))
SET DEFAULT TO (lcDefaultPath)


lcReportFullName = ALLTRIM(tcFrxFile)
lcReportFullName = FORCEEXT(lcReportFullName, 'FRX')

lcReportFile 	 = JUSTSTEM(lcReportFullName)
lcExportPath 	 = IIF(EMPTY(gcExportPath),ADDBS(JUSTPATH(lcReportFullName)),gcExportPath)

IF !FILE(lcReportFullName)
	lcErrorMessage = 'File ' + lcReportFullName + ' does not exist.'
	=MESSAGEBOX(lcErrorMessage, 16, 'Error')
ELSE

	CLOSE TABLES ALL
	CLOSE DATABASES ALL

	lcModule        = 'Frx2Any.app'
	lcInApplication = 'Frx2Any.app'
  
	DO CASE
		CASE tnFileType = cnWORD OR tnFileType = cnRTF
			lcClassName     = 'WORDFile'

		CASE tnFileType = cnHTML
			lcClassName     = 'HTMLFile'
			
		CASE tnFileType = cnEXCEL
			lcClassName     = 'EXCELFile'

		CASE tnFileType = cnPREVIEW
			lcClassName     = 'PREVIEWFile'	
			
		CASE tnFileType = cnPDF
			lcClassName 	= 'PDFFile'	
			
	ENDCASE


	loFile = NEWOBJECT(lcClassName, lcModule, lcInApplication, tnFileType)


	IF TYPE('loFile') = 'O'

*!*			loFile.cExportFileName = lcReportFile
		loFile.cExportFileName = lcExportFileName
		loFile.cSaveFolder     = lcExportPath

*-- Here we can get current version of FRX2ANY
		lcVersion = loFile.GetVersion()
*-- Set up Report Scope
		IF INLIST(tnScope, cnSCOPE_CLAUSE_ALL, cnSCOPE_CLAUSE_NEXT, cnSCOPE_CLAUSE_RECORD, cnSCOPE_CLAUSE_REST)
			loFile.nScopeClauseType = tnScope
		ELSE
			loFile.nScopeClauseType = cnSCOPE_CLAUSE_ALL
		ENDIF

		DO CASE
			CASE loFile.nScopeClauseType = cnSCOPE_CLAUSE_NEXT
				loFile.nScopeRecords = tnRecord
			CASE loFile.nScopeClauseType = cnSCOPE_CLAUSE_RECORD
				loFile.nScopeRecordNumber = tnRecord
		ENDCASE
				
		IF !EMPTY(tcForExpr)
			loFile.cFORExpression = ALLTRIM(tcForExpr)
		ENDIF

		IF !EMPTY(tcWhileExpr)
			loFile.cWHILEExpression = ALLTRIM(tcWhileExpr)
		ENDIF

		IF !EMPTY(tcHeading)
			loFile.cHeadingText = ALLTRIM(tcHeading)
		ENDIF
		
		loFile.lPlain   = tlPlain
		loFile.lSummary = tlSummary
		
*-- Init DE
		lnSuccess = loFile.InitDataEnvironment(lcReportFullName)

		DO CASE
			CASE lnSuccess = cnDE_INIT_RETURN_FALSE
			OTHERWISE

				DO CASE
					CASE lnSuccess = cnNO_OPEN_TABLE
						USE ?
				ENDCASE

				lnSuccess  		 = loFile.SAVE(lcReportFullName)

				loFile.RELEASE()
				loFile 			 = .NULL.

		ENDCASE


		DECLARE INTEGER ShellExecute IN SHELL32.DLL INTEGER nWinHandle, STRING cOperation, STRING cFileName, STRING cParameters,;
				STRING cDirectory, INTEGER nShowWindow

		DO CASE
			CASE lnSuccess = cnDE_INIT_RETURN_FALSE
				lcErrorMessage = 'Init method of dataenvironment returned false.'
				=MESSAGEBOX(lcErrorMessage, 16, 'Error')
				
			CASE lnSuccess = cnNO_OPEN_TABLE
				lcErrorMessage = 'No open table and no dataenvironment cursors in FRX file.'
				=MESSAGEBOX(lcErrorMessage, 16, 'Error')
				
			CASE lnSuccess = cnOK AND tnFileType = cnHTML

				ShellExecute(0, 'Open', lcExportPath + FORCEEXT(lcReportFile, 'HTM') , '', '', 1)

			CASE lnSuccess = cnOK AND tnFileType = cnWORD

				ShellExecute(0, 'Open', lcExportPath + FORCEEXT(lcReportFile, 'DOC') , '', '', 1)

			CASE lnSuccess = cnOK AND tnFileType = cnRTF

				ShellExecute(0, 'Open', lcExportPath + FORCEEXT(lcReportFile, 'RTF') , '', '', 1)

			CASE lnSuccess = cnOK AND tnFileType = cnEXCEL

				ShellExecute(0, 'Open', lcExportPath + FORCEEXT(lcReportFile, 'XLS') , '', '', 1)
			CASE lnSuccess = cnOK AND tnFileType = cnPDF

				ShellExecute(0, 'Open', lcExportPath + FORCEEXT(lcReportFile, 'PDF') , '', '', 1)

			OTHERWISE
		ENDCASE
	ELSE
		lcErrorMessage = 'Could not instatiate Frx2Any.HTMLFile object.'
		=MESSAGEBOX(lcErrorMessage, 16, 'Error')
	ENDIF
ENDIF
Thanks in advance,
Send me an email when the shouting stops
Next
Reply
Map
View

Click here to load this message in the networking platform