Como exportar imagens do gerais campos utilizando a classe base ReportListener no Visual FoxPro 9

*-----------------------------------
* Microsoft Knowledge Base Article 894819
* EXAMPLE 2
* AUTHOR: Trevor Hancock
* CREATED: February 22, 2005 09:59:32
* ABSTRACT: This code extracts pictures to disk from the 
*                 General field that is named PHOTO in the 
*                 EMPLOYEE sample table.
*-----------------------------------

*-- This opposite value of the constant will be used to set the QuietMode
*-- property of the ReportListener base class. When the value is .T., 
*-- wait windows that indicate processing appear. At the end, a message box
*-- appears. Any errors in the ReportListener base class also appear.
#DEFINE ShowReportFlow_Errs  .F.

LOCAL lcReportName AS STRING, ;
	lcGenFldName AS STRING, ;
	lnGenFldHeight AS INTEGER, ;
	lnGenFldWidth AS INTEGER, ;
	lcTargetDir AS STRING, ;
	lcFileNameExpr AS STRING, ;
	lcGenTable AS STRING

*-- Choose the name of a table to extract one General
*-- field from.
lcGenTable = ADDBS( HOME() ) + 'Samples\Data\employee.dbf'

*-- Set the name of the General field that you want to extract from.
lcGenFldName = 'PHOTO'

*-- Set the height that you want for the General field.
lnGenFldHeight = 8000.00

*-- Set the width that you want for the General field.
lnGenFldWidth = 7000.00

*-- Set the folder into which the General field
*-- pictures will be extracted.
lcTargetDir = 'C:\TmpTst\'

*-- By default, pictures that are rendered to disk by the ReportListener class
*-- use the following file name format: _n.jpg. In this format, n
*-- is a number. If you set this next variable to an expression, you 
*-- can override that behavior. In this example, we name
*-- the .jpg files based on the FIRST_NAME and LAST_NAME
*-- fields from the EMPLOYEE table that we are reporting from.

*-- This expression will be wrapped in the EVAL function when it is called. 
*-- Therefore, make sure that you specify an expression, a variable, or something else. 
*-- Possible choices include the RECNO function and other table field names.
lcFileNameExpr = ;
	"ALLT(Employee.First_Name) + '_' + ALLTRIM(Employee.Last_Name)"



*------ START REPORT CREATION
*
CLOSE DATA ALL
IF !DIRECTORY( lcTargetDir, 1 )
	MESSAGEBOX( 'Target output folder does not exist. Process stopped.', 48, '' )
	RETURN .F.
ENDIF
CD ( lcTargetDir )

*-- Clean up the folder first to prevent any file name conflicts.
LOCAL lcOldSetSafe as String
lcOldSetSafe = SET("Safety")
SET SAFETY OFF
DELETE FILE *.*
SET SAFETY &lcOldSetSafe

*-- Create a temporary cursor to base the report
*-- on, make the report, and then close the cursor.
*-- This temporary cursor is used to set up the report for the first time.
*-- It is not needed after the report is made.
lcReportName = lcTargetDir + 'GenReport'
CREATE CURSOR TEMP ( Fld1 G )
CREATE REPORT ( lcReportName ) FROM TEMP
USE IN TEMP

*-- Open the report file (FRX) as a table.
USE ( FORCEEXT( lcReportName, 'FRX' ) ) IN 0 ALIAS TheReport EXCLUSIVE
SELECT TheReport

*-- This command removes objects that are not required 
*-- from the report surface and from the report table itself.
*-- ObjType = 5 or 8: Removes the label and field objects from the footer.
*-- ObjType = 23 & FontStyle = 1: Removes a font resource
*-- that is not needed. The resource belonged to the label that was deleted.
DELETE ALL FOR (ObjType = 23 AND FontStyle = 1) ;
	OR INLIST(ObjType, 5, 8) IN TheReport

*-- This command adjusts the layout of the header and footer bands.
*-- ObjType = 9 & ObjCode = 1 means Page Header band.
*-- ObjType = 9 & ObjCode = 7 means Page Footer band.
*-  Reduce them because they are not required for this code.
UPDATE TheReport SET Vpos = 0, Hpos = 0, HEIGHT = 0 ;
	WHERE ObjType = 9 AND (ObjCode = 1 OR ObjCode = 7)

*-- Increase the height of the Detail band
*-- (ObjType = 9 & ObjCode = 4) to fit the
*-- Picture/OLE Bound control that is inserted by using the next command.
UPDATE TheReport SET Vpos = 0, Hpos = 0, HEIGHT = lnGenFldHeight ;
	WHERE ObjType = 9 AND ObjCode = 4

*-- Add a Picture/OLE Bound control to the report by inserting a
*-- record with appropriate values. Using an object that is based on the EMPTY
*-- class here and the GATHER NAME class later to insert the record makes it easier to
*-- see which values line up to which fields when compared to a large
*-- SQL-INSERT command).
LOCAL loNewRecObj AS EMPTY
loNewRecObj = NEWOBJECT('EMPTY')
ADDPROPERTY( loNewRecObj, 'PLATFORM', 'WINDOWS' )
ADDPROPERTY( loNewRecObj, 'Uniqueid', SYS(2015) )
ADDPROPERTY( loNewRecObj, 'ObjType', 17 ) && "Picture/OLE Bound control"
ADDPROPERTY( loNewRecObj, 'NAME', lcGenFldName ) && Name of the General field in the cursor.
ADDPROPERTY( loNewRecObj, 'Vpos', 2083.333) && Put it in the Detail band.
ADDPROPERTY( loNewRecObj, 'HEIGHT', lnGenFldHeight )
ADDPROPERTY( loNewRecObj, 'WIDTH', lnGenFldWidth )
ADDPROPERTY( loNewRecObj, 'DOUBLE', .T. ) && The picture is centered in the Picture/OLE Bound control
ADDPROPERTY( loNewRecObj, 'Supalways', .T. )
*-- For the Picture/OLE Bound control, the contents of the OFFSET field specify whether
*-- File name (0), General field name (1), or Expression (2) is the source.
ADDPROPERTY( loNewRecObj, 'Offset', 1 )

*-- Add the Picture/OLE Bound control record to the report.
APPEND BLANK IN TheReport
GATHER NAME loNewRecObj MEMO

*-- Clean up and then close the report table.
PACK MEMO
USE
*
*------ END REPORT CREATION


*-- Rerun the report by using the Listener subclass
*-- that is defined in later code.
USE ( lcGenTable )
LOCAL loXMLD_Listener AS ;
	XMLDISPLAYLISTENER OF ADDBS( HOME( ) ) + 'Ffc\_reportlistener.vcx'

loXMLD_Listener = NEWOBJECT( 'MyListener' )
loXMLD_Listener.TargetFileName = ADDBS( lcTargetDir ) + 'tmp.htm'
loXMLD_Listener.ImgFileNameExpr = lcFileNameExpr
loXMLD_Listener.QUIETMODE = !ShowReportFlow_Errs

WAIT WINDOW 'Rendering pictures.' NOWAIT NOCLEAR
REPORT FORM ( lcReportName ) OBJECT loXMLD_Listener
ERASE (loXMLD_Listener.TargetFileName)
ERASE ( FORCEEXT( lcReportName , '*' ) )
RELEASE loXMLD_Listener
WAIT WINDOW 'Complete!' TIMEOUT 2
RETURN



*----------------------------------
*----------------------------------
DEFINE CLASS MyListener AS XMLDISPLAYLISTENER OF ADDBS(HOME()) + 'Ffc\_reportlistener.vcx'
	ImgFileNameExpr = ''
	ImgFile = ''

	PROCEDURE RENDER(nFRXRecNo, nLeft, nTop, nWidth, nHeight, ;
			nObjectContinuationType, cContentsToBeRendered, GDIPlusImage)
		NODEFAULT

		*-- ImageFileBaseName is an optional prefix to be added
		*-- to generated image file names when image files are saved
		*-- to disk during the rendering of general fields in a report run.
		THIS.ImageFileBaseName = EVAL( THIS.ImgFileNameExpr )

		*-- This is the full path and file name of the picture file that will
		*-- be rendered to disk when the DODEFAULT function is called. This information is retrieved here
		*-- so we can clean it up in the AfterBand event.
		THIS.ImgFile	 = FORCEPATH(THIS.ImageFileBaseName + "_" + ;
			TRANSFORM(THIS.ImageFieldInstance + 1) + ".jpg", ;
			FULLPATH(THIS.ExternalFileLocation,ADDBS(JUSTPATH(THIS.TargetFileName))))

		DODEFAULT(nFRXRecNo,nLeft,nTop,nWidth,nHeight, ;
			nObjectContinuationType, cContentsToBeRendered, GDIPlusImage)
	ENDPROC


	PROCEDURE AFTERBAND(nBandObjCode, nFRXRecNo)
		NODEFAULT

		IF nBandObjCode = 4 && In Detail Band
			*-- Look for the image file on the disk.
			*-- If the image file is there, the code inside the IF...ENDIF
			*-- construct strips off the _n that is at the end of the file name,
			*-- just before the extension. This is added in the Render event by the
			*-- XMLDISPLAYLISTENER class. You do not have to clean up the file name.  However,
			*-- it looks cleaner. For example, "Scott_Rockfeld_1.jpg" would change to
			*-- "Scott_Rockfeld.jpg".
			IF FILE( THIS.ImgFile )
				LOCAL lnLastUnderscorePos AS INTEGER
				lnLastUnderscorePos = ATC('_', THIS.ImgFile, OCCURS( '_', THIS.ImgFile ) )
				RENAME ( THIS.ImgFile ) TO ;
					FORCEEXT( SUBSTR( THIS.ImgFile, 1, lnLastUnderscorePos - 1 ), 'JPG' )
			ENDIF
		ENDIF

		DODEFAULT( nBandObjCode, nFRXRecNo )
	ENDPROC
ENDDEFINE