PLATFORM UNIQUEID TIMESTAMP CLASS CLASSLOC BASECLASS OBJNAME PARENT PROPERTIES PROTECTED METHODS OBJCODE RESERVED1 RESERVED2 RESERVED3 RESERVED4 RESERVED5 RESERVED6 RESERVED7 RESERVED8 COMMENT Class WINDOWS _18P105OTS 956777596^ COMMENT RESERVED WINDOWS _1DS143BJE1065463466 COMMENT RESERVED WINDOWS _2FE0JKNKY1087704109 COMMENT RESERVED VERSION = 3.00 pdflistener registry hpdf_consts.h enumregistrykey enumvalue Pixels Provides read and write access to the System Registry. The Functionality provided is greatly abstracted resulting in using a single method call to set and retrieve values from the registry. Class custom registry *readregistrystring Lee un Valor String del Registro de Windows *readregistryint Lee un valor Integer (DWORD) o Short en el registro de Windows *writeregistrystring Escribe una valor String en el Registro de Windows *writeregistryint Escribe una valor num rico en el Registro de windows *writeregistrybinary Escribe un valor binario en el registro de Windows *deleteregistrykey Elimina una llave del registro de Windows *enumregistrykey Retorna un valor del registro basado en un indice. Permite llamadas desde un ciclo FOR *enumvalue Retorna el nombre de un valor del registro *getenumvalues Retorna todos los valores de una llave en un array *getenumkeys Retorna todas las subclaves de una clave especificada *examples Ejemplos de Uso de la Clase ,Height = 19 Width = 35 Name = "registry" custom hpdf_consts.hf hpdf_consts.h nlastpageproccesed lstarted npageheight lunderline addpdfstandardfonts findfontfilename parseunderlinetext processdynamics getpicturehandle Pixels PDF Listener using HARU Library Class fxlistener pdflistener reportlistener pr_reportlistener.vcx hpdf_consts.hf hpdf_consts.hN pdfasimagelistener hpdf_consts.h Pixels &Listener to Create PDF Files as Images Class fxlistener FkPROCEDURE readregistrystring ************************************************************************ * Registry :: ReadRegistryString ********************************* *** Function: Reads a string value from the registry. *** Pass: tnHKEY - HKEY value (in CGIServ.h) *** tcSubkey - The Registry subkey value *** tcEntry - The actual Key to retrieve *** Return: Registry String or .NULL. on error ************************************************************************ Lparameters tnHKey, tcSubkey, tcEntry Local lnRegHandle, lnResult, lnSize, lcDataBuffer, tnType tnHKey=Iif(Type("tnHKey")="N",tnHKey,HKEY_LOCAL_MACHINE) lnRegHandle=0 *** Open the registry key lnResult=RegOpenKey(tnHKey,tcSubkey,@lnRegHandle) If lnResult#ERROR_SUCCESS Return .Null. EndIf *** Need to define here specifically for Return Type *** for lpdData parameter or VFP will choke. *** Here it's STRING. Declare Integer RegQueryValueEx ; IN Win32API As RegQueryString; INTEGER nHKey,; STRING lpszValueName,; INTEGER dwReserved,; INTEGER @lpdwType,; STRING @lpbData,; INTEGER @lpcbData *** Return buffer to receive value lcDataBuffer=Space(MAX_INI_BUFFERSIZE) lnSize=Len(lcDataBuffer) lnType=0 lnResult=RegQueryString(lnRegHandle,tcEntry,0,@lnType,; @lcDataBuffer,@lnSize) =RegCloseKey(lnRegHandle) If lnResult#ERROR_SUCCESS Return .Null. EndIf If lnSize<2 Return "" EndIf *** Return string based on length returned Return Substr(lcDataBuffer,1,lnSize-1) ENDPROC PROCEDURE readregistryint ************************************************************************ * Registry :: ReadRegistryInt ********************************* *** Function: Reads an integer (DWORD) or short (4 byte or less) binary *** value from the registry. *** Pass: tnHKEY - HKEY value (in CGIServ.h) *** tcSubkey - The Registry subkey value *** tcEntry - The actual Key to retrieve *** Return: Registry String or .NULL. on error ************************************************************************ Lparameters tnHKey, tcSubkey, tcEntry Local lnRegHandle, lnResult, lnSize, lcDataBuffer, tnType tnHKey=Iif(Type("tnHKey")="N",tnHKey,HKEY_LOCAL_MACHINE) lnRegHandle=0 lnResult=RegOpenKey(tnHKey,tcSubkey,@lnRegHandle) If lnResult#ERROR_SUCCESS Return .Null. EndIf *** Need to define here specifically for Return Type *** for lpdData parameter or VFP will choke. *** Here's it's an INTEGER Declare Integer RegQueryValueEx ; IN Win32API As RegQueryInt; INTEGER nHKey,; STRING lpszValueName,; INTEGER dwReserved,; Integer @lpdwType,; INTEGER @lpbData,; INTEGER @lpcbData lnDataBuffer=0 lnSize=4 lnResult=RegQueryInt(lnRegHandle,tcEntry,0,@tnType,; @lnDataBuffer,@lnSize) =RegCloseKey(lnRegHandle) If lnResult#ERROR_SUCCESS Return .Null. EndIf Return lnDataBuffer ENDPROC PROCEDURE writeregistrystring ************************************************************************ * Registry :: WriteRegistryString ********************************* *** Function: Reads a string value from the registry. *** Pass: tnHKEY - HKEY value (in CGIServ.h) *** tcSubkey - The Registry subkey value *** tcEntry - The actual Key to write to *** tcValue - Value to write or .NULL. to delete key *** tlCreate - Create if it doesn't exist *** Assume: Use with extreme caution!!! Blowing your registry can *** hose your system! *** Return: .T. or .NULL. on error ************************************************************************ Lparameters tnHKey, tcSubkey, tcEntry, tcValue,tlCreate Local lnRegHandle, lnResult, lnSize, lcDataBuffer, tnType tnHKey=Iif(Type("tnHKey")="N",tnHKey,HKEY_LOCAL_MACHINE) lnRegHandle=0 lnResult=RegOpenKey(tnHKey,tcSubkey,@lnRegHandle) If lnResult#ERROR_SUCCESS If !tlCreate Return .Null. Else lnResult=RegCreateKey(tnHKey,tcSubkey,@lnRegHandle) If lnResult#ERROR_SUCCESS Return .Null. EndIf EndIf EndIf *** Need to define here specifically for Return Type! *** Here lpbData is STRING. Declare Integer RegSetValueEx ; IN Win32API ; INTEGER nHKey,; STRING lpszEntry,; INTEGER dwReserved,; INTEGER fdwType,; STRING lpbData,; INTEGER cbData *** Check for .NULL. which means delete key If !Isnull(tcValue) *** Nope - write new value lnSize=Len(tcValue) lnResult=RegSetValueEx(lnRegHandle,tcEntry,0,REG_SZ,; tcValue,lnSize) *** DELETE THE KEY lnResult=RegDeleteValue(lnRegHandle,tcEntry) EndIf =RegCloseKey(lnRegHandle) If lnResult#ERROR_SUCCESS Return .Null. EndIf Return .T. ENDPROC PROCEDURE writeregistryint ************************************************************************ * Registry :: WriteRegistryInt ********************************* *** Function: Writes a numeric value to the registry. *** Pass: tnHKEY - HKEY value (in CGIServ.h) *** tcSubkey - The Registry subkey value *** tcEntry - The actual Key to write to *** tcValue - Value to write or .NULL. to delete key *** tlCreate - Create if it doesn't exist *** Assume: Use with extreme caution!!! Blowing your registry can *** hose your system! *** Return: .T. or .NULL. on error ************************************************************************ Lparameters tnHKey, tcSubkey, tcEntry, tnValue,tlCreate Local lnRegHandle, lnResult, lnSize, lcDataBuffer, tnType tnHKey=Iif(Type("tnHKey")="N",tnHKey,HKEY_LOCAL_MACHINE) lnRegHandle=0 lnResult=RegOpenKey(tnHKey,tcSubkey,@lnRegHandle) If lnResult#ERROR_SUCCESS If !tlCreate Return .Null. Else lnResult=RegCreateKey(tnHKey,tcSubkey,@lnRegHandle) If lnResult#ERROR_SUCCESS Return .Null. EndIf EndIf EndIf *** Need to define here specifically for Return Type! *** Here lpbData is STRING. Declare Integer RegSetValueEx ; IN Win32API ; INTEGER nHKey,; STRING lpszEntry,; INTEGER dwReserved,; INTEGER fdwType,; INTEGER @lpbData,; INTEGER cbData *** Check for .NULL. which means delete key If !Isnull(tnValue) *** Nope - write new value lnSize=4 lnResult=RegSetValueEx(lnRegHandle,tcEntry,0,REG_DWORD,; @tnValue,lnSize) *** DELETE THE KEY lnResult=RegDeleteValue(lnRegHandle,tcEntry) EndIf =RegCloseKey(lnRegHandle) If lnResult#ERROR_SUCCESS Return .Null. EndIf Return .T. ENDPROC PROCEDURE writeregistrybinary ************************************************************************ * Registry :: WriteRegistryBinary ********************************* *** Function: Writes a binary value to the registry. *** Binary must be written as character values: *** chr(80)+chr(13) will result in "50 1D" *** for example. *** Pass: tnHKEY - HKEY value (in CGIServ.h) *** tcSubkey - The Registry subkey value *** tcEntry - The actual Key to write to *** tcValue - Value to write or .NULL. to delete key *** tnLength - you have to supply the length *** tlCreate - Create if it doesn't exist *** Assume: Use with extreme caution!!! Blowing your registry can *** hose your system! *** Return: .T. or .NULL. on error ************************************************************************ Lparameters tnHKey, tcSubkey, tcEntry, tcValue,tnLength,tlCreate Local lnRegHandle, lnResult, lnSize, lcDataBuffer, tnType tnHKey=Iif(Type("tnHKey")="N",tnHKey,HKEY_LOCAL_MACHINE) tnLength=Iif(Type("tnLength")="N",tnLength,Len(tcValue)) lnRegHandle=0 lnResult=RegOpenKey(tnHKey,tcSubkey,@lnRegHandle) If lnResult#ERROR_SUCCESS If !tlCreate Return .Null. Else lnResult=RegCreateKey(tnHKey,tcSubkey,@lnRegHandle) If lnResult#ERROR_SUCCESS Return .Null. EndIf EndIf EndIf *** Need to define here specifically for Return Type! *** Here lpbData is STRING. Declare Integer RegSetValueEx ; IN Win32API ; INTEGER nHKey,; STRING lpszEntry,; INTEGER dwReserved,; INTEGER fdwType,; STRING @lpbData,; INTEGER cbData *** Check for .NULL. which means delete key If !Isnull(tcValue) *** Nope - write new value lnResult=RegSetValueEx(lnRegHandle,tcEntry,0,REG_BINARY,; @tcValue,tnLength) *** DELETE THE KEY lnResult=RegDeleteValue(lnRegHandle,tcEntry) EndIf =RegCloseKey(lnRegHandle) If lnResult#ERROR_SUCCESS Return .Null. EndIf Return .T. ENDPROC PROCEDURE deleteregistrykey ************************************************************************ * Registry :: DeleteRegistryKey ********************************* *** Function: Deletes a registry key. Note this does not delete *** an entry but the key (ie. a path node). *** Use WriteRegistryString/Int with a .NULL. to *** Delete an entry. *** Pass: tnHKey - Registry Root node key *** tcSubkey - Path to clip *** Return: .T. or .NULL. ************************************************************************ Lparameters tnHKEY,tcSubKey Local lnResult, lnRegHandle tnHKEY=Iif(Type("tnHKey")="N",tnHKEY,HKEY_LOCAL_MACHINE) lnRegHandle=0 lnResult=RegOpenKey(tnHKEY,tcSubKey,@lnRegHandle) If lnResult#ERROR_SUCCESS *** Key doesn't exist or can't be opened Return .Null. EndIf lnResult=RegDeleteKey(tnHKEY,tcSubKey) =RegCloseKey(lnRegHandle) If lnResult#ERROR_SUCCESS Return .Null. EndIf Return .T. ENDPROC PROCEDURE enumregistrykey ************************************************************************ * wwAPI :: EnumRegistryKey ********************************* *** Function: Returns a registry key name based on an index *** Allows enumeration of keys in a FOR loop. If key *** is empty end of list is reached or the key doesn't *** exist or is empty. *** Pass: tnHKey - HKEY_ root key *** tcSubkey - Subkey string *** tnIndex - Index of key name to get (0 based) *** Return: "" on error - Key name otherwise ************************************************************************ Lparameters tnHKey, tcSubKey, tnIndex Local lcSubKey, lcReturn, lnResult, lcDataBuffer lnRegHandle=0 *** Open the registry key lnResult=RegOpenKey(tnHKey,tcSubKey,@lnRegHandle) If lnResult#ERROR_SUCCESS *** Not Found Return .Null. EndIf Declare Integer RegEnumKey ; IN WIN32API ; INTEGER nHKey, ; INTEGER nIndex, ; STRING @cSubkey, ; INTEGER nSize lcDataBuffer=Space(MAX_INI_BUFFERSIZE) lnSize=MAX_INI_BUFFERSIZE lnReturn=RegEnumKey(lnRegHandle, tnIndex, @lcDataBuffer, lnSize) =RegCloseKey(lnRegHandle) If lnResult#ERROR_SUCCESS *** Not Found Return .Null. EndIf Return Trim(Chrtran(lcDataBuffer,Chr(0),"")) ENDPROC PROCEDURE enumvalue ************************************************************************ * Registry :: EnumValue ********************************* *** Function: Returns the name of a registry Value key. Note the actual *** Value is not returned but just the key. This is done *** so you can check the type first and use the appropriate *** ReadRegistryX method. The type is returned by ref in the *** last parameter. *** Assume: *** Pass: tnHKey - HKEY value *** tcSubkey - The key to enumerate valuekeys for *** tnIndex - Index of key to work on *** @tnType - Used to pass back the type of the value *** Return: String of ValueKey or .NULL. ************************************************************************ Lparameters tnHKey, tcSubKey, tnIndex, tnType Local lcSubKey, lcReturn, lnResult, lcDataBuffer tnType=Iif(Type("tnType")="N",tnType,0) lnRegHandle=0 *** Open the registry key lnResult=RegOpenKey(tnHKey,tcSubKey,@lnRegHandle) If lnResult#ERROR_SUCCESS *** Not Found Return .Null. EndIf *** Need to define here specifically for Return Type *** for lpdData parameter or VFP will choke. *** Here it's STRING. Declare Integer RegEnumValue ; IN Win32API ; INTEGER nHKey,; INTEGER nIndex,; STRING @lpszValueName,; INTEGER @lpdwSize,; INTEGER dwReserved,; INTEGER @lpdwType,; STRING @lpbData,; INTEGER @lpcbData tcSubKey=Space(MAX_INI_BUFFERSIZE) tcValue=Space(MAX_INI_BUFFERSIZE) lnSize=MAX_INI_BUFFERSIZE lnValSize=MAX_INI_BUFFERSIZE lnReturn=RegEnumValue(lnRegHandle, tnIndex, @tcSubKey,@lnValSize, 0, @tnType, @tcValue, @lnSize) =RegCloseKey(lnRegHandle) If lnResult#ERROR_SUCCESS *** Not Found Return .Null. EndIf Return Trim(Chrtran(tcSubKey,Chr(0),"")) ENDPROC PROCEDURE getenumvalues ************************************************************************ * Registry :: GetEnumValues ********************************* *** Function: Retrieves all Values off a key into an array. The *** array is 2D and consists of: Key Name, Value *** Assume: Not tested with non-string values *** Pass: @taValues - Result Array: Pass by Reference *** tnHKEY - ROOT KEY value *** tcSubKey - SubKey to work on *** Return: Count of Values retrieved ************************************************************************ Lparameters taValues, tnHKey, tcSubKey Local x, lcKey lcKey="x" Do While !Empty(lcKey) Or Isnull(lcKey) lnType=0 lcKey=This.EnumValue(tnHKey,tcSubKey,x,@lnType) If Isnull(lcKey) Or Empty(lcKey) Exit EndIf x=x+1 Dimension taValues[x,2] Do Case Case lnType=REG_SZ Or lnType=REG_BINARY Or lnType=REG_NONE lcValue=oRegistry.ReadRegistryString(tnHKey,tcSubKey,lcKey) taValues[x,1]=lcKey taValues[x,2]=lcValue Case lnType=REG_DWORD lnValue=oRegistry.ReadRegistryInt(tnHKey,tcSubKey,lcKey) taValues[x,1]=lcKey taValues[x,2]=lnValue Otherwise taValues[x,1]=lcKey taValues[x,2]="" EndCase EndDo Return x ENDPROC PROCEDURE getenumkeys ************************************************************************ * Registry :: GetEnumKeys ********************************* *** Function: Returns an array of all subkeys for a given key *** NOTE: This function does not return Value Keys only *** Tree Keys!!!! *** Pass: @taKeys - An array that gets filled with key names *** tnHKEY - Root Key *** tcSubkey - Subkey to enumerate for *** Return: Number of keys or 0 ************************************************************************ Lparameters taKeys, tnHKey, tcSubKey Local x, lcKey lcKey="x" Do While !Empty(lcKey) Or Isnull(lcKey) lnType=0 lcKey=This.EnumKey(tnHKey,tcSubKey,x) If Isnull(lcKey) Or Empty(lcKey) Exit EndIf x=x+1 Dimension taKeys[x] taKeys[x]=lcKey EndDo Return x ENDPROC PROCEDURE examples *** Create a new Tree ? oRegistry.WriteRegistryString(HKEY_LOCAL_MACHINE,; "SOFTWARE\West Wind Technologies",; "","",.T.) *** Now create a a key off the root and add a value ? oRegistry.WriteRegistryString(HKEY_LOCAL_MACHINE,; "SOFTWARE\West Wind Technologies\WebConnection",; "CurrentVersion","1.45",.T.) *** Add another Value - numeric ? oRegistry.WriteRegistryInt (HKEY_LOCAL_MACHINE,; "SOFTWARE\West Wind Technologies\WebConnection",; "Timeout",60,.T.) *** Now Read the values back ? oRegistry.ReadRegistryString(HKEY_LOCAL_MACHINE,; "SOFTWARE\West Wind Technologies\WebConnection",; "CurrentVersion") ? oRegistry.ReadRegistryInt(HKEY_LOCAL_MACHINE,; "SOFTWARE\West Wind Technologies\WebConnection",; "Timeout") *** Uncomment this code to delete the registry entries again *-**** Now delete the value entries - Write with a NULL *-*? oRegistry.WriteRegistryString(HKEY_LOCAL_MACHINE,; *-* "SOFTWARE\West Wind Technologies\WebConection",; *-* "CurrentVersion",.NULL.,.T.) *-**** And the numeric entry - again with a .NULL. *-*? oRegistry.WriteRegistryInt (HKEY_LOCAL_MACHINE,; *-* "SOFTWARE\West Wind Technologies\WebConection",; *-* "Timeout",.NULL.,.T.) *-**** Get rid of the keys - Web Connection *-*? oRegistry.DeleteRegistryKey(HKEY_LOCAL_MACHINE,; *-* "SOFTWARE\West Wind Technologies\WebConection") *-**** Again the West Wind Technologies Key *-*? oRegistry.DeleteRegistryKey(HKEY_LOCAL_MACHINE,; *-* "SOFTWARE\West Wind Technologies") *#ENDIF ENDPROC PROCEDURE Init ************************************************************************ * Registry :: Init ********************************* *** Function: Loads required DLLs. Note Read and Write DLLs are *** not loaded here since they need to be reloaded each *** time depending on whether String or Integer values *** are required ************************************************************************ *** Open Registry Key Declare Integer RegOpenKey ; IN Win32API ; INTEGER nHKey,; STRING cSubKey,; INTEGER @nHandle *** Create a new Key Declare Integer RegCreateKey ; IN Win32API ; INTEGER nHKey,; STRING cSubKey,; INTEGER @nHandle *** Close an open Key Declare Integer RegCloseKey ; IN Win32API ; INTEGER nHKey *** Delete a key (path) Declare Integer RegDeleteKey ; IN Win32API ; INTEGER nHKEY,; STRING cSubkey *** Delete a value from a key Declare Integer RegDeleteValue ; IN Win32API ; INTEGER nHKEY,; STRING cEntry ENDPROC pdfasimagelistener Ipdfhandle Handle for the Pdf Document To Generate pageheight Height of The Report Pages pagewidth Width of Report Pages encryptdocument Property to Know if the Document Will Be Encrypted oprogress Property to Store Progress Bar oregistry mergedocument mergedocumentname opage Property to Store the Page Object oimagescollection Collection of images files used in the report cpdfauthor Pdf Author cuserpassword User Pasword of the Document lencryptdocument nencryptionlevel Accepts a Value of 0 Or 1, 0 = Standard 40-bit encryption. 1 = Advanced 128-bit encryption. npageheight lcanedit lcancopy lcanaddnotes lcanprint If .T. User will be allowed to print the document, if 0 he won't lopenviewer If .T. Adobe Reader will be opened cmasterpassword Master Password of the Pdf Document ctargetfilename cpdfcreator Pdf Creator cpdfkeywords Pdf Keywords cpdfsubject Pdf Subject cpdftitle Pdf Title waitfornextreport npgcounter npagemode lextended ldefaultmode npagewidth lobjtypemode _stat lshowerrors ncurrentpage *addblankpage *cleardlls *encryptpdf Method to Encrypt the Pdf Document *startpdfdocument Method to start pdf generation *writepdfinformation Writes Information About the File *declaredll Method to Start Dll Declarations *makepdf *outputfromdata *updateproperties *_stat_assign *_errorinfo LNWIDTH LNHEIGHT LDEFAULTMODE GETPAGEWIDTH GETPAGEHEIGHT NPAGEWIDTH NPAGEHEIGHT OPAGE HPDF_ADDPAGE PDFHANDLE _STAT HPDF_PAGE_SETWIDTH HPDF_PAGE_SETHEIGHT HPDF_New,HPDF_Free HPDF_SaveToFile HPDF_SetPageMode HPDF_AddPage HPDF_Page_SetWidth HPDF_Page_SetHeight HPDF_LoadJpegImageFromFile HPDF_SetInfoAttr HPDF_SetPassword HPDF_SetPermission HPDF_SetEncryptionMode HPDF_SetCompressionMode HPDF_Page_Concat HPDF_Page_DrawImage HPDF_LoadPngImageFromFile HPDF_GetError HPDF_ResetError INTEGER LENCRYPTDOCUMENT CMASTERPASSWORD CUSERPASSWORD _STAT HPDF_SETPASSWORD PDFHANDLE LNPERMIT LCANPRINT LCANEDIT LCANCOPY LCANADDNOTES HPDF_SETPERMISSION NENCRIPTIONLEVEL HPDF_SETENCRYPTIONMODE Could not load the library LIBHPDF.DLL .C The process can't continue. Make sure that you have the PDF library available, and that FoxyPreviewer is installed in a folder that has READ/WRITE access. Error DECLAREDLL PDFHANDLE HPDF_NEW CANCELREPORT _STAT HPDF_SETCOMPRESSIONMODE HPDF_SETPAGEMODE NPAGEMODE WRITEPDFINFORMATION ENCRYPTPDF ADDBLANKPAGE CPDFAUTHOR _STAT HPDF_SETINFOATTR PDFHANDLE CPDFTITLE CPDFSUBJECT CPDFKEYWORDS CPDFCREATOR HPDF_New libhpdf.dll HPDF_Free libhpdf.dll HPDF_SaveToFile libhpdf.dll HPDF_SetPageMode libhpdf.dll HPDF_AddPage libhpdf.dll HPDF_Page_SetWidth libhpdf.dll HPDF_Page_SetHeight libhpdf.dll HPDF_LoadJpegImageFromFile libhpdf.dll HPDF_LoadPngImageFromFile libhpdf.dll HPDF_SetInfoAttr libhpdf.dll HPDF_SetPassword libhpdf.dll HPDF_SetPermission libhpdf.dll HPDF_SetEncryptionMode libhpdf.dll HPDF_SetCompressionMode libhpdf.dll HPDF_Page_Concat libhpdf.dll HPDF_Page_DrawImage libhpdf.dll HPDF_GetError libhpdf.dll HPDF_ResetError libhpdf.dll HPDF_NEW LIBHPDF HPDF_FREE HPDF_SAVETOFILE HPDF_SETPAGEMODE HPDF_ADDPAGE HPDF_PAGE_SETWIDTH HPDF_PAGE_SETHEIGHT HPDF_LOADJPEGIMAGEFROMFILE HPDF_LOADPNGIMAGEFROMFILE HPDF_SETINFOATTR HPDF_SETPASSWORD HPDF_SETPERMISSION HPDF_SETENCRYPTIONMODE HPDF_SETCOMPRESSIONMODE HPDF_PAGE_CONCAT HPDF_PAGE_DRAWIMAGE HPDF_GETERROR HPDF_RESETERROR& REPORTLISTENER Report Listener could not be accessed % - TEMP5 Internal error loading the page image file from the report. Error 100% - CCC TOLISTENER TNWIDTH TNHEIGHT LLSHOWTHERM THIS QUIETMODE LOBJTYPEMODE LNSECS DOFOXYTHERM _GOHELPER _INITSTATUSTEXT LDEFAULTMODE NPAGEWIDTH NPAGEHEIGHT BEFOREREPORT STARTPDFDOCUMENT LNPAGECOUNT LNFILETYPE LNDEVICETYPE LNPAGENO LCFILE LNHANDLE LNPERCENT LNLASTPERCENT LNDELAY PAGETOTAL _SECONDSTEXT _RUNSTATUSTEXT NCURRENTPAGE ADDBLANKPAGE OUTPUTPAGE HPDF_LOADPNGIMAGEFROMFILE PDFHANDLE _STAT HPDF_PAGE_DRAWIMAGE OPAGE OIMAGESCOLLECTION AFTERREPORT UNLOADREPORT] LOBJTYPEMODE OFOXYPREVIEWER COMMANDCLAUSES LOPENVIEWER PREVIEW TOFILE CTARGETFILENAME CDESTFILE LCDESTFILE COUTPUTPATH LCFILE _REPORTLISTENER CANCELREPORT QUIETMODE LQUIETMODE LCANPRINT LPDFCANPRINT LCANEDIT LPDFCANEDIT LCANCOPY LPDFCANCOPY LCANADDNOTES LPDFCANADDNOTES LENCRYPTDOCUMENT LPDFENCRYPTDOCUMENT CMASTERPASSWORD CPDFMASTERPASSWORD CUSERPASSWORD CPDFUSERPASSWORD CPDFAUTHOR CPDFTITLE CPDFSUBJECT CPDFKEYWORDS CPDFCREATOR LNPGMODE NPDFPAGEMODE NPAGEMODE LDEFAULTMODEM PDFx error in CC Error code : Description: Page: Press 'Retry' to debug the application. Error PDFx error in CC Error code : Description : Object: Error TNSTATUS _STAT LNHPDF_ERR LCHEX HPDF_GETERROR PDFHANDLE HPDF_RESETERROR LSHOWERRORS STARTMODE LNOPTION _ERRORINFO NCURRENTPAGE COBJECTTORENDERC HPDF_ARRAY_COUNT_ERR HPDF_ARRAY_ITEM_NOT_FOUND HPDF_ARRAY_ITEM_UNEXPECTED_TYPE HPDF_BINARY_LENGTH_ERR HPDF_CANNOT_GET_PALLET HPDF_DICT_COUNT_ERR HPDF_DICT_ITEM_NOT_FOUND HPDF_DICT_ITEM_UNEXPECTED_TYPE HPDF_DICT_STREAM_LENGTH_NOT_FOUND HPDF_DOC_ENCRYPTDICT_NOT_FOUND HPDF_DOC_INVALID_OBJECT HPDF_DUPLICATE_REGISTRATION HPDF_EXCEED_JWW_CODE_NUM_LIMIT HPDF_ENCRYPT_INVALID_PASSWORD HPDF_ERR_UNKNOWN_CLASS HPDF_EXCEED_GSTATE_LIMIT HPDF_FAILD_TO_ALLOC_MEM HPDF_FILE_IO_ERROR HPDF_FILE_OPEN_ERROR HPDF_FONT_EXISTS HPDF_FONT_INVALID_WIDTHS_TABLE HPDF_INVALID_AFM_HEADER HPDF_INVALID_ANNOTATION HPDF_INVALID_BIT_PER_COMPONENT HPDF_INVALID_CHAR_MATRICS_DATA HPDF_INVALID_COLOR_SPACE HPDF_INVALID_COMPRESSION_MODE HPDF_INVALID_DATE_TIME HPDF_INVALID_DESTINATION HPDF_INVALID_DOCUMENT HPDF_INVALID_DOCUMENT_STATE HPDF_INVALID_ENCODER HPDF_INVALID_ENCODER_TYPE HPDF_INVALID_ENCODING_NAME HPDF_INVALID_ENCRYPT_KEY_LEN HPDF_INVALID_FONTDEF_DATA HPDF_INVALID_FONTDEF_TYPE HPDF_INVALID_FONT_NAME HPDF_INVALID_IMAGE HPDF_INVALID_JPEG_DATA HPDF_INVALID_N_DATA HPDF_INVALID_OBJECT HPDF_INVALID_OBJ_ID HPDF_INVALID_OPERATION HPDF_INVALID_OUTLINE HPDF_INVALID_PAGE HPDF_INVALID_PAGES HPDF_INVALID_PARAMETER HPDF_INVALID_PNG_IMAGE HPDF_INVALID_STREAM HPDF_MISSING_FILE_NAME_ENTRY HPDF_INVALID_TTC_FILE HPDF_INVALID_TTC_INDEX HPDF_INVALID_WX_DATA HPDF_ITEM_NOT_FOUND HPDF_LIBPNG_ERROR HPDF_NAME_INVALID_VALUE HPDF_NAME_OUT_OF_RANGE HPDF_PAGE_INVALID_PARAM_COUNT HPDF_PAGES_MISSING_KIDS_ENTRY HPDF_PAGE_CANNOT_FIND_OBJECT HPDF_PAGE_CANNOT_GET_ROOT_PAGES HPDF_PAGE_CANNOT_RESTORE_GSTATE HPDF_PAGE_CANNOT_SET_PARENT HPDF_PAGE_FONT_NOT_FOUND HPDF_PAGE_INVALID_FONT HPDF_PAGE_INVALID_FONT_SIZE HPDF_PAGE_INVALID_GMODE HPDF_PAGE_INVALID_INDEX HPDF_PAGE_INVALID_ROTATE_VALUE HPDF_PAGE_INVALID_SIZE HPDF_PAGE_INVALID_XOBJECT HPDF_PAGE_OUT_OF_RANGE HPDF_REAL_OUT_OF_RANGE HPDF_STREAM_EOF HPDF_STREAM_READLN_CONTINUE HPDF_STRING_OUT_OF_RANGE HPDF_THIS_FUNC_WAS_SKIPPED HPDF_TTF_CANNOT_EMBEDDING_FONT HPDF_TTF_INVALID_CMAP HPDF_TTF_INVALID_FOMAT HPDF_TTF_MISSING_TABLE HPDF_UNSUPPORTED_FONT_TYPE HPDF_UNSUPPORTED_FUNC HPDF_UNSUPPORTED_JPEG_FORMAT HPDF_UNSUPPORTED_TYPE1_FONT HPDF_XREF_COUNT_ERR HPDF_ZLIB_ERROR HPDF_INVALID_PAGE_INDEX HPDF_INVALID_URI HPDF_PAGE_LAYOUT_OUT_OF_RANGE HPDF_PAGE_MODE_OUT_OF_RANGE HPDF_PAGE_NUM_STYLE_OUT_OF_RANGE HPDF_ANNOT_INVALID_ICON HPDF_ANNOT_INVALID_BORDER_STYLE HPDF_PAGE_INVALID_DIRECTION HPDF_INVALID_FONT HPDF_PAGE_INSUFFICIENT_SPACE HPDF_PAGE_INVALID_DISPLAY_TIME HPDF_PAGE_INVALID_TRANSITION_TIME HPDF_INVALID_PAGE_SLIDESHOW_TYPE HPDF_EXT_GSTATE_OUT_OF_RANGE HPDF_INVALID_EXT_GSTATE HPDF_EXT_GSTATE_READ_ONLY Unknown Error TNSTATUS UPDATEPROPERTIES Collection OIMAGESCOLLECTION STRING LDEFAULTMODE WAITFORNEXTREPORT OIMAGESCOLLECTION LCITEM LOEXC LDEFAULTMODE LOBJTYPEMODE OUTPUTFROMDATA GETPAGEWIDTH GETPAGEHEIGHT WAITFORNEXTREPORT OFOXYPREVIEWER CDESTFILE CTARGETFILENAME LCFILE _STAT HPDF_FREE PDFHANDLE HPDF_SAVETOFILE LOPENVIEWER SHELLEXEC NPGCOUNTERn INTEGER STRING TEMP5 NPAGENO EDEVICE NDEVICETYPE NLEFT NWIDTH NHEIGHT NCLIPLEFT NCLIPTOP NCLIPWIDTH NCLIPHEIGHT LNHANDLE LCFILE STARTPDFDOCUMENT ADDBLANKPAGE OUTPUTPAGE HPDF_LOADPNGIMAGEFROMFILE PDFHANDLE _STAT HPDF_PAGE_DRAWIMAGE OPAGE GETPAGEWIDTH GETPAGEHEIGHT OIMAGESCOLLECTION THIS CLEARDLLS addblankpage, cleardlls encryptpdf0 startpdfdocument writepdfinformation declaredll@ outputfromdata updateproperties _stat_assignP _errorinfoC LoadReport BeforeReport UnloadReport AfterReport OutputPage Destroy,? reportlistener pr_reportlistener.vcx tnHKeyb RegQueryValueEx Win32APIQ RegQueryString TNHKEY TCSUBKEY TCENTRY LNREGHANDLE LNRESULT LNSIZE LCDATABUFFER TNTYPE REGOPENKEY REGQUERYVALUEEX WIN32API REGQUERYSTRING LNTYPE REGCLOSEKEYI tnHKeyb RegQueryValueEx Win32APIQ RegQueryInt TNHKEY TCSUBKEY TCENTRY LNREGHANDLE LNRESULT LNSIZE LCDATABUFFER TNTYPE REGOPENKEY REGQUERYVALUEEX WIN32API REGQUERYINT LNDATABUFFER REGCLOSEKEY tnHKeyb RegSetValueEx Win32API TNHKEY TCSUBKEY TCENTRY TCVALUE TLCREATE LNREGHANDLE LNRESULT LNSIZE LCDATABUFFER TNTYPE REGOPENKEY REGCREATEKEY REGSETVALUEEX WIN32API REGDELETEVALUE REGCLOSEKEY tnHKeyb RegSetValueEx Win32API TNHKEY TCSUBKEY TCENTRY TNVALUE TLCREATE LNREGHANDLE LNRESULT LNSIZE LCDATABUFFER TNTYPE REGOPENKEY REGCREATEKEY REGSETVALUEEX WIN32API REGDELETEVALUE REGCLOSEKEY tnHKeyb tnLengthb RegSetValueEx Win32API TNHKEY TCSUBKEY TCENTRY TCVALUE TNLENGTH TLCREATE LNREGHANDLE LNRESULT LNSIZE LCDATABUFFER TNTYPE REGOPENKEY REGCREATEKEY REGSETVALUEEX WIN32API REGDELETEVALUE REGCLOSEKEY tnHKeyb TNHKEY TCSUBKEY LNRESULT LNREGHANDLE REGOPENKEY REGDELETEKEY REGCLOSEKEY RegEnumKey WIN32API TNHKEY TCSUBKEY TNINDEX LCSUBKEY LCRETURN LNRESULT LCDATABUFFER LNREGHANDLE REGOPENKEY REGENUMKEY WIN32API LNSIZE LNRETURN REGCLOSEKEYp tnTypeb RegEnumValue Win32API TNHKEY TCSUBKEY TNINDEX TNTYPE LCSUBKEY LCRETURN LNRESULT LCDATABUFFER LNREGHANDLE REGOPENKEY REGENUMVALUE WIN32API TCVALUE LNSIZE LNVALSIZE LNRETURN REGCLOSEKEY TAVALUES TNHKEY TCSUBKEY LCKEY LNTYPE THIS ENUMVALUE LCVALUE OREGISTRY READREGISTRYSTRING LNVALUE READREGISTRYINT TAKEYS TNHKEY TCSUBKEY LCKEY LNTYPE ENUMKEY SOFTWARE\West Wind Technologies SOFTWARE\West Wind Technologies\WebConnection CurrentVersion 1.45a SOFTWARE\West Wind Technologies\WebConnection Timeout SOFTWARE\West Wind Technologies\WebConnection CurrentVersion SOFTWARE\West Wind Technologies\WebConnection Timeout OREGISTRY WRITEREGISTRYSTRING WRITEREGISTRYINT READREGISTRYSTRING READREGISTRYINT RegOpenKey Win32API RegCreateKey Win32API RegCloseKey Win32API RegDeleteKey Win32API RegDeleteValue Win32API REGOPENKEY WIN32API REGCREATEKEY REGCLOSEKEY REGDELETEKEY REGDELETEVALUE readregistrystring, readregistryintT writeregistrystring@ writeregistryint writeregistrybinary deleteregistrykey enumregistrykey enumvalueg getenumvalues getenumkeys examples `)PROCEDURE addblankpage WITH This LOCAL lnWidth, lnHeight IF This.lDefaultMode lnWidth = .GetPageWidth() lnHeight = .GetPageHeight() ELSE lnWidth = This.nPageWidth lnHeight = This.nPageHeight ENDIF .oPage=HPDF_AddPage(.pdfHandle) &&Add a New Page This._Stat = HPDF_Page_SetWidth(.oPage, (lnWidth/960)*72) &&Establish the Width of the page This._Stat = HPDF_Page_SetHeight(.oPage, (lnHeight/960)*72) &&Establish the Height of the page ENDWITH ENDPROC PROCEDURE cleardlls Clear Dlls "HPDF_New,HPDF_Free","HPDF_SaveToFile","HPDF_SetPageMode","HPDF_AddPage","HPDF_Page_SetWidth","HPDF_Page_SetHeight",; "HPDF_LoadJpegImageFromFile","HPDF_SetInfoAttr","HPDF_SetPassword","HPDF_SetPermission","HPDF_SetEncryptionMode",; "HPDF_SetCompressionMode","HPDF_Page_Concat","HPDF_Page_DrawImage","HPDF_LoadPngImageFromFile", "HPDF_GetError", "HPDF_ResetError" ENDPROC PROCEDURE encryptpdf With This If .lEncryptDocument Then &&Protect the document with password If !Empty(.cMasterPassword) Then If .cMasterPassword!=.cUserPassword Then &&User Password and Master Password can't be the same This._Stat = HPDF_SetPassword(.pdfHandle, .cMasterPassword, .cUserPassword) Local lnPermit As Integer lnPermit=0 &&Establish PDF files permissions If .lCanPrint Then lnPermit = lnPermit + HPDF_ENABLE_PRINT EndIf If .lCanEdit Then lnPermit = lnPermit + HPDF_ENABLE_EDIT_ALL EndIf If .lCanCopy Then lnPermit = lnPermit + HPDF_ENABLE_COPY EndIf If .lCanAddNotes Then lnPermit = lnPermit + HPDF_ENABLE_EDIT EndIf This._Stat = HPDF_SetPermission(This.pdfHandle, lnPermit) If .nEncriptionLevel!=5 Then This._Stat = HPDF_SetEncryptionMode(.pdfHandle, HPDF_ENCRYPT_R3, .nEncriptionLevel) Else This._Stat = HPDF_SetEncryptionMode(.pdfHandle, HPDF_ENCRYPT_R2, .nEncriptionLevel) EndIf EndIf EndIf EndIf EndWith ENDPROC PROCEDURE startpdfdocument This.DeclareDll() With This .pdfHandle=HPDF_New(0, 0) &&Create a New Document IF .pdfHandle = 0 * Check if the library HPDF.DLL is in the disk MESSAGEBOX("Could not load the library LIBHPDF.DLL ." + CHR(13) + ; "The process can't continue. Make sure that you have the PDF library available, and that FoxyPreviewer is installed in a folder that has READ/WRITE access.", 16, "Error") This.CancelReport() RETURN .F. ENDIF This._Stat = HPDF_SetCompressionMode(.pdfHandle, HPDF_COMP_ALL) &&Set Document Compression Method * KHentschel 2010-06-15 * Added "nPageMode" property: how Document should be displayed HPDF_PAGE_MODE_USE_OUTLINE * HPDF_SetPageMode(.pdfHandle, HPDF_PAGE_MODE_USE_OUTLINE) &&Set the how Document should be displayed * Available possibilities: * #define HPDF_PAGE_MODE_USE_NONE 0 * #define HPDF_PAGE_MODE_USE_OUTLINE 1 * #define HPDF_PAGE_MODE_USE_THUMBS 2 * #define HPDF_PAGE_MODE_FULL_SCREEN 3 This._Stat = HPDF_SetPageMode(.pdfHandle, .nPageMode) .WritePdfInformation() &&Stablish PDF File Information .EncryptPdf() .AddBlankPage() EndWith ENDPROC PROCEDURE writepdfinformation With This If !Empty(.cPdfAuthor) Then This._Stat = HPDF_SetInfoAttr(.pdfHandle, HPDF_INFO_AUTHOR, .cPdfAuthor) EndIf If !Empty(.cPdfTitle) Then This._Stat = HPDF_SetInfoAttr(.pdfHandle, HPDF_INFO_TITLE, .cPdfTitle) EndIf If !Empty(.cPdfSubject) Then This._Stat = HPDF_SetInfoAttr(.pdfHandle, HPDF_INFO_SUBJECT, .cPdfSubject) EndIf If !Empty(.cPdfKeyWords) Then This._Stat = HPDF_SetInfoAttr(.pdfHandle, HPDF_INFO_KEYWORDS, .cPdfKeywords) EndIf If !Empty(.cPdfCreator) Then This._Stat = HPDF_SetInfoAttr(.pdfHandle, HPDF_INFO_CREATOR, .cPdfCreator) EndIf EndWith ENDPROC PROCEDURE declaredll *!* * Check if the library HPDF.DLL is in the disk *!* LOCAL lcPDFFile *!* lcPDFFile = "libhpdf.dll" *!* IF EMPTY(SYS(2000,lcPDFFile)) *!* MESSAGEBOX("Could not locate the library LIBHPDF.DLL ." + CHR(13) + ; *!* "The process can't continue. Make sure that you have the PDF library available, and that FoxyPreviewer is installed in a folder that has READ/WRITE access.", 16, "Error") *!* RETURN .F. *!* ENDIF Declare Integer HPDF_New In libhpdf.dll Integer, Integer Declare Integer HPDF_Free In libhpdf.dll Integer Declare Integer HPDF_SaveToFile In libhpdf.dll Integer, String Declare Integer HPDF_SetPageMode In libhpdf.dll Integer, Integer Declare Integer HPDF_AddPage In libhpdf.dll Integer Declare Integer HPDF_Page_SetWidth In libhpdf.dll Integer, Single Declare Integer HPDF_Page_SetHeight In libhpdf.dll Integer, Single Declare Integer HPDF_LoadJpegImageFromFile In libhpdf.dll Integer, String Declare Integer HPDF_LoadPngImageFromFile In libhpdf.dll Integer, String Declare Integer HPDF_SetInfoAttr In libhpdf.dll Integer, Integer, String Declare Integer HPDF_SetPassword In libhpdf.dll Integer, String, String Declare Integer HPDF_SetPermission In libhpdf.dll Integer, Integer Declare Integer HPDF_SetEncryptionMode In libhpdf.dll Integer, Integer, Integer Declare Integer HPDF_SetCompressionMode In libhpdf.dll Integer, Integer Declare Integer HPDF_Page_Concat In libhpdf.dll Integer, Single, Single, Single, Single, Single, Single Declare Integer HPDF_Page_DrawImage In libhpdf.dll Integer, Integer, Single, Single, Single, Single Declare Integer HPDF_GetError In libhpdf.dll Integer Declare Integer HPDF_ResetError In libhpdf.dll Integer ENDPROC PROCEDURE outputfromdata LPARAMETERS toListener as ReportListener, tnWidth, tnHeight LOCAL llShowTherm llShowTherm = (This.QuietMode = .F.) AND (This.lObjTypeMode = .F.) * =DoFoxyTherm(90, "Texto label", "Titulo") * =DoFoxyTherm(-1, "Teste2", "Titulo") && Continuo * =DoFoxyTherm() && Desliga IF llShowTherm LOCAL lnSecs lnSecs = SECONDS() *!* ._InitStatusText = .GetLoc("INITSTATUS") + SPACE(1) *!* ._RunStatusText = .GetLoc("RUNSTATUS") + SPACE(1) *!* ._SecondsText = .GetLoc("SECONDS") + SPACE(1) =DoFoxyTherm(1, "0%", _goHelper._InitStatusText) ENDIF #DEFINE OutputJPEG 102 #DEFINE OutputPNG 104 This.lDefaultMode = .F. This.nPageWidth = tnWidth This.nPageHeight = tnHeight IF VARTYPE(toListener) <> "O" ERROR "Report Listener could not be accessed" RETURN .F. ENDIF IF NOT This.lObjTypeMode This.BeforeReport() ENDIF This.StartPdfDocument() LOCAL lnPageCount, lnFileType, lnDeviceType, lnPageNo, lcFile, lnDeviceType, lnHandle, lnPercent, lnLastPercent, lnDelay lnDeviceType = OutputPNG lnPageCount = toListener.PageTotal && _goHelper.nPageTotal && toListener.PageTotal lnLastPercent = 0 lnDelay = 5 FOR lnPageNo = 1 TO lnPageCount IF llShowTherm lnPercent = CEILING(100*lnPageNo/lnPageCount) IF (lnLastPercent > 0 AND ; lnPercent - lnLastPercent < lnDelay AND ; lnPercent <> 100) ELSE =DoFoxyTherm(lnPercent, ; ALLTRIM(TRANSFORM(lnPercent)) + "% - " + TRANSFORM(FLOOR(SECONDS() - lnSecs)) + " " + _goHelper._SecondsText , ; _goHelper._RunStatusText) ENDIF ENDIF This.nCurrentPage = lnPageNo IF lnPageNo > 1 This.AddBlankPage() ENDIF lcFile = ADDBS(GETENV("TEMP")) + SYS(2015) + ".PNG" toListener.OutputPage(lnPageNo, lcFile, lnDeviceType) * lnHandle = HPDF_LoadJpegImageFromFile(This.pdfHandle, lcFile) lnHandle = HPDF_LoadPngImageFromFile(This.pdfHandle, lcFile) IF lnHandle = 0 MESSAGEBOX("Internal error loading the page image file from the report.", 48, "Error") SET STEP ON ELSE This._Stat = HPDF_Page_DrawImage(This.oPage, lnHandle, 0, 0, (tnWidth/960)*72, (tnHeight/960)*72) This.oImagesCollection.Add(lcFile) ENDIF ENDFOR IF llShowTherm =DoFoxyTherm(100, ; "100% - " + TRANSFORM(CEILING(SECONDS() - lnSecs)) + " " + _goHelper._SecondsText , ; _goHelper._RunStatusText) ENDIF IF NOT This.lObjTypeMode This.AfterReport() This.UnloadReport() ENDIF IF llShowTherm =DoFoxyTherm() ENDIF ENDPROC PROCEDURE updateproperties IF NOT This.lObjTypeMode OR (VARTYPE(_Screen.oFoxyPreviewer) <> "O") RETURN ENDIF LOCAL loFP loFP = _Screen.oFoxyPreviewer IF VARTYPE(This.CommandClauses) = "O" *!* IF This.CommandClauses.Preview *!* This.lOpenViewer = .T. *!* ELSE *!* This.lOpenViewer = NVL(loFP.lOpenViewer, .T.) *!* ENDIF This.lOpenViewer = This.CommandClauses.Preview IF NOT EMPTY(This.CommandClauses.ToFile) This.cTargetFileName = This.CommandClauses.ToFile ELSE IF VARTYPE(_Screen.oFoxyPreviewer) = "O" AND ; NOT EMPTY(_Screen.oFoxyPreviewer.cDestFile) AND ; EMPTY(This.cTargetFileName) LOCAL lcDestFile lcDestFile = _Screen.oFoxyPreviewer.cDestFile IF NOT "\" $ lcDestFile lcDestFile = ALLTRIM(ADDBS(_Screen.oFoxyPreviewer.cOutputPath) + lcDestFile) ENDIF This.cTargetFileName = lcDestFile ELSE LOCAL lcFile lcFile = This.cTargetFileName IF EMPTY(lcFile) lcFile = PUTFILE("","","pdf") ENDIF IF EMPTY(lcFile) _ReportListener::CancelReport() * This.CancelReport() RETURN .F. ENDIF This.cTargetFileName = lcFile ENDIF ENDIF ENDIF This.QUIETMODE = NVL(loFP.lQuietMode , .F.) *This.lEmbedFont = NVL(loFP.lPDFEmbedFonts , .T.) This.lCanPrint = NVL(loFP.lPDFCanPrint , .T.) This.lCanEdit = NVL(loFP.lPDFCanEdit , .T.) This.lCanCopy = NVL(loFP.lPDFCanCopy , .T.) This.lCanAddNotes = NVL(loFP.lPDFCanAddNotes , .T.) This.lEncryptDocument = NVL(loFP.lPDFEncryptDocument, .T.) This.cMasterPassword = NVL(loFP.cPDFMasterPassword , "") This.cUserPassword = NVL(loFP.cPDFUserPassword , "") *This.lShowErrors = NVL(loFP.lPDFShowErrors , .F.) *This.cSymbolFontsList = NVL(loFP.cPDFSymbolFontsList, "") This.cPdfAuthor = NVL(loFP.cPdfAuthor , "") This.cPdfTitle = NVL(loFP.cPdfTitle , "") This.cPdfSubject = NVL(loFP.cPdfSubject , "") This.cPdfKeyWords = NVL(loFP.cPdfKeyWords , "") This.cPdfCreator = NVL(loFP.cPdfCreator , "") *This.cDefaultFont = NVL(loFP.cPDFDefaultFont , "") LOCAL lnPgMode lnPgMode = MAX(NVL(loFP.nPDFPageMode, 0) - 1, 0) lnPgMode = IIF(lnPgMode = 1, 2, lnPgMode) This.nPageMode = lnPgMode This.lDefaultMode = .T. This.QuietMode = .T. ENDPROC PROCEDURE _stat_assign LPARAMETERS tnStatus This._Stat = tnStatus IF tnStatus != 0 * Clear existing the HPDF errors * Here we can see if an error occurred during the rendering process of the * current field LOCAL lnHPDF_err, lcHex lnHPDF_err = HPDF_GetError(This.pdfHandle) IF lnHPDF_err <> 0 lcHex = TRANSFORM(lnHPDF_err, "@0") * SET STEP ON HPDF_ResetError(This.pdfHandle) ENDIF IF This.lShowErrors = .T. AND tnStatus > 1 IF _VFP.StartMode = 0 && Development LOCAL lnOption lnOption = MESSAGEBOX("PDFx error in " + PROGRAM(PROGRAM(-1) - 1) + CHR(13); + "Error code : " + TRANSFORM(tnStatus) + CHR(13) ; + "Description: " + This._ErrorInfo(tnStatus) + CHR(13) ; + "Page: " + TRANSFORM(This.nCurrentPage) + CHR(13) ; + "Press 'Retry' to debug the application.", 16 + 2, "Error") IF lnOption = 3 CANCEL ENDIF IF lnOption = 4 SUSPEND ENDIF ELSE MESSAGEBOX("PDFx error in " + PROGRAM(PROGRAM(-1) - 1) + CHR(13); + "Error code : " + TRANSFORM(tnStatus) + CHR(13) ; + "Description : " + This._ErrorInfo(tnStatus) + CHR(13) ; + "Object: " + This.cObjectToRender, 16, "Error") ENDIF ENDIF ENDIF ENDPROC PROCEDURE _errorinfo LPARAMETERS tnStatus DO CASE CASE tnStatus = 0x1001 RETURN "HPDF_ARRAY_COUNT_ERR " && 0x1001 CASE tnStatus = 0x1002 RETURN "HPDF_ARRAY_ITEM_NOT_FOUND " && 0x1002 CASE tnStatus = 0x1003 RETURN "HPDF_ARRAY_ITEM_UNEXPECTED_TYPE " && 0x1003 CASE tnStatus = 0x1004 RETURN "HPDF_BINARY_LENGTH_ERR " && 0x1004 CASE tnStatus = 0x1005 RETURN "HPDF_CANNOT_GET_PALLET " && 0x1005 CASE tnStatus = 0x1007 RETURN "HPDF_DICT_COUNT_ERR " && 0x1007 CASE tnStatus = 0x1008 RETURN "HPDF_DICT_ITEM_NOT_FOUND " && 0x1008 CASE tnStatus = 0x1009 RETURN "HPDF_DICT_ITEM_UNEXPECTED_TYPE " && 0x1009 CASE tnStatus = 0x100A RETURN "HPDF_DICT_STREAM_LENGTH_NOT_FOUND " && 0x100A CASE tnStatus = 0x100B RETURN "HPDF_DOC_ENCRYPTDICT_NOT_FOUND " && 0x100B CASE tnStatus = 0x100C RETURN "HPDF_DOC_INVALID_OBJECT " && 0x100C CASE tnStatus = 0x100E RETURN "HPDF_DUPLICATE_REGISTRATION " && 0x100E CASE tnStatus = 0x100F RETURN "HPDF_EXCEED_JWW_CODE_NUM_LIMIT " && 0x100F CASE tnStatus = 0x10011 RETURN "HPDF_ENCRYPT_INVALID_PASSWORD " && 0x1011 CASE tnStatus = 0x1013 RETURN "HPDF_ERR_UNKNOWN_CLASS " && 0x1013 CASE tnStatus = 0x1014 RETURN "HPDF_EXCEED_GSTATE_LIMIT " && 0x1014 CASE tnStatus = 0x1015 RETURN "HPDF_FAILD_TO_ALLOC_MEM " && 0x1015 CASE tnStatus = 0x1016 RETURN "HPDF_FILE_IO_ERROR " && 0x1016 CASE tnStatus = 0x1017 RETURN "HPDF_FILE_OPEN_ERROR " && 0x1017 CASE tnStatus = 0x1019 RETURN "HPDF_FONT_EXISTS " && 0x1019 CASE tnStatus = 0x101A RETURN "HPDF_FONT_INVALID_WIDTHS_TABLE " && 0x101A CASE tnStatus = 0x101B RETURN "HPDF_INVALID_AFM_HEADER " && 0x101B CASE tnStatus = 0x101C RETURN "HPDF_INVALID_ANNOTATION " && 0x101C CASE tnStatus = 0x101E RETURN "HPDF_INVALID_BIT_PER_COMPONENT " && 0x101E CASE tnStatus = 0x101F RETURN "HPDF_INVALID_CHAR_MATRICS_DATA " && 0x101F CASE tnStatus = 0x1020 RETURN "HPDF_INVALID_COLOR_SPACE " && 0x1020 CASE tnStatus = 0x1021 RETURN "HPDF_INVALID_COMPRESSION_MODE " && 0x1021 CASE tnStatus = 0x1022 RETURN "HPDF_INVALID_DATE_TIME " && 0x1022 CASE tnStatus = 0x1023 RETURN "HPDF_INVALID_DESTINATION " && 0x1023 CASE tnStatus = 0x1025 RETURN "HPDF_INVALID_DOCUMENT " && 0x1025 CASE tnStatus = 0x1026 RETURN "HPDF_INVALID_DOCUMENT_STATE " && 0x1026 CASE tnStatus = 0x1027 RETURN "HPDF_INVALID_ENCODER " && 0x1027 CASE tnStatus = 0x1028 RETURN "HPDF_INVALID_ENCODER_TYPE " && 0x1028 CASE tnStatus = 0x102B RETURN "HPDF_INVALID_ENCODING_NAME " && 0x102B CASE tnStatus = 0x102C RETURN "HPDF_INVALID_ENCRYPT_KEY_LEN " && 0x102C CASE tnStatus = 0x102D RETURN "HPDF_INVALID_FONTDEF_DATA " && 0x102D CASE tnStatus = 0x102E RETURN "HPDF_INVALID_FONTDEF_TYPE " && 0x102E CASE tnStatus = 0x102F RETURN "HPDF_INVALID_FONT_NAME " && 0x102F CASE tnStatus = 0x1030 RETURN "HPDF_INVALID_IMAGE " && 0x1030 CASE tnStatus = 0x1031 RETURN "HPDF_INVALID_JPEG_DATA " && 0x1031 CASE tnStatus = 0x1032 RETURN "HPDF_INVALID_N_DATA " && 0x1032 CASE tnStatus = 0x1033 RETURN "HPDF_INVALID_OBJECT " && 0x1033 CASE tnStatus = 0x1034 RETURN "HPDF_INVALID_OBJ_ID " && 0x1034 CASE tnStatus = 0x1035 RETURN "HPDF_INVALID_OPERATION " && 0x1035 CASE tnStatus = 0x1036 RETURN "HPDF_INVALID_OUTLINE " && 0x1036 CASE tnStatus = 0x1037 RETURN "HPDF_INVALID_PAGE " && 0x1037 CASE tnStatus = 0x1038 RETURN "HPDF_INVALID_PAGES " && 0x1038 CASE tnStatus = 0x1039 RETURN "HPDF_INVALID_PARAMETER " && 0x1039 CASE tnStatus = 0x103B RETURN "HPDF_INVALID_PNG_IMAGE " && 0x103B CASE tnStatus = 0x103C RETURN "HPDF_INVALID_STREAM " && 0x103C CASE tnStatus = 0x103D RETURN "HPDF_MISSING_FILE_NAME_ENTRY " && 0x103D CASE tnStatus = 0x103F RETURN "HPDF_INVALID_TTC_FILE " && 0x103F CASE tnStatus = 0x1040 RETURN "HPDF_INVALID_TTC_INDEX " && 0x1040 CASE tnStatus = 0x1041 RETURN "HPDF_INVALID_WX_DATA " && 0x1041 CASE tnStatus = 0x1042 RETURN "HPDF_ITEM_NOT_FOUND " && 0x1042 CASE tnStatus = 0x1043 RETURN "HPDF_LIBPNG_ERROR " && 0x1043 CASE tnStatus = 0x1044 RETURN "HPDF_NAME_INVALID_VALUE " && 0x1044 CASE tnStatus = 0x1045 RETURN "HPDF_NAME_OUT_OF_RANGE " && 0x1045 CASE tnStatus = 0x1048 RETURN "HPDF_PAGE_INVALID_PARAM_COUNT " && 0x1048 CASE tnStatus = 0x1049 RETURN "HPDF_PAGES_MISSING_KIDS_ENTRY " && 0x1049 CASE tnStatus = 0x104A RETURN "HPDF_PAGE_CANNOT_FIND_OBJECT " && 0x104A CASE tnStatus = 0x104B RETURN "HPDF_PAGE_CANNOT_GET_ROOT_PAGES " && 0x104B CASE tnStatus = 0x104C RETURN "HPDF_PAGE_CANNOT_RESTORE_GSTATE " && 0x104C CASE tnStatus = 0x104D RETURN "HPDF_PAGE_CANNOT_SET_PARENT " && 0x104D CASE tnStatus = 0x104E RETURN "HPDF_PAGE_FONT_NOT_FOUND " && 0x104E CASE tnStatus = 0x104F RETURN "HPDF_PAGE_INVALID_FONT " && 0x104F CASE tnStatus = 0x1050 RETURN "HPDF_PAGE_INVALID_FONT_SIZE " && 0x1050 CASE tnStatus = 0x1051 RETURN "HPDF_PAGE_INVALID_GMODE " && 0x1051 CASE tnStatus = 0x1052 RETURN "HPDF_PAGE_INVALID_INDEX " && 0x1052 CASE tnStatus = 0x1053 RETURN "HPDF_PAGE_INVALID_ROTATE_VALUE " && 0x1053 CASE tnStatus = 0x1054 RETURN "HPDF_PAGE_INVALID_SIZE " && 0x1054 CASE tnStatus = 0x1055 RETURN "HPDF_PAGE_INVALID_XOBJECT " && 0x1055 CASE tnStatus = 0x1056 RETURN "HPDF_PAGE_OUT_OF_RANGE " && 0x1056 CASE tnStatus = 0x1057 RETURN "HPDF_REAL_OUT_OF_RANGE " && 0x1057 CASE tnStatus = 0x1058 RETURN "HPDF_STREAM_EOF " && 0x1058 CASE tnStatus = 0x1059 RETURN "HPDF_STREAM_READLN_CONTINUE " && 0x1059 CASE tnStatus = 0x105B RETURN "HPDF_STRING_OUT_OF_RANGE " && 0x105B CASE tnStatus = 0x105C RETURN "HPDF_THIS_FUNC_WAS_SKIPPED " && 0x105C CASE tnStatus = 0x105D RETURN "HPDF_TTF_CANNOT_EMBEDDING_FONT " && 0x105D CASE tnStatus = 0x105E RETURN "HPDF_TTF_INVALID_CMAP " && 0x105E CASE tnStatus = 0x105F RETURN "HPDF_TTF_INVALID_FOMAT " && 0x105F CASE tnStatus = 0x1060 RETURN "HPDF_TTF_MISSING_TABLE " && 0x1060 CASE tnStatus = 0x1061 RETURN "HPDF_UNSUPPORTED_FONT_TYPE " && 0x1061 CASE tnStatus = 0x1062 RETURN "HPDF_UNSUPPORTED_FUNC " && 0x1062 CASE tnStatus = 0x1063 RETURN "HPDF_UNSUPPORTED_JPEG_FORMAT " && 0x1063 CASE tnStatus = 0x1064 RETURN "HPDF_UNSUPPORTED_TYPE1_FONT " && 0x1064 CASE tnStatus = 0x1065 RETURN "HPDF_XREF_COUNT_ERR " && 0x1065 CASE tnStatus = 0x1066 RETURN "HPDF_ZLIB_ERROR " && 0x1066 CASE tnStatus = 0x1067 RETURN "HPDF_INVALID_PAGE_INDEX " && 0x1067 CASE tnStatus = 0x1068 RETURN "HPDF_INVALID_URI " && 0x1068 CASE tnStatus = 0x1069 RETURN "HPDF_PAGE_LAYOUT_OUT_OF_RANGE " && 0x1069 CASE tnStatus = 0x1070 RETURN "HPDF_PAGE_MODE_OUT_OF_RANGE " && 0x1070 CASE tnStatus = 0x1071 RETURN "HPDF_PAGE_NUM_STYLE_OUT_OF_RANGE " && 0x1071 CASE tnStatus = 0x1072 RETURN "HPDF_ANNOT_INVALID_ICON " && 0x1072 CASE tnStatus = 0x1073 RETURN "HPDF_ANNOT_INVALID_BORDER_STYLE " && 0x1073 CASE tnStatus = 0x1074 RETURN "HPDF_PAGE_INVALID_DIRECTION " && 0x1074 CASE tnStatus = 0x1075 RETURN "HPDF_INVALID_FONT " && 0x1075 CASE tnStatus = 0x1076 RETURN "HPDF_PAGE_INSUFFICIENT_SPACE " && 0x1076 CASE tnStatus = 0x1077 RETURN "HPDF_PAGE_INVALID_DISPLAY_TIME " && 0x1077 CASE tnStatus = 0x1078 RETURN "HPDF_PAGE_INVALID_TRANSITION_TIME " && 0x1078 CASE tnStatus = 0x1079 RETURN "HPDF_INVALID_PAGE_SLIDESHOW_TYPE " && 0x1079 CASE tnStatus = 0x1080 RETURN "HPDF_EXT_GSTATE_OUT_OF_RANGE " && 0x1080 CASE tnStatus = 0x1081 RETURN "HPDF_INVALID_EXT_GSTATE " && 0x1081 CASE tnStatus = 0x1082 RETURN "HPDF_EXT_GSTATE_READ_ONLY " && 0x1082 OTHERWISE RETURN "Unknown Error" ENDCASE ENDPROC PROCEDURE LoadReport This.UpdateProperties() DODEFAULT() ENDPROC PROCEDURE BeforeReport This.oImagesCollection=CreateObject("Collection") ENDPROC PROCEDURE UnloadReport IF This.lDefaultMode DODEFAULT() ENDIF With This * CChalom 2010-01-20 * Added "WaitForNextReport" property in order to allow merging reports * If another report is expected to come, don't close the objects and handles IF Not .WaitForNextReport If Vartype(.oImagesCollection)="O" Then &&Cleanup Temporary Images Files Local lcItem As String For Each lcItem In .oImagesCollection FOXOBJECT TRY Delete File (lcItem) CATCH TO loexc SET STEP ON ENDTRY EndFor .oImagesCollection=Null EndIf ENDIF ENDWITH ENDPROC PROCEDURE AfterReport IF This.lDefaultMode DODEFAULT() ENDIF IF This.lObjTypeMode This.OutputFromData(This, This.GetPageWidth(), This.GetPageHeight()) ENDIF WITH This IF NOT .WaitForNextReport IF This.lObjTypeMode AND VARTYPE(_Screen.oFoxyPreviewer) = "O" AND ; NOT EMPTY(_Screen.oFoxyPreviewer.cDestFile) This.cTargetFileName = _Screen.oFoxyPreviewer.cDestFile ENDIF LOCAL lcFile lcFile = This.cTargetFileName IF EMPTY(lcFile) lcFile = PUTFILE("","","pdf") ENDIF IF EMPTY(lcFile) This._Stat = HPDF_Free(.pdfHandle) RETURN ELSE This._Stat = HPDF_SaveToFile(.pdfHandle, lcFile) This._Stat = HPDF_Free(.pdfHandle) If .lOpenViewer Then .ShellExec(lcFile) EndIf ENDIF ENDIF * Reset the report page counter This.nPgCounter = 0 ENDWITH ENDPROC PROCEDURE OutputPage Lparameters nPageNo, eDevice, nDeviceType, nLeft, nTop, nWidth, nHeight, nClipLeft, nClipTop, nClipWidth, nClipHeight #Define OutputNothing -1 #Define OutputTIFF 101 #Define OutputTIFFAdditive (OutputTIFF+100) #Define OutPutJPEG 102 #Define OutPutPNG 104 #Define COULDNTCREATE "Could Not Create PDF Document" Local lnHandle As Integer, lcFile As String With This If (nDeviceType == OutputNothing) Then If nPageNo == 1 Then * nDeviceType = OutputJPEG && Start JPEG Generation Process nDeviceType = OutputPNG && Start PNG Generation Process .StartPdfDocument() Else .AddBlankPage() * nDeviceType = OutputJPEG && Start JPEG Generation Process nDeviceType = OutputPNG && Start PNG Generation Process EndIf * lcFile=GetEnv("TEMP")+"\"+Sys(2015)+".Jpg" lcFile=GetEnv("TEMP")+"\"+Sys(2015)+".Png" .OutputPage(nPageNo, lcFile, nDeviceType) * lnHandle=LoadJpegImageFromFile(.pdfHandle, lcFile) lnHandle=HPDF_LoadPNGImageFromFile(.pdfHandle, lcFile) This._Stat = HPDF_Page_DrawImage(.oPage, lnHandle, 0, 0, (.GetPageWidth()/960)*72, (.GetPageHeight()/960)*72) .oImagesCollection.Add(lcFile) NoDefault EndIf EndWith ENDPROC PROCEDURE Destroy This.ClearDLLS() DODEFAULT() ENDPROC EHeight = 23 Width = 23 ListenerType = 2 FRXDataSession = -1 pdfhandle = 0 pageheight = 0 pagewidth = 0 encryptdocument = .F. oprogress = .F. oregistry = .F. mergedocument = .F. mergedocumentname = opage = .NULL. oimagescollection = .NULL. cpdfauthor = cuserpassword = lencryptdocument = .F. nencryptionlevel = 5 npageheight = 0 lcanedit = .F. lcancopy = .T. lcanaddnotes = .F. lcanprint = .T. lopenviewer = .F. cmasterpassword = ctargetfilename = cpdfcreator = cpdfkeywords = cpdfsubject = cpdftitle = waitfornextreport = .F. npgcounter = 0 npagemode = 0 lextended = .T. ldefaultmode = .F. npagewidth = 0 lobjtypemode = .F. _stat = 0 lshowerrors = .T. ncurrentpage = 0 _memberdata = 3133 Name = "pdfasimagelistener" pdfhandle Handle to the PDF file to create by the DLL nlastpageproccesed Number of the last page proccesed by the system ndivisionfactor Factor to be used for the conversion between unit of measures cpdfauthor Author of the Pdf File cpdftitle Title of the PDF Document cpdfsubject Subject of the PDF File cpdfkeywords Keywords of the PDF Document cpdfcreator Name of the Pdf Creator lcanprint Property to know if user can print or can't print the document lcancopy Property to know if user can copy the document contents lcanedit Property to know if user can Edit the contents of the document lcanaddnotes Property to know if the user can add or modify annotations lencryptdocument Property to know if the document should be Encripted cuserpassword User Password for the PDF document cmasterpassword Master Password for the PDF document nencriptionlevel A Value Between 5(40bit) and 16(128bit) can be specified for length of the key opage Current Page object returned by the library lstarted Property to know if the conversion procces has started ctargetfilename Name of the PDF File to create lopenviewer Flag to execute the default PDF reader of the pc ofonts Fonts Collection used in the library oregistry Property to store the Registry Object, this object will provide access to windows registry npageheight Height of the page, used to invert the coordinate system of the pdf library nspacesfortab Number of Spaces per TAB character lembedfont Property to Know if the font is Embedded into the document, if .T. file size will increase ccodepage Code Page to be used by the pdf listener when loading fonts lunderline Property to know if the text being draw should use underline style ctextstyle Internal to the Class odynamics Property to store the object used to store temporary values of the dynamics properties waitfornextreport Logical, keep the PDF handles opened, waiting for a new report to be joined. npgcounter nglobalpgcounter otempimagescollection Property to store the collection of temporary Images used in the PDF Generation opicturehandles Used to store the handle of pictures used in the PDF generation _lsetconsole _lsettalk npagemode How the document should be displayed - 0 = USE_NONE; 1 = USE_OUTLINE; 2 = USE_THUMBS; 3 = FULL_SCREEN lextended ldefaultmode npagewidth _cwinfolder _ctempfolder _stat lshowerrors csymbolfontslist cobjecttorender _stat2 ncurrentpage oactivelistener cdefaultfont lobjtypemode _lschinese lrighttoleft lreplacefonts Replaces some fonts using some generic fonts that are stored inside the DLL _ltchinese _lkorean _ljapanese nwmwidthratio nwmheightratio nwmwidth nwmheight cwmpicture hwmpdfhandle _cwmpicture _nwmy _nwmx _nwmw _nwmh lusingwatermark nsystemlangid lhasuserfld *declaredll Method to Declare all DLL required for the Job *writepdfinformation *searchfont *startpdfdocument *cleardlls Method to Clear from Memory all the DLL Calls *encryptpdf *addblankpage Method to add a Blank Page to the document *addpdfstandardfonts *findfontfilename Method to find the real filename of a True Type Font, it will look in the Registry for it *cropimage Method to Crop an Image, uses code from Cesar Chalom Samples *parseunderlinetext Method to prepare the text to be drawed as underline *processdynamics Method to process the dynamics properties of VFP9 SP2 *processfields *processshapes *processlabel *processpictures *processlines *getpicturehandle Used to get the picture handle when pictures are not in general fields ^aspawnobj[1,1] *ispixelalpha *outputfromdata *getparheight ^afontsreplaced[1,0] *stringtopic *processpictures2 ^afontssymbol[1,0] *_stat_assign *_errorinfo *_stat2_assign *getpicturefromlistener *getpageimg ^apagesimgs[1,0] *clearpdferrors *getimgtype *getdefaultfont *updateproperties *filesize Returns the file size *getfonthandle *getfontstylename *gettempfile *istempfile *getwatermarkobject *getwatermark *getlanguagefromsystem HPDF_New libhpdf.dll HPDF_Free libhpdf.dll HPDF_SaveToFile libhpdf.dll HPDF_GetError libhpdf.dll HPDF_ResetError libhpdf.dll HPDF_SetPageMode libhpdf.dll HPDF_GetCurrentPage libhpdf.dll HPDF_AddPage libhpdf.dll HPDF_Page_SetWidth libhpdf.dll HPDF_Page_SetHeight libhpdf.dll HPDF_GetFont libhpdf.dll HPDF_LoadTTFontFromFile libhpdf.dll HPDF_GetEncoder libhpdf.dll HPDF_GetCurrentEncoder libhpdf.dll HPDF_SetCurrentEncoder libhpdf.dll HPDF_Encoder_GetType libhpdf.dll HPDF_Encoder_GetByteType libhpdf.dll HPDF_Encoder_GetUnicode libhpdf.dll HPDF_Encoder_GetWritingMode libhpdf.dll HPDF_UseJPEncodings libhpdf.dll HPDF_UseKREncodings libhpdf.dll HPDF_UseCNSEncodings libhpdf.dll HPDF_UseCNTEncodings libhpdf.dll HPDF_UseJPFonts libhpdf.dll HPDF_UseKRFonts libhpdf.dll HPDF_UseCNSFonts libhpdf.dll HPDF_UseCNTFonts libhpdf.dll HPDF_LoadPngImageFromFile libhpdf.dll HPDF_LoadJpegImageFromFile libhpdf.dll HPDF_Image_GetWidth libhpdf.dll HPDF_Image_GetHeight libhpdf.dll HPDF_SetInfoAttr libhpdf.dll HPDF_SetPassword libhpdf.dll HPDF_SetPermission libhpdf.dll HPDF_SetEncryptionMode libhpdf.dll HPDF_SetCompressionMode libhpdf.dll HPDF_Font_MeasureText libhpdf.dll HPDF_Page_GetWidth libhpdf.dll HPDF_Page_GetHeight libhpdf.dll HPDF_Page_TextWidth libhpdf.dll HPDF_Page_GetCurrentFont libhpdf.dll HPDF_Page_MeasureText libhpdf.dll HPDF_Page_GetRGBFill libhpdf.dll HPDF_Page_GetCurrentFont libhpdf.dll HPDF_Page_GetCurrentFontSize libhpdf.dll HPDF_Page_SetLineWidth libhpdf.dll HPDF_Page_SetDash libhpdf.dll HPDF_Page_MoveTo libhpdf.dll HPDF_Page_LineTo libhpdf.dll HPDF_Page_ClosePath libhpdf.dll HPDF_Page_Rectangle libhpdf.dll HPDF_Page_Concat libhpdf.dll HPDF_Page_SetCharSpace libhpdf.dll HPDF_Page_SetWordSpace libhpdf.dll HPDF_Page_SetHorizontalScalling libhpdf.dll HPDF_Page_SetTextLeading libhpdf.dll HPDF_Page_SetTextRise libhpdf.dll HPDF_Page_Stroke libhpdf.dll HPDF_Page_ClosePathStroke libhpdf.dll HPDF_Page_Fill libhpdf.dll HPDF_Page_FillStroke libhpdf.dll HPDF_Page_EndPath libhpdf.dll HPDF_Page_BeginText libhpdf.dll HPDF_Page_EndText libhpdf.dll HPDF_Page_SetFontAndSize libhpdf.dll HPDF_Page_SetTextRenderingMode libhpdf.dll HPDF_Page_MoveTextPos libhpdf.dll HPDF_Page_MoveToNextLine libhpdf.dll HPDF_Page_SetRGBFill libhpdf.dll HPDF_Page_SetRGBStroke libhpdf.dll HPDF_Page_Ellipse libhpdf.dll HPDF_Page_DrawImage libhpdf.dll HPDF_Page_TextRect libhpdf.dll HPDF_Page_TextOut libhpdf.dll HPDF_Page_SetTextMatrix libhpdf.dll HPDF_Page_ShowText libhpdf.dll HPDF_Page_CurveTo libhpdf.dll GdipCloneBitmapAreaI GDIPLUS.DLLQ pdfxGdipCloneBitmapAreaI _strrev msvcrt20.dllQ xfcRevertString HPDF_NEW LIBHPDF HPDF_FREE HPDF_SAVETOFILE HPDF_GETERROR HPDF_RESETERROR HPDF_SETPAGEMODE HPDF_GETCURRENTPAGE HPDF_ADDPAGE HPDF_PAGE_SETWIDTH HPDF_PAGE_SETHEIGHT HPDF_GETFONT HPDF_LOADTTFONTFROMFILE HPDF_GETENCODER HPDF_GETCURRENTENCODER HPDF_SETCURRENTENCODER HPDF_ENCODER_GETTYPE HPDF_ENCODER_GETBYTETYPE HPDF_ENCODER_GETUNICODE HPDF_ENCODER_GETWRITINGMODE HPDF_USEJPENCODINGS HPDF_USEKRENCODINGS HPDF_USECNSENCODINGS HPDF_USECNTENCODINGS HPDF_USEJPFONTS HPDF_USEKRFONTS HPDF_USECNSFONTS HPDF_USECNTFONTS HPDF_LOADPNGIMAGEFROMFILE HPDF_LOADJPEGIMAGEFROMFILE HPDF_IMAGE_GETWIDTH HPDF_IMAGE_GETHEIGHT HPDF_SETINFOATTR HPDF_SETPASSWORD HPDF_SETPERMISSION HPDF_SETENCRYPTIONMODE HPDF_SETCOMPRESSIONMODE HPDF_FONT_MEASURETEXT HPDF_PAGE_GETWIDTH HPDF_PAGE_GETHEIGHT HPDF_PAGE_TEXTWIDTH HPDF_PAGE_GETCURRENTFONT HPDF_PAGE_MEASURETEXT HPDF_PAGE_GETRGBFILL HPDF_PAGE_GETCURRENTFONTSIZE HPDF_PAGE_SETLINEWIDTH HPDF_PAGE_SETDASH HPDF_PAGE_MOVETO HPDF_PAGE_LINETO HPDF_PAGE_CLOSEPATH HPDF_PAGE_RECTANGLE HPDF_PAGE_CONCAT HPDF_PAGE_SETCHARSPACE HPDF_PAGE_SETWORDSPACE HPDF_PAGE_SETHORIZONTALSCALLING HPDF_PAGE_SETTEXTLEADING HPDF_PAGE_SETTEXTRISE HPDF_PAGE_STROKE HPDF_PAGE_CLOSEPATHSTROKE HPDF_PAGE_FILL HPDF_PAGE_FILLSTROKE HPDF_PAGE_ENDPATH HPDF_PAGE_BEGINTEXT HPDF_PAGE_ENDTEXT HPDF_PAGE_SETFONTANDSIZE HPDF_PAGE_SETTEXTRENDERINGMODE HPDF_PAGE_MOVETEXTPOS HPDF_PAGE_MOVETONEXTLINE HPDF_PAGE_SETRGBFILL HPDF_PAGE_SETRGBSTROKE HPDF_PAGE_ELLIPSE HPDF_PAGE_DRAWIMAGE HPDF_PAGE_TEXTRECT HPDF_PAGE_TEXTOUT HPDF_PAGE_SETTEXTMATRIX HPDF_PAGE_SHOWTEXT HPDF_PAGE_CURVETO GDIPCLONEBITMAPAREAI GDIPLUS PDFXGDIPCLONEBITMAPAREAI _STRREV MSVCRT20 XFCREVERTSTRING CPDFAUTHOR _STAT HPDF_SETINFOATTR PDFHANDLE CPDFTITLE CPDFSUBJECT CPDFKEYWORDS CPDFCREATOR STRING INTEGER STRING STRING STRING Bold Italic BOOLEAN INTEGER STRING LCFONTNAME LNSTYLE LNPOS0 AFONTSSYMBOL LCRETORNO LCFONTREGULAR LCFONTSTYLE CTEXTSTYLE LBRESULT OFONTS COUNT GETKEY LNREPLCOUNT LNPOS AFONTSREPLACED LCKEY LCNEWFONT FINDFONTFILENAME GETDEFAULTFONT Could not load the library LIBHPDF.DLL .C The process can't continue. Make sure that you have the PDF library available, and that FoxyPreviewer is installed in a folder that has READ/WRITE access. Error GB-EUC-H GB-EUC-V GBK-EUC-H GBK-EUC-V CP936 EUC-CN SimSun GBK-EUC-H ETEN-B5-H ETEN-B5-V CP950 MingLiU ETen-B5-H 90MS-RKSJ-H 90MS-RKSJ-V 90MSP-RKSJ-H EUC-H EUC-V CP932 MS-Mincyo 90ms-RKSJ-H EUC-H EUC-V KSC-EUC-H KSC-EUC-V KSCMS-UHC-H KSCMS-UHC-HW-H KSCMS-UHC-HW-V CP949 DotumChe KSC-EUC-H CP1256 ISO8859-6 THIS PDFHANDLE LSTARTED LLERROR HPDF_NEW CANCELREPORT _STAT HPDF_SETCOMPRESSIONMODE HPDF_SETPAGEMODE NPAGEMODE WRITEPDFINFORMATION ENCRYPTPDF CLEARPDFERRORS ADDBLANKPAGE LCCODEPAGE CCODEPAGE _LSCHINESE CDEFAULTFONT HPDF_USECNSFONTS HPDF_USECNSENCODINGS _LTCHINESE HPDF_USECNTFONTS HPDF_USECNTENCODINGS _LJAPANESE HPDF_USEJPFONTS HPDF_USEJPENCODINGS _LKOREAN HPDF_USEKRFONTS HPDF_USEKRENCODINGS LRIGHTTOLEFT HPDF_New HPDF_Free HPDF_SaveToFile HPDF_GetError HPDF_ResetError HPDF_SetPageMode HPDF_GetCurrentPage HPDF_AddPage HPDF_Page_SetWidth HPDF_Page_SetHeight HPDF_GetFont HPDF_LoadTTFontFromFile HPDF_GetEncoder HPDF_GetCurrentEncoder HPDF_SetCurrentEncoder HPDF_Encoder_GetType HPDF_Encoder_GetByteType HPDF_Encoder_GetUnicode HPDF_Encoder_GetWritingMode HPDF_UseJPEncodings HPDF_UseKREncodings HPDF_UseCNSEncodings HPDF_UseCNTEncodings HPDF_LoadPngImageFromFile HPDF_LoadJpegImageFromFile HPDF_Image_GetWidth HPDF_Image_GetHeight HPDF_SetInfoAttr HPDF_SetPassword HPDF_SetPermission HPDF_SetEncryptionMode HPDF_SetCompressionMode HPDF_Font_MeasureText HPDF_Page_GetWidth HPDF_Page_GetHeight HPDF_Page_TextWidth HPDF_Page_GetCurrentFont HPDF_Page_MeasureText HPDF_Page_GetRGBFill HPDF_Page_GetCurrentFont HPDF_Page_GetCurrentFontSize HPDF_Page_SetLineWidth HPDF_Page_SetDash HPDF_Page_MoveTo HPDF_Page_LineTo HPDF_Page_ClosePath HPDF_Page_Rectangle HPDF_Page_Concat HPDF_Page_SetCharSpace HPDF_Page_SetWordSpace HPDF_Page_SetHorizontalScalling HPDF_Page_SetTextLeading HPDF_Page_SetTextRise HPDF_Page_Stroke HPDF_Page_ClosePathStroke HPDF_Page_Fill HPDF_Page_FillStroke HPDF_Page_EndPath HPDF_Page_BeginText HPDF_Page_EndText HPDF_Page_SetFontAndSize HPDF_Page_SetTextRenderingMode HPDF_Page_MoveTextPos HPDF_Page_MoveToNextLine HPDF_Page_SetRGBFill HPDF_Page_SetRGBStroke HPDF_Page_Ellipse HPDF_Page_DrawImage HPDF_Page_TextRect HPDF_Page_TextOut HPDF_Page_SetTextMatrix HPDF_Page_ShowText HPDF_Page_CurveTo INTEGER LENCRYPTDOCUMENT CMASTERPASSWORD CUSERPASSWORD HPDF_SETPASSWORD PDFHANDLE LNPERMIT LCANPRINT LCANEDIT LCANCOPY LCANADDNOTES _STAT HPDF_SETPERMISSION NENCRIPTIONLEVEL HPDF_SETENCRYPTIONMODE0 LDEFAULTMODE LNWIDTH LNHEIGHT GETPAGEWIDTH GETPAGEHEIGHT NPAGEHEIGHT NPAGEWIDTH OPAGE HPDF_ADDPAGE PDFHANDLE _STAT HPDF_PAGE_SETWIDTH HPDF_PAGE_SETHEIGHT _CWMPICTURE _NWMW _NWMH PROCESSPICTURES _NWMY _NWMXo Courier Courier Courier-Bold Courier-Bold Courier-Oblique Courier-Oblique Courier-BoldOblique Courier-BoldOblique Helvetica Helvetica Helvetica-Bold Helvetica-Bold Helvetica-Oblique Helvetica-Oblique Helvetica-BoldOblique Helvetica-BoldOblique Times-Roman Times-Roman Times-Bold Times-Bold Times-Italic Times-Italic Times-BoldItalic Times-BoldItalic Symbol Symbol ZapfDingbats ZapfDingbats OFONTS STRING STRING STRING SOFTWARE\Microsoft\Windows\CurrentVersion\Fonts Software\Microsoft\Windows NT\CurrentVersion\Fonts6 Registry Fonts\ (TrueType) Fonts\ Negrito Italic negrita Italic cursiva Italic Italique Fonts\ (TrueType) LCFONTNAME LCFILENAME LCFOLDER THIS OREGISTRY CLASSLIBRARY _CWINFOLDER READREGISTRYSTRING LNLANGID NSYSTEMLANGID LURETURN HPDF_LOADTTFONTFROMFILE PDFHANDLE LEMBEDFONT LOEXC CLEARPDFERRORSw STRING INTEGER INTEGER GPBITMAP ffc\_gdiplus.vcx GpBitmap _GdiPlus.vcx GPBITMAP ffc\_gdiplus.vcx GpBitmap _GdiPlus.vcx image/png image/jpeg6 LCFILE TNWIDTH TNHEIGHT TLFILE LOBMP CREATEFROMFILE IMAGEHEIGHT IMAGEWIDTH LHBITMAP LNSTATUS PDFXGDIPCLONEBITMAPAREAI PIXELFORMAT GETHANDLE LNHANDLE LOCROPPED SETHANDLE SETRESOLUTION HORIZONTALRESOLUTION VERTICALRESOLUTION LCEXT LCENCODER LCCROPPEDFILE GETTEMPFILE SAVETOFILE HPDF_LOADPNGIMAGEFROMFILE PDFHANDLE HPDF_LOADJPEGIMAGEFROMFILE ISTEMPFILE LOEXC- STRING NUMBER NUMBER INTEGER STRING INTEGER STRING LCTEXT NWIDTH LNANCHO LCTEMP LNLEN LCRETORNO HPDF_PAGE_TEXTWIDTH OPAGE STRING STRING BOOLEAN STRING _TempDynamics _TempDynamics _TempDynamicsN Empty FIELD SHAPE PICTURE FIELD cValue cExecWhen cFontName nFontSizeCC nFontStyleCC nPenRedCCCC nPenGreenCCCC nPenBlueCCCC nPenRed nPenGreen nPenBlue nFillRedCCCC nFillGreenCCCC nFillBlueCCCC nFillRed nFillGreen nFillBlue SHAPE IMAGE cExecWhen nWidthCC nHeightCC Microsoft.VFP.Reporting.Builder.Rotate nRotationDegreeCC LCSTYLE LCTYPE LBRETURN LCCURSOR THIS ODYNAMICS _TEMPDYNAMICS EXECWHEN SCRIPT FNAME FSIZE FSTYLE PENRGB FILLRGB WIDTH HEIGHT EXECUTE STRING INTEGER NUMBER NUMBER NUMBER NUMBER NUMBER NUMBER NUMBER NUMBER NUMBER STRING STRING INTEGER BOOLEAN INTEGER NUMBER INTEGER STRING INTEGER STRING INTEGER INTEGER INTEGER INTEGER STRING INTEGER INTEGER FIELD cFontName nFontSize nFontStyle cValue nPenRed nPenBlue nPenGreen nFillRed nFillBlue nFillGreen nRotationDegree NUMBER LCFONTFACE LIFONTSTYLE LNFONTSIZE LNPENRED LNPENGREEN LNPENBLUE LNFILLRED LNFILLGREEN LNFILLBLUE NLEFT LCCONTENTS LCFILLCHAR LNOFFSET LBSTRETCH LNCODEPAGE NHEIGHT NWIDTH LCSTYLE LNMODE LCUSER LCORIGCONTENTS LNTIMES LCTABREPL LRIGHTTOLEFT XFCREVERTSTRING LNOCURRENCES LNANCHO LNFONTHANDLE LNALTO LCUNDERLINETEXT LNROTATE LNCHARWIDTH LDEFAULTMODE _GOHELPER OLISTENER CMAINALIAS LCALIAS LCMAINALIAS LNREC DBFRECNO PROCESSDYNAMICS ODYNAMICS CFONTNAME NFONTSIZE NFONTSTYLE CVALUE NPENRED NPENBLUE NPENGREEN NFILLRED NFILLBLUE NFILLGREEN NROTATIONDEGREE LOEXC LNPENSIZE LNPENPAT LNFILLPAT LNOBJCONTTYPE PROCESSSHAPES NPAGEHEIGHT GETFONTHANDLE LCIMAGE LNTXTW LNTXTH STRINGTOPIC PROCESSPICTURES2 _STAT HPDF_PAGE_BEGINTEXT OPAGE HPDF_PAGE_SETFONTANDSIZE CTEXTSTYLE HPDF_PAGE_TEXTWIDTH HPDF_PAGE_GETCURRENTFONTSIZE LNFONTHEIGHT2 PARSEUNDERLINETEXT LUNDERLINE HPDF_PAGE_SETRGBFILL HPDF_PAGE_SETTEXTLEADING LNLEN LNCHARS LNREALWIDTH LCCURRTEXT LCREMAININGTEXT LNLINEHEIGHT LNLINESAVAIL LNCURRLINE GETPARHEIGHT HPDF_FONT_MEASURETEXT _STAT2 HPDF_PAGE_TEXTRECT LNRAD HPDF_PAGE_SETTEXTMATRIX HPDF_PAGE_SHOWTEXT HPDF_PAGE_ENDTEXT LLSUCCESS INTEGER INTEGER INTEGER INTEGER INTEGER INTEGER NUMBER NUMBER NUMBER NUMBER INTEGER INTEGER INTEGER INTEGER STRING INTEGER INTEGER lnObjectContinuationTypeb STRING INTEGER BOOLEAN BOOLEAN BOOLEAN BOOLEAN BOOLEAN INTEGER INTEGER INTEGER SHAPE nHeight nWidth NUMBER NUMBER NUMBER NUMBER NUMBER NUMBER LNFILLRED LNFILLGREEN LNFILLBLUE LNPENRED LNPENGREEN LNPENBLUE NLEFT NWIDTH NHEIGHT LNOFFSET LNPENSIZE LNPENPAT LNFILLPAT LCSTYLE LNMODE LNOBJECTCONTINUATIONTYPE TLSKIPBORDER LCDASH NTOP2 LDECOMPOSERECT LDOTOPLINE LDOLEFTLINE LDORIGHTLINE LDOBOTTOMLINE LINE_LNPENRED LINE_LNPENGREEN LINE_LNPENBLUE PROCESSDYNAMICS ODYNAMICS NPAGEHEIGHT _STAT HPDF_PAGE_SETRGBFILL OPAGE HPDF_PAGE_SETRGBSTROKE HPDF_PAGE_SETLINEWIDTH HPDF_PAGE_SETDASH HPDF_PAGE_RECTANGLE HPDF_PAGE_MOVETO HPDF_PAGE_LINETO HPDF_PAGE_CURVETO HPDF_PAGE_ELLIPSE HPDF_PAGE_STROKE HPDF_PAGE_FILLSTROKE PROCESSLINES STRING INTEGER NUMBER NUMBER NUMBER NUMBER NUMBER NUMBER NUMBER NUMBER NUMBER STRING STRING INTEGER INTEGER INTEGER NUMBER STRING STRING INTEGER NUMBER STRING INTEGER STRING INTEGER INTEGER LABEL nRotationDegree 333333 NUMBER LCFONTFACE LIFONTSTYLE LNFONTSIZE LNPENRED LNPENGREEN LNPENBLUE LNFILLRED LNFILLGREEN LNFILLBLUE NLEFT LCCONTENTS LCFILLCHAR LNOFFSET NWIDTH LNCODEPAGE NHEIGHT LCPICTURE LCSTYLE LNMODE LNALTO LNTXTWIDTH LNFONTHANDLE LCUNDERLINETEXT LNROTATE LNCHARWIDTH PROCESSDYNAMICS ODYNAMICS NROTATIONDEGREE LNPENSIZE LNPENPAT LNFILLPAT PROCESSSHAPES NPAGEHEIGHT GETFONTHANDLE LCIMAGE LNTXTW LNTXTH STRINGTOPIC PROCESSPICTURES2 CTEXTSTYLE _STAT HPDF_PAGE_BEGINTEXT OPAGE HPDF_PAGE_SETFONTANDSIZE HPDF_PAGE_TEXTWIDTH HPDF_PAGE_SETRGBSTROKE HPDF_PAGE_SETRGBFILL LUNDERLINE LCORIGCONTENTS LNPARAG LNPARHEIGHT LCPAR LNPARTOP LNALIGNMODE LNPARWIDTH GETPARHEIGHT HPDF_PAGE_TEXTRECT LNRAD HPDF_PAGE_SETTEXTMATRIX HPDF_PAGE_SHOWTEXT HPDF_PAGE_ENDTEXT{ NUMBER NUMBER NUMBER NUMBER STRING NUMBER INTEGER INTEGER STRING STRING STRING INTEGER GPIMAGE FFC\_GdiPlus.vcx GpImage _GdiPlus.vcx image/png IMAGE Image Collection NLEFT NWIDTH NHEIGHT LCCONTENTS GDIPLUSIMAGE LNOFFSET LIPICTUREMODE LCSTYLE LCFILE LCFILE2 LNHANDLE NPAGEHEIGHT LNPICWIDTH LNPICHEIGHT GETTEMPFILE LOIMAGE SETHANDLE IMAGEWIDTH IMAGEHEIGHT SAVETOFILE HPDF_LOADPNGIMAGEFROMFILE PDFHANDLE GETPICTUREHANDLE CROPIMAGE _STAT HPDF_PAGE_DRAWIMAGE OPAGE LOVFPIMG PICTURE WIDTH HEIGHT LNHORFACTOR LNVERTFACTOR LNRESIZEFACTOR LNISOWIDTH LNISOHEIGHT OTEMPIMAGESCOLLECTION INTEGER INTEGER INTEGER NUMBER NUMBER NUMBER NUMBER INTEGER NUMBER INTEGER STRING STRING LNPENRED LNPENGREEN LNPENBLUE NLEFT NWIDTH NHEIGHT LNPENSIZE LNOFFSET LNPENPAT LCSTYLE LCDASH _STAT HPDF_PAGE_SETRGBSTROKE OPAGE NPAGEHEIGHT HPDF_PAGE_SETDASH HPDF_PAGE_SETLINEWIDTH HPDF_PAGE_MOVETO HPDF_PAGE_LINETO HPDF_PAGE_STROKE STRING STRING INTEGER INTEGER STRING INTEGER STRING Collection Image GpBitmap _GdiPlus.vcx image/jpeg GPBITMAP GpBitmap _GdiPlus.vcx GPBITMAP STRING STRING GpBitmap _GdiPlus.vcx GPBITMAP \ffc\_Gdiplus.vcx GpBitmap _GdiPlus.vcx GPGRAPHICS \ffc\_Gdiplus.vcx GpGraphics _GdiPlus.vcx image/png LCINTERNALNAME LCEXTERNALNAME LNPICWIDTH LNPICHEIGHT LCFILESTREAM LNHANDLE LCEXTENSION OPICTUREHANDLES GETKEY LOEXC LOVFPIMG LCFILE PICTURE GETTEMPFILE LOIMAGE CREATEFROMFILE SETRESOLUTION WIDTH HEIGHT SAVETOFILE FILESIZE ISTEMPFILE HPDF_LOADJPEGIMAGEFROMFILE PDFHANDLE LOBMPTMP IMAGEWIDTH IMAGEHEIGHT ISPIXELALPHA GETPIXEL HPDF_LOADPNGIMAGEFROMFILE CLEARPDFERRORS LOBMP2 LCFILE2 LOBMP3 CREATE HORIZONTALRESOLUTION VERTICALRESOLUTION LOGFX CREATEFROMIMAGE CLEAR DRAWIMAGEAT ITEMj TNARGB TLALPHAISUSEDg REPORTLISTENER Invalid parameter. Report listener not available Error GPIMAGE \FFC\_Gdiplus.vcx TEMP5 Temp_WM_ image/ % - 100% - CCC TOLISTENER TCOUTPUTDBF TNWIDTH TNHEIGHT OACTIVELISTENER QUIETMODE LNSECS DOFOXYTHERM _GOHELPER _INITSTATUSTEXT LISTENERDATASESSION LNSELECT LLEXIT LDEFAULTMODE NPAGEWIDTH NPAGEHEIGHT LNPGFROM LNPGTO _CLAUSENRANGEFROM _CLAUSENRANGETO LUSINGWATERMARK LCTEMPFILE LCTYPE LOBMP CWATERMARKIMAGE OWATERMARKBMP SAVETOFILE _CWMPICTURE LNWIDTH LNHEIGHT NWATERMARKWIDTHRATIO NWATERMARKHEIGHTRATIO _NWMX _NWMY _NWMW _NWMH BEFOREREPORT RENDER FRXRECNO WIDTH HEIGHT CONTTYPE UNCONTENTS LNPERCENT LNLASTPERCENT LNDELAY LNTOTRECS LNREC _SECONDSTEXT _RUNSTATUSTEXT AFTERREPORT UNLOADREPORT GPRECTANGLE \ffc\_Gdiplus.vcx GPRectangle _Gdiplus.vcx GPFont _Gdiplus.vcx GPGRAPHICS \ffc\_Gdiplus.vcx GpGraphics _Gdiplus.vcx 333333 GPSIZE \ffc\_Gdiplus.vcx TCTEXT TCFONTNAME TNSIZE TCSTYLE TNLEFT TNTOP TNWIDTH TNHEIGHT LNFACTOR LOFONT LNCHARS LNLINES LNHEIGHT LNWIDTH LORECT CREATE LOGFX LDEFAULTMODE SETHANDLE ISSUCCESSOR SHAREDGDIPLUSGRAPHICS GDIPLUSGRAPHICS CREATEFROMHWND PAGEUNIT PAGESCALE LOSIZE MEASURESTRINGA GDIPRECTF> GPRECTANGLE \ffc\_Gdiplus.vcx GPRectangle GPGRAPHICS ffc\_gdiplus.vcx gpGraphics _gdiplus.vcx 333333 GPFONT ffc\_gdiplus.vcx gpFont _gdiplus.vcx GPSTRINGFORMAT ffc\_gdiplus.vcx gpStringFormat _gdiplus.vcx GPCOLOR ffc\_gdiplus.vcx gpColor _gdiplus.vcx GPSOLIDBRUSH ffc\_gdiplus.vcx gpSolidBrush _gdiplus.vcx GPSIZE ffc\_gdiplus.vcx GPBITMAP ffc\_gdiplus.vcx gpBitmap _gdiplus.vcx GPGRAPHICS ffc\_gdiplus.vcx gpGraphics _gdiplus.vcx 333333 image/png TCSTRING TCFONT TNSIZE TNALIGN LNFACTOR LORECT LOGFX0 CREATEFROMHWND PAGEUNIT PAGESCALE LOFONT CREATE LOSTRFMT LOCOLOR LOBRUSH LOSIZE MEASURESTRINGA GDIPRECTF LOBMP LOGFX CREATEFROMIMAGE CLEAR DRAWSTRINGA LCTEMPFILE GETTEMPFILE SAVETOFILE TCFILE TNLEFT TNTOP TNWIDTH TNHEIGHT LNHANDLE HPDF_LOADPNGIMAGEFROMFILE THIS PDFHANDLE _STAT HPDF_PAGE_DRAWIMAGE OPAGE ISTEMPFILE LCFILEa PDFx error in CC Error code : Description: Page: Object: Press 'Retry' to debug the application. Error PDFx error in CC Error code : Description : Object: Error TNSTATUS _STAT LNHPDF_ERR LCHEX HPDF_GETERROR PDFHANDLE HPDF_RESETERROR LSHOWERRORS STARTMODE LNOPTION _ERRORINFO NCURRENTPAGE COBJECTTORENDERC HPDF_ARRAY_COUNT_ERR HPDF_ARRAY_ITEM_NOT_FOUND HPDF_ARRAY_ITEM_UNEXPECTED_TYPE HPDF_BINARY_LENGTH_ERR HPDF_CANNOT_GET_PALLET HPDF_DICT_COUNT_ERR HPDF_DICT_ITEM_NOT_FOUND HPDF_DICT_ITEM_UNEXPECTED_TYPE HPDF_DICT_STREAM_LENGTH_NOT_FOUND HPDF_DOC_ENCRYPTDICT_NOT_FOUND HPDF_DOC_INVALID_OBJECT HPDF_DUPLICATE_REGISTRATION HPDF_EXCEED_JWW_CODE_NUM_LIMIT HPDF_ENCRYPT_INVALID_PASSWORD HPDF_ERR_UNKNOWN_CLASS HPDF_EXCEED_GSTATE_LIMIT HPDF_FAILD_TO_ALLOC_MEM HPDF_FILE_IO_ERROR HPDF_FILE_OPEN_ERROR HPDF_FONT_EXISTS HPDF_FONT_INVALID_WIDTHS_TABLE HPDF_INVALID_AFM_HEADER HPDF_INVALID_ANNOTATION HPDF_INVALID_BIT_PER_COMPONENT HPDF_INVALID_CHAR_MATRICS_DATA HPDF_INVALID_COLOR_SPACE HPDF_INVALID_COMPRESSION_MODE HPDF_INVALID_DATE_TIME HPDF_INVALID_DESTINATION HPDF_INVALID_DOCUMENT HPDF_INVALID_DOCUMENT_STATE HPDF_INVALID_ENCODER HPDF_INVALID_ENCODER_TYPE HPDF_INVALID_ENCODING_NAME HPDF_INVALID_ENCRYPT_KEY_LEN HPDF_INVALID_FONTDEF_DATA HPDF_INVALID_FONTDEF_TYPE HPDF_INVALID_FONT_NAME HPDF_INVALID_IMAGE HPDF_INVALID_JPEG_DATA HPDF_INVALID_N_DATA HPDF_INVALID_OBJECT HPDF_INVALID_OBJ_ID HPDF_INVALID_OPERATION HPDF_INVALID_OUTLINE HPDF_INVALID_PAGE HPDF_INVALID_PAGES HPDF_INVALID_PARAMETER HPDF_INVALID_PNG_IMAGE HPDF_INVALID_STREAM HPDF_MISSING_FILE_NAME_ENTRY HPDF_INVALID_TTC_FILE HPDF_INVALID_TTC_INDEX HPDF_INVALID_WX_DATA HPDF_ITEM_NOT_FOUND HPDF_LIBPNG_ERROR HPDF_NAME_INVALID_VALUE HPDF_NAME_OUT_OF_RANGE HPDF_PAGE_INVALID_PARAM_COUNT HPDF_PAGES_MISSING_KIDS_ENTRY HPDF_PAGE_CANNOT_FIND_OBJECT HPDF_PAGE_CANNOT_GET_ROOT_PAGES HPDF_PAGE_CANNOT_RESTORE_GSTATE HPDF_PAGE_CANNOT_SET_PARENT HPDF_PAGE_FONT_NOT_FOUND HPDF_PAGE_INVALID_FONT HPDF_PAGE_INVALID_FONT_SIZE HPDF_PAGE_INVALID_GMODE HPDF_PAGE_INVALID_INDEX HPDF_PAGE_INVALID_ROTATE_VALUE HPDF_PAGE_INVALID_SIZE HPDF_PAGE_INVALID_XOBJECT HPDF_PAGE_OUT_OF_RANGE HPDF_REAL_OUT_OF_RANGE HPDF_STREAM_EOF HPDF_STREAM_READLN_CONTINUE HPDF_STRING_OUT_OF_RANGE HPDF_THIS_FUNC_WAS_SKIPPED HPDF_TTF_CANNOT_EMBEDDING_FONT HPDF_TTF_INVALID_CMAP HPDF_TTF_INVALID_FOMAT HPDF_TTF_MISSING_TABLE HPDF_UNSUPPORTED_FONT_TYPE HPDF_UNSUPPORTED_FUNC HPDF_UNSUPPORTED_JPEG_FORMAT HPDF_UNSUPPORTED_TYPE1_FONT HPDF_XREF_COUNT_ERR HPDF_ZLIB_ERROR HPDF_INVALID_PAGE_INDEX HPDF_INVALID_URI HPDF_PAGE_LAYOUT_OUT_OF_RANGE HPDF_PAGE_MODE_OUT_OF_RANGE HPDF_PAGE_NUM_STYLE_OUT_OF_RANGE HPDF_ANNOT_INVALID_ICON HPDF_ANNOT_INVALID_BORDER_STYLE HPDF_PAGE_INVALID_DIRECTION HPDF_INVALID_FONT HPDF_PAGE_INSUFFICIENT_SPACE HPDF_PAGE_INVALID_DISPLAY_TIME HPDF_PAGE_INVALID_TRANSITION_TIME HPDF_INVALID_PAGE_SLIDESHOW_TYPE HPDF_EXT_GSTATE_OUT_OF_RANGE HPDF_INVALID_EXT_GSTATE HPDF_EXT_GSTATE_READ_ONLY Unknown Error TNSTATUS* TNSTATUS _STAT2 _STAT fffff fffff Collection TNWIDTH TNHEIGHT CLEARPDFERRORS LCFILE GETPAGEIMG LNHOR LNVERT LCNEWFILE CROPIMAGE PROCESSPICTURES OTEMPIMAGESCOLLECTION REPORTLISTENER LOLISTENER OACTIVELISTENER LNPAGE NCURRENTPAGE COMMANDCLAUSES RANGEFROM APAGESIMGS LNDEVICETYPE LCFILE LNHANDLE GETTEMPFILE OUTPUTPAGE[ LNHPDF_ERR LCHEX HPDF_GETERROR THIS PDFHANDLE HPDF_RESETERROR LCDATA LCRETURN LCCONTENTS LADUMMY TCFONTSTYLE LCNEWFONT LNPOS AFONTSREPLACED CDEFAULTFONTm LOBJTYPEMODE OFOXYPREVIEWER COMMANDCLAUSES LOPENVIEWER PREVIEW TOFILE CTARGETFILENAME CDESTFILE LCDESTFILE COUTPUTPATH LCFILE _REPORTLISTENER CANCELREPORT QUIETMODE LQUIETMODE LEMBEDFONT LPDFEMBEDFONTS LCANPRINT LPDFCANPRINT LCANEDIT LPDFCANEDIT LCANCOPY LPDFCANCOPY LCANADDNOTES LPDFCANADDNOTES LENCRYPTDOCUMENT LPDFENCRYPTDOCUMENT CMASTERPASSWORD CPDFMASTERPASSWORD CUSERPASSWORD CPDFUSERPASSWORD LSHOWERRORS LPDFSHOWERRORS CSYMBOLFONTSLIST CPDFSYMBOLFONTSLIST CPDFAUTHOR CPDFTITLE CPDFSUBJECT CPDFKEYWORDS CPDFCREATOR CDEFAULTFONT CPDFDEFAULTFONT CCODEPAGE LNPGMODE NPDFPAGEMODE NPAGEMODE GETWATERMARK0 LCFILE LASIZEARRAY LCFONTFACE LIFONTSTYLE _LSCHINESE _LTCHINESE _LJAPANESE _LKOREAN LNFONTHANDLE HPDF_GETFONT PDFHANDLE CDEFAULTFONT GETFONTSTYLENAME CCODEPAGE LCPDFFONT SEARCHFONT CLEARPDFERRORS STRING Italic TISTYLE LCFONTSTYLEW FP_TMP_ TCTYPE _CTEMPFOLDERF FP_TMP_ TCFILE _CTEMPFOLDER GPBITMAP \ffc\_gdiplus.vcx GpBitmap COLORMATRIX PR_GdiplusHelper.Prg GpAttrib PR_GdiplusHelper.Prg 333333 333333 333333 TEMP5 Temp_WM_ image/ OFOXYPREVIEWER LCWATERMARKIMAGE LNWATERMARKTYPE LNWATERMARKTRANSPARENCY LNWATERMARKWIDTHRATIO LNWATERMARKHEIGHTRATIO CWATERMARKIMAGE NWATERMARKTYPE NWATERMARKTRANSPARENCY NWATERMARKWIDTHRATIO NWATERMARKHEIGHTRATIO LUSINGWATERMARK LOBMP CREATEFROMFILE LOATT LCMATRIX COLORMATRIX APPLYCOLORMATRIX LCTEMPFILE LCTYPE SAVETOFILE _CWMPICTURE LNWIDTH LNHEIGHT LNPGWIDTH LNPGHEIGHT GETPAGEWIDTH GETPAGEHEIGHT NPAGEHEIGHT NPAGEWIDTH _NWMX _NWMY _NWMW _NWMH2 GetSystemDefaultLangID kernel32 GETSYSTEMDEFAULTLANGID KERNEL32 LNLANGID NSYSTEMLANGID GETLANGUAGEFROMSYSTEM THIS CLEARDLLS UPDATEPROPERTIES3 STRING EXCEPTION _TempDynamics _TempDynamics SET CONSOLE &llConsole. SET TALK &llTalk. LDEFAULTMODE WAITFORNEXTREPORT OTEMPIMAGESCOLLECTION LCITEM LOEXC ISTEMPFILE ODYNAMICS LLCONSOLE LLTALK _LSETCONSOLE _LSETTALK LCFILE APAGESIMGS Collection Courier New Courier Courier New Bold Courier-Bold Courier New Italic Courier-Oblique Courier New Bold Italic Courier-BoldOblique Monotype Sorts ZapfDingbats Wingdings ZapfDingbats Arial Helvetica Arial Bold Helvetica-Bold Arial Italic Helvetica-Oblique Arial Bold Italic Helvetica-BoldOblique Times New Roman Times-Roman Times New Roman Bold Times-Bold Times New Roman Italic Times-Italic Times New Roman Bold Italic Times-BoldItalic Courier Courier Courier Bold Courier-Bold Courier Italic Courier-Oblique Courier Bold Italic Courier-BoldOblique Helvetica Helvetica Helvetica Bold Helvetica-Bold Helvetica Italic Helvetica-Oblique Helvetica Bold Italic Helvetica-BoldOblique Times-Roman Times-Roman Times-Roman Bold Times-Bold Times-Roman Italic Times-Italic Times-Roman Bold Italic Times-BoldItalic Consolev Talkv WING-DINGS WEBDINGS BARRAS BIRO PF BARCODE 128 BARRA25 BARRA25I BARRA39 BARRAEAN8 BARRAEAN13 BARRA128B IDAUTOMATIONHC39M PF BARCODE 39 PF EAN P36 PF EAN P72 PF INTERLEAVED 2 of 5 PF INTERLEAVED 2 OF 5 WIDE PF INTERLEAVED 2 OF 5 TEXT CODE 128AB CODE 128AB SHORT CODE 128AB TALL CODE 128AB HR CODE 128AB SHORT CODE 128AB TALL HR CODE 128C CODE 128C SHORT CODE 128C TALL CODE 128C HR CODE 128C HR SHORT CODE 128C HR TALL CODIGO DE BARRAS CYT C39HRP24DHTT C39HRP48DHTT INTERLEAVED 2OF5 NT 3 of 9 Barcode windir5 Courier Helvetica Times-Roman Helvetica LDEFAULTMODE OACTIVELISTENER OFONTS AFONTSSYMBOL ADDPDFSTANDARDFONTS DECLAREDLL CCODEPAGE LREPLACEFONTS AFONTSREPLACED _LSETCONSOLE _LSETTALK LNFONTS LNFONTSTOADD CSYMBOLFONTSLIST _CTEMPFOLDER _CWINFOLDER LCDEFAULTFONT CDEFAULTFONT STRING EXCEPTION LABEL: FIELD: PICTURE: RECTANGLE NFRXRECNO NLEFT NWIDTH NHEIGHT NOBJECTCONTINUATIONTYPE CCONTENTSTOBERENDERED GDIPLUSIMAGE TWOPASSPROCESS CURRENTPASS LDEFAULTMODE PAGENO NGLOBALPGCOUNTER NPGCOUNTER LNRANGETO COMMANDCLAUSES RANGETO RANGEFROM NLEFT0 NTOP0 NWIDTH0 NHEIGHT0 LCCONTENTS LOERROR NPDFLEFT NPDFTOP NPDFWIDTH NPDFHEIGHT LNPAGENO SETFRXDATASESSION NCURRENTPAGE LSTARTED STARTPDFDOCUMENT NLASTPAGEPROCCESED ADDBLANKPAGE NPAGEWIDTH NPAGEHEIGHT OFRX LLSUCCESS RESETDATASESSION OBJTYPE RESOID COBJECTTORENDER PROCESSLABEL FONTFACE FONTSTYLE FONTSIZE PENRED PENGREEN PENBLUE FILLRED FILLGREEN FILLBLUE FILLCHAR OFFSET PICTURE STYLE GETPICTUREFROMLISTENER PROCESSFIELDS STRETCH _STAT2 LNWORDS LNCHARWIDTH LNLEN LNCHARSALLOWED LNCHARSTOINSERT LCTEXT CTEXTSTYLE LNTXTWIDTH PROCESSLINES PENSIZE PENPAT PROCESSPICTURES GENERAL LCPICVAL LCTMPIMG FOXYGETIMAGE _CTEMPFOLDER LOEXC CLEARPDFERRORS PROCESSSHAPES FILLPAT LDEFAULTMODE _CWMPICTURE LOBJTYPEMODE WAITFORNEXTREPORT COMMANDCLAUSES NOPAGEEJECT LCFILE CTARGETFILENAME HPDF_FREE PDFHANDLE LSTARTED _STAT HPDF_SAVETOFILE NPGCOUNTER APAGESIMGS CTEXTSTYLE NCURRENTPAGE NDIVISIONFACTOR NGLOBALPGCOUNTER NLASTPAGEPROCCESED OPICTUREHANDLES ODYNAMICS OTEMPIMAGESCOLLECTION LLSAVED OFOXYPREVIEWER LSAVED LOPENVIEWER SHELLEXEC OACTIVELISTENER* CURRENTDATASESSION DATASESSIONv FRXDataSession FRXDATASESSION RESETTODEFAULT RESETDATASESSION declaredll, writepdfinformation[ searchfont startpdfdocumentM cleardlls encryptpdf addblankpage7, addpdfstandardfontsR. findfontfilename cropimageD5 parseunderlinetextP: processdynamics processfieldsmC processshapes!W processlabel processpicturesmw processlines getpicturehandle= ispixelalpha outputfromdata getparheight stringtopic processpictures2t _stat_assign _errorinfo _stat2_assign, getpicturefromlistenery getpageimg clearpdferrors` getimgtype getdefaultfont updateproperties filesize getfonthandle getfontstylename gettempfile istempfile getwatermarkx getlanguagefromsystem Destroy@ LoadReportn UnloadReport BeforeReport Render AfterReport resetdatasession setfrxdatasession @PROCEDURE declaredll *!* * Check if the library HPDF.DLL is in the disk *!* LOCAL lcPDFFile *!* lcPDFFile = "libhpdf.dll" *!* IF EMPTY(SYS(2000,lcPDFFile)) *!* MESSAGEBOX("Could not locate the library LIBHPDF.DLL ." + CHR(13) + ; *!* "The process can't continue. Make sure that you have the PDF library available, and that FoxyPreviewer is installed in a folder that has READ/WRITE access.", 16, "Error") *!* RETURN .F. *!* ENDIF Declare Integer HPDF_New In libhpdf.dll Integer, Integer Declare Integer HPDF_Free In libhpdf.dll Integer Declare Integer HPDF_SaveToFile In libhpdf.dll Integer, String Declare Integer HPDF_GetError In libhpdf.dll Integer Declare Integer HPDF_ResetError In libhpdf.dll Integer Declare Integer HPDF_SetPageMode In libhpdf.dll Integer, Integer Declare Integer HPDF_GetCurrentPage In libhpdf.dll Integer Declare Integer HPDF_AddPage In libhpdf.dll Integer Declare Integer HPDF_Page_SetWidth In libhpdf.dll Integer, Single Declare Integer HPDF_Page_SetHeight In libhpdf.dll Integer, Single Declare Integer HPDF_GetFont In libhpdf.dll Integer, String, String Declare String HPDF_LoadTTFontFromFile In libhpdf.dll Integer, String, Integer Declare Integer HPDF_GetEncoder In libhpdf.dll Integer, String Declare Integer HPDF_GetCurrentEncoder In libhpdf.dll Integer Declare Integer HPDF_SetCurrentEncoder In libhpdf.dll Integer, String Declare Integer HPDF_Encoder_GetType In libhpdf.dll Integer Declare Integer HPDF_Encoder_GetByteType In libhpdf.dll Integer, String, Integer Declare String HPDF_Encoder_GetUnicode In libhpdf.dll Integer, String Declare Integer HPDF_Encoder_GetWritingMode In libhpdf.dll Integer Declare Integer HPDF_UseJPEncodings In libhpdf.dll Integer Declare Integer HPDF_UseKREncodings In libhpdf.dll Integer Declare Integer HPDF_UseCNSEncodings In libhpdf.dll Integer Declare Integer HPDF_UseCNTEncodings In libhpdf.dll Integer Declare Integer HPDF_UseJPFonts In libhpdf.dll Integer Declare Integer HPDF_UseKRFonts In libhpdf.dll Integer Declare Integer HPDF_UseCNSFonts In libhpdf.dll Integer Declare Integer HPDF_UseCNTFonts In libhpdf.dll Integer Declare Integer HPDF_LoadPngImageFromFile In libhpdf.dll Integer, String Declare Integer HPDF_LoadJpegImageFromFile In libhpdf.dll Integer, String Declare Integer HPDF_Image_GetWidth In libhpdf.dll Integer Declare Integer HPDF_Image_GetHeight In libhpdf.dll Integer Declare Integer HPDF_SetInfoAttr In libhpdf.dll Integer, Integer, String Declare Integer HPDF_SetPassword In libhpdf.dll Integer, String, String Declare Integer HPDF_SetPermission In libhpdf.dll Integer, Integer Declare Integer HPDF_SetEncryptionMode In libhpdf.dll Integer, Integer, Integer Declare Integer HPDF_SetCompressionMode In libhpdf.dll Integer, Integer Declare Integer HPDF_Font_MeasureText In libhpdf.dll Integer, String, Integer, Single, Single, Single, Single, Integer, Single @ Declare Single HPDF_Page_GetWidth In libhpdf.dll Integer Declare Single HPDF_Page_GetHeight In libhpdf.dll Integer Declare Single HPDF_Page_TextWidth In libhpdf.dll Integer, String Declare Integer HPDF_Page_GetCurrentFont In libhpdf.dll Integer Declare Integer HPDF_Page_MeasureText In libhpdf.dll Integer, String, Single, Integer, Single @ Declare Integer HPDF_Page_GetRGBFill In libhpdf.dll Integer Declare Integer HPDF_Page_GetCurrentFont In libhpdf.dll Integer Declare Single HPDF_Page_GetCurrentFontSize In libhpdf.dll Integer Declare Integer HPDF_Page_SetLineWidth In libhpdf.dll Integer, Single Declare Integer HPDF_Page_SetDash In libhpdf.dll Integer, String, Integer, Integer Declare Integer HPDF_Page_MoveTo In libhpdf.dll Integer, Single, Single Declare Integer HPDF_Page_LineTo In libhpdf.dll Integer, Single, Single Declare Integer HPDF_Page_ClosePath In libhpdf.dll Integer Declare Integer HPDF_Page_Rectangle In libhpdf.dll Integer, Single, Single, Single, Single Declare Integer HPDF_Page_Concat In libhpdf.dll Integer, Single, Single, Single, Single, Single, Single Declare Integer HPDF_Page_SetCharSpace In libhpdf.dll Integer, Single Declare Integer HPDF_Page_SetWordSpace In libhpdf.dll Integer, Single Declare Integer HPDF_Page_SetHorizontalScalling In libhpdf.dll Integer, Single Declare Integer HPDF_Page_SetTextLeading In libhpdf.dll Integer, Single Declare Integer HPDF_Page_SetTextRise In libhpdf.dll Integer, Single Declare Integer HPDF_Page_Stroke In libhpdf.dll Integer Declare Integer HPDF_Page_ClosePathStroke In libhpdf.dll Integer Declare Integer HPDF_Page_Fill In libhpdf.dll Integer Declare Integer HPDF_Page_FillStroke In libhpdf.dll Integer Declare Integer HPDF_Page_EndPath In libhpdf.dll Integer Declare Integer HPDF_Page_BeginText In libhpdf.dll Integer Declare Integer HPDF_Page_EndText In libhpdf.dll Integer Declare Integer HPDF_Page_SetFontAndSize In libhpdf.dll Integer, Integer, Single Declare Integer HPDF_Page_SetTextRenderingMode In libhpdf.dll Integer, Integer Declare Integer HPDF_Page_MoveTextPos In libhpdf.dll Integer, Single, Single Declare Integer HPDF_Page_MoveToNextLine In libhpdf.dll Integer Declare Integer HPDF_Page_SetRGBFill In libhpdf.dll Integer, Single, Single, Single Declare Integer HPDF_Page_SetRGBStroke In libhpdf.dll Integer, Single, Single, Single Declare Integer HPDF_Page_Ellipse In libhpdf.dll Integer, Single, Single, Single, Single Declare Integer HPDF_Page_DrawImage In libhpdf.dll Integer, Integer, Single, Single, Single, Single Declare Integer HPDF_Page_TextRect In libhpdf.dll Integer, Single, Single, Single, Single, String, Integer, Integer Declare Integer HPDF_Page_TextOut In libhpdf.dll Integer, Single, Single, String Declare Integer HPDF_Page_SetTextMatrix In libhpdf.dll Integer ,Single, Single, Single, Single, Single, Single Declare Integer HPDF_Page_ShowText In libhpdf.dll Integer, String Declare Integer HPDF_Page_CurveTo In libhpdf.dll Integer, Single, Single, Single, Single, Single, Single * CChalom 2010-01-17 * Removed the dependance of having "System.App" from GdiPlusX * Now using _Gdiplus.vcx that is already embedded in ReportOutput.App * Added a GdiPlus.dll declaration missing in the embedded classes * Function used in the CropImage method DECLARE Long GdipCloneBitmapAreaI IN GDIPLUS.DLL AS pdfxGdipCloneBitmapAreaI Long x, Long y, Long nWidth, Long Height, Long PixelFormat, Long srcBitmap, Long @dstBitmap * Function to revert strings DECLARE STRING _strrev IN msvcrt20.dll as xfcRevertString STRING @ ENDPROC PROCEDURE writepdfinformation With This If !Empty(.cPdfAuthor) Then This._Stat = HPDF_SetInfoAttr(.pdfHandle, HPDF_INFO_AUTHOR, .cPdfAuthor) EndIf If !Empty(.cPdfTitle) Then This._Stat = HPDF_SetInfoAttr(.pdfHandle, HPDF_INFO_TITLE, .cPdfTitle) EndIf If !Empty(.cPdfSubject) Then This._Stat = HPDF_SetInfoAttr(.pdfHandle, HPDF_INFO_SUBJECT, .cPdfSubject) EndIf If !Empty(.cPdfKeyWords) Then This._Stat = HPDF_SetInfoAttr(.pdfHandle, HPDF_INFO_KEYWORDS, .cPdfKeywords) EndIf If !Empty(.cPdfCreator) Then This._Stat = HPDF_SetInfoAttr(.pdfHandle, HPDF_INFO_CREATOR, .cPdfCreator) EndIf EndWith ENDPROC PROCEDURE searchfont LPARAMETERS lcFontName As String, lnStyle As Integer &&, lnCodePage As Integer LOCAL lnPos0 lnPos0 = ASCAN(This.aFontsSymbol, UPPER(lcFontName)) IF lnPos0 > 0 RETURN "" ENDIF LOCAL lcRetorno As String, lcFontRegular as String, lcFontStyle as String lcFontRegular = lcFontName lcFontStyle = "" WITH This .cTextStyle="" If Bittest(lnStyle, 0) Then &&Bold lcFontStyle = lcFontStyle + " Bold" * lcFontName = lcFontName + " Bold" .cTextStyle="B" EndIf If Bittest(lnStyle, 1) Then &&Italic lcFontStyle = lcFontStyle + " Italic" * lcFontName = lcFontName + " Italic" .cTextStyle = .cTextStyle + "I" EndIf Local lbResult As Boolean, lnI As Integer *!* Look for the font in the current collection lcFontName = lcFontName + lcFontStyle For lnI=1 To .oFonts.Count If This.oFonts.GetKey(lnI)==lcFontName Then lbResult = .T. Exit EndIf EndFor * Check if the font is at the replacement list LOCAL lnReplCount, lnPos lnReplCount = ALEN(This.aFontsReplaced, 1) lnPos = ASCAN(This.aFontsReplaced, lcFontName) IF lnPos > 0 lnPos = (lnPos + 1) / 2 lcFontName = This.aFontsReplaced(lnPos, 2) lbResult = .T. ENDIF IF !lbResult THEN && Font does NOT exist, let's add it to the collection LOCAL lcKey AS String, lcNewFont lcKey = .FindFontFileName(lcFontName) && If it didnt find the full name of the font, with style, && try at least to get the regular font IF EMPTY(lcKey) lcKey = .FindFontFileName(lcFontRegular) lcFontName = lcFontRegular ENDIF IF !Empty(lcKey) THEN .oFonts.Add(lcKey, lcFontName) ELSE && Can't add fonts lcNewFont = This.GetDefaultFont(lcFontStyle) && "Times-Roman" DIMENSION This.aFontsReplaced(lnReplCount + 1, 2) This.aFontsReplaced(lnReplCount + 1, 1) = lcFontName This.aFontsReplaced(lnReplCount + 1, 2) = lcNewFont lcFontName = lcNewFont ENDIF ENDIF lcRetorno = .oFonts.Item(.oFonts.GetKey(lcFontName)) ENDWITH RETURN lcRetorno ENDPROC PROCEDURE startpdfdocument WITH This * CChalom 2010-01-20 * Added "lStarted" property in order to allow merging reports SET TALK OFF SET CONSOLE OFF IF .pdfHandle = 0 AND NOT .lStarted LOCAL llError TRY .pdfHandle = HPDF_New(0, 0) && Create a New Document llError = .F. CATCH llError = .T. ENDTRY IF .pdfHandle = 0 OR llError * Check if the library HPDF.DLL is in the disk MESSAGEBOX("Could not load the library LIBHPDF.DLL ." + CHR(13) + ; "The process can't continue. Make sure that you have the PDF library available, and that FoxyPreviewer is installed in a folder that has READ/WRITE access.", 16, "Error") This.CancelReport() RETURN .F. ENDIF This._Stat = HPDF_SetCompressionMode(.pdfHandle, HPDF_COMP_ALL) &&Set Document Compression Method * KHentschel 2010-06-15 * Added "nPageMode" property: how Document should be displayed HPDF_PAGE_MODE_USE_OUTLINE * HPDF_SetPageMode(.pdfHandle, HPDF_PAGE_MODE_USE_OUTLINE) &&Set the how Document should be displayed * Available possibilities: * #define HPDF_PAGE_MODE_USE_NONE 0 * #define HPDF_PAGE_MODE_USE_OUTLINE 1 * #define HPDF_PAGE_MODE_USE_THUMBS 2 * #define HPDF_PAGE_MODE_FULL_SCREEN 3 * Make a special call to enable the Chinese characters * http://libharu.sourceforge.net/fonts.html * GB-EUC-H EUC-CN encoding * GB-EUC-V Vertical writing virsion of GB-EUC-H * GBK-EUC-H Microsoft Code Page 936 (lfCharSet 0x86) GBK encoding * GBK-EUC-V Vertical writing virsion of GBK-EUC-H This._Stat = HPDF_SetPageMode(.pdfHandle, .nPageMode) .WritePdfInformation() &&Stablish PDF File Information .EncryptPdf() * Clear existing HPDF errors This.ClearPDFErrors() .AddBlankPage() * Clear existing HPDF errors This.ClearPDFErrors() * Identify Double-Byte languages * And prepare HPDF to use specific encodings, with some specific fonts LOCAL lcCodePage lcCodePage = UPPER(ALLTRIM(This.cCodePage)) DO CASE CASE INLIST(lcCodePage, "GB-EUC-H", "GB-EUC-V", "GBK-EUC-H", "GBK-EUC-V", "CP936", "936", "EUC-CN") This._lSChinese = .T. && Simplified Chinese This.cDefaultFont = "SimSun" This._Stat = HPDF_UseCNSFonts(.pdfHandle) This._Stat = HPDF_UseCNSEncodings(.pdfHandle) IF "936" $ lcCodePage This.cCodePage = "GBK-EUC-H" ENDIF CASE INLIST(lcCodePage, "ETEN-B5-H", "ETEN-B5-V", "CP950", "950") This._lTChinese = .T. && Traditional Chinese This.cDefaultFont = "MingLiU" This._Stat = HPDF_UseCNTFonts(.pdfHandle) This._Stat = HPDF_UseCNTEncodings(.pdfHandle) IF "950" $ lcCodePage This.cCodePage = "ETen-B5-H" ENDIF CASE INLIST(lcCodePage, "90MS-RKSJ-H", "90MS-RKSJ-V", "90MSP-RKSJ-H", "EUC-H", "EUC-V", "CP932", "932") This._lJapanese = .T. && Japanese This.cDefaultFont = "MS-Mincyo" This._Stat = HPDF_UseJPFonts(.pdfHandle) This._Stat = HPDF_UseJPEncodings(.pdfHandle) IF "932" $ lcCodePage This.cCodePage = "90ms-RKSJ-H" && 90ms-RKSJ-H, 90ms-RKSJ-V, 90msp-RKSJ-H ENDIF CASE INLIST(lcCodePage, "EUC-H", "EUC-V", "KSC-EUC-H", "KSC-EUC-V", "KSCMS-UHC-H", "KSCMS-UHC-HW-H", "KSCMS-UHC-HW-V", "CP949", "949") This._lKorean = .T. && Korean This.cDefaultFont = "DotumChe" This._Stat = HPDF_UseKRFonts(.pdfHandle) This._Stat = HPDF_UseKREncodings(.pdfHandle) IF "949" $ lcCodePage This.cCodePage = "KSC-EUC-H" && KSC-EUC-H, KSC-EUC-V, KSCms-UHC-H, KSCms-UHC-HW-H, KSCms-UHC-HW-V ENDIF CASE INLIST(lcCodePage, "CP1256", "1256") && Arabic This.cCodePage = "ISO8859-6" This.lRightToLeft = .T. OTHERWISE IF VAL(lcCodePage) > 0 This.cCodePage = "CP" + lcCodePage ENDIF ENDCASE *!* 1 - "Simplified Chinese Encodings" *!* CodePages: GB-EUC-H, GB-EUC-V, GBK-EUC-H, GBK-EUC-V, CP936 *!* SIMSUN Font as Default *!* SIMHEI font will be available, but used only if selected, with these variations: *!* SimSun *!* SimSun,Bold *!* SimSun,Italic *!* SimSun,BoldItalic *!* SimHei *!* SimHei,Bold *!* SimHei,Italic *!* SimHei,BoldItalic *!* 2 - "Traditional Chinese Encodings" *!* CodePages: ETen-B5-H, ETen-B5-V, CP950 *!* MINGLIU will be the ONLY font available, with these variations: *!* MingLiU *!* MingLiU,Bold *!* MingLiU,Italic *!* MingLiU,BoldItalic *!* *!* 3 - "Japanese Encodings" *!* CodePages: 90ms-RKSJ-H, 90ms-RKSJ-V, 90msp-RKSJ-H, EUC-H, EUC-V, CP932 *!* MS-MINCYO as Default, with these variations: *!* MS-Mincyo *!* MS-Mincyo,Bold *!* MS-Mincyo,Italic *!* MS-Mincyo,BoldItalic *!* MS-Gothic *!* MS-Gothic,Bold *!* MS-Gothic,Italic *!* MS-Gothic,BoldItalic *!* MS-PMincyo *!* MS-PMincyo,Bold *!* MS-PMincyo,Italic *!* MS-PMincyo,BoldItalic *!* MS-PGothic *!* MS-PGothic,Bold *!* MS-PGothic,Italic *!* MS-PGothic,BoldItalic *!* *!* 4 - "Korean Encodings" *!* CodePages: KSC-EUC-H, KSC-EUC-V, KSCms-UHC-H, KSCms-UHC-HW-H, KSCms-UHC-HW-V, CP949 *!* DOTUMCHE as Default, with these variations: *!* DotumChe *!* DotumChe,Bold *!* DotumChe,Italic *!* DotumChe,BoldItalic *!* Dotum *!* Dotum,Bold *!* Dotum,Italic *!* Dotum,BoldItalic *!* BatangChe *!* BatangChe,Bold *!* BatangChe,Italic *!* BatangChe,BoldItalic *!* Batang *!* Batang,Bold *!* Batang,Italic *!* Batang,BoldItalic .lStarted=.T. ENDIF ENDWITH ENDPROC PROCEDURE cleardlls Clear Dlls "HPDF_New","HPDF_Free","HPDF_SaveToFile","HPDF_GetError","HPDF_ResetError","HPDF_SetPageMode",; "HPDF_GetCurrentPage","HPDF_AddPage","HPDF_Page_SetWidth","HPDF_Page_SetHeight","HPDF_GetFont","HPDF_LoadTTFontFromFile",; "HPDF_GetEncoder","HPDF_GetCurrentEncoder","HPDF_SetCurrentEncoder","HPDF_Encoder_GetType","HPDF_Encoder_GetByteType",; "HPDF_Encoder_GetUnicode","HPDF_Encoder_GetWritingMode","HPDF_UseJPEncodings","HPDF_UseKREncodings","HPDF_UseCNSEncodings",; "HPDF_UseCNTEncodings","HPDF_LoadPngImageFromFile","HPDF_LoadJpegImageFromFile","HPDF_Image_GetWidth","HPDF_Image_GetHeight",; "HPDF_SetInfoAttr","HPDF_SetPassword","HPDF_SetPermission","HPDF_SetEncryptionMode","HPDF_SetCompressionMode",; "HPDF_Font_MeasureText","HPDF_Page_GetWidth","HPDF_Page_GetHeight","HPDF_Page_TextWidth","HPDF_Page_GetCurrentFont",; "HPDF_Page_MeasureText","HPDF_Page_GetRGBFill","HPDF_Page_GetCurrentFont","HPDF_Page_GetCurrentFontSize","HPDF_Page_SetLineWidth",; "HPDF_Page_SetDash","HPDF_Page_MoveTo","HPDF_Page_LineTo","HPDF_Page_ClosePath","HPDF_Page_Rectangle","HPDF_Page_Concat",; "HPDF_Page_SetCharSpace","HPDF_Page_SetWordSpace","HPDF_Page_SetHorizontalScalling","HPDF_Page_SetTextLeading",; "HPDF_Page_SetTextRise","HPDF_Page_Stroke","HPDF_Page_ClosePathStroke","HPDF_Page_Fill","HPDF_Page_FillStroke",; "HPDF_Page_EndPath","HPDF_Page_BeginText","HPDF_Page_EndText","HPDF_Page_SetFontAndSize","HPDF_Page_SetTextRenderingMode",; "HPDF_Page_MoveTextPos","HPDF_Page_MoveToNextLine","HPDF_Page_SetRGBFill","HPDF_Page_SetRGBStroke","HPDF_Page_Ellipse",; "HPDF_Page_DrawImage","HPDF_Page_TextRect","HPDF_Page_TextOut","HPDF_Page_SetTextMatrix","HPDF_Page_ShowText","HPDF_Page_CurveTo" ENDPROC PROCEDURE encryptpdf With This If .lEncryptDocument Then &&Protect the document with password If !Empty(.cMasterPassword) Then If .cMasterPassword!=.cUserPassword Then &&User Password and Master Password can't be the same HPDF_SetPassword(.pdfHandle, .cMasterPassword, .cUserPassword) Local lnPermit As Integer lnPermit=0 && Establish PDF files permissions If .lCanPrint Then lnPermit = lnPermit + HPDF_ENABLE_PRINT EndIf If .lCanEdit Then lnPermit = lnPermit + HPDF_ENABLE_EDIT_ALL EndIf If .lCanCopy Then lnPermit = lnPermit + HPDF_ENABLE_COPY EndIf If .lCanAddNotes Then lnPermit = lnPermit + HPDF_ENABLE_EDIT EndIf This._Stat = HPDF_SetPermission(.pdfHandle, lnPermit) If .nEncriptionLevel!=5 Then This._Stat = HPDF_SetEncryptionMode(.pdfHandle, HPDF_ENCRYPT_R3, .nEncriptionLevel) Else This._Stat = HPDF_SetEncryptionMode(.pdfHandle, HPDF_ENCRYPT_R2, .nEncriptionLevel) EndIf EndIf EndIf ENDIF EndWith ENDPROC PROCEDURE addblankpage *!* Change page coordinates and measure system WITH This IF .lDefaultMode LOCAL lnWidth, lnHeight lnWidth = .GetPageWidth() lnHeight = .GetPageHeight() .nPageHeight = (lnHeight / 960) * 72 .nPageWidth = (lnWidth / 960) * 72 ENDIF .oPage = HPDF_AddPage(.pdfHandle) && Add a New Page This._Stat = HPDF_Page_SetWidth(.oPage, .nPageWidth ) && Establish the Width of the page This._Stat = HPDF_Page_SetHeight(.oPage, .nPageHeight) && Establish the Height of the page ENDWITH * Draw watermark IF NOT EMPTY(This._cWMpicture) AND (This._nWmw > 20) AND (This._nWmh > 20) This.ProcessPictures(This._nwmy, This._nWmx, This._nWmw, This._nWmh, This._cWMpicture,; 0, 0, 2, "") *Lparameters nTop As Number,nLeft As Number,nWidth As Number,nHeight As Number,lcContents As String,; * GDIPlusImage As Number, lnOffset As Integer, liPictureMode As Integer, lcStyle As String ENDIF ENDPROC PROCEDURE addpdfstandardfonts With This.oFonts .Add("Courier", "Courier") .Add("Courier-Bold", "Courier-Bold") .Add("Courier-Oblique", "Courier-Oblique") .Add("Courier-BoldOblique", "Courier-BoldOblique") .Add("Helvetica", "Helvetica") .Add("Helvetica-Bold", "Helvetica-Bold") .Add("Helvetica-Oblique", "Helvetica-Oblique") .Add("Helvetica-BoldOblique", "Helvetica-BoldOblique") .Add("Times-Roman", "Times-Roman") .Add("Times-Bold", "Times-Bold") .Add("Times-Italic", "Times-Italic") .Add("Times-BoldItalic", "Times-BoldItalic") .Add("Symbol", "Symbol") .Add("ZapfDingbats", "ZapfDingbats") EndWith ENDPROC PROCEDURE findfontfilename LPARAMETERS lcFontName As String Local lcFileName As String, lcFolder As String lcFolder = Iif(Os(3) < "5","SOFTWARE\Microsoft\Windows\CurrentVersion\Fonts","Software\Microsoft\Windows NT\CurrentVersion\Fonts") IF VARTYPE(This.oRegistry)!="O" THEN This.oRegistry = NewObject("Registry", This.ClassLibrary) ENDIF lcFileName = This._cWinFolder + "Fonts\" + This.oRegistry.ReadRegistryString(HKEY_LOCAL_MACHINE,lcFolder,ALLTRIM(lcFontName) + " (TrueType)") IF ISNULL(lcFileName) lcFileName = This._cWinFolder + "Fonts\" + This.oRegistry.ReadRegistryString(HKEY_LOCAL_MACHINE,lcFolder,ALLTRIM(lcFontName)) IF ISNULL(lcFileName) LOCAL lnLangID lnLangID = This.nSystemLangID *!* 1029 Czech *!* 1031 German *!* 1033 English (Default) *!* 1034 Spanish *!* 1036 French *!* 1040 Italian *!* 1045 Polish *!* 1046 Portuguese (Brazilian) * http://www.science.co.il/language/locale-codes.asp DO CASE CASE lnLangID = 1046 && Portuguese lcFontName = STRTRAN(lcFontName, "Bold" , "Negrito") lcFontName = STRTRAN(lcFontName, "Italic", "It lico") CASE lnLangID = 1034 && Spanish lcFontName = STRTRAN(lcFontName, "Bold" , "negrita") lcFontName = STRTRAN(lcFontName, "Italic", "cursiva") CASE lnLangID = 1036 && French lcFontName = STRTRAN(lcFontName, "Bold" , "Gras") lcFontName = STRTRAN(lcFontName, "Italic", "Italique") OTHERWISE ENDCASE lcFileName = This._cWinFolder + "Fonts\" + This.oRegistry.ReadRegistryString(HKEY_LOCAL_MACHINE,lcFolder,ALLTRIM(lcFontName) + " (TrueType)") ENDIF ENDIF LOCAL luReturn luReturn = "" If !ISNULL(lcFileName) THEN luReturn = HPDF_LoadTTFontFromFile(This.pdfHandle, lcFileName, IIF(This.lEmbedFont,1,0)) CATCH TO loExc * SET STEP ON ENDTRY ENDIF DEBUGOUT lcFontName, lcFileName, luReturn This.ClearPDFErrors() RETURN luReturn ********************************************* *!* TRY *!* Declare String HPDF_LoadType1FontFromFile In libhpdf.dll Integer, String, String *!* luReturn = HPDF_LoadType1FontFromFile(This.pdfHandle, lcFileName, NULL) *!* CATCH TO loExc2 *!* * SET STEP ON *!* ENDTRY ********************************************* *!* LOCAL lcRegKey *!* lcRegKey = ; *!* "HKEY_LOCAL_MACHINE\" + ; *!* ADDBS(lcFolder) + ; *!* lcFontName + " (TrueType)" *!* LOCAL loWSH AS wscript.shell *!* loWSH = CREATEOBJECT("wscript.shell") *!* lcFileName = loWSH.RegRead(lcRegKey) *!* * ? loWSH.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\ProductId") *!* lcFileName = GETENV("windir") + "\Fonts\" + lcFileName ENDPROC PROCEDURE cropimage LPARAMETERS lcFile As String, tnX, tnY, tnWidth As Integer, tnHeight As Integer, tlFile * CChalom 2010-01-17 * Removed the dependance of having "System.App" from GdiPlusX * Now using _Gdiplus.vcx that is already embedded in ReportOutput.App *!* Original code *!* If Vartype(_Screen.System)!="O" Then *!* Do System.App &&Initializes GDIPLUSX *!* EndIf *!* With _Screen.System.Drawing *!* .Graphics.PageUnit = .GraphicsUnit.Point *!* Local loBmp As xfcBitmap *!* loBmp = .Bitmap.FromFile(lcFile) *!* * Crop Image *!* Local loCropped As xfcBitmap, loRect As xfcRectangle *!* loRect = .Rectangle.New(0, 0, tnWidth, tnHeight) *!* loCropped = loBmp.Clone(loRect) *!* lcFile = Substr(lcFile, 1, Len(lcFile)-3)+"Png" *!* loCropped.Save(lcFile, .Imaging.ImageFormat.Png) *!* Return lcFile *!* ENDWITH IF NOT FILE(lcFile) RETURN .F. ENDIF Local loBmp As gpBitmap OF HOME() + "ffc\_gdiplus.vcx" loBmp = NEWOBJECT("GpBitmap", "_GdiPlus.vcx") loBmp.CreateFromFile(lcFile) tnHeight = MIN(tnHeight, loBmp.ImageHeight) tnWidth = MIN(tnWidth , loBmp.ImageWidth) LOCAL lhBitmap, lnStatus lhBitmap = 0 lnStatus = pdfxGdipCloneBitmapAreaI(tnX, tnY, CEILING(tnWidth), CEILING(tnHeight), loBmp.PixelFormat, loBmp.GetHandle(), @lhBitmap) IF (lhBitmap = 0) OR (lnStatus <> 0) loBmp = NULL lnHandle = 0 RETURN lnHandle ENDIF Local loCropped As gpBitmap OF HOME() + "ffc\_gdiplus.vcx" loCropped = NEWOBJECT("GpBitmap", "_GdiPlus.vcx") loCropped.SetHandle(lhBitmap, .T.) && Owns handle, please destroy the Bmp object when releasing loCropped.SetResolution(loBmp.HorizontalResolution, loBmp.VerticalResolution) LOCAL lcEXT, lcEncoder lcEXT = UPPER(JUSTEXT(lcFile)) lcEncoder = IIF(lcEXT = "PNG", "image/png", "image/jpeg") LOCAL lcCroppedFile lcCroppedFile = This.GetTempFile(lcEXT) loCropped.SaveToFile(lcCroppedFile, lcEncoder) loCropped = NULL loBMP = NULL IF tlFile RETURN lcCroppedFile ENDIF IF lcEXT = "PNG" lnHandle = HPDF_LoadPngImageFromFile(This.pdfHandle, lcCroppedFile) lnHandle = HPDF_LoadJpegImageFromFile(This.pdfHandle, lcCroppedFile) ENDIF IF This.IsTempFile(lcFile) DELETE FILE (lcFile) ENDIF CATCH TO loExc * SET STEP ON ENDTRY IF This.IsTempFile(lcCroppedFile) DELETE FILE (lcCroppedFile) ENDIF CATCH TO loExc * SET STEP ON ENDTRY RETURN lnHandle ENDPROC PROCEDURE parseunderlinetext Lparameters lcText As String, nWidth As Number, lnAncho As Number Local lnI As Integer, lcTemp As String, lnLen As Integer, lcRetorno As String lnLen = Len(lcText) lcTemp = "" lcRetorno = "" For lnI=1 To lnLen If HPDF_Page_TextWidth(This.oPage, lcTemp + Substr(lcText, lnI, 1)) < nWidth Then lcTemp = lcTemp + Substr(lcText, lnI, 1) Else lcRetorno = lcRetorno + lcTemp + " " lcTemp = "" EndIf EndFor Return lcRetorno + lcTemp ENDPROC PROCEDURE processdynamics LParameters lcStyle As String, lcType As String Local lbReturn As Boolean, lcCursor As String lcCursor=Select() XMLToCursor(lcStyle, "_TempDynamics") Catch lbReturn = .F. EndTry This.oDynamics = Null * CChalom 2010-06-15 * Included verification for IF USED("_TempDynamics") * for the case of an invalid XML IF USED("_TempDynamics") AND Reccount("_TempDynamics") > 0 Then This.oDynamics = CreateObject("Empty") Select _TempDynamics If InList(lcType,"FIELD","SHAPE","PICTURE") Scan For !Empty(_TempDynamics.ExecWhen) Try If Evaluate(_TempDynamics.ExecWhen) Do Case Case lcType="FIELD" AddProperty(This.oDynamics, "cValue", _TempDynamics.Script) &&Corresponds to the Replace Expression With AddProperty(This.oDynamics, "cExecWhen", _TempDynamics.ExecWhen) &&Corresponds to the expresion to be evaluate it AddProperty(This.oDynamics, "cFontName", _TempDynamics.FName) &&Corresponds to the font name applied if expresion is true AddProperty(This.oDynamics, "nFontSize", Iif(Vartype(_TempDynamics.FSize)="N", _TempDynamics.FSize, 0)) &&Corresponds to the font size applied if expresion is true AddProperty(This.oDynamics, "nFontStyle",Iif(Vartype(_TempDynamics.FStyle)="N", _TempDynamics.FStyle, 0)) &&Corresponds to the font style applied if expresion is true If Cast(_TempDynamics.PenRgb As I)!= -1 Then *!* This color transformation was taken from samples provided by etin Bas AddProperty(This.oDynamics, "nPenRed", Bitrshift(Bitand(Iif(Vartype(_TempDynamics.PenRgb)="C", Int(Val(_TempDynamics.PenRgb)), _TempDynamics.PenRgb), 0x0000FF),0)) AddProperty(This.oDynamics, "nPenGreen", Bitrshift(Bitand(Iif(Vartype(_TempDynamics.PenRgb)="C", Int(Val(_TempDynamics.PenRgb)), _TempDynamics.PenRgb), 0x00FF00),8)) AddProperty(This.oDynamics, "nPenBlue", Bitrshift(Bitand(Iif(Vartype(_TempDynamics.PenRgb)="C", Int(Val(_TempDynamics.PenRgb)), _TempDynamics.PenRgb), 0xFF0000),16)) Else AddProperty(This.oDynamics, "nPenRed", -1) AddProperty(This.oDynamics, "nPenGreen", -1) AddProperty(This.oDynamics, "nPenBlue", -1) EndIf If Cast(_TempDynamics.FillRgb As I)!= -1 Then AddProperty(This.oDynamics, "nFillRed", Bitrshift(Bitand(Iif(Vartype(_TempDynamics.FillRgb)="C", Int(Val(_TempDynamics.FillRgb)), _TempDynamics.FillRgb), 0x0000FF),0)) AddProperty(This.oDynamics, "nFillGreen", Bitrshift(Bitand(Iif(Vartype(_TempDynamics.FillRgb)="C", Int(Val(_TempDynamics.FillRgb)), _TempDynamics.FillRgb), 0x00FF00),8)) AddProperty(This.oDynamics, "nFillBlue", Bitrshift(Bitand(Iif(Vartype(_TempDynamics.FillRgb)="C", Int(Val(_TempDynamics.FillRgb)), _TempDynamics.FillRgb), 0xFF0000),16)) Else AddProperty(This.oDynamics, "nFillRed", -1) AddProperty(This.oDynamics, "nFillGreen", -1) AddProperty(This.oDynamics, "nFillBlue", -1) EndIf lbReturn = .T. Exit Case lcType="SHAPE" Or lcType="IMAGE" AddProperty(This.oDynamics, "cExecWhen", _TempDynamics.ExecWhen) &&Corresponds to the expresion to be evaluate it AddProperty(This.oDynamics, "nWidth", Iif(Vartype(_TempDynamics.Width)="C", Int(Val(_TempDynamics.Width)), _TempDynamics.Width)) &&Corresponds to the width assigned AddProperty(This.oDynamics, "nHeight", Iif(Vartype(_TempDynamics.Height)="C", Int(Val(_TempDynamics.Height)), _TempDynamics.Height)) &&Corresponds to the width assigned lbReturn = .T. Exit EndCase EndIf Catch lbReturn = .F. EndTry EndScan EndIf *!* No check for Rotation Values Scan For _TempDynamics.Name="Microsoft.VFP.Reporting.Builder.Rotate" AddProperty(This.oDynamics, "nRotationDegree", Iif(Vartype(_TempDynamics.Execute)="C", Int(Val(_TempDynamics.Execute)), _TempDynamics.Execute)) lbReturn = .T. EndScan Select (lcCursor) Return lbReturn lbReturn = .F. EndIf Select (lcCursor) Return lbReturn ENDPROC PROCEDURE processfields LPARAMETERS lcFontFace As String, liFontStyle As Integer, lnFontSize As Number, lnPenRed As Number, lnPenGreen As Number,; lnPenBlue As Number, lnFillRed As Number, lnFillGreen As Number, lnFillBlue As Number, nLeft As Number, nTop As Number,; lcContents As String, lcFillChar As String, lnOffset As Integer, lbStretch As Boolean, lnCodePage As Integer, nHeight As Number, ; nWidth As Integer, lcStyle As String, lnMode As Integer, lcUser As String IF EMPTY(lcContents) RETURN .T. ENDIF LOCAL lcOrigContents, lnTimes, lcTabRepl lnTimes = 8 lcTabRepl = REPLICATE(CHR(160),lnTimes) lcOrigContents = lcContents lcOrigContents = STRTRAN(lcOrigContents,CHR(9), lcTabRepl) && Replaces the With a CHR(160) to keep paragraphs lcContents = STRTRAN(lcContents, CHR(9), lcTabRepl) IF This.lRightToLeft lcContents = xfcRevertString(lcContents + CHR(0)) ENDIF LOCAL lnOcurrences As Integer, lnAncho As Integer, lnFontHandle As Integer, lnAlto As Integer, lcUnderLineText As String, lnRotate As Integer, lnCharWidth As Integer lnRotate = 0 WITH This *!* Code to handle the Dynamic Options added in SP2 IF !Empty(lcStyle) ; AND (This.lDefaultMode OR (VARTYPE(_goHelper) = "O" AND USED(_goHelper.oListener.cMainAlias))) && AND This.lDefaultMode Then && Dynamic Properties are stored here as xml TRY * Get the current field data IF NOT This.lDefaultMode LOCAL lcAlias, lcMainAlias, lnRec lnRec = DBFRECNO lcAlias = ALIAS() lcMainAlias = _goHelper.oListener.cMainAlias SELECT(lcMainAlias) GO (lnRec) ENDIF If .ProcessDynamics(lcStyle, "FIELD") Then lcFontFace = Iif(PemStatus(.oDynamics, "cFontName", 5), .oDynamics.cFontName, lcFontFace) lnFontSize = Iif(PemStatus(.oDynamics, "nFontSize",5), Iif(.oDynamics.nFontSize!=0, .oDynamics.nFontSize, lnFontSize), lnFontSize) liFontStyle = Iif(PemStatus(.oDynamics, "nFontStyle",5), Iif(.oDynamics.nFontStyle!=0, .oDynamics.nFontStyle, liFontStyle), liFontStyle) lcContents = Iif(PemStatus(.oDynamics, "cValue",5), Iif(!Empty(.oDynamics.cValue), .oDynamics.cValue, lcContents), lcContents) lnPenRed = Iif(PemStatus(.oDynamics, "nPenRed",5), .oDynamics.nPenRed, lnPenRed) lnPenBlue = Iif(PemStatus(.oDynamics, "nPenBlue",5), .oDynamics.nPenBlue, lnPenBlue) lnPenGreen = Iif(PemStatus(.oDynamics, "nPenGreen",5), .oDynamics.nPenGreen, lnPenGreen) lnFillRed = Iif(PemStatus(.oDynamics, "nFillRed",5), .oDynamics.nFillRed, lnFillRed) lnFillBlue = Iif(PemStatus(.oDynamics, "nFillBlue",5), .oDynamics.nFillBlue, lnFillBlue) lnFillGreen = Iif(PemStatus(.oDynamics, "nFillGreen",5), .oDynamics.nFillGreen, lnFillGreen) lnRotate = Iif(PemStatus(.oDynamics, "nRotationDegree", 5), .oDynamics.nRotationDegree, 0) EndIf * Restore the driving table IF NOT This.lDefaultMode SELECT(lcAlias) ENDIF CATCH TO loExc * SET STEP ON ENDTRY ENDIF If lnFillRed=-1 And lnFillBlue=-1 And lnFillGreen=-1 Then &&Default Colors of VFP Report Designer Store 255 To lnFillRed, lnFillBlue, lnFillGreen EndIf * Draw the field background IF lnMode = 0 && Mode: 0 = Opaque background; 1 = Transparent lnPenSize = 0 lnPenPat = 0 lnFillPat = 1 lcStyle = "" LOCAL lnObjContType lnObjContType = 0 This.ProcessShapes(lnFillRed, lnFillGreen, lnFillBlue, ; lnFillRed, lnFillGreen, lnFillBlue, ; nLeft, nTop, nWidth, nHeight, lnOffset, ; lnPenSize, lnPenPat, lnFillPat, lcStyle, lnMode, lnObjContType, .T.) && Last parameter is to inform 'ProcessShapes' not to draw a line border ENDIF nTop = .nPageHeight - nTop && Change the Top Coordinates Because of the PDF Coordinate System * Get the font Handle * If no font is retrieved, then draw the string as an image lnFontHandle = This.Getfonthandle(lcFontFace, liFontStyle) IF lnFontHandle = 0 LOCAL lcImage, lnTxtW, lnTxtH lnTxtW = nWidth lnTxtH = nHeight lcImage = This.StringToPic(lcContents, lcFontFace, lnFontSize, ; IIF(lnPenRed = -1, 0, lnPenRed), ; IIF(lnPenGreen = -1, 0, lnPenGreen), ; IIF(lnPenBlue = -1, 0, lnPenBlue), ; 0, @lnTxtW, @lnTxtH) This.ProcessPictures2(lcImage, nLeft, nTop, lnTxtW, lnTxtH) RETURN ENDIF This._Stat = HPDF_Page_BeginText(.oPage) &&Change to Text Mode This._Stat = HPDF_Page_SetFontAndSize(.oPage, lnFontHandle, lnFontSize) &&Find and choose the font lnCharWidth = FontMetric(7, lcFontFace, lnFontSize, .cTextStyle) IF lnPenRed=-1 And lnPenBlue=-1 And lnPenGreen=-1 Then &&Default Colors of VFP Report Designer STORE 0 TO lnPenBlue, lnPenRed, lnPenGreen ENDIF lnAncho = HPDF_Page_TextWidth(.oPage, lcContents) &&Get the size of the text width lnAlto = HPDF_Page_GetCurrentFontSize(.oPage) && Get the height of the current font * Not precise at all LOCAL lnFontHeight2 lnFontHeight2 = FontMetric(1, lcFontFace, lnFontSize, .cTextStyle) * Process Underline, currently being tested IF BITTEST(liFontStyle, 2) THEN lcUnderLineText = REPLICATE("_", ROUND(lnAncho / HPDF_Page_TextWidth(.oPage, "_"), 0)) IF HPDF_Page_TextWidth(.oPage, lcUnderLineText) > nWidth THEN lcUnderLineText = .ParseUnderLineText(lcUnderLineText, nWidth, lnAncho) ENDIF .lUnderline = .T. ELSE .lUnderline = .F. ENDIF This._Stat = HPDF_Page_SetRGBFill(.oPage, lnPenRed / 255, lnPenGreen / 255, lnPenBlue / 255) &&Convert colors to PDF mode This._Stat = HPDF_Page_SetTextLeading(.oPage, lnFontSize) && Space between lines IF lnRotate = 0 THEN && No Text Rotation *!* LOCAL lnLines *!* lnLines = CEILING(nHeight / lnFontHeight2) *!* IF lbStretch OR (CHR(10) $ lcContents) && OR (lnLines > 1) *!* nHeight = This.GetParHeight(lcContents, lcFontFace, lnFontSize, liFontStyle, nLeft, nTop, nWidth, nHeight) *!* ELSE *!* * 2010-12-19 - by Fabio Vieira *!* DO WHILE HPDF_Page_TextWidth(.oPage, lcContents) > nWidth *!* lcContents = PADR(lcContents,LEN(lcContents)-1) *!* ENDDO *!* lnAlto = 0 *!* ENDIF *!* HPDF_Font_MeasureText() *!* HPDF_UINT HPDF_Font_MeasureText (HPDF_Font font, *!* const HPDF_BYTE *text, *!* HPDF_UINT len, *!* HPDF_REAL width, *!* HPDF_REAL font_size, *!* HPDF_REAL char_space, *!* HPDF_REAL word_space, *!* HPDF_BOOL wordwrap, *!* HPDF_REAL *real_width); *!* *!* Declare Integer HPDF_Font_MeasureText In libhpdf.dll *!* Integer, String, Integer, Single, Single, Single, Single, Integer, Single @ *!* *!* calculates the byte length which can be included within the specified width. *!* *!* Parameters *!* font - Specify the handle of a font object. *!* text - The text to use for calculation. *!* len - The length of the text. *!* width - The width of the area to put the text. *!* font_size - The size of the font. *!* char_space - The character spacing. *!* word_space - The word spacing. *!* wordwrap - Suppose there are three words: "ABCDE", "FGH", and "IJKL". *!* Also, suppose the substring until "J" can be included within the width (12 bytes). *!* If word_wrap is HPDF_FALSE the function returns 12. If word_wrap parameter is HPDF_TRUE, it returns 10 (the end of the previous word). LOCAL lnLen, lnChars, lnRealWidth, lcCurrText, lcRemainingText, lnLineHeight, lnLinesAvail, lnCurrLine STORE "" TO lcCurrText STORE 0 TO lnLen, lnChars, lnRealWidth lcRemainingText = lcOrigContents lnLineHeight = This.GetParHeight("AB", lcFontFace, lnFontSize, liFontStyle, 0, 0, 10000, 10000) lnLinesAvail = ROUND(nHeight / lnLineHeight, 0) lnCurrLine = 1 DO WHILE .T. lnRealWidth = 0 lnLen = LEN(lcRemainingText) lnChars = HPDF_Font_MeasureText( lnFontHandle, ; lcRemainingText, ; LEN(lcRemainingText), ; nWidth, ; lnFontSize, ; 0, ; 0, ; 1, ; @lnRealWidth) IF lnChars = 0 && it seems that we had one single word, so we'll cut the word in the middle && Changing the WordWrap parameter to 0 lnChars = HPDF_Font_MeasureText( lnFontHandle, ; lcRemainingText, ; LEN(lcRemainingText), ; nWidth, ; lnFontSize, ; 0, ; 0, ; 0, ; @lnRealWidth) ENDIF lcCurrText = LEFT(lcRemainingText, lnChars) lcRemainingText = ALLTRIM(SUBSTR(lcRemainingText, lnChars + 1)) IF NOT "" $ lcUser lcCurrText = ALLTRIM(lcCurrText) * lcCurrText = CHRTRAN(lcCurrText, CHR(10), CHR(13)) lcCurrText = CHRTRAN(lcCurrText, CHR(10), "") lcCurrText = CHRTRAN(lcCurrText, CHR(13), "") ELSE IF (CHR(10) $ lcCurrText) OR (EMPTY(lcRemainingText)) lcCurrText = ALLTRIM(lcCurrText) ELSE && Trick to force the justification, telling the HPDF engine that we'll have a next line, forcing it to continue justifying lcCurrText = ALLTRIM(lcCurrText) + CHR(10) + CHR(10) ENDIF ENDIF lcContents = lcCurrText DO CASE CASE "" $ lcUser This._Stat2 = HPDF_Page_TextRect(.oPage, nLeft, nTop, nLeft + nWidth, nTop - nHeight - lnAlto, lcContents, HPDF_TALIGN_JUSTIFY, 0) CASE lnOffset = 0 && Left Aligned This._Stat2 = HPDF_Page_TextRect(.oPage, nLeft, nTop, nLeft + nWidth, nTop - nHeight - lnAlto, lcContents, HPDF_TALIGN_LEFT, 0) IF .lUnderline Then &&Draw fake underline text This._Stat = HPDF_Page_TextRect(.oPage, nLeft, nTop, nLeft + nWidth , nTop - nHeight - lnAlto, lcUnderLineText, HPDF_TALIGN_LEFT, 0) ENDIF CASE lnOffset = 1 && Right Aligned This._Stat2 = HPDF_Page_TextRect(.oPage, nLeft, nTop, nLeft + nWidth, nTop - nHeight - lnAlto, lcContents, HPDF_TALIGN_RIGHT, 0) If .lUnderline Then &&Draw fake underline text This._Stat = HPDF_Page_TextRect(.oPage, nLeft, nTop, nLeft + nWidth, nTop - nHeight - lnAlto, lcUnderLineText, HPDF_TALIGN_RIGHT, 0) EndIf Case lnOffset = 2 && Center Aligned This._Stat2 = HPDF_Page_TextRect(.oPage, nLeft, nTop, nLeft + nWidth, nTop - nHeight - lnAlto, lcContents, HPDF_TALIGN_CENTER, 0) If .lUnderline Then &&Draw fake underline text This._Stat = HPDF_Page_TextRect(.oPage, nLeft, nTop, nLeft + nWidth, nTop - nHeight - lnAlto, lcUnderLineText, HPDF_TALIGN_CENTER, 0) EndIf EndCase nTop = nTop - lnLineHeight lnCurrLine = lnCurrLine + 1 IF (NOT lbStretch) AND (lnCurrLine > lnLinesAvail) EXIT ENDIF IF (EMPTY(lcRemainingText)) EXIT ENDIF ENDDO Else *!* Let's Draw the rotated text Local lnRad As Number lnRad = ((lnRotate * -1) / 180) * Pi() This._Stat = HPDF_Page_SetTextMatrix(.oPage, Cos(lnRad), Sin(lnRad), -Sin(lnRad), Cos(lnRad), nLeft, nTop) This._Stat2 = HPDF_Page_ShowText(.oPage, lcContents) EndIf This._Stat = HPDF_Page_EndText(.oPage) ENDWITH LOCAL llSuccess llSuccess = This._Stat2 = 0 RETURN llSuccess ENDPROC PROCEDURE processshapes LPARAMETERS lnFillRed As Integer,lnFillGreen As Integer,lnFillBlue As Integer,lnPenRed As Integer,lnPenGreen As Integer,; lnPenBlue As Integer,nLeft As Number,nTop As Number,nWidth As Number,nHeight As Number,lnOffset As Integer, ; lnPenSize As Integer, lnPenPat As Integer, lnFillPat As Integer, lcStyle As String, lnMode as Integer, lnObjectContinuationType as Integer, ; tlSkipBorder *!* Value Continuation Type *!* ------- -------------------------------------------------------------------------- *!* 0 Complete (no continuation). *!* 1 Start of layout element occurrence, will not finish on the current page. *!* 2 Mid-element, neither started nor finished on the current page. *!* 3 End of element, completed on the current page. IF TYPE("lnObjectContinuationType") <> "N" lnObjectContinuationType = 0 ENDIF LOCAL lcDash As String, nTop2 As Integer LOCAL lDecomposeRect as Boolean, lDoTopLine as Boolean, lDoLeftLine as Boolean, lDoRightLine as Boolean, ; lDoBottomLine as Boolean, Line_lnPenRed as Integer, Line_lnPenGreen as Integer, Line_lnPenBlue as Integer *!* 2010-08-25 - Jacques Parent - Let multiple band shape be printed correctly DO CASE * CASE lnOffSet <> 0 *!* Other than rectangle... *!* OK, we proceed! * lDecomposeRect = .F. CASE lnObjectContinuationType == 0 *!* No continuation *!* OK, we proceed! lDecomposeRect = .F. CASE lnObjectContinuationType == 1 *!* Top element *!* OK, we proceed! lDecomposeRect = .T. lDoTopLine = .T. lDoLeftLine = .T. lDoRightLine = .T. lDoBottomLine = .F. CASE lnObjectContinuationType == 2 *!* Mid element... lDecomposeRect = .T. lDoTopLine = .F. lDoLeftLine = .T. lDoRightLine = .T. lDoBottomLine = .F. CASE lnObjectContinuationType == 3 *!* Bottom element *!* OK, we proceed! lDecomposeRect = .T. lDoTopLine = .F. lDoLeftLine = .T. lDoRightLine = .T. lDoBottomLine = .T. ENDCASE With This *!* Code to handle the Dynamic Options added in SP2 IF !EMPTY(lcStyle) THEN &&Dynamic Properties are stored here as xml If .ProcessDynamics(lcStyle, "SHAPE") Then nHeight = Iif(PemStatus(.oDynamics, "nHeight",5), Iif(.oDynamics.nHeight!=-1, (.oDynamics.nHeight / 960) * 72, nHeight), nHeight) nWidth = Iif(PemStatus(.oDynamics, "nWidth",5), Iif(.oDynamics.nWidth!=-1, (.oDynamics.nWidth / 960) * 72, nWidth), nWidth) EndIf EndIf nTop2 = nTop nTop = .nPageHeight - nTop If lnFillRed = -1 lnFillRed = 255 lnFillGreen = 255 lnFillBlue = 255 ENDIF * IF lnMode = 0 OR lnFillPat > 0 && Opaque IF lnFillPat > 0 && Opaque => 2010-08-25 - Jacques Parent - Let transparent be transparent, not RGB(255,255,255) This._Stat = HPDF_Page_SetRGBFill(This.oPage, lnFillRed / 255, lnFillGreen / 255, lnFillBlue / 255) lnMode = 0 ELSE lnMode = 1 ENDIF IF lDecomposeRect *!* The rectangle that will be traced will have border same color as the filling! Line_lnPenRed = lnPenRed Line_lnPenGreen = lnPenGreen Line_lnPenBlue = lnPenBlue IF lnMode == 0 lnPenRed = lnFillRed lnPenGreen = lnFillGreen lnPenBlue = lnFillBlue ENDIF ELSE If lnPenRed = -1 IF lnPenPat = 0 lnPenRed = 255 lnPenGreen = 255 lnPenBlue = 255 ELSE lnPenRed = 0 lnPenGreen = 0 lnPenBlue = 0 ENDIF ENDIF ENDIF * From CChalom to JParent * Jacques, * Please check the lines below. I didn't apply any major change cause you did a big * refactoring in this method months ago. * A "hidden" error was happening if the value lnPenRed, lnPenGreen or lnPenBlue is -1 * I've included a basic checking, just skipping this line for now * Please revise this, the recommended is to change from -1 to 0 or 255, * depending on the situation. IF lnPenRed <> -1 && AND lnPenPat <> 0 && None This._Stat = HPDF_Page_SetRGBStroke(.oPage, lnPenRed / 255, lnPenGreen / 255, lnPenBlue / 255) ENDIF *!* * Check if we are done *!* IF tlSkipBorder ; && Called from ProcessFields *!* OR lnPenPat = 0 && Don't need to draw border *!* RETURN *!* ENDIF IF (lnPenSize >= 1) AND (lnPenPat > 0) AND (NOT tlSkipBorder) This._Stat = HPDF_Page_SetLineWidth(.oPage, lnPenSize) ELSE This._Stat = HPDF_Page_SetLineWidth(.oPage, 0) ENDIF DO CASE Case lnPenPat=8 &&Normal Mode This._Stat = HPDF_Page_SetDash(.oPage, Null, 0, 0) Case lnPenPat=1 &&Dotted lcDash=Chr(3) + Chr(0) + Chr(0) This._Stat = HPDF_Page_SetDash(.oPage, lcDash, 1, 1) Case lnPenPat=2 &&Dashed lcDash = Chr(18)+Chr(0)+Chr(6)+Chr(0)+Chr(0) This._Stat = HPDF_Page_SetDash(.oPage, lcDash, 2, 2) Case lnPenPat=3 &&Dash-dot lcDash = Chr(9)+Chr(0)+Chr(6)+Chr(0)+Chr(3)+Chr(0)+Chr(6)+Chr(0)+Chr(0) This._Stat = HPDF_Page_SetDash(.oPage, lcDash, 4, 0) Case lnPenPat=4 &&Dash-dot-dot lcDash = Chr(9)+Chr(0)+Chr(3)+Chr(0)+Chr(3)+Chr(0)+Chr(3)+Chr(0)+Chr(3)+Chr(0)+Chr(3)+Chr(0)+Chr(0) This._Stat = HPDF_Page_SetDash(.oPage, lcDash, 6, 0) ENDCASE IF NOT lDecomposeRect OR (lnMode==0 AND lDecomposeRect) && If mode == 1, then there is no reason to draw a rectangle! *!* Draw the rectangle Do Case Case lnOffSet=0 &&Normal Rectangle This._Stat = HPDF_Page_Rectangle(.oPage, nLeft, nTop - nHeight, nWidth, nHeight) Case Between(lnOffSet, 1, 98) &&Rounded Rectangle *!* Code to Draw Rounded Rectangle Courtesy of Dorin Vasilescu Local nRay As Number, nb As Number nRay = Round(Iif(nWidth > nHeight, Min(lnOffSet, Int(nHeight / 2)), Min(lnOffSet, Int(nWidth / 2))), 0) nB = .nPageHeight - (nTop2 + nHeight) This._Stat = HPDF_Page_MoveTo(.oPage, nLeft + nRay, nB) This._Stat = HPDF_Page_LineTo(.oPage, (nLeft + nWidth) - nRay, nB) This._Stat = HPDF_Page_CurveTo(.oPage, (nLeft + nWidth), nB, (nLeft + nWidth), nB, (nLeft + nWidth), nB + nRay) This._Stat = HPDF_Page_LineTo(.oPage, (nLeft + nWidth), nTop - nRay) This._Stat = HPDF_Page_CurveTo(.oPage, (nLeft + nWidth), nTop, (nLeft + nWidth), nTop, (nLeft + nWidth) - nRay, nTop) This._Stat = HPDF_Page_LineTo(.oPage, nLeft + nRay, nTop) This._Stat = HPDF_Page_CurveTo(.oPage, nLeft, nTop, nLeft, nTop, nLeft, nTop - nRay) This._Stat = HPDF_Page_LineTo(.oPage, nLeft , nB + nRay) This._Stat = HPDF_Page_CurveTo(.oPage, nLeft, nB , nLeft, nB, nLeft + nRay, nB) Case lnOffSet=99 &&Ellipsis This._Stat = HPDF_Page_Ellipse(.oPage, nLeft + (nWidth / 2), nTop - (nHeight / 2), nWidth / 2, nHeight / 2) EndCase *!* Refresh page * Mode: 0 = Opaque background; 1 = Transparent IF lnMode = 1 && Transparent This._Stat = HPDF_Page_Stroke(.oPage) ELSE && 0 = Opaque This._Stat = HPDF_Page_FillStroke(.oPage) ENDIF ENDIF IF lDecomposeRect AND Line_lnPenRed <> lnFillRed AND Line_lnPenGreen <> lnFillGreen AND Line_lnPenBlue <> lnFillBlue *!* Draw the necessary lines IF Between(lnOffSet, 1, 98) &&Rounded Rectangle *!* Local nRay As Number, nb As Number *!* nRay = Round(Iif(nWidth > nHeight, Min(lnOffSet, Int(nHeight / 2)), Min(lnOffSet, Int(nWidth / 2))), 0) *!* nB = .nPageHeight - (nTop2 + nHeight) *!* This._Stat = HPDF_Page_MoveTo(.oPage, nLeft + nRay, nB) *!* This._Stat = HPDF_Page_LineTo(.oPage, (nLeft + nWidth) - nRay, nB) *!* This._Stat = HPDF_Page_CurveTo(.oPage, (nLeft + nWidth), nB, (nLeft + nWidth), nB, (nLeft + nWidth), nB + nRay) *!* This._Stat = HPDF_Page_LineTo(.oPage, (nLeft + nWidth), nTop - nRay) *!* This._Stat = HPDF_Page_CurveTo(.oPage, (nLeft + nWidth), nTop, (nLeft + nWidth), nTop, (nLeft + nWidth) - nRay, nTop) *!* This._Stat = HPDF_Page_LineTo(.oPage, nLeft + nRay, nTop) *!* This._Stat = HPDF_Page_CurveTo(.oPage, nLeft, nTop, nLeft, nTop, nLeft, nTop - nRay) *!* This._Stat = HPDF_Page_LineTo(.oPage, nLeft , nB + nRay) *!* This._Stat = HPDF_Page_CurveTo(.oPage, nLeft, nB , nLeft, nB, nLeft + nRay, nB) IF lDoTopLine Local nRay As Number, nb As Number nRay = Round(Iif(nWidth > nHeight, Min(lnOffSet, Int(nHeight / 1)), Min(lnOffSet, Int(nWidth / 2))), 0) * 1 nB = .nPageHeight - (nTop2 + nHeight) This._Stat = HPDF_Page_MoveTo(.oPage, nLeft + nRay, nB) *** This._Stat = HPDF_Page_LineTo(.oPage, (nLeft + nWidth) - nRay, nB) * This._Stat = HPDF_Page_CurveTo(.oPage, (nLeft + nWidth), nB, (nLeft + nWidth), nB, (nLeft + nWidth), nB + nRay) && Inferior * This._Stat = HPDF_Page_LineTo(.oPage, (nLeft + nWidth), nTop - nRay) This._Stat = HPDF_Page_MoveTo(.oPage, (nLeft + nWidth), nTop - nRay) This._Stat = HPDF_Page_CurveTo(.oPage, (nLeft + nWidth), nTop, (nLeft + nWidth), nTop, (nLeft + nWidth) - nRay, nTop) * This._Stat = HPDF_Page_LineTo(.oPage, nLeft + nRay, nTop) This._Stat = HPDF_Page_MoveTo(.oPage, nLeft + nRay, nTop) This._Stat = HPDF_Page_CurveTo(.oPage, nLeft, nTop, nLeft, nTop, nLeft, nTop - nRay) * This._Stat = HPDF_Page_LineTo(.oPage, nLeft , nB + nRay) * This._Stat = HPDF_Page_CurveTo(.oPage, nLeft, nB , nLeft, nB, nLeft + nRay, nB) This.ProcessLines(Line_lnPenRed, Line_lnPenGreen, Line_lnPenBlue, nTop2, nLeft-0.5 + nRay, nWidth+0.5 - nRay - nRay,; 0, lnPenSize, 1, lnPenPat, lcStyle) ENDIF IF lDoBottomLine Local nRay As Number, nb As Number nRay = Round(Iif(nWidth > nHeight, Min(lnOffSet, Int(nHeight / 1)), Min(lnOffSet, Int(nWidth / 2))), 0) * 1 nB = .nPageHeight - (nTop2 + nHeight) This._Stat = HPDF_Page_MoveTo(.oPage, nLeft + nRay, nB) * This._Stat = HPDF_Page_LineTo(.oPage, (nLeft + nWidth) - nRay, nB) This._Stat = HPDF_Page_MoveTo(.oPage, (nLeft + nWidth) - nRay, nB) This._Stat = HPDF_Page_CurveTo(.oPage, (nLeft + nWidth), nB, (nLeft + nWidth), nB, (nLeft + nWidth), nB + nRay) && Inferior direito * This._Stat = HPDF_Page_LineTo(.oPage, (nLeft + nWidth), nTop - nRay) This._Stat = HPDF_Page_MoveTo(.oPage, (nLeft + nWidth), nTop - nRay) * This._Stat = HPDF_Page_CurveTo(.oPage, (nLeft + nWidth), nTop, (nLeft + nWidth), nTop, (nLeft + nWidth) - nRay, nTop) && Superior direito **** This._Stat = HPDF_Page_LineTo(.oPage, nLeft + nRay, nTop) * This._Stat = HPDF_Page_MoveTo(.oPage, nLeft + nRay, nTop) * This._Stat = HPDF_Page_CurveTo(.oPage, nLeft, nTop, nLeft, nTop, nLeft, nTop - nRay) * This._Stat = HPDF_Page_LineTo(.oPage, nLeft , nB + nRay) This._Stat = HPDF_Page_MoveTo(.oPage, nLeft , nB + nRay) This._Stat = HPDF_Page_CurveTo(.oPage, nLeft, nB , nLeft, nB, nLeft + nRay, nB) This.ProcessLines(Line_lnPenRed, Line_lnPenGreen, Line_lnPenBlue, nTop2 + nHeight, nLeft-0.5 + nRay, nWidth+0.5 -nRay -nRay,; 0, lnPenSize, 1, lnPenPat, lcStyle) ENDIF IF lDoLeftLine AND (lDoBottomLine = .F.) AND (lDoTopLine = .F.) && AND (lDoRightLine = .F.) This.ProcessLines(Line_lnPenRed, Line_lnPenGreen, Line_lnPenBlue, nTop2-0.5, nLeft, 0,; nHeight+0.5, lnPenSize, 0, lnPenPat, lcStyle) This.ProcessLines(Line_lnPenRed, Line_lnPenGreen, Line_lnPenBlue, nTop2-0.5, nLeft+nWidth, 0,; nHeight+0.5, lnPenSize, 0, lnPenPat, lcStyle) ENDIF *!* IF lDoRightLine AND (lDoBottomLine = .F.) AND (lDoTopLine = .F.) AND (lDoLeftLine = .F.) *!* This.ProcessLines(Line_lnPenRed, Line_lnPenGreen, Line_lnPenBlue, nTop2-0.5, nLeft+nWidth, 0,; *!* nHeight+0.5, lnPenSize, 0, lnPenPat, lcStyle) *!* ENDIF ELSE IF lDoTopLine This.ProcessLines(Line_lnPenRed, Line_lnPenGreen, Line_lnPenBlue, nTop2, nLeft-0.5, nWidth+0.5,; 0, lnPenSize, 1, lnPenPat, lcStyle) ENDIF IF lDoLeftLine This.ProcessLines(Line_lnPenRed, Line_lnPenGreen, Line_lnPenBlue, nTop2-0.5, nLeft, 0,; nHeight+0.5, lnPenSize, 0, lnPenPat, lcStyle) ENDIF IF lDoRightLine This.ProcessLines(Line_lnPenRed, Line_lnPenGreen, Line_lnPenBlue, nTop2-0.5, nLeft+nWidth, 0,; nHeight+0.5, lnPenSize, 0, lnPenPat, lcStyle) ENDIF IF lDoBottomLine This.ProcessLines(Line_lnPenRed, Line_lnPenGreen, Line_lnPenBlue, nTop2 + nHeight, nLeft-0.5, nWidth+0.5,; 0, lnPenSize, 1, lnPenPat, lcStyle) ENDIF ENDIF ENDIF ENDWITH ENDPROC PROCEDURE processlabel Lparameters lcFontFace As String, liFontStyle As Integer, lnFontSize As Number, lnPenRed As Number, lnPenGreen As Number,; lnPenBlue As Number, lnFillRed As Number, lnFillGreen As Number, lnFillBlue As Number, nLeft As Number, nTop As Number,; lcContents As String, lcFillChar As String, lnOffset As Integer, nWidth As Integer, lnCodePage As Integer, nHeight As Number,; lcPicture As String, lcStyle As String, lnMode as Integer Local lnAlto As Number, lnTxtWidth As String, lnFontHandle As Integer, lcUnderLineText As String, lnRotate As Integer, lnCharWidth As Integer lnRotate = 0 With This If !Empty(lcStyle) Then &&Dynamic Properties are stored here as xml If .ProcessDynamics(lcStyle, "LABEL") Then lnRotate = Iif(PemStatus(.oDynamics, "nRotationDegree", 5),. oDynamics.nRotationDegree, 0) EndIf EndIf If lnPenRed=-1 And lnPenBlue=-1 And lnPenGreen=-1 Then &&Replace the Default forecolor of VFP with Black Store 0 To lnPenBlue, lnPenRed, lnPenGreen EndIf If lnFillRed=-1 And lnFillBlue=-1 And lnFillGreen=-1 Then &&Default Colors of VFP Report Designer Store 255 To lnFillRed, lnFillBlue, lnFillGreen EndIf * Draw the field background IF lnMode = 0 && Mode: 0 = Opaque background; 1 = Transparent lnPenSize = 0 lnPenPat = 0 lnFillPat = 1 lcStyle = "" This.ProcessShapes(lnFillRed, lnFillGreen, lnFillBlue, ; lnFillRed, lnFillGreen, lnFillBlue, ; nLeft, nTop, nWidth + 5, nHeight, lnOffset, ; lnPenSize, lnPenPat, lnFillPat, lcStyle, lnMode) ENDIF nTop = .nPageHeight - nTop &&Change the Top Coordinates Because of the PDF Coordinate System * Get the font Handle * If no font is retrieved, then draw the string as an image lnFontHandle = This.Getfonthandle(lcFontFace, liFontStyle) IF lnFontHandle = 0 LOCAL lcImage, lnTxtW, lnTxtH lnTxtW = nWidth lnTxtH = nHeight lcImage = This.StringToPic(lcContents, lcFontFace, lnFontSize, ; IIF(lnPenRed = -1, 0, lnPenRed), ; IIF(lnPenGreen = -1, 0, lnPenGreen), ; IIF(lnPenBlue = -1, 0, lnPenBlue), ; 0, @lnTxtW, @lnTxtH) This.ProcessPictures2(lcImage, nLeft, nTop, lnTxtW, lnTxtH) RETURN ENDIF * lnFontHandle = HPDF_GetFont(.pdfHandle, .SearchFont(lcFontFace, liFontStyle), Iif(Empty(.cCodePage), NULL, .cCodePage)) &&Find and select the font lnCharWidth = FontMetric(6, lcFontFace, lnFontSize, .cTextStyle) This._Stat = HPDF_Page_BeginText(.oPage) &&Start text proccesing mode This._Stat = HPDF_Page_SetFontAndSize(.oPage, lnFontHandle, lnFontSize) lnTxtWidth = HPDF_Page_TextWidth(.oPage, lcContents) &&Get the size of the text width * lnAlto = HPDF_Page_GetCurrentFontSize(.oPage) lnAlto = FontMetric(1, lcFontFace, lnFontSize, .cTextStyle) This._Stat = HPDF_Page_SetRGBStroke(.oPage, lnFillRed / 255, lnFillGreen / 255, lnFillBlue / 255) &&Set Forecolor of the text This._Stat = HPDF_Page_SetRGBFill(.oPage, lnPenRed / 255, lnPenGreen / 255, lnPenBlue / 255) &&Set Forecolor of the text If Bittest(liFontStyle, 2) Then lcUnderLineText=Replicate("_", Round(lnTxtWidth/HPDF_Page_TextWidth(.oPage, "_"), 0)) .lUnderline= .T. Else .lUnderline= .F. EndIf If lnRotate=0 Then LOCAL lcOrigContents lcOrigContents = lcContents LOCAL lnParag, lnParHeight, n, lcPar, lnParTop, lnAlignMode, lnParWidth lnParTop = 0 lnParag = GETWORDCOUNT(lcContents, CHR(10)) DO CASE CASE EMPTY(lcPicture) && Left aligned lnAlignMode = HPDF_TALIGN_LEFT CASE lcPicture = '"@I"' && Center aligned lnAlignMode = HPDF_TALIGN_CENTER OTHERWISE && Right aligned lnAlignMode = HPDF_TALIGN_RIGHT ENDCASE FOR m.n = 1 TO lnParag lcPar = GETWORDNUM(lcOrigContents, m.n, CHR(10)) IF .lUnderline lnParWidth = HPDF_Page_TextWidth(.oPage, lcPar) && Get the size of the text width lcUnderLineText = Replicate("_", Round(lnParWidth/HPDF_Page_TextWidth(.oPage, "_"), 0) + 0.3) ENDIF * Because in labels we don't have a width limit, * here we multiply by 1000 the width, to make sure the text for that line * will fit lnParHeight = This.GetParHeight(lcPar, lcFontFace, lnFontSize, liFontStyle, nLeft, nTop, nWidth * 1000, nHeight) DO CASE CASE lnAlignMode = HPDF_TALIGN_CENTER This._Stat = HPDF_Page_TextRect(.oPage, nLeft - 20, nTop - lnParTop, nLeft + nWidth + 20, nTop - nHeight - lnAlto, lcPar, lnAlignMode,0) If .lUnderline Then This._Stat = HPDF_Page_TextRect(.oPage, nLeft - 20, nTop - lnParTop, nLeft + nWidth + 20, nTop - nHeight - lnAlto, lcUnderLineText, lnAlignMode, 0) EndIf CASE lnAlignMode = HPDF_TALIGN_RIGHT This._Stat = HPDF_Page_TextRect(.oPage, nLeft - 20, nTop - lnParTop, nLeft + nWidth, nTop - nHeight - lnAlto, lcPar, lnAlignMode,0) If .lUnderline Then This._Stat = HPDF_Page_TextRect(.oPage, nLeft - 20, nTop - lnParTop, nLeft + nWidth, nTop - nHeight - lnAlto, lcUnderLineText, lnAlignMode, 0) EndIf OTHERWISE This._Stat = HPDF_Page_TextRect(.oPage, nLeft, nTop - lnParTop, nLeft + lnTxtWidth + lnCharWidth, nTop - nHeight - lnAlto, lcPar, lnAlignMode,0) If .lUnderline Then This._Stat = HPDF_Page_TextRect(.oPage, nLeft, nTop - lnParTop, nLeft + lnTxtWidth + lnCharWidth, nTop - nHeight - lnAlto, lcUnderLineText, lnAlignMode, 0) EndIf ENDCASE lnParTop = lnParTop + lnParHeight ENDFOR Else *!* Let's Draw the rotated text Local lnRad As Number lnRad = ((lnRotate * -1) / 180) * Pi() This._Stat = HPDF_Page_SetTextMatrix (.oPage, Cos(lnRad), Sin(lnRad), -Sin(lnRad), Cos(lnRad), nLeft, nTop) This._Stat = HPDF_Page_ShowText (.oPage, lcContents) EndIf This._Stat = HPDF_Page_EndText(.oPage) ENDWITH ENDPROC PROCEDURE processpictures Lparameters nTop As Number,nLeft As Number,nWidth As Number,nHeight As Number,lcContents As String,; GDIPlusImage As Number, lnOffset As Integer, liPictureMode As Integer, lcStyle As String #Define PICTURE_SOURCE_FILENAME 0 && stored in PICTURE column #Define PICTURE_SOURCE_GENERAL 1 && stored in NAME column #Define PICTURE_SOURCE_EXPRESSION 2 && stored in NAME column IF EMPTY(GDIPlusImage) AND EMPTY(lcContents) && Nothing to render && try drawing directly, from the original canvas RETURN .F. ENDIF Local lcFile As String, lcFile2 As String, lnHandle As Integer nTop = This.nPageHeight - nTop lnHandle = 0 Local lnPicWidth, lnPicHeight Store 0 TO lnPicWidth, lnPicHeight * liPictureMode = MAX(liPictureMode, 1) If GDIPlusImage != 0 Then &&General Field or Expresion * CChalom 2010-01-17 * Removed the dependance of having "System.App" from GdiPlusX * Now using _Gdiplus.vcx that is already embedded in ReportOutput.App *!* Original code *!* Do System.App &&Initialize GDIPLUSX library *!* Local loImage As xfcBitmap *!* With _Screen.System.Drawing *!* loImage = .Bitmap.New() *!* loImage.Handle = GDIPlusImage *!* lcFile = This._cTempFolder + Sys(2015) + ".Png" *!* loImage.Save(lcFile, .Imaging.Imageformat.Png) *!* EndWith lcFile = This.GetTempFile("Png") Local loImage As GpImage Of (ADDBS(HOME()) + "FFC\_GdiPlus.vcx") loImage = NEWOBJECT("GpImage", "_GdiPlus.vcx") loImage.SetHandle(GDIPlusImage) lnPicWidth = loImage.ImageWidth lnPicHeight = loImage.ImageHeight loImage.SaveToFile(lcFile,"image/png") loImage = NULL *--- lnHandle = HPDF_LoadPngImageFromFile(This.pdfHandle, lcFile) Else &&File Name *!* 10/03/2010 Change to reuse image handles IF FILE(lcContents) AND (liPictureMode <> 0) THEN && If using 'CLIP' && We wont store the image handle * lcFile = lcContents lcFile = This.GetTempFile(JustExt(lcContents)) * lcFile = This._cTempFolder + Sys(2015) + "." + JustExt(lcContents) ** lnHandle = This.GetPictureHandle(lcContents, lcFile, @lnPicWidth, @lnPicHeight) *!* 2010-08-25 - Jacques Parent *!* Add @ to lcFile parameters so the new lcFile can be updated by the GetPictureHandle method *!* The lcFile will then be added to oTempImagesCollection and will be cleaned up later. lnHandle = This.GetPictureHandle(lcContents, @lcFile, @lnPicWidth, @lnPicHeight) ENDIF IF FILE(lcContents) AND (liPictureMode = 0) THEN && If using 'CLIP' lcFile = lcContents ENDIF ENDIF IF (!ISNULL(lnHandle) And lnHandle > 0) ; && Valid Image Handle OR (liPictureMode = 0) &&Clip DO CASE CASE liPictureMode = 0 AND (NOT EMPTY(lcFile)) && 0 &&Clip lnHandle = This.CropImage(lcFile, 0, 0, @nWidth, @nHeight) *!* IF lcFile = lcContents *!* lcFile = "" *!* ENDIF IF lnHandle > 0 This._Stat = HPDF_Page_DrawImage(This.oPage, lnHandle, nLeft, nTop - nHeight, nWidth, nHeight) ELSE RETURN .F. ENDIF Case liPictureMode = 1 &&Scale Keeping the Shape * CChalom * Calculating the image size for isometric images If lnPicWidth = 0 Local loVFPImg as Image loVFPImg = CreateObject("Image") *!* loVFPImg.Picture = lcFile loVFPImg.Picture = lcContents && 2010-09-17 - Jacques Parent - If lnPicWidth = 0, then the lcFile does not point to the actual temporary file. Take then the original one. lnPicWidth = loVFPImg.Width lnPicHeight = loVFPImg.Height loVFPImg = NULL EndIf lnPicWidth = (lnPicWidth / 960) * 72 lnPicHeight = (lnPicHeight / 960) * 72 * Isometric Adjustment Local lnHorFactor, lnVertFactor, lnResizeFactor, lnIsoWidth, lnIsoHeight m.lnHorFactor = m.nWidth / m.lnPicWidth m.lnVertFactor = m.nHeight / m.lnPicHeight m.lnResizeFactor = MIN(m.lnHorFactor, m.lnVertFactor) m.lnIsoWidth = m.lnPicWidth * m.lnResizeFactor m.lnIsoHeight = m.lnPicHeight * m.lnResizeFactor This._Stat = HPDF_Page_DrawImage(This.oPage, lnHandle, nLeft, nTop - lnIsoHeight, lnIsoWidth, lnIsoHeight) * --- Otherwise &&Stretch IF lnHandle <= 0 RETURN .F. ENDIF This._Stat = HPDF_Page_DrawImage(This.oPage, lnHandle, nLeft, nTop - nHeight, nWidth, nHeight) ENDCASE ELSE RETURN .F. && did not succeed to load the image, so try from the report canvas EndIf *!* 10/03/2010 Luis Navas *!* Changed the name of this property from oImagesCollection to oTempImagesCollection to avoid confusion of users If Vartype(This.oTempImagesCollection) != "O" Then This.oTempImagesCollection= CreateObject("Collection") EndIf This.oTempImagesCollection.Add(lcFile) ENDPROC PROCEDURE processlines Lparameters lnPenRed As Integer,lnPenGreen As Integer,lnPenBlue As Integer,nTop As Number,nLeft As Number,nWidth As Number,; nHeight As Number, lnPenSize As Integer, lnOffSet As Number, lnPenPat As Integer, lcStyle As String Local lcDash As String With This If lnPenRed!=-1 And lnPenGreen!=-1 And lnPenBlue!=-1 Then This._Stat = HPDF_Page_SetRGBStroke(.oPage, lnPenRed / 255, lnPenGreen / 255, lnPenBlue / 255) Else This._Stat = HPDF_Page_SetRGBStroke(.oPage, 0, 0, 0) EndIf nTop = .nPageHeight - nTop Do Case Case lnPenPat=8 &&Normal Mode This._Stat = HPDF_Page_SetDash(.oPage, Null, 0, 0) Case lnPenPat=1 &&Dotted lcDash=Chr(3) + Chr(0) + Chr(0) This._Stat = HPDF_Page_SetDash(.oPage, lcDash, 1, 1) Case lnPenPat=2 &&Dashed lcDash = Chr(18)+Chr(0)+Chr(6)+Chr(0)+Chr(0) This._Stat = HPDF_Page_SetDash(.oPage, lcDash, 2, 2) Case lnPenPat=3 &&Dash-dot lcDash = Chr(9)+Chr(0)+Chr(6)+Chr(0)+Chr(3)+Chr(0)+Chr(6)+Chr(0)+Chr(0) This._Stat = HPDF_Page_SetDash(.oPage, lcDash, 4, 0) Case lnPenPat=4 &&Dash-dot-dot lcDash = Chr(9)+Chr(0)+Chr(3)+Chr(0)+Chr(3)+Chr(0)+Chr(3)+Chr(0)+Chr(3)+Chr(0)+Chr(3)+Chr(0)+Chr(0) This._Stat = HPDF_Page_SetDash(.oPage, lcDash, 6, 0) EndCase If lnOffSet=1 Then &&Horizontal Line If lnPenSize>=1 Then This._Stat = HPDF_Page_SetLineWidth(.oPage, lnPenSize) Else This._Stat = HPDF_Page_SetLineWidth(.oPage, 0) EndIf This._Stat = HPDF_Page_MoveTo(.oPage, nLeft, nTop) &&Move to the screen position This._Stat = HPDF_Page_LineTo(.oPage, nLeft + nWidth, nTop) Else &&Vertical Line If lnPenSize>=1 Then This._Stat = HPDF_Page_SetLineWidth(.oPage, lnPenSize) Else This._Stat = HPDF_Page_SetLineWidth(.oPage, 0) EndIf This._Stat = HPDF_Page_MoveTo(.oPage, nLeft, nTop - nHeight) This._Stat = HPDF_Page_LineTo(.oPage, nLeft, nTop ) EndIf This._Stat = HPDF_Page_Stroke(.oPage) EndWith ENDPROC PROCEDURE getpicturehandle LPARAMETERS lcInternalName As String, lcExternalName As String, lnPicWidth As Integer, lnPicHeight As Integer LOCAL lcFileStream As String, lnHandle As Integer, lcExtension As String IF VARTYPE(This.oPictureHandles) != "O" Then This.oPictureHandles = CreateObject("Collection") ENDIF lnHandle = This.oPictureHandles.GetKey(lcInternalName) If lnHandle = 0 Then lcFileStream = FILETOSTR(lcInternalName) TRY STRTOFILE(lcFileStream, lcExternalName, 0) CATCH TO loExc * SET STEP ON ENDTRY lcExtension = Upper(JustExt(lcExternalName)) Do Case *!* 2011-04-22 - Fabio Vieira *!* lnHandle = HPDF_LoadJpegImageFromFile(This.pdfHandle, m.lcExternalName) Case lcExtension = "PNG" *!* 2010-09-27 - Jacques Parent - Checking for transparency Local loBmpTmp as GpBitmap loBmpTmp = NewObject("GpBitmap", "_GdiPlus.vcx") loBmpTmp.CreateFromFile(lcExternalName) lnPicWidth = loBmpTmp.ImageWidth lnPicHeight = loBmpTmp.ImageHeight IF This.IsPixelALPHA(loBmpTmp.GetPixel(0 , 0 )); OR This.IsPixelALPHA(loBmpTmp.GetPixel(0 , lnPicHeight - 1)); OR This.IsPixelALPHA(loBmpTmp.GetPixel(lnPicWidth - 1, 0 )); OR This.IsPixelALPHA(loBmpTmp.GetPixel(lnPicWidth - 1, lnPicHeight - 1)) *!* Then, we will convert the file as if it were a GIF *!* This will let the transparency to be converted with a white background. *!* To do this, simply do not call the HPDF_LoadPngImageFromFile function. ELSE *!* Treat as normal PNG lnHandle = HPDF_LoadPngImageFromFile(This.pdfHandle, lcExternalName) ENDIF loBmpTmp = NULL *!* Original code *!* lnHandle = HPDF_LoadPngImageFromFile(This.pdfHandle, lcExternalName) Otherwise EndCase IF lnHandle = 0 * CChalom * This is being done outside the DOCASE statement because sometimes HARU may fail loading the image * So, here we give it another chance to load the image, this time using a converted image by GdiPlus * Clear the existing HPDF errors * As the image could not be loaded, we probably have an error, that needs to be cleared * Here we can see if an error occurred during the rendering process of the * current field This.ClearPDFErrors() * Not Supported Format, will never happen when is a general field * Convert all images to PNG, that is a safer image type for HPDF Local loBmp2 as GpBitmap, lcFile as String, lcFile2 As String lcFile = lcExternalName lcFile2 = This.GetTempFile("PNG") * lcFile2 = This._cTempFolder + "FP_Tmp_" + Sys(2015) + ".PNG" loBmp2 = NewObject("GpBitmap", "_GdiPlus.vcx") loBmp2.CreateFromFile(lcFile) lnPicWidth = loBmp2.ImageWidth lnPicHeight = loBmp2.ImageHeight * Check if we have an invalid size IF lnPicWidth = 0 OR lnPicHeight = 0 RETURN 0 ENDIF LOCAL loBmp3 as GpBitmap OF HOME() + "\ffc\_Gdiplus.vcx" loBmp3 = NewObject("GpBitmap", "_GdiPlus.vcx") &&, "", lnPicWidth, lnPicHeight) loBmp3.Create(lnPicWidth, lnPicHeight) loBmp3.SetResolution(loBmp2.HorizontalResolution, loBmp2.VerticalResolution) && Jacques Parent - 2010-12-01 - Set original resolution of the file LOCAL loGfx as GpGraphics OF HOME() + "\ffc\_Gdiplus.vcx" loGfx = NewObject("GpGraphics", "_GdiPlus.vcx") loGfx.CreateFromImage(loBmp3) loGfx.Clear(0xFFFFFFFF) loGfx.DrawImageAt(loBmp2, 0, 0) loBmp3.SaveToFile(lcFile2, "image/png") loBmp2 = Null loBmp3 = NULL IF This.IsTempFile(lcFile) DELETE FILE (lcFile) ENDIF lcFile = lcFile2 * Try loading the image lnHandle = HPDF_LoadPngImageFromFile(This.pdfHandle, lcFile) *!* 2010-08-25 - Jacques Parent - Update the image filename lcExternalName = lcFile ENDIF This.oPictureHandles.Add(lnHandle, lcInternalName) lnHandle = This.oPictureHandles.Item(lnHandle) EndIf Return lnHandle ENDPROC PROCEDURE ispixelalpha LPARAMETERS tnARGB IF ISNULL(tnARGB) tnARGB = 0xFF000000 && OPAQUE BLACK ENDIF LOCAL tlAlphaIsUsed tlAlphaIsUsed = .T. *!* Alpha = BITAND(BITRSHIFT(tnARGB, 24), 0xFF) *!* Red = BITAND(BITRSHIFT(tnARGB, 16), 0xFF) *!* Green = BITAND(BITRSHIFT(tnARGB, 8), 0xFF) *!* Blue = BITAND(BITRSHIFT(tnARGB, 0), 0xFF) *!* tlAlphaIsUsed = (BITAND(tnARGB, 0xFF000000) / 16^6) < 255 tlAlphaIsUsed = BITAND(BITRSHIFT(tnARGB, 24), 0xFF) < 255 RETURN tlAlphaIsUsed ENDPROC PROCEDURE outputfromdata LPARAMETERS toListener as ReportListener, tcOutputDBF, tnWidth, tnHeight * lnSecs = SECONDS() IF VARTYPE(toListener) <> "O" MESSAGEBOX("Invalid parameter. Report listener not available", 16, "Error") RETURN ENDIF This.oActiveListener = toListener * =DoFoxyTherm(90, "Texto label", "Titulo") * =DoFoxyTherm(-1, "Teste2", "Titulo") && Continuo * =DoFoxyTherm() && Desliga IF NOT This.QuietMode LOCAL lnSecs lnSecs = SECONDS() *!* ._InitStatusText = .GetLoc("INITSTATUS") + SPACE(1) *!* ._RunStatusText = .GetLoc("RUNSTATUS") + SPACE(1) *!* ._SecondsText = .GetLoc("SECONDS") + SPACE(1) =DoFoxyTherm(1, "0%", _goHelper._InitStatusText) ENDIF * Ensure we are at the correct DataSession * SET DATASESSION TO (toListener.CurrentDataSession) SET DATASESSION TO (toListener.ListenerDataSession) * toListener.SetCurrentDataSession() LOCAL lnSelect,llExit lnSelect = SELECT() llExit = .F. SELECT (tcOutputDBF) * Generate PDF using the stored information This.lDefaultMode = .F. This.nPageWidth = (tnWidth / 960) * 72 This.nPageHeight = (tnHeight / 960) * 72 LOCAL lnPgFrom, lnPgTo lnPgFrom = _goHelper._ClausenRangeFrom && = loListener.COMMANDCLAUSES.RangeFrom lnPgTo = IIF(_goHelper._ClausenRangeTo = -1, 999999, _goHelper._ClausenRangeTo) && = loListener.COMMANDCLAUSES.RangeTo && -1 = All pages * Prepare Watermark IF toListener.lUsingWaterMark LOCAL lnX, lnY, lnW, lnH, lcTempFile, lcType LOCAL loBmp as GpImage OF HOME() + "\FFC\_Gdiplus.vcx" lcType = LOWER(JUSTEXT(toListener.cWatermarkImage)) DO CASE CASE INLIST(lcType, "jpg", "jpeg", "tif", "tiff") lcType = "jpeg" OTHERWISE lcType = "png" ENDCASE lcTempFile = ADDBS(GETENV("TEMP")) + "Temp_WM_" + SYS(2015) + "." + lcType IF VARTYPE(toListener.oWaterMarkBmp) = "O" toListener.oWaterMarkBmp.SaveToFile(lcTempFile, "image/" + lcType) This._cWMpicture = lcTempFile ENDIF LOCAL lnX, lnY, lnWidth, lnHeight lnX = (1 - toListener.nWatermarkWidthRatio) / 2 lnY = (1 - toListener.nWatermarkHeightRatio) / 2 lnWidth = toListener.nWatermarkWidthRatio lnHeight = toListener.nWatermarkHeightRatio This._nWMx = lnx * This.nPageWidth This._nWMy = lnY * This.nPageHeight This._nWMw = This.nPageWidth * lnWidth This._nWMh = This.nPageHeight * lnHeight ENDIF * Initialize class This.BeforeReport() IF This.QuietMode SCAN IF BETWEEN(Page, lnPgFrom, lnPgTo) IF NOT This.Render(FRXRECNO, Left, Top, Width, Height, ContType, UNContents, 0) llExit = .T. EXIT ENDIF ENDIF ENDSCAN ELSE LOCAL lnPercent, lnLastPercent, lnDelay, lnTotRecs, lnRec lnLastPercent = 0 lnDelay = 1 lnTotRecs = RECCOUNT() lnRec = 0 SCAN IF BETWEEN(Page, lnPgFrom, lnPgTo) lnRec = lnRec + 1 lnPercent = CEILING(100*lnRec/lnTotRecs) IF (lnLastPercent > 0 AND ; lnPercent - lnLastPercent < lnDelay AND ; lnPercent <> 100) ELSE =DoFoxyTherm(lnPercent, ; ALLTRIM(TRANSFORM(lnPercent)) + "% - " + TRANSFORM(FLOOR(SECONDS() - lnSecs)) + " " + _goHelper._SecondsText , ; _goHelper._RunStatusText) ENDIF IF NOT This.Render(FRXRECNO, Left, Top, Width, Height, ContType, UNContents, 0) llExit = .T. EXIT ENDIF ENDIF ENDSCAN =DoFoxyTherm(100, ; "100% - " + TRANSFORM(CEILING(SECONDS() - lnSecs)) + " " + _goHelper._SecondsText , ; _goHelper._RunStatusText) ENDIF IF NOT llExit * Finalize This.AfterReport() This.UnloadReport() ENDIF USE IN SELECT (tcOutputDBF) SELECT (lnSelect) * MESSAGEBOX("Elapsed " + TRANSFORM(SECONDS() - lnSecs) + " secs.") * Delete temp watermark image IF toListener.lUsingWaterMark AND FILE(lcTempFile) TRY DELETE FILE (lcTempFile) CATCH ENDTRY ENDIF IF NOT This.QuietMode =DoFoxyTherm() ENDIF RETURN ENDPROC PROCEDURE getparheight LPARAMETERS tcText, tcFontName, tnSize, tcStyle, tnLeft, tnTop, tnWidth, tnHeight LOCAL lnX0, lnY0, lnW0, lnH0, lnFactor lnX0 = tnLeft * 960 / 72 lnY0 = tnTop * 960 / 72 lnW0 = tnWidth * 960 / 72 lnH0 = tnHeight * 960 / 72 LOCAL loFont, lnChars, lnLines, lnHeight, lnWidth LOCAL loRect as GpRectangle OF HOME() + "\ffc\_Gdiplus.vcx" loRect = NEWOBJECT("GPRectangle", "_Gdiplus.vcx", "", lnX0, lnY0, lnW0, lnH0) * Create a font object using the text object's settings. loFont = NEWOBJECT("GPFont", "_Gdiplus.vcx") loFont.Create(tcFontName, tnSize, tcStyle, 3) LOCAL loGfx as GpGraphics OF HOME() + "\ffc\_Gdiplus.vcx" loGfx = NEWOBJECT("GpGraphics", "_Gdiplus.vcx") IF This.lDefaultMode lnFactor = 1 loGfx.SetHandle(IIF(This.IsSuccessor, ; This.SharedGDIPlusGraphics, This.GDIPlusGraphics)) ELSE lnFactor = 10 loGfx.CreateFromHWND(_Screen.HWnd) loGfx.PageUnit = 1 loGfx.PageScale = 0.3 loRect.w = lnW0 / lnFactor loRect.h = lnH0 / lnFactor ENDIF LOCAL loSize as GpSize OF HOME() + "\ffc\_Gdiplus.vcx" loSize = loGfx.MeasureStringA(tcText, loFont, loRect.GdipRectF, .F., @lnChars, @lnLines) lnWidth = loSize.w lnHeight = loSize.h * loGfx.SetHandle(0) RETURN (lnHeight / 960) * 72 * lnFactor ENDPROC PROCEDURE stringtopic * CChalom 2010-12-18 * Converts the string to image LPARAMETERS tcString, tcFont, tnSize, tnR, tnG, tnB, tnAlign, tnW, tnH #define GDIPLUS_Unit_Point 3 #define GDIPLUS_FontStyle_Regular 0 LOCAL lnW0, lnH0, lnFactor lnW0 = tnW * 960 / 72 lnH0 = tnH * 960 / 72 lnFactor = 10 LOCAL loRect as GpRectangle OF HOME() + "\ffc\_Gdiplus.vcx" loRect = NEWOBJECT("GPRectangle") loRect.w = lnW0 / lnFactor loRect.h = lnH0 / lnFactor LOCAL loGfx0 as GpGraphics OF HOME(1) + "ffc\_gdiplus.vcx" loGfx0 = NEWOBJECT("gpGraphics", "_gdiplus.vcx") loGfx0.CreateFromHWND(_Screen.HWnd) loGfx0.PageUnit = 1 loGfx0.PageScale = 0.3 LOCAL loFont as GpFont OF HOME(1) + "ffc\_gdiplus.vcx" loFont = NEWOBJECT("gpFont", "_gdiplus.vcx") loFont.Create(tcFont, tnSize, GDIPLUS_FontStyle_Regular, GDIPLUS_Unit_Point) LOCAL loStrFmt as GpStringFormat OF HOME(1) + "ffc\_gdiplus.vcx" loStrFmt = NEWOBJECT("gpStringFormat", "_gdiplus.vcx") loStrFmt.Create() LOCAL loColor as GpColor OF HOME(1) + "ffc\_gdiplus.vcx" loColor = NEWOBJECT("gpColor", "_gdiplus.vcx", "", tnR, tnG, tnB) LOCAL loBrush as GpSolidBrush OF HOME(1) + "ffc\_gdiplus.vcx" loBrush = NEWOBJECT("gpSolidBrush", "_gdiplus.vcx") loBrush.Create(loColor) LOCAL loSize as GpSize OF HOME(1) + "ffc\_gdiplus.vcx" loSize = loGfx0.MeasureStringA(tcString, loFont, loRect.GdipRectF) tnW = loSize.W tnH = loSize.H IF EMPTY(tnH) OR EMPTY(tnW) RETURN "" ENDIF LOCAL loBmp as GpBitmap OF HOME(1) + "ffc\_gdiplus.vcx" loBmp = NEWOBJECT("gpBitmap", "_gdiplus.vcx", "", tnW, tnH) * loBmp.SetResolution(loBmp2.HorizontalResolution, loBmp2.VerticalResolution) LOCAL loGfx as GpGraphics OF HOME(1) + "ffc\_gdiplus.vcx" loGfx = NEWOBJECT("gpGraphics", "_gdiplus.vcx") loGfx.CreateFromImage(loBmp) loGfx.PageUnit = 1 loGfx.PageScale = 0.3 loGfx.Clear(0xFFFFFFFF) loGfx.DrawStringA(tcString, loFont, 0h0000000000000000, loStrFmt, loBrush) lcTempFile = This.GetTempFile("png") * lcTempFile = This._cTempFolder + SYS(2015) + ".png" loBmp.SaveToFile(lcTempFile, "image/png") loBmp = NULL RETURN lcTempFile *!* lcCommand = "RUN /N6 Explorer.Exe " + lcTempFile *!* &lcCommand. ENDPROC PROCEDURE processpictures2 * CChalom 2010-12-18 * Draws the image of the string in the PDF document LPARAMETERS tcFile, tnLeft, tnTop, tnWidth, tnHeight *tnWidth = (tnWidth / 960) * 72 *tnHeight = (tnHeight / 960) * 72 tnWidth = tnWidth * .75 tnHeight = tnHeight &&* .75 LOCAL lnHandle lnHandle = HPDF_LoadPngImageFromFile(This.pdfHandle, tcFile) This._Stat = HPDF_Page_DrawImage(This.oPage, lnHandle, tnLeft, tnTop - tnHeight, tnWidth, tnHeight) IF This.IsTempFile(lcFile) DELETE FILE (lcFile) ENDIF CATCH ENDTRY ENDPROC PROCEDURE _stat_assign LPARAMETERS tnStatus This._Stat = tnStatus IF tnStatus != 0 * Clear existing the HPDF errors * Here we can see if an error occurred during the rendering process of the * current field LOCAL lnHPDF_err, lcHex lnHPDF_err = HPDF_GetError(This.pdfHandle) IF lnHPDF_err <> 0 lcHex = TRANSFORM(lnHPDF_err, "@0") * SET STEP ON HPDF_ResetError(This.pdfHandle) ENDIF IF This.lShowErrors = .T. IF _VFP.StartMode = 0 && Development LOCAL lnOption lnOption = MESSAGEBOX("PDFx error in " + PROGRAM(PROGRAM(-1) - 1) + CHR(13); + "Error code : " + TRANSFORM(tnStatus) + CHR(13) ; + "Description: " + This._ErrorInfo(tnStatus) + CHR(13) ; + "Page: " + TRANSFORM(This.nCurrentPage) + CHR(13) ; + "Object: " + This.cObjectToRender + CHR(13) + CHR(13) ; + "Press 'Retry' to debug the application.", 16 + 2, "Error") IF lnOption = 3 CANCEL ENDIF IF lnOption = 4 SUSPEND ENDIF ELSE MESSAGEBOX("PDFx error in " + PROGRAM(PROGRAM(-1) - 1) + CHR(13); + "Error code : " + TRANSFORM(tnStatus) + CHR(13) ; + "Description : " + This._ErrorInfo(tnStatus) + CHR(13) ; + "Object: " + This.cObjectToRender, 16, "Error") ENDIF ENDIF ENDIF ENDPROC PROCEDURE _errorinfo LPARAMETERS tnStatus DO CASE CASE tnStatus = 0x1001 RETURN "HPDF_ARRAY_COUNT_ERR " && 0x1001 CASE tnStatus = 0x1002 RETURN "HPDF_ARRAY_ITEM_NOT_FOUND " && 0x1002 CASE tnStatus = 0x1003 RETURN "HPDF_ARRAY_ITEM_UNEXPECTED_TYPE " && 0x1003 CASE tnStatus = 0x1004 RETURN "HPDF_BINARY_LENGTH_ERR " && 0x1004 CASE tnStatus = 0x1005 RETURN "HPDF_CANNOT_GET_PALLET " && 0x1005 CASE tnStatus = 0x1007 RETURN "HPDF_DICT_COUNT_ERR " && 0x1007 CASE tnStatus = 0x1008 RETURN "HPDF_DICT_ITEM_NOT_FOUND " && 0x1008 CASE tnStatus = 0x1009 RETURN "HPDF_DICT_ITEM_UNEXPECTED_TYPE " && 0x1009 CASE tnStatus = 0x100A RETURN "HPDF_DICT_STREAM_LENGTH_NOT_FOUND " && 0x100A CASE tnStatus = 0x100B RETURN "HPDF_DOC_ENCRYPTDICT_NOT_FOUND " && 0x100B CASE tnStatus = 0x100C RETURN "HPDF_DOC_INVALID_OBJECT " && 0x100C CASE tnStatus = 0x100E RETURN "HPDF_DUPLICATE_REGISTRATION " && 0x100E CASE tnStatus = 0x100F RETURN "HPDF_EXCEED_JWW_CODE_NUM_LIMIT " && 0x100F CASE tnStatus = 0x10011 RETURN "HPDF_ENCRYPT_INVALID_PASSWORD " && 0x1011 CASE tnStatus = 0x1013 RETURN "HPDF_ERR_UNKNOWN_CLASS " && 0x1013 CASE tnStatus = 0x1014 RETURN "HPDF_EXCEED_GSTATE_LIMIT " && 0x1014 CASE tnStatus = 0x1015 RETURN "HPDF_FAILD_TO_ALLOC_MEM " && 0x1015 CASE tnStatus = 0x1016 RETURN "HPDF_FILE_IO_ERROR " && 0x1016 CASE tnStatus = 0x1017 RETURN "HPDF_FILE_OPEN_ERROR " && 0x1017 CASE tnStatus = 0x1019 RETURN "HPDF_FONT_EXISTS " && 0x1019 CASE tnStatus = 0x101A RETURN "HPDF_FONT_INVALID_WIDTHS_TABLE " && 0x101A CASE tnStatus = 0x101B RETURN "HPDF_INVALID_AFM_HEADER " && 0x101B CASE tnStatus = 0x101C RETURN "HPDF_INVALID_ANNOTATION " && 0x101C CASE tnStatus = 0x101E RETURN "HPDF_INVALID_BIT_PER_COMPONENT " && 0x101E CASE tnStatus = 0x101F RETURN "HPDF_INVALID_CHAR_MATRICS_DATA " && 0x101F CASE tnStatus = 0x1020 RETURN "HPDF_INVALID_COLOR_SPACE " && 0x1020 CASE tnStatus = 0x1021 RETURN "HPDF_INVALID_COMPRESSION_MODE " && 0x1021 CASE tnStatus = 0x1022 RETURN "HPDF_INVALID_DATE_TIME " && 0x1022 CASE tnStatus = 0x1023 RETURN "HPDF_INVALID_DESTINATION " && 0x1023 CASE tnStatus = 0x1025 RETURN "HPDF_INVALID_DOCUMENT " && 0x1025 CASE tnStatus = 0x1026 RETURN "HPDF_INVALID_DOCUMENT_STATE " && 0x1026 CASE tnStatus = 0x1027 RETURN "HPDF_INVALID_ENCODER " && 0x1027 CASE tnStatus = 0x1028 RETURN "HPDF_INVALID_ENCODER_TYPE " && 0x1028 CASE tnStatus = 0x102B RETURN "HPDF_INVALID_ENCODING_NAME " && 0x102B CASE tnStatus = 0x102C RETURN "HPDF_INVALID_ENCRYPT_KEY_LEN " && 0x102C CASE tnStatus = 0x102D RETURN "HPDF_INVALID_FONTDEF_DATA " && 0x102D CASE tnStatus = 0x102E RETURN "HPDF_INVALID_FONTDEF_TYPE " && 0x102E CASE tnStatus = 0x102F RETURN "HPDF_INVALID_FONT_NAME " && 0x102F CASE tnStatus = 0x1030 RETURN "HPDF_INVALID_IMAGE " && 0x1030 CASE tnStatus = 0x1031 RETURN "HPDF_INVALID_JPEG_DATA " && 0x1031 CASE tnStatus = 0x1032 RETURN "HPDF_INVALID_N_DATA " && 0x1032 CASE tnStatus = 0x1033 RETURN "HPDF_INVALID_OBJECT " && 0x1033 CASE tnStatus = 0x1034 RETURN "HPDF_INVALID_OBJ_ID " && 0x1034 CASE tnStatus = 0x1035 RETURN "HPDF_INVALID_OPERATION " && 0x1035 CASE tnStatus = 0x1036 RETURN "HPDF_INVALID_OUTLINE " && 0x1036 CASE tnStatus = 0x1037 RETURN "HPDF_INVALID_PAGE " && 0x1037 CASE tnStatus = 0x1038 RETURN "HPDF_INVALID_PAGES " && 0x1038 CASE tnStatus = 0x1039 RETURN "HPDF_INVALID_PARAMETER " && 0x1039 CASE tnStatus = 0x103B RETURN "HPDF_INVALID_PNG_IMAGE " && 0x103B CASE tnStatus = 0x103C RETURN "HPDF_INVALID_STREAM " && 0x103C CASE tnStatus = 0x103D RETURN "HPDF_MISSING_FILE_NAME_ENTRY " && 0x103D CASE tnStatus = 0x103F RETURN "HPDF_INVALID_TTC_FILE " && 0x103F CASE tnStatus = 0x1040 RETURN "HPDF_INVALID_TTC_INDEX " && 0x1040 CASE tnStatus = 0x1041 RETURN "HPDF_INVALID_WX_DATA " && 0x1041 CASE tnStatus = 0x1042 RETURN "HPDF_ITEM_NOT_FOUND " && 0x1042 CASE tnStatus = 0x1043 RETURN "HPDF_LIBPNG_ERROR " && 0x1043 CASE tnStatus = 0x1044 RETURN "HPDF_NAME_INVALID_VALUE " && 0x1044 CASE tnStatus = 0x1045 RETURN "HPDF_NAME_OUT_OF_RANGE " && 0x1045 CASE tnStatus = 0x1048 RETURN "HPDF_PAGE_INVALID_PARAM_COUNT " && 0x1048 CASE tnStatus = 0x1049 RETURN "HPDF_PAGES_MISSING_KIDS_ENTRY " && 0x1049 CASE tnStatus = 0x104A RETURN "HPDF_PAGE_CANNOT_FIND_OBJECT " && 0x104A CASE tnStatus = 0x104B RETURN "HPDF_PAGE_CANNOT_GET_ROOT_PAGES " && 0x104B CASE tnStatus = 0x104C RETURN "HPDF_PAGE_CANNOT_RESTORE_GSTATE " && 0x104C CASE tnStatus = 0x104D RETURN "HPDF_PAGE_CANNOT_SET_PARENT " && 0x104D CASE tnStatus = 0x104E RETURN "HPDF_PAGE_FONT_NOT_FOUND " && 0x104E CASE tnStatus = 0x104F RETURN "HPDF_PAGE_INVALID_FONT " && 0x104F CASE tnStatus = 0x1050 RETURN "HPDF_PAGE_INVALID_FONT_SIZE " && 0x1050 CASE tnStatus = 0x1051 RETURN "HPDF_PAGE_INVALID_GMODE " && 0x1051 CASE tnStatus = 0x1052 RETURN "HPDF_PAGE_INVALID_INDEX " && 0x1052 CASE tnStatus = 0x1053 RETURN "HPDF_PAGE_INVALID_ROTATE_VALUE " && 0x1053 CASE tnStatus = 0x1054 RETURN "HPDF_PAGE_INVALID_SIZE " && 0x1054 CASE tnStatus = 0x1055 RETURN "HPDF_PAGE_INVALID_XOBJECT " && 0x1055 CASE tnStatus = 0x1056 RETURN "HPDF_PAGE_OUT_OF_RANGE " && 0x1056 CASE tnStatus = 0x1057 RETURN "HPDF_REAL_OUT_OF_RANGE " && 0x1057 CASE tnStatus = 0x1058 RETURN "HPDF_STREAM_EOF " && 0x1058 CASE tnStatus = 0x1059 RETURN "HPDF_STREAM_READLN_CONTINUE " && 0x1059 CASE tnStatus = 0x105B RETURN "HPDF_STRING_OUT_OF_RANGE " && 0x105B CASE tnStatus = 0x105C RETURN "HPDF_THIS_FUNC_WAS_SKIPPED " && 0x105C CASE tnStatus = 0x105D RETURN "HPDF_TTF_CANNOT_EMBEDDING_FONT " && 0x105D CASE tnStatus = 0x105E RETURN "HPDF_TTF_INVALID_CMAP " && 0x105E CASE tnStatus = 0x105F RETURN "HPDF_TTF_INVALID_FOMAT " && 0x105F CASE tnStatus = 0x1060 RETURN "HPDF_TTF_MISSING_TABLE " && 0x1060 CASE tnStatus = 0x1061 RETURN "HPDF_UNSUPPORTED_FONT_TYPE " && 0x1061 CASE tnStatus = 0x1062 RETURN "HPDF_UNSUPPORTED_FUNC " && 0x1062 CASE tnStatus = 0x1063 RETURN "HPDF_UNSUPPORTED_JPEG_FORMAT " && 0x1063 CASE tnStatus = 0x1064 RETURN "HPDF_UNSUPPORTED_TYPE1_FONT " && 0x1064 CASE tnStatus = 0x1065 RETURN "HPDF_XREF_COUNT_ERR " && 0x1065 CASE tnStatus = 0x1066 RETURN "HPDF_ZLIB_ERROR " && 0x1066 CASE tnStatus = 0x1067 RETURN "HPDF_INVALID_PAGE_INDEX " && 0x1067 CASE tnStatus = 0x1068 RETURN "HPDF_INVALID_URI " && 0x1068 CASE tnStatus = 0x1069 RETURN "HPDF_PAGE_LAYOUT_OUT_OF_RANGE " && 0x1069 CASE tnStatus = 0x1070 RETURN "HPDF_PAGE_MODE_OUT_OF_RANGE " && 0x1070 CASE tnStatus = 0x1071 RETURN "HPDF_PAGE_NUM_STYLE_OUT_OF_RANGE " && 0x1071 CASE tnStatus = 0x1072 RETURN "HPDF_ANNOT_INVALID_ICON " && 0x1072 CASE tnStatus = 0x1073 RETURN "HPDF_ANNOT_INVALID_BORDER_STYLE " && 0x1073 CASE tnStatus = 0x1074 RETURN "HPDF_PAGE_INVALID_DIRECTION " && 0x1074 CASE tnStatus = 0x1075 RETURN "HPDF_INVALID_FONT " && 0x1075 CASE tnStatus = 0x1076 RETURN "HPDF_PAGE_INSUFFICIENT_SPACE " && 0x1076 CASE tnStatus = 0x1077 RETURN "HPDF_PAGE_INVALID_DISPLAY_TIME " && 0x1077 CASE tnStatus = 0x1078 RETURN "HPDF_PAGE_INVALID_TRANSITION_TIME " && 0x1078 CASE tnStatus = 0x1079 RETURN "HPDF_INVALID_PAGE_SLIDESHOW_TYPE " && 0x1079 CASE tnStatus = 0x1080 RETURN "HPDF_EXT_GSTATE_OUT_OF_RANGE " && 0x1080 CASE tnStatus = 0x1081 RETURN "HPDF_INVALID_EXT_GSTATE " && 0x1081 CASE tnStatus = 0x1082 RETURN "HPDF_EXT_GSTATE_READ_ONLY " && 0x1082 OTHERWISE RETURN "Unknown Error" ENDCASE ENDPROC PROCEDURE _stat2_assign LPARAMETERS tnStatus This._Stat2 = tnStatus This._Stat = tnStatus ENDPROC PROCEDURE getpicturefromlistener *!* 2011/02/25 CChalom *!* When we can't render the PDF text or image correctly, we still can get * an image of the object, and draw it to the PDF document LPARAMETERS tnX, tnY, tnWidth, tnHeight * Clear any existing HPDF errors * Here we can see if an error occurred during the rendering process of the * current field This.ClearPDFErrors() LOCAL lcFile lcFile = This.GetPageImg() * RUN /n explorer.exe &lcFile. IF EMPTY(lcFile) RETURN .F. && Could not load image ENDIF * Horizontal and Vertical factors to divide to convert to the correct coordinate LOCAL lnHor, lnVert lnHor = 9.972 lnVert = 9.996 lcNewFile = This.CropImage(lcFile, tnX / lnHor, tnY / lnVert, tnWidth / lnHor, tnHeight / lnVert, .T.) * RUN /n explorer.exe &lcNewFile. lnHor = 13.45 lnVert = 13.45 This.ProcessPictures(tnY / lnVert, tnX / lnHor, tnWidth / lnHor, tnHeight / lnVert, ; lcNewFile, 0, 0, 2, "") IF VARTYPE(This.oTempImagesCollection) != "O" THEN This.oTempImagesCollection = CreateObject("Collection") ENDIF This.oTempImagesCollection.Add(lcNewFile) This.oTempImagesCollection.Add(lcFile) ENDPROC PROCEDURE getpageimg #DEFINE OutputJPEG 102 #DEFINE OutputPNG 104 LOCAL loListener as ReportListener loListener = IIF(VARTYPE(This.oActiveListener)="O", This.oActiveListener, This) LOCAL lnPage lnPage = This.nCurrentPage - loListener.CommandClauses.RangeFrom + 1 DIMENSION This.aPagesImgs(lnPage) IF EMPTY(This.aPagesImgs(lnPage)) LOCAL lnDeviceType, lcFile, lnDeviceType, lnHandle lnDeviceType = OutputPNG lcFile = This.GetTempFile("PNG") TRY loListener.OutputPage(lnPage, lcFile, lnDeviceType) CATCH lcFile = "" ENDTRY This.aPagesImgs(lnPage) = lcFile ENDIF RETURN This.aPagesImgs(lnPage) ENDPROC PROCEDURE clearpdferrors * Clear any existing HPDF errors * Here we can see if an error occurred during the rendering process of the * current field LOCAL lnHPDF_err, lcHex lnHPDF_err = HPDF_GetError(This.pdfHandle) IF lnHPDF_err <> 0 lcHex = TRANSFORM(lnHPDF_err, "@0") * MESSAGEBOX("PDFx error in " + PROGRAM(PROGRAM(-1) - 1) + CHR(13); + "Error code : " + TRANSFORM(lnHPDF_err) + CHR(13) ; + "Description: " + This._ErrorInfo(lnHPDF_err) + CHR(13) ; + "Page: " + TRANSFORM(This.nCurrentPage) + CHR(13) ; + "Object: " + This.cObjectToRender, ; 16, "Error") HPDF_ResetError(This.pdfHandle) ENDIF ENDPROC PROCEDURE getimgtype LPARAMETERS lcData LOCAL lcReturn,lcContents IF PCOUNT()=0 OR VARTYPE(lcData)#'C' lcReturn='' IF ADIR(laDummy,lcData)>0 && File lcContents=FILETOSTR(lcData) ELSE && Memory variable lcContents=lcData ENDIF DO CASE CASE LEN(lcContents)<4 lcReturn='' CASE LEFT(lcContents,3)=CHR(0xFF)+CHR(0xD8)+CHR(0xFF) lcReturn='JPG' CASE LEFT(lcContents,3)='GIF' lcReturn='GIF' CASE SUBSTR(lcContents,42,3)='EMF' lcReturn='EMF' CASE LEFT(lcContents,4)=CHR(0xD7)+CHR(0xCD)+CHR(0xC6)+CHR(0x9A) lcReturn='WMF' CASE LEFT(lcContents,4)=CHR(0x4D)+CHR(0x4D)+CHR(0x00)+CHR(0x2A) lcReturn='TIF' CASE LEFT(lcContents,4)=CHR(0x89)+'PNG' lcReturn='PNG' CASE LEFT(lcContents,2)='BM' lcReturn='BMP' CASE LEFT(lcContents,3)='CWS' AND ASC(SUBSTR(lcContents,4,1))<16 lcReturn='SWF' CASE LEFT(lcContents,3)='FWS' AND ASC(SUBSTR(lcContents,4,1))<16 lcReturn='SWF' OTHERWISE lcReturn='' ENDCASE ENDIF RETURN lcReturn ENDPROC PROCEDURE getdefaultfont LPARAMETERS tcFontStyle LOCAL lcNewFont, lnPos lnPos = ASCAN(This.aFontsReplaced, This.cDefaultFont + tcFontStyle) IF lnPos > 0 lnPos = (lnPos + 1) / 2 lcNewFont = This.aFontsReplaced(lnPos, 2) ELSE lcNewFont = This.cDefaultFont ENDIF RETURN lcNewFont ENDPROC PROCEDURE updateproperties IF NOT This.lObjTypeMode OR (VARTYPE(_Screen.oFoxyPreviewer) <> "O") RETURN ENDIF LOCAL loFP loFP = _Screen.oFoxyPreviewer IF VARTYPE(This.CommandClauses) = "O" *!* IF This.CommandClauses.Preview *!* This.lOpenViewer = .T. *!* ELSE *!* This.lOpenViewer = NVL(loFP.lOpenViewer, .T.) *!* ENDIF This.lOpenViewer = This.CommandClauses.Preview IF NOT EMPTY(This.CommandClauses.ToFile) This.cTargetFileName = This.CommandClauses.ToFile ELSE IF VARTYPE(_Screen.oFoxyPreviewer) = "O" AND ; NOT EMPTY(_Screen.oFoxyPreviewer.cDestFile) AND ; EMPTY(This.cTargetFileName) LOCAL lcDestFile lcDestFile = _Screen.oFoxyPreviewer.cDestFile IF NOT "\" $ lcDestFile lcDestFile = ALLTRIM(ADDBS(_Screen.oFoxyPreviewer.cOutputPath) + lcDestFile) ENDIF This.cTargetFileName = lcDestFile ELSE LOCAL lcFile lcFile = This.cTargetFileName IF EMPTY(lcFile) lcFile = PUTFILE("","","pdf") ENDIF IF EMPTY(lcFile) _ReportListener::CancelReport() * This.CancelReport() RETURN .F. ENDIF This.cTargetFileName = lcFile ENDIF ENDIF ENDIF This.QUIETMODE = NVL(loFP.lQuietMode , .F.) This.lEmbedFont = NVL(loFP.lPDFEmbedFonts , .F.) This.lCanPrint = NVL(loFP.lPDFCanPrint , .T.) This.lCanEdit = NVL(loFP.lPDFCanEdit , .T.) This.lCanCopy = NVL(loFP.lPDFCanCopy , .T.) This.lCanAddNotes = NVL(loFP.lPDFCanAddNotes , .T.) This.lEncryptDocument = NVL(loFP.lPDFEncryptDocument, .T.) This.cMasterPassword = NVL(loFP.cPDFMasterPassword , "") This.cUserPassword = NVL(loFP.cPDFUserPassword , "") This.lShowErrors = NVL(loFP.lPDFShowErrors , .F.) This.cSymbolFontsList = NVL(loFP.cPDFSymbolFontsList, "") This.cPdfAuthor = NVL(loFP.cPdfAuthor , "") This.cPdfTitle = NVL(loFP.cPdfTitle , "") This.cPdfSubject = NVL(loFP.cPdfSubject , "") This.cPdfKeyWords = NVL(loFP.cPdfKeyWords , "") This.cPdfCreator = NVL(loFP.cPdfCreator , "") This.cDefaultFont = NVL(loFP.cPDFDefaultFont , "") IF This.lObjTypeMode This.cCodePage = NVL(This.cCodePage , loFP.cCodePage) ELSE This.cCodePage = NVL(loFP.cCodePage , This.cCodePage) ENDIF *!* This.nWMheight = loFp.nWATERMARKHEIGHTRATIO *!* This.nWMheightratio = lofp.nwaTERMARKHEIGHTRATIO *!* This.nWMWidth = lofp.nwaTERMARKWIDTHRATIO *!* This.nWMWidthratio = lofp.nwaTERMARKWIDTHRATIO *!* This.cWMpicture = lofp.cwaTERMARKIMAGE *!* This.hWMpdfhandle = LOCAL lnPgMode lnPgMode = MAX(NVL(loFP.nPDFPageMode, 0) - 1, 0) lnPgMode = IIF(lnPgMode = 1, 2, lnPgMode) This.nPageMode = lnPgMode IF VARTYPE(This.CommandClauses) = "O" IF This.CommandClauses.Preview This.lOpenViewer = .T. ENDIF IF NOT EMPTY(This.CommandClauses.ToFile) This.cTargetFileName = This.CommandClauses.ToFile ENDIF ENDIF This.GetWatermark() ENDPROC PROCEDURE filesize LPARAMETERS lcFile LOCAL ARRAY laSizeArray(1) RETURN laSizeArray(ADIR(laSizeArray,lcFile)+1) *!* lParameters lcFileName && File to be checked *!* Local lnAcFiles *!* Local Array laSizeArray(1) *!* lnAcFiles = adir(laSizeArray,m.lcFilename) *!* Return iif(m.lnAcFiles>0,laSizeArray(2),-1) *!* Local lnHandle,lnSize *!* lnHandle = Fopen(m.lcFile,10) *!* lnSize = Fseek(m.lnHandle,0,2) *!* Fclose(m.lnHandle) *!* Return m.lnSize ENDPROC PROCEDURE getfonthandle LPARAMETERS lcFontFace, liFontStyle IF This._lSChinese OR This._lTChinese OR This._lJapanese OR This._lKorean lnFontHandle = HPDF_GetFont (.pdfHandle, This.cDefaultFont + This.GetFontStyleName(liFontStyle), .cCodePage) ELSE LOCAL lcPDFFont lcPDFFont = .SearchFont(lcFontFace, liFontStyle) IF EMPTY(lcPDFFont) RETURN 0 ENDIF lnFontHandle = HPDF_GetFont(.pdfHandle, lcPDFFont, IIF(Empty(.cCodePage), Null, .cCodePage)) && Find and select the font ENDIF IF lnFontHandle = 0 This.ClearPdfErrors() ENDIF RETURN lnFontHandle ENDPROC PROCEDURE getfontstylename LPARAMETERS tiStyle LOCAL lcFontStyle as String lcFontStyle = "" If Bittest(tiStyle, 0) Then &&Bold lcFontStyle = lcFontStyle + "Bold" EndIf If Bittest(tiStyle, 1) Then &&Italic lcFontStyle = lcFontStyle + "Italic" EndIf lcFontStyle = IIF(EMPTY(lcFontStyle), "", "," + lcFontStyle) RETURN lcFontStyle ENDPROC PROCEDURE gettempfile LPARAMETERS tcType IF EMPTY(tcType) tcType = "JPG" ENDIF RETURN ADDBS(This._cTempFolder) + "FP_TMP_" + SYS(2015) + "." + tcType ENDPROC PROCEDURE istempfile LPARAMETERS tcFile IF EMPTY(tcFile) RETURN .F. ENDIF RETURN UPPER(ADDBS(This._cTempFolder) + "FP_TMP_") $ UPPER(tcFile) ENDPROC PROCEDURE getwatermark * Prepare the watermarks stuff *!* .AddProperty("lUsingWatermark", .F.) *!* .AddProperty("cWatermarkImage" , "") && loFP.cWaterMarkImage *!* .AddProperty("nWatermarkType" , 1) && 1 = colored ; 2 = greyscale (1) *!* .AddProperty("nWatermarkTransparency", 0) && 0 = transparent ; 1 = opaque (.25) *!* .AddProperty("nWatermarkWidthRatio" , 0) && 0 - 1 (.75) *!* .AddProperty("nWatermarkHeightRatio" , 0) && 0 - 1 (.75) *!* .AddProperty("oWatermarkBmp" , NULL) * Watermarks IF VARTYPE(_Screen.oFoxyPreviewer) = "O" LOCAL loFP loFP = _Screen.oFoxyPreviewer LOCAL lcWatermarkImage, lnWatermarkType, lnWatermarkTransparency, lnWatermarkWidthRatio, lnWatermarkHeightRatio lcWatermarkImage = loFP.cWaterMarkImage lnWatermarkType = loFP.nWatermarkType && 1 = colored ; 2 = greyscale (1) lnWatermarkTransparency = loFP.nWatermarkTransparency && 0 = transparent ; 1 = opaque (.25) lnWatermarkWidthRatio = loFP.nWatermarkWidthRatio && 0 - 1 (.75) lnWatermarkHeightRatio = loFP.nWatermarkHeightRatio && 0 - 1 (.75) IF (NOT FILE(lcWatermarkImage)) OR ; (lnWatermarkTransparency = 0) OR ; (lnWatermarkWidthRatio = 0) OR ; (lnWatermarkHeightRatio = 0) This.lUsingWatermark = .F. ELSE This.lUsingWatermark = .T. LOCAL loBmp AS GpBitmap OF HOME() + "\ffc\_gdiplus.vcx" loBmp = CREATEOBJECT("GpBitmap") loBmp.CreateFromFile(lcWatermarkImage) IF (lnWatermarkTransparency < 1) OR ; (lnWatermarkType = 2) && 1 = colored ; 2 = greyscale * Applying the effects if necessary LOCAL loAtt && AS GPATTRIB OF "PR_GdiplusHelper.Prg" LOCAL lcMatrix AS COLORMATRIX OF "PR_GdiplusHelper.Prg" loAtt = NEWOBJECT("GpAttrib", "PR_GdiplusHelper.Prg") IF lnWatermarkType = 2 && 1 = colored ; 2 = greyscale lcMatrix = loAtt.COLORMATRIX(; .30, .30, .30, 0, 0, ; .59, .59, .59, 0, 0, ; .11, .11, .11, 0, 0, ; 0, 0, 0, lnWatermarkTransparency, 0, ; 0, 0, 0, 0, 1) ELSE lcMatrix = loAtt.COLORMATRIX(; 1, 0, 0, 0, 0, ; 0, 1, 0, 0, 0, ; 0, 0, 1, 0, 0, ; 0, 0, 0, lnWatermarkTransparency, 0, ; 0, 0, 0, 0, 1) ENDIF loAtt.ApplyColorMatrix(lcMatrix, loBmp, .F., 0xFFFFFF) loAtt = NULL ENDIF * Prepare Watermark LOCAL lcTempFile, lcType lcType = LOWER(JUSTEXT(lcWatermarkImage)) DO CASE CASE INLIST(lcType, "jpg", "jpeg", "tif", "tiff") lcType = "jpeg" OTHERWISE lcType = "png" ENDCASE lcTempFile = ADDBS(GETENV("TEMP")) + "Temp_WM_" + SYS(2015) + "." + lcType loBmp.SaveToFile(lcTempFile, "image/" + lcType) This._cWMpicture = lcTempFile LOCAL lnX, lnY, lnWidth, lnHeight lnX = (1 - lnWatermarkWidthRatio) / 2 lnY = (1 - lnWatermarkHeightRatio) / 2 lnWidth = lnWatermarkWidthRatio lnHeight = lnWatermarkHeightRatio LOCAL lnPgWidth, lnPgHeight lnPgWidth = This.GetPageWidth() lnPgHeight = This.GetPageHeight() This.nPageHeight = (lnPgHeight / 960) * 72 This.nPageWidth = (lnPgWidth / 960) * 72 This._nWMx = CEILING(lnX * This.nPageWidth) This._nWMy = CEILING(lnY * This.nPageHeight) This._nWMw = CEILING(This.nPageWidth * lnWidth) This._nWMh = CEILING(This.nPageHeight * lnHeight) ENDIF ENDIF ENDPROC PROCEDURE getlanguagefromsystem DECLARE SHORT GetSystemDefaultLangID IN kernel32 LOCAL lnLangID lnLangID = GetSystemDefaultLangID() * We'll use the most common Language IDs used DO CASE CASE INLIST(lnLangID, 1046, 2070) && Portuguese lnLangID = 1046 CASE INLIST(lnLangID, 1034, 2058, 3082, 4106, 5130, 6154, 7178, 8202, 9226, 10250, 11274, 12298, 13322, 14346, 15370, 16394, 17418, 17529, 18442, 19466, 20490) && Spanish lnLangID = 1034 CASE INLIST(lnLangID, 1036, 2060, 3084, 4108, 5132) && French lnLangID = 1036 OTHERWISE ENDCASE This.nSystemLangID = lnLangID ENDPROC PROCEDURE Init DODEFAULT() This.GetLanguageFromSystem() ENDPROC PROCEDURE Destroy This.ClearDLLS() DODEFAULT() ENDPROC PROCEDURE LoadReport This.UpdateProperties() DODEFAULT() ENDPROC PROCEDURE UnloadReport IF This.lDefaultMode DODEFAULT() ENDIF WITH This * CChalom 2010-01-20 * Added "WaitForNextReport" property in order to allow merging reports * If another report is expected to come, don't close the objects and handles If Not .WaitForNextReport If VARTYPE(.oTempImagesCollection) = "O" Then && Cleanup Temporary Images Files LOCAL lcItem AS String FOR EACH lcItem IN .oTempImagesCollection FOXOBJECT *!* 2010-08-25 - Jacques Parent - Add TRY CATCH ENDTRY to catch error message IF VARTYPE(lcItem) = "C" AND FILE(lcItem) LOCAL loExc as Exception TRY IF This.IsTempFile(lcItem) DELETE FILE (lcItem) ENDIF CATCH TO loExc * SET STEP ON ENDTRY ENDIF ENDFOR .oTempImagesCollection = Null ENDIF .oDynamics = NULL If Used("_TempDynamics") Then Use In "_TempDynamics" EndIf LOCAL llConsole, llTalk llConsole = This._lSetConsole llTalk = This._lSetTalk SET CONSOLE &llConsole. SET TALK &llTalk. ENDIF * Delete the pages files LOCAL n, lcFile FOR m.n = 1 TO ALEN(This.aPagesImgs,1) lcFile = This.aPagesImgs(m.n) IF NOT EMPTY(lcFile) TRY IF This.IsTempFile(lcFile) DELETE FILE (lcFile) ENDIF CATCH ENDTRY ENDIF ENDFOR ENDWITH ENDPROC PROCEDURE BeforeReport IF This.lDefaultMode This.oActiveListener = This DODEFAULT() ENDIF WITH This * Reset values, just for security .oFonts = NULL DIMENSION .aFontsSymbol(1) .aFontsSymbol = .F. .oFonts = CREATEOBJECT("Collection") .AddPDFStandardFonts() .DeclareDLL() IF "1252" $ This.cCodePage ELSE This.lReplaceFonts = .F. ENDIF IF This.lReplaceFonts DIMENSION This.aFontsReplaced(26,2) .aFontsReplaced(1,1) = "Courier New" .aFontsReplaced(1,2) = "Courier" .aFontsReplaced(2,1) = "Courier New Bold" .aFontsReplaced(2,2) = "Courier-Bold" .aFontsReplaced(3,1) = "Courier New Italic" .aFontsReplaced(3,2) = "Courier-Oblique" .aFontsReplaced(4,1) = "Courier New Bold Italic" .aFontsReplaced(4,2) = "Courier-BoldOblique" .aFontsReplaced(5,1) = "Monotype Sorts" .aFontsReplaced(5,2) = "ZapfDingbats" .aFontsReplaced(6,1) = "Wingdings" .aFontsReplaced(6,2) = "ZapfDingbats" .aFontsReplaced(7,1) = "Arial" .aFontsReplaced(7,2) = "Helvetica" .aFontsReplaced(8,1) = "Arial Bold" .aFontsReplaced(8,2) = "Helvetica-Bold" .aFontsReplaced(9,1) = "Arial Italic" .aFontsReplaced(9,2) = "Helvetica-Oblique" .aFontsReplaced(10,1) = "Arial Bold Italic" .aFontsReplaced(10,2) = "Helvetica-BoldOblique" .aFontsReplaced(11,1) = "Times New Roman" .aFontsReplaced(11,2) = "Times-Roman" .aFontsReplaced(12,1) = "Times New Roman Bold" .aFontsReplaced(12,2) = "Times-Bold" .aFontsReplaced(13,1) = "Times New Roman Italic" .aFontsReplaced(13,2) = "Times-Italic" .aFontsReplaced(14,1) = "Times New Roman Bold Italic" .aFontsReplaced(14,2) = "Times-BoldItalic" * Other compatible possibilities .aFontsReplaced(15,1) = "Courier" .aFontsReplaced(15,2) = "Courier" .aFontsReplaced(16,1) = "Courier Bold" .aFontsReplaced(16,2) = "Courier-Bold" .aFontsReplaced(17,1) = "Courier Italic" .aFontsReplaced(17,2) = "Courier-Oblique" .aFontsReplaced(18,1) = "Courier Bold Italic" .aFontsReplaced(18,2) = "Courier-BoldOblique" .aFontsReplaced(19,1) = "Helvetica" .aFontsReplaced(19,2) = "Helvetica" .aFontsReplaced(20,1) = "Helvetica Bold" .aFontsReplaced(20,2) = "Helvetica-Bold" .aFontsReplaced(21,1) = "Helvetica Italic" .aFontsReplaced(21,2) = "Helvetica-Oblique" .aFontsReplaced(22,1) = "Helvetica Bold Italic" .aFontsReplaced(22,2) = "Helvetica-BoldOblique" .aFontsReplaced(23,1) = "Times-Roman" .aFontsReplaced(23,2) = "Times-Roman" .aFontsReplaced(24,1) = "Times-Roman Bold" .aFontsReplaced(24,2) = "Times-Bold" .aFontsReplaced(25,1) = "Times-Roman Italic" .aFontsReplaced(25,2) = "Times-Italic" .aFontsReplaced(26,1) = "Times-Roman Bold Italic" .aFontsReplaced(26,2) = "Times-BoldItalic" ENDIF * Missing to add to corresponding fonts array *!* .Add("Symbol", "Symbol") ._lSetConsole = Set("Console") ._lSetTalk = Set("Talk") Set Talk Off Set Console Off Local lnFonts, lnFontstoAdd lnFonts = 34 lnFontstoAdd = Getwordcount(This.cSymbolFontsList, ",") Dimension .aFontsSymbol(lnFonts + lnFontstoAdd) .aFontsSymbol(1) = "WING-DINGS" .aFontsSymbol(2) = "WEBDINGS" .aFontsSymbol(3) = "BARRAS BIRO" .aFontsSymbol(4) = "PF BARCODE 128" .aFontsSymbol(5) = "BARRA25" .aFontsSymbol(6) = "BARRA25I" .aFontsSymbol(7) = "BARRA39" .aFontsSymbol(8) = "BARRAEAN8" .aFontsSymbol(9) = "BARRAEAN13" .aFontsSymbol(10) = "BARRA128B" .aFontsSymbol(11) = "IDAUTOMATIONHC39M" .aFontsSymbol(12) = "PF BARCODE 39" .aFontsSymbol(13) = "PF EAN P36" .aFontsSymbol(14) = "PF EAN P72" .aFontsSymbol(15) = "PF INTERLEAVED 2 of 5" .aFontsSymbol(16) = "PF INTERLEAVED 2 OF 5 WIDE" .aFontsSymbol(17) = "PF INTERLEAVED 2 OF 5 TEXT" .aFontsSymbol(18) = "CODE 128AB" .aFontsSymbol(19) = "CODE 128AB SHORT" .aFontsSymbol(20) = "CODE 128AB TALL" .aFontsSymbol(21) = "CODE 128AB HR" .aFontsSymbol(22) = "CODE 128AB SHORT" .aFontsSymbol(23) = "CODE 128AB TALL HR" .aFontsSymbol(24) = "CODE 128C" .aFontsSymbol(25) = "CODE 128C SHORT" .aFontsSymbol(26) = "CODE 128C TALL" .aFontsSymbol(27) = "CODE 128C HR" .aFontsSymbol(28) = "CODE 128C HR SHORT" .aFontsSymbol(29) = "CODE 128C HR TALL" .aFontsSymbol(30) = "CODIGO DE BARRAS CYT" .aFontsSymbol(31) = "C39HRP24DHTT" .aFontsSymbol(32) = "C39HRP48DHTT" .aFontsSymbol(33) = "INTERLEAVED 2OF5 NT" .aFontsSymbol(34) = "3 of 9 Barcode" If lnFontstoAdd > 0 Local N For m.N = 1 To lnFontstoAdd .aFontsSymbol(lnFonts + m.N) = GETWORDNUM(.cSymbolFontsList, m.N, ",") Endfor Endif ._cTempFolder = Addbs(Sys(2023)) && ADDBS(GETENV("TEMP")) ._cWinFolder = Addbs(Getenv("windir")) * ENDIF ENDWITH * Checking the default font LOCAL lcDefaultFont lcDefaultFont = ALLTRIM(This.cDefaultFont) IF EMPTY(lcDefaultFont) OR NOT INLIST(lcDefaultFont, "Courier", "Helvetica", "Times-Roman") This.cDefaultFont = "Helvetica" ENDIF ENDPROC PROCEDURE Render LPARAMETERS nFRXRecno, nLeft, nTop, nWidth, nHeight, nObjectContinuationType, cContentsToBeRendered, GDIPlusImage IF This.TwoPassProcess And This.CurrentPass=0 Then &&Code to detect if report will run twice because of use of _PAGETOTAL DODEFAULT(nFRXRecno, nLeft, nTop, nWidth, nHeight, nObjectContinuationType, cContentsToBeRendered, GDIPlusImage) RETURN ENDIF * CChalom 2010-01-25 * If the report page is not between the page ranges asked, just skip IF This.lDefaultMode IF This.PageNo > This.nGlobalPgCounter OR This.nPgCounter = 0 This.nPgCounter = This.nPgCounter + 1 This.nGlobalPgCounter = This.nGlobalPgCounter + 1 ENDIF LOCAL lnRangeTo lnRangeTo = This.CommandClauses.RangeTo IF lnRangeTo <> -1 AND NOT BETWEEN(This.nPgCounter, This.CommandClauses.RangeFrom, lnRangeTo) NODEFAULT RETURN ENDIF ENDIF #Define OBJ_COMMENT 0 #Define OBJ_LABEL 5 #Define OBJ_LINE 6 #Define OBJ_RECTANGLE 7 #Define OBJ_FIELD 8 #Define OBJ_PICTURE 17 #Define OBJ_VARIABLE 18 nLeft0 = nLeft nTop0 = nTop nWidth0 = nWidth nHeight0 = nHeight LOCAL lcContents AS String, loError AS Exception *!* Modify the measures according to the PDF library LOCAL nPDFLeft, nPDFTop, nPDFWidth, nPDFHeight nPDFLeft = (nLeft / 960) * 72 nPDFTop = (nTop / 960) * 72 nPDFWidth = (nWidth / 960) * 72 nPDFHeight = (nHeight / 960) * 72 WITH This LOCAL lnPageNo IF This.lDefaultMode .SetFRXDataSession() lnPageNo = .PageNo ELSE lnPageNo = PAGE ENDIF .nCurrentPage = lnPageNo If !.lStarted Then &&Start PDF Document IF NOT .StartPdfDocument() &&Method Called to Start the PDF Generation RETURN .F. ENDIF .nLastPageProccesed = lnPageNo EndIf If lnPageNo!=.nLastPageProccesed Then &&Add a New Page .AddBlankPage() .nLastPageProccesed = lnPageNo EndIf If Empty(cContentsToBeRendered) Then lcContents = '' EndIf EndWith IF (nPdfLeft < 0) OR (nPDFLeft > This.nPageWidth) OR ; (nPDFTop < 0) OR (nPdfTop > This.nPageHeight) * SET STEP ON RETURN ENDIF *!* Change to FRX Datasession and take out the important values IF This.lDefaultMode Go nFRXRecno In FRX ENDIF Scatter Memo Name oFrx LOCAL llSuccess With oFrx *!* Restore Report Datasession IF This.lDefaultMode This.ResetDataSession() ENDIF *!* Start Generation Proccess depending of Object Type Do Case Case .ObjType=OBJ_LABEL &&Label If !Empty(.ResoId) And .ResoId!=1 Then &&Convert from Unicode lcContents = Strconv(cContentsToBeRendered, 6, .ResoId, 2) This.Tag = lcContents Else &&Convert from Unicode lcContents = Strconv(cContentsToBeRendered, 6) This.Tag = "" EndIf Try This.cObjectToRender = "LABEL: " + lcContents llSuccess = This.ProcessLabel(.FontFace, .FontStyle,.FontSize,.PenRed,.PenGreen,.PenBlue,.FillRed,.FillGreen,.FillBlue,nPDFLeft,nPDFTop,lcContents,.FillChar,.Offset,nPDFWidth, ; .ResoId,nPDFHeight,.Picture,.Style, .Mode) IF NOT llSuccess This.GetPictureFromListener(nLeft, nTop, nWidth, nHeight) ENDIF Catch To loError *!* Handle Error Here EndTry Case .ObjType=OBJ_FIELD &&Field If !Empty(.ResoId) And .ResoId!=1 Then &&Convert from Unicode lcContents = Strconv(cContentsToBeRendered, 6, .ResoId, 2) This.Tag = lcContents Else &&Convert from Unicode lcContents = Strconv(cContentsToBeRendered, 6) This.Tag = "" EndIf Try This.cObjectToRender = "FIELD: " + lcContents llSuccess = This.ProcessFields(.FontFace,.FontStyle,.FontSize,.PenRed,.PenGreen,.PenBlue, ; .FillRed,.FillGreen,.FillBlue,; nPDFLeft,nPDFTop,; lcContents,.FillChar,.Offset, ; .Stretch,.ResoId,nPDFHeight,nPDFWidth,.Style, .Mode, .User) IF NOT llSuccess IF This._Stat2 = 4214 && Could not fit in space LOCAL lnWords, lnCharWidth, n, lnLen, lnCharsAllowed, ; lnCharsToInsert, lcText lnWords = GETWORDCOUNT(lcContents) IF lnWords = 1 && Add some spaces in the string to allow wordwrap lnCharWidth = FONTMETRIC(6, .FontFace, .FontSize, This.cTextStyle) * 10 lnTxtWidth = TXTWIDTH(lcContents,.FontFace,.FontSize, This.cTextStyle) * ; lnCharWidth && * 104.166 lnLen = LEN(lcContents) * IF (lnTxtWidth * .70) > nWidth lnCharsAllowed = CEILING((nWidth / lnCharWidth) * 0.73) lnCharsToInsert = FLOOR(lnLen / lnCharsAllowed) lcText = lcContents FOR m.n = 1 TO lnCharsToInsert lcText = STUFF(lcText, (lnCharsAllowed * m.n) + m.n, 0, " ") ENDFOR llSuccess = This.ProcessFields(.FontFace,.FontStyle,.FontSize,.PenRed,.PenGreen,.PenBlue, ; .FillRed,.FillGreen,.FillBlue,; nPDFLeft,nPDFTop,; lcText,.FillChar,.Offset, ; .Stretch,.ResoId,nPDFHeight,nPDFWidth,.Style, .Mode, .User) * ENDIF ENDIF ENDIF IF NOT llSuccess This.GetPictureFromListener(nLeft, nTop, nWidth, nHeight) ENDIF ENDIF * Another possible way to get the width of the text *!* loFRXCursor = newobject('FRXCursor', home() + 'FFC\_FRXCursor.vcx') *!* lnWidth = loFRXCursor.GetFRUTextWidth(lcText, lcFontName, lnFontSize, lcFontStyle) Catch To loError * SET STEP ON *!* Handle Error Here EndTry Case .ObjType=OBJ_LINE &&Line Try This.cObjectToRender = "LINE" This.ProcessLines(.PenRed, .PenGreen, .PenBlue, nPDFTop, nPDFLeft, nPDFWidth, nPDFHeight, .PenSize, .Offset, .PenPat, .Style) Catch To loError *!* Handle Error Here EndTry Case .ObjType=OBJ_PICTURE &&Picture or General Field IF nPdfWidth = 0 OR nPdfHeight = 0 * Nothing to render RETURN ENDIF lcContents = cContentsToBeRendered Try This.cObjectToRender = "PICTURE: " + lcContents llSuccess = This.ProcessPictures(nPDFTop, nPDFLeft, nPDFWidth, nPDFHeight, lcContents, GDIPlusImage, .Offset, .General, .Style) IF NOT llSuccess AND (NOT EMPTY(lcContents)) && image is in General field TRY LOCAL lcPicVal, lcTmpImg lcPicVal = FOXYGETIMAGE(lcContents) IF NOT EMPTY(lcPicVal) lcTmpImg = ADDBS(This._cTempFolder) + JUSTFNAME(lcContents) STRTOFILE(lcPicVal, lcTmpImg) llSuccess = This.ProcessPictures(nPDFTop, nPDFLeft, nPDFWidth, nPDFHeight, lcTmpImg, GDIPlusImage, .Offset, .General, .Style) TRY DELETE FILE (lcTmpImg) CATCH ENDTRY ENDIF CATCH TO loExc * Clear existing the HPDF errors This.ClearPDFErrors() ENDTRY ENDIF IF NOT llSuccess This.GetPictureFromListener(nLeft, nTop, nWidth, nHeight) * Clear existing the HPDF errors This.ClearPDFErrors() ENDIF CATCH TO loError * SET STEP ON *!* Handle Error Here EndTry Case .ObjType=OBJ_RECTANGLE &&Rectangle TRY *!* 2010-08-25 - Jacques Parent - Add nObjectContinuationType to the call This.cObjectToRender = "RECTANGLE" This.ProcessShapes(.FillRed, .FillGreen, .FillBlue, .PenRed, .PenGreen, .PenBlue, nPDFLeft, nPDFTop, nPDFWidth, nPDFHeight, .Offset, .PenSize, .PenPat, .FillPat, .Style, .Mode, nObjectContinuationType) CATCH TO loError * SET STEP ON *!* Handle Error Here *!* IF VERSION(2) = 2 *!* MESSAGEBOX(loError.Message) *!* ENDIF ENDTRY ENDCASE * Clear existing the HPDF errors This.ClearPDFErrors() DODEFAULT(nFRXRecno, nLeft, nTop, nWidth, nHeight, nObjectContinuationType, cContentsToBeRendered, GDIPlusImage) ENDWITH ENDPROC PROCEDURE AfterReport IF This.lDefaultMode DODEFAULT() ENDIF * Delete watermark temp image file IF NOT EMPTY(This._cWMpicture) TRY DELETE FILE (This._cWMpicture) CATCH ENDTRY ENDIF * Determine the ".WaitForNextReport" status if using "lObjTypeMode" IF This.lObjTypeMode TRY This.WaitForNextReport = This.CommandClauses.NoPageEject CATCH ENDTRY ENDIF With This IF NOT .WaitForNextReport LOCAL lcFile lcFile = This.cTargetFileName IF EMPTY(lcFile) HPDF_Free(.pdfHandle) .pdfHandle = 0 .lStarted = .F. ELSE ._Stat = HPDF_SaveToFile(.pdfHandle, lcFile) HPDF_Free(.pdfHandle) INKEY(.1) .pdfHandle = 0 .lStarted = .F. .nPgCounter = 0 .aPagesImgs = "" .cTextStyle = "" .nCurrentPage = 0 .nDivisionFactor = 0 .nGlobalPgCounter = 0 .nLastPageProccesed = 0 .nPgCounter = 0 This.oPictureHandles = "" This.oDynamics = "" This.oTempImagesCollection = "" LOCAL llSaved llSaved = FILE(lcFile) IF llSaved IF This.lObjTypeMode _Screen.oFoxyPreviewer.lSaved = llSaved ENDIF IF .lOpenViewer THEN .ShellExec(This.cTargetFileName) ENDIF ENDIF ENDIF ENDIF * CChalom * Reset the report page counter This.nPgCounter = 0 ENDWITH This.oActiveListener = "" ENDPROC PROCEDURE resetdatasession Set DataSession To (This.CurrentDataSession) Catch When .T. *Can't Return DataSession to do: handle this EndTry ENDPROC PROCEDURE setfrxdatasession With This If (.FRXDatasession > -1) And (.FRXDatasession # Set("DATASESSION")) Then Try Set DataSession To (.FRXDatasession) Catch When .T. .ResetToDefault("FRXDataSession") .ResetDataSession() EndTry EndIf EndWith ENDPROC Height = 23 Width = 23 ListenerType = -1 FRXDataSession = -1 SendGDIPlusImage = 1 pdfhandle = 0 nlastpageproccesed = 0 ndivisionfactor = 0 cpdfauthor = cpdftitle = cpdfsubject = cpdfkeywords = cpdfcreator = lcanprint = .T. lcancopy = .T. lcanedit = .F. lcanaddnotes = .F. lencryptdocument = .F. cuserpassword = cmasterpassword = nencriptionlevel = 5 opage = .NULL. lstarted = .F. ctargetfilename = lopenviewer = .F. ofonts = .NULL. oregistry = .NULL. npageheight = 0 nspacesfortab = 4 lembedfont = .T. ccodepage = CP1252 lunderline = .F. ctextstyle = odynamics = .NULL. waitfornextreport = .F. npgcounter = 0 nglobalpgcounter = 0 otempimagescollection = .NULL. opicturehandles = .NULL. _lsetconsole = .F. _lsettalk = .F. npagemode = 0 lextended = .T. ldefaultmode = .T. npagewidth = 0 _cwinfolder = _ctempfolder = _stat = .F. lshowerrors = .F. csymbolfontslist = cobjecttorender = _stat2 = 0 ncurrentpage = 0 oactivelistener = .NULL. cdefaultfont = Helvetica lobjtypemode = .F. _lschinese = .F. lrighttoleft = .F. lreplacefonts = .T. _ltchinese = .F. _lkorean = .F. _ljapanese = .F. nwmwidthratio = 0 nwmheightratio = 0 nwmwidth = 0 nwmheight = 0 cwmpicture = hwmpdfhandle = 0 _cwmpicture = _nwmy = 0 _nwmx = 0 _nwmw = 0 _nwmh = 0 lusingwatermark = .F. nsystemlangid = 0 lhasuserfld = .F. _memberdata = .T. Name = "pdflistener" PLATFORM UNIQUEID TIMESTAMP CLASS CLASSLOC BASECLASS OBJNAME PARENT PROPERTIES PROTECTED METHODS OBJCODE RESERVED1 RESERVED2 RESERVED3 RESERVED4 RESERVED5 RESERVED6 RESERVED7 RESERVED8 COMMENT Class WINDOWS _1TF0Z2JS31087744875 COMMENT RESERVED VERSION = 3.00 rtfreportlistener Pixels * VFP reports to rtf converter * Class is based on report listener clas. * It permits to see VFP reports in MS Word * Authors -Vladimir Zhuravlev, Dmitriy Petrov, Valeriy Lifshits * with help of Vadim Pirozhkov and Andrey Petrov Class fxlistener rtfreportlistener paper_letter handle code_page oldpageno borderwidth lofrxrecord waitfornextreport npgcounter nglobalpgcounter orecord targetfilename lstarted _llandscape npagewidth npageheight ldefaultmode nmarginleft nmarginright nmargintop nmarginbottom ncurrentpage oactivelistener _ctempfolder oimages lobjtypemode lopenviewer ctempfrx cfrxalias *getfrxrecord *fontstyleconvert *pagesetup *twips *rtf_create ^arfont[1,0] *himetrictortf *dectoproc *mabout ^arcolors[1,4] *frxtotwips *outputfromdata *renderrtf *getpageimg ^apagesimgs[1,0] *getpicturefromlistener *cropimage ^aimgs[1,0] *updateproperties *stringfromunicode PNFRXRECNO LOFRX SETFRXDATASESSION RESETDATASESSION \strike \plain TNFONTSTYLE LCSTYLE TCEXPR LNPGWIDTH LNPGHEIGHT GETPAGEWIDTH GETPAGEHEIGHT _LLANDSCAPE NPAGEWIDTH FRXTOTWIPS NPAGEHEIGHT& Collection CopyFRX \redCC \green \blue \redCC \green \blue TempColors TempColors \red0\green0\blue0 TempColors \red255\green255\blue255 TempColors \red0\green0\blue0 {\colortbl; {\fonttbl{ \fnil\fcharset Error creating file: Error \paperwCC \paperh \margl \margr \margt \margb \landscape {\rtf1\ansi\ansicpgCC \uc1 \deff0\deflang1049\deflangfe1049 _CTEMPFOLDER OIMAGES HANDLE LCFRXALIAS LDEFAULTMODE LOBJTYPEMODE SETFRXDATASESSION CTEMPFRX CFRXALIAS _GOHELPER OLISTENER FONTFACE ARFONT LNSELECT DISTINCT PENRED PENGREEN PENBLUE OBJTYPE FILLRED FILLGREEN FILLBLUE TEMPCOLORS ARCOLORS RESETDATASESSION LCCOLORTABLE LCFONTTABLE LNFCS TARGETFILENAME LCPAPER LCOUTSTR NPAGEWIDTH NPAGEHEIGHT NMARGINLEFT NMARGINRIGHT NMARGINTOP _LLANDSCAPE CODE_PAGE HIMETRICVALUE LNDEC TNFRX[ Invalid parameter. Report listener not available Error The helper FRX table is not available. Output can't be created Error Datasessionv % - 100% - CCC TOLISTENER TCOUTPUTDBF TNWIDTH TNHEIGHT OACTIVELISTENER CFRXALIAS LNSELECT LNORIGDATASESSION LISTENERDATASESSION QUIETMODE LNSECS DOFOXYTHERM _GOHELPER _INITSTATUSTEXT LDEFAULTMODE NPAGEWIDTH FRXTOTWIPS NPAGEHEIGHT LNPGFROM LNPGTO _CLAUSENRANGEFROM _CLAUSENRANGETO RTF_CREATE RENDER FRXRECNO WIDTH HEIGHT CONTTYPE UNCONTENTS LNPERCENT LNLASTPERCENT LNDELAY LNTOTRECS LNREC _SECONDSTEXT _RUNSTATUSTEXT AFTERREPORTq <_CR_> <_CR_> <_CR_> <_CR_> \par \par {\sp{\sn WrapText}{\sv 2}} {\sp{\sn lineColor}{\sv CC {\sp{\sn fillColor}{\sv C {\sp{\sn fRecolorFillAsPicture}{\sv 0}}{\sp{\sn fFilled}{\sv 1}} {\shp{\*\shpinst \shpleft \shptop \shpright \shpbottom \shpfhdr0 \shpbxmargin \shpbxignore \shpbymargin \shpbyignore {\sp{\sn fline}{\sv 1}}{\sp{\sn fFlipH}{\sv 0}}{\sp{\sn fFilled}{\sv 0}} {\sp{\sn lineWidth}{\sv \red0\green0\blue0 \redCC \green \blue {\shp{\*\shpinst \shpleft \shptop \shpright \shpbottom \shpfhdr0 {\sp{\sn fline}{\sv 0}} {\sp{\sn dxTextLeft}{\sv 0}} {\sp{\sn dyTextTop}{\sv 0}} {\sp{\sn dxTextRight}{\sv 0}} {\sp{\sn dyTextBottom}{\sv 0}} {\sp{\sn fFilled}{\sv 0}} {\sp{\sn fFitShapeToText}{\sv 1}} { \shptxt\pard {\sp{\sn lineColor}{\sv CC {\shp{\*\shpinst \shpleft \shptop \shpright \shpbottom \shpfhdr0 {\sp{\sn fline}{\sv 1}} {\sp{\sn ShapeType}{\sv 20}} {\sp{\sn lineWidth}{\sv {\shp{\*\shpinst \shpleft \shptop \shpright \shpbottom \shpfhdr0 {\sp{\sn fline}{\sv 1}} {\sp{\sn ShapeType}{\sv 20}} {\sp{\sn lineWidth}{\sv {\sp{\sn lineColor}{\sv CC {\sp{\sn lineColor}{\sv CC {\sp{\sn lineColor}{\sv CC {\sp{\sn lineColor}{\sv CC {\sp{\sn fillColor}{\sv C {\sp{\sn fRecolorFillAsPicture}{\sv 0}}{\sp{\sn fFilled}{\sv 1}} {\sp{\sn shapeType}{\sv 2}}6 {\shp{\*\shpinst \shpleft \shptop \shpright \shpbottom \shpfhdr0 \shpbxmargin \shpbxignore \shpbymargin \shpbyignore {\sp{\sn fline}{\sv 1}}{\sp{\sn fFlipH}{\sv 0}}{\sp{\sn fFilled}{\sv 0}} {\sp{\sn lineWidth}{\sv TEMP5 GPIMAGE GpImage _GdiPlus.vcx image/jpeg IMAGE Image {\shp{\*\shpinst \shpleft \shptop \shpright \shpbottom {\sp{\sn ShapeType}{\sv 75}} {\sp{\sn fline}{\sv 0}} {\sp{\sn fLockAspectRatio}{\sv {\sp{\sn cropFromBottom}{\sv {\sp{\sn cropFromRight} {\sv {\sp{\sn pib} {\sv {\pict \wmetafile8\pic \picbpp4 {\sp{\sn pibFlags}{\sv 2}} {\sp{\sn fUseShapeAnchor}{\sv 0}} LOFRXRECORD NLEFT NWIDTH NHEIGHT NOBJECTCONTINUATIONTYPE CCONTENTSTOBERENDERED GDIPLUSIMAGE _TFORCEOBJECTTYPE _TFORCELINEOFSET FONTNUM FONT_ID _FONTSTYLE LCRTF _ALLG LCPENSIZE LCTEXT LLDBLBYTE OBJTYPE LCWRAPTEXT STRINGFROMUNICODE PICTURE OFFSET LCCOLORRTF LNCLRINDEX LCCOLORTAG LCBACKCOLORRTF LNBACKCLRINDEX PENSIZE LCPENCOLOR LCFILLCOLOR FILLRED FILLGREEN FILLBLUE LNRGB FRXTOTWIPS PENRED PENGREEN PENBLUE ARCOLORS ARFONT FONTFACE FONTSTYLECONVERT FONTSTYLE LNBORDER FONTSIZE FILLPAT PENPAT LCROUNDED HANDLE RENDERRTF HDPICT STRFILE LNFILESIZE LHFILE OBJPICT LNPICTWIDTH LNPICTHEIGHT LNWIDTH LNHEIGHT LLLOCK LNCROPR LNCROPB LCTEMPIMGFILE LOIMAGE SETHANDLE SAVETOFILE GETPICTUREFROMLISTENER LCEXT LOVFPIMG WIDTH HEIGHT HIMETRICTORTF GENERAL DECTOPROC LNHORFACTOR LNVERTFACTOR LNRESIZEFACTOR LOEXC REPORTLISTENER TEMP5 LOLISTENER OACTIVELISTENER LNPAGE NCURRENTPAGE COMMANDCLAUSES RANGEFROM APAGESIMGS LNDEVICETYPE LCFILE LNHANDLE OUTPUTPAGE TNWIDTH TNHEIGHT LDEFAULTMODE LCFILE GETPAGEIMG LNHOR LNVERT LCNEWFILE CROPIMAGE STRING INTEGER INTEGER GPBITMAP ffc\_gdiplus.vcx GpBitmap _GdiPlus.vcx GdipCloneBitmapAreaI GDIPLUS.DLLQ pdfxGdipCloneBitmapAreaI GPBITMAP ffc\_gdiplus.vcx GpBitmap _GdiPlus.vcx image/png image/jpeg6 LCFILE LNWIDTH LNHEIGHT TLFILE LOBMP CREATEFROMFILE IMAGEHEIGHT IMAGEWIDTH LHBITMAP LNSTATUS GDIPCLONEBITMAPAREAI GDIPLUS PDFXGDIPCLONEBITMAPAREAI PIXELFORMAT GETHANDLE LOCROPPED SETHANDLE SETRESOLUTION HORIZONTALRESOLUTION VERTICALRESOLUTION LCEXT LCENCODER LCCROPPEDFILE _CTEMPFOLDER SAVETOFILE OIMAGES LOBJTYPEMODE OFOXYPREVIEWER COMMANDCLAUSES LOPENVIEWER PREVIEW TOFILE TARGETFILENAME CDESTFILE LCDESTFILE COUTPUTPATH LCFILE _REPORTLISTENER CANCELREPORT QUIETMODE LQUIETMODE \par TCUNICODE LCUNVALUE LNUNVALUE LCNEWCONTENTS LNCHARS LDEFAULTMODE STRING EXCEPTION LDEFAULTMODE LOBJTYPEMODE WAITFORNEXTREPORT COMMANDCLAUSES NOPAGEEJECT HANDLE LLSAVED OFOXYPREVIEWER LSAVED LOPENVIEWER SHELLEXEC TARGETFILENAME NPGCOUNTER LCFILE APAGESIMGS OIMAGES LCITEM LOEXC OACTIVELISTENER CFRXALIAS CTEMPFRX \page \page NFRXRECNO NLEFT NWIDTH NHEIGHT NOBJECTCONTINUATIONTYPE CCONTENTSTOBERENDERED GDIPLUSIMAGE LNPAGENO PAGENO LDEFAULTMODE LNRANGETO TLNEWPAGE NGLOBALPGCOUNTER NPGCOUNTER COMMANDCLAUSES RANGETO RANGEFROM OLDPAGENO LSTARTED HANDLE NCURRENTPAGE TWOPASSPROCESS CURRENTPASS LOFRXRECORD GETFRXRECORD LOFRX RENDERRTFT LDEFAULTMODE LOBJTYPEMODE OACTIVELISTENER PAGESETUP RTF_CREATE TCRTFFILENAME TARGETFILENAME NPGCOUNTER LDEFAULTMODE LOBJTYPEMODE UPDATEPROPERTIES getfrxrecord, fontstyleconvert pagesetup twips rtf_create himetrictortf dectoproc mabout frxtotwips outputfromdata% renderrtf] getpageimg[1 getpicturefromlistener cropimageC4 updateproperties stringfromunicode Destroy AfterReport%= Render BeforeReport LoadReportvF PROCEDURE getfrxrecord LPARAMETERS pnFRXRecNo LOCAL loFRX *-- Switch to the FRX This.setFRXDataSession() SET TALK OFF *-- Goto the record GOTO pnFRXRecNo *-- Get the data SCATTER MEMO NAME loFRX This.resetDataSession() *-- Return the data RETURN loFRX ENDPROC PROCEDURE fontstyleconvert *-- Convert FontStyle from numeric value *-- to character codes LPARAMETERS tnFontStyle LOCAL lcStyle lcStyle = '' IF BITTEST(tnFontStyle, 0) lcStyle = lcStyle + '\b' ENDIF IF BITTEST(tnFontStyle, 1) lcStyle = lcStyle + '\i' ENDIF IF BITTEST(tnFontStyle, 2) lcStyle = lcStyle + '\ulw' ENDIF IF BITTEST(tnFontStyle, 7) lcStyle = lcStyle + '\strike' ENDIF IF EMPTY(lcStyle) lcStyle = '\plain' ENDIF RETURN lcStyle ENDPROC PROCEDURE pagesetup LPARAMETERS tcExpr LOCAL lnPgWidth, lnPgHeight lnPgWidth = This.GetPageWidth() lnPgHeight = This.GetPageHeight() This._lLandscape = lnPgWidth > lnPgHeight WITH This .nPageWidth = This.FrxToTwips(lnPgWidth) .nPageHeight = This.FrxToTwips(lnPgHeight) ENDWITH ENDPROC PROCEDURE twips LParameters nCm_ * making Twip Return Int(nCm_ * 1440 / 2.54) ENDPROC PROCEDURE rtf_create This._cTempFolder = ADDBS(SYS(2023)) && ADDBS(GETENV("TEMP")) This.oImages = CREATEOBJECT("Collection") WITH This * Creating rtf file IF NOT EMPTY(.handle) RETURN ENDIF LOCAL lcFRXAlias IF This.lDefaultMode OR This.lObjTypeMode This.setFRXDataSession() SET TALK OFF This.cTempFRX = ADDBS(SYS(2023)) + "FRX_" + SYS(2015) + '.dbf' This.cFRXAlias = "CopyFRX" lcFRXAlias = This.cFRXAlias * Make a copy of the FRX table and manipulate it SELECT FRX COPY TO (This.cTempFRX) USE (This.cTempFRX) SHARED AGAIN IN 0 ALIAS (This.cFRXalias) lcFRXAlias = _goHelper.oListener.cFRXAlias * USE (_goHelper.oListener.cFRXDBF) AGAIN ALIAS FRX IN 0 ENDIF * Getting all fonts sizes SELECT ALLTRIM(Padr(Mline(fontface,1),30)); FROM (lcFRXAlias) ; INTO ARRAY .arFont; WHERE NOT EMPTY(fontface); GROUP By 1 * CChalom 2010-01-23 * Creating the Color table LOCAL lnSelect lnSelect = SELECT() SELECT ; DISTINCT ("\red" + ALLTRIM(STR(penRed)) + "\green" + ALLTRIM(STR(penGreen)) + "\blue" + ALLTRIM(STR(penBlue))) as RTF, ; PenRed, PenGreen, PenBlue ; FROM (lcFRXAlias); WHERE INLIST(ObjType, 5, 8) ; AND NOT INLIST(-1, PenRed, PenGreen, PenBlue) ; UNION ; SELECT; DISTINCT ("\red" + ALLTRIM(STR(FillRed)) + "\green" + ALLTRIM(STR(FillGreen)) + "\blue" + ALLTRIM(STR(FillBlue))) as RTF, ; FillRed AS PenRed, FillGreen AS PenGreen, FillBlue AS PenBlue ; FROM (lcFRXAlias); WHERE INLIST(ObjType, 5, 8) ; AND NOT INLIST(-1, FillRed, FillGreen, FillBlue) ; INTO CURSOR TempColors ; READWRITE * Check if we have the two basic colors, white and black INSERT INTO TempColors VALUES ("\red0\green0\blue0", 0, 0, 0) INSERT INTO TempColors VALUES ("\red255\green255\blue255", 255, 255, 255) * Urrutia 2010-02-05 * initialize the array property in case all colors are Default If _Tally > 0 SELECT Distinct RTF, penRed, penGreen, penBlue ; FROM TempColors Into Array .ArColors NOFILTER ELSE .ArColors(1,1)="\red0\green0\blue0" .ArColors(1,2)=0 .ArColors(1,3)=0 .ArColors(1,4)=0 Endif USE IN TempColors SELECT (lnSelect) *-- Restore the datasession IF This.lDefaultMode This.ResetDataSession() ENDIF ********** Making Color table * {\colortbl;\red0\green0\blue0;\red255\green0\blue0;} LOCAL lcColorTable lcColorTable = '{\colortbl;' FOR m.i = 1 TO (ALEN(.arColors) / 4) lcColorTable = lcColorTable + ALLTRIM(.arColors(m.i, 1)) + ";" NEXT i lcColorTable = lcColorTable + "}" ********** Making font RTF features LOCAL lcFontTable, lnFcs lcFontTable = "" lcFontTable = '{\fonttbl{' FOR m.i = 1 TO ALEN(.arFont) lnFcs = FONTMETRIC(17, .arfont[m.i], 10) lcFontTable = lcFontTable+'\f' + Alltrim(Str(m.i,2,0)) + '\fnil\fcharset' + Alltrim(Str(lnFcs)) + ' ' + Alltrim(.arfont[m.i])+';' NEXT i lcFontTable = SUBSTR(lcFontTable, 1, LEN(lcFontTable)-1) + '}}' .handle = FCREATE(.TargetFileName) IF .handle <= 0 = MESSAGEBOX("Error creating file: " + .TargetFileName, "Error") RETURN ENDIF LOCAL lcPaper, lcOutStr * Storing paper information lcPaper = '\paperw' + Alltrim(Str(.nPageWidth))+; '\paperh' + Alltrim(Str(.nPageHeight))+; '\margl' + Alltrim(Str(.nMarginLeft))+; '\margr' + Alltrim(Str(.nMarginRight))+; '\margt' + Alltrim(Str(.nMarginTop))+; '\margb' + Alltrim(Str(.nMarginTop))+; IIF(._lLandscape, '\landscape', '') * IIF(.paper_letter, '\landscape', '') lcOutStr = "{\rtf1\ansi\ansicpg" + Alltrim(Str(.code_page)) + ; '\uc1 \deff0\deflang1049\deflangfe1049' +; lcFontTable + lcPaper + lcColorTable = FPUTS(.handle, lcOutStr) ENDWITH ENDPROC PROCEDURE himetrictortf LPARAMETERS HiMetricValue * metric transformation RETURN INT(HiMetricValue*240/635) ENDPROC PROCEDURE dectoproc LPARAMETERS lnDec RETURN ROUND(lnDec*65536, 0) ENDPROC PROCEDURE mabout * VFP reports to rtf converter * Class is based on report listener class. * It permits to see VFP reports in MS Word * Authors: Vladimir Zhuravlev, Dmitriy Petrov, Valeriy Lifshits * with help of Vadim Pirozhkov and Andrey Petrov * Received improvements and fixes from Cesar Chalom * - Fixed the calculated fields * - Allowed general image fields to be printed * - Enabled colors and backcolors in texts, and colors and backcolors in shapes and lines * - Allowed generating a determined range of pages * - Allowed merging more tan one report together * Usage: * SET CLASSLIB TO frx_rtf * LOCAL loRTFListener as ReportListener * loRTFListener = CREATEOBJECT('RtfReportListener') * loRTFListener.TargetFileName = "MyRTFReport.RTF" * REPORT FORM MyReport OBJECT loRTFListener * CChalom comments * All changed codes in this class are preceeded with comments *!* Removed methods, that are not used any more: *!* 1 - PutPageBreak() *!* 2 - DoBeforeRender *!* 3 - GetBandName *!* 4 - GetFormatCode *!* 5 - GetNextNumber *!* 6 - Pix2FRX *!* 7 - StrTransform *!* 8 - CalcAgrVal *!* 9 - CommaTran *!* 10 - CreateAgrProp *!* 11 - ExprChange *!* 12 - MEval *!* 13 - StrTransform *!* 14 - Thistran *!* Removed properties *!* This.cReportName *!* New properties *!* WaitForNextReport - logical determines if the listener object will keep *!* the file handles opened in order to get the next report pages *!* Renamed property: *!* "RTF_filename" to "TargetFileName" *!* in order to use the same property name from HTMLListener *!* Method Init() *!* Removed the need of all parameters *!* Just one parameter is allowed, the destination RTF file name *!* This will fill the "TargetFileName" property *!* Original comments from Vladimir Zhuravlev - original usage has changed ! * Not valid anymore * SET CLASSLIB TO frx_rtf * loObjectList = CREATEOBJECT('rtfreportlistener', 'report1.frx', 'newrep.rtf', '', '') * loObjectList.OutputType = 1 * REPORT FORM report1 OBJECT loObjectList PREVIEW noconsole * in CREATEOBJECT('rtfreportlistener', 'report1.frx', 'newrep.rtf', '', '') * first parameter is class name, second is report name to be converted, third parameters is * MS Word document name. To This document VFP report will be converted * Two optional parameters can be 'ThisForm','This' * These for reports, where ThisForm or This are used in expresions * Class does not cover General fields, if they were in report expresions * Comments for future implementation *!* * Get color attributes *!* IF VARTYPE(This.oRecord) = "O" *!* SET STEP ON *!* LOCAL lnRed, lnGreen, lnBlue, lnColorIndex *!* lnRed = This.oRecord.PenRed *!* lnGreen = This.oRecord.PenGreen *!* lnBlue = This.oRecord.PenBlue *!* lnColorIndex = This.AddColor(lnRed, lnGreen, lnBlue) *!* ELSE *!* ENDIF ENDPROC PROCEDURE frxtotwips LPARAMETERS tnFrx */ inches to twip RETURN INT(tnFrx / 960 * 1440) ENDPROC PROCEDURE outputfromdata LPARAMETERS toListener, tcOutputDBF, tnWidth, tnHeight IF VARTYPE(toListener) <> "O" MESSAGEBOX("Invalid parameter. Report listener not available", 16, "Error") RETURN ENDIF This.oActiveListener = toListener IF EMPTY(toListener.cFRXAlias) MESSAGEBOX("The helper FRX table is not available. Output can't be created", 16, "Error") RETURN ENDIF LOCAL lnSelect, lnOrigDataSession lnSelect = SELECT() lnOrigDataSession = SET("Datasession") * Ensure we are at the correct DataSession SET DATASESSION TO (toListener.ListenerDataSession) * SET DATASESSION TO (toListener.CurrentDataSession) SELECT (tcOutputDBF) * =DoFoxyTherm(90, "Texto label", "Titulo") * =DoFoxyTherm(-1, "Teste2", "Titulo") && Continuo * =DoFoxyTherm() && Desliga IF NOT This.QuietMode LOCAL lnSecs lnSecs = SECONDS() *!* ._InitStatusText = .GetLoc("INITSTATUS") + SPACE(1) *!* ._RunStatusText = .GetLoc("RUNSTATUS") + SPACE(1) *!* ._SecondsText = .GetLoc("SECONDS") + SPACE(1) =DoFoxyTherm(1, "0%", _goHelper._InitStatusText) ENDIF * Generate RTF using the stored information This.lDefaultMode = .F. This.nPageWidth = This.FrxToTwips(tnWidth) This.nPageHeight = This.FrxToTwips(tnHeight) LOCAL lnPgFrom, lnPgTo lnPgFrom = _goHelper._ClausenRangeFrom && = loListener.COMMANDCLAUSES.RangeFrom lnPgTo = IIF(_goHelper._ClausenRangeTo = -1, 999999, _goHelper._ClausenRangeTo) && = loListener.COMMANDCLAUSES.RangeTo && -1 = All pages * Initialize class * This.BeforeReport() This.RTF_Create() SELECT (tcOutputDBF) IF This.QuietMode SCAN IF BETWEEN(Page, lnPgFrom, lnPgTo) This.Render(FRXRECNO, Left, Top, Width, Height, ContType, UNContents, 0) ENDIF ENDSCAN ELSE LOCAL lnPercent, lnLastPercent, lnDelay, lnTotRecs, lnRec lnLastPercent = 0 lnDelay = 1 lnTotRecs = RECCOUNT() lnRec = 0 SCAN IF BETWEEN(Page, lnPgFrom, lnPgTo) IF NOT This.QuietMode lnRec = lnRec + 1 lnPercent = CEILING(100*lnRec/lnTotRecs) IF (lnLastPercent > 0 AND ; lnPercent - lnLastPercent < lnDelay AND ; lnPercent <> 100) ELSE =DoFoxyTherm(lnPercent, ; ALLTRIM(TRANSFORM(lnPercent)) + "% - " + TRANSFORM(FLOOR(SECONDS() - lnSecs)) + " " + _goHelper._SecondsText , ; _goHelper._RunStatusText) ENDIF ENDIF This.Render(FRXRECNO, Left, Top, Width, Height, ContType, UNContents, 0) ENDIF ENDSCAN =DoFoxyTherm(100, ; "100% - " + TRANSFORM(CEILING(SECONDS() - lnSecs)) + " " + _goHelper._SecondsText , ; _goHelper._RunStatusText) ENDIF * Finalize This.AfterReport() USE IN SELECT(tcOutputDBF) * Restore DataSession, Alias SET DATASESSION TO (lnOrigDataSession) SELECT (lnSelect) IF NOT This.QuietMode =DoFoxyTherm() ENDIF RETURN ENDPROC PROCEDURE renderrtf LPARAMETERS loFRXrecord, nleft, ntop, nwidth, nheight, nobjectcontinuationtype, ccontentstoberendered, gdiplusimage, _tForceObjectType, _tForceLineOfset *!* 2011-08-12 - Jacques Parent *!* _tForceObjectType, _tForceLineOfset are used in cate there is a continuation for boxes *!* Boxes are then decomposed into lines. #Define OBJ_COMMENT 0 #Define OBJ_LABEL 5 #Define OBJ_LINE 6 #Define OBJ_RECTANGLE 7 #Define OBJ_FIELD 8 #Define OBJ_PICTURE 17 #Define OBJ_VARIABLE 18 *!* 2011-08-12 - Jacques Parent - Some constants #DEFINE tnConstVerticalLine 0 #DEFINE tnConstHorizontalLine 1 IF VARTYPE(_tForceObjectType) <> "N" _tForceObjectType = -1 ENDIF IF VARTYPE(_tForceLineOfset) <> "N" _tForceLineOfset = -1 ENDIF WITH loFrxRecord ******* * OUTPUT ******* ****************************************** Local fontnum, font_id, _fontstyle, lcRTF, _allg, lcpensize lcRTF = '' LOCAL lcText, llDblByte lcText = STRCONV(cContentsToBeRendered,6) IF LEN(lcText) <> LENC(lcText) && Double-Byte characters llDblByte = .T. ELSE llDblByte = .F. ENDIF Do Case ************************************************************************* *** Field or label into textbox ************************************************************************* Case _tForceObjectType == OBJ_FIELD OR _tForceObjectType == OBJ_LABEL OR (_tForceObjectType==-1 AND (.ObjType = OBJ_FIELD OR .ObjType = OBJ_LABEL)) LOCAL lcWrapText lcWrapText = "" IF .ObjType = OBJ_FIELD IF llDblByte = .T. lcText = This.StringFromUnicode(cContentsToBeRendered) .Expr = lcText *!* .Expr = STRCONV(cContentsToBeRendered,6) *!* .Expr = STRTRAN(.Expr, CHR(13) + CHR(10), "<_CR_>") *!* .Expr = STRTRAN(.Expr, CHR(13), "<_CR_>") *!* .Expr = STRTRAN(.Expr, CHR(10), "<_CR_>") *!* .Expr = STRTRAN(.Expr, "<_CR_>", " \par ") ELSE && Single-byte .Expr = STRCONV(cContentsToBeRendered,6) .Expr = STRTRAN(.Expr, CHR(13) + CHR(10), "<_CR_>") .Expr = STRTRAN(.Expr, CHR(13), "<_CR_>") .Expr = STRTRAN(.Expr, CHR(10), "<_CR_>") .Expr = STRTRAN(.Expr, "<_CR_>", " \par ") ENDIF *!* .Expr = STRCONV(cContentsToBeRendered,6) *!* .Expr = STRTRAN(.Expr, CHR(13) + CHR(10), "<_CR_>") *!* .Expr = STRTRAN(.Expr, CHR(13), "<_CR_>") *!* .Expr = STRTRAN(.Expr, CHR(10), "<_CR_>") *!* .Expr = STRTRAN(.Expr, "<_CR_>", " \par ") ELSE IF llDblByte .Expr = This.StringFromUnicode(cContentsToBeRendered) ELSE .Expr = CHRTRAN(loFRXRecord.Expr, ["], []) * Removing CHR(13) from texts IF CHR(13) $ .Expr .Expr=Strtran(.Expr, Chr(13), ' \par ') * .Expr=Strtran(.Expr, Chr(13), ' \line ') nWidth = nWidth + 150 ELSE lcWrapText = '{\sp{\sn WrapText}{\sv 2}}' ENDIF ENDIF ENDIF ************* Making allign *!* If .ObjType = OBJ_LABEL *!* _allg = '\ql ' *!* Else If Left(.Picture, 1) = '@' Do Case Case 'J'$.Picture _allg = '\qr ' Case 'I'$.Picture _allg = '\qc ' Otherwise _allg = '\ql ' Endcase Else Do Case * CChalom 2010-09-28 * Included the Full Justify option, when the tag "" is found in the USER field CASE "" $ .User _allg = '\qj ' *- Case .offset = 0 _allg = '\ql ' Case .offset = 2 _allg = '\qc ' Case .offset = 1 _allg = '\qr ' Otherwise _allg = '\ql ' Endcase Endif *!* Endif * CChalom 2010-01-21 * Included color tags for "Fields" and "Labels" ********* Color attributes LOCAL lcColorRTF, lnClrIndex, lcColorTag, lcBackColorRTF, lnBackClrIndex lcColorTag = "" * Draw a box as a background for the texts * Create a border color with the same color of the backcolor lcpensize = Alltrim(Str(9525*.pensize)) LOCAL lcPenColor, lcFillColor IF .FillRed <> -1 && Not default lcPenColor = '{\sp{\sn lineColor}{\sv ' + TRANSFORM(RGB(.FillRed, .FillGreen, .FillBlue)) + '}}' ELSE lcPenColor = "" ENDIF IF .Mode = 0 AND .FillRed <> -1 && Mode: 0 = Opaque background; 1 = Transparent LOCAL lnRGB IF .FillRed = -1 lnRGB = RGB(255,255,255) ELSE lnRGB = RGB(.FillRed, .FillGreen, .FillBlue) ENDIF lcFillColor = '{\sp{\sn fillColor}{\sv ' + TRANSFORM(lnRGB) + '}}' + ; '{\sp{\sn fRecolorFillAsPicture}{\sv 0}}{\sp{\sn fFilled}{\sv 1}}' ELSE lcFillColor = "" ENDIF IF EMPTY(lcFillColor) lcRTF = "" ELSE lcRTF = '{\shp{\*\shpinst' + ; '\shpleft' + Alltrim(Str(This.FrxToTwips(nleft)))+; '\shptop' + Alltrim(Str(This.FrxToTwips(ntop)))+; '\shpright' + Alltrim(Str(This.FrxToTwips(nleft + nwidth)))+; '\shpbottom' + Alltrim(Str(This.FrxToTwips(ntop + nheight)))+; '\shpfhdr0' + ; '\shpbxmargin' + ; '\shpbxignore' + ; '\shpbymargin' + ; '\shpbyignore' + ; '{\sp{\sn fline}{\sv 1}}{\sp{\sn fFlipH}{\sv 0}}{\sp{\sn fFilled}{\sv 0}}'+; '{\sp{\sn lineWidth}{\sv ' + lcpensize + '}}'+; lcFillColor + ; lcPenColor + ; '}}' ENDIF IF .PenRed = -1 && Default Black lcColorRTF = "\red0\green0\blue0" ELSE lcColorRTF = "\red" + ALLTRIM(STR(.penRed)) + "\green" + ALLTRIM(STR(.penGreen)) + "\blue" + ALLTRIM(STR(.penBlue)) ENDIF lnClrIndex = Ascan(This.arColors, lcColorRTF) &&, 1, 1, 1, 1) IF lnClrIndex = 0 lnClrIndex = 1 ELSE lnClrIndex = ((lnClrIndex -1) / 4) + 1 ENDIF lcColorTag = lcColorTag + "\cf" + ALLTRIM(STR(lnClrIndex)) + " " ********* Font number fontnum = Ascan(This.arfont,Alltrim(.fontface),1) font_id = Iif(fontnum = 0, '0', Alltrim(Str(fontnum))) *********** FONT features _fontstyle = This.fontstyleconvert(.fontstyle) LOCAL lnBorder lnBorder = 8 lcRTF = lcRTF + '{\shp{\*\shpinst'+; '\shpleft' + Alltrim(Str(This.FrxToTwips(nleft)))+; '\shptop' + Alltrim(Str(This.FrxToTwips(ntop)))+; '\shpright' + Alltrim(Str(This.FrxToTwips(nleft+nwidth+lnBorder)))+; '\shpbottom' + Alltrim(Str(This.FrxToTwips(ntop+nheight+lnBorder)))+; '\shpfhdr0' + ; '{\sp{\sn fline}{\sv 0}}'+; '{\sp{\sn dxTextLeft}{\sv 0}}'+; '{\sp{\sn dyTextTop}{\sv 0}}'+; '{\sp{\sn dxTextRight}{\sv 0}}'+; '{\sp{\sn dyTextBottom}{\sv 0}}'+; '{\sp{\sn fFilled}{\sv 0}}'+; '{\sp{\sn fFitShapeToText}{\sv 1}}'+; lcWrapText + ; '{ \shptxt\pard' + _fontstyle + '\f' + m.font_id + '\fs' + Alltrim(Str(.FontSize*2))+; _allg + lcColorTag + .Expr + ' '+'}}}' *********************************************************** * Line *************************************************************** Case _tForceObjectType == OBJ_LINE OR (_tForceObjectType==-1 AND .ObjType = OBJ_LINE) lcpensize = Alltrim(Str(9525*.pensize)) * CChalom 2010-01-21 * Included color tags for "Lines" LOCAL lcPenColor, lcFillColor IF .PenRed <> -1 && Not default lcPenColor = '{\sp{\sn lineColor}{\sv ' + TRANSFORM(RGB(.PenRed, .PenGreen, .PenBlue)) + '}}' ELSE lcPenColor = "" ENDIF *--- If _tForceLineOfset == 1 OR (_tForceLineOfset==-1 AND .offset = 1) && horizontal lcRTF = '{\shp{\*\shpinst'+; '\shpleft' + Alltrim(Str(This.FrxToTwips(nleft)))+; '\shptop' + Alltrim(Str(This.FrxToTwips(ntop)))+; '\shpright' + Alltrim(Str(This.FrxToTwips(nleft+nwidth)))+; '\shpbottom' + Alltrim(Str(This.FrxToTwips(ntop)))+; '\shpfhdr0'+; '{\sp{\sn fline}{\sv 1}}' + '{\sp{\sn ShapeType}{\sv 20}}'+; '{\sp{\sn lineWidth}{\sv ' + lcpensize + '}}'+; lcPenColor + ; '}}' ELSE && Vertical lcRTF = '{\shp{\*\shpinst' + ; '\shpleft' + Alltrim(Str(This.FrxToTwips(nleft+nwidth)))+; '\shptop' + Alltrim(Str(This.FrxToTwips(ntop)))+; '\shpright' + Alltrim(Str(This.FrxToTwips(nleft+nwidth)))+; '\shpbottom' + Alltrim(Str(This.FrxToTwips(ntop+nheight)))+; '\shpfhdr0' + ; '{\sp{\sn fline}{\sv 1}}' + '{\sp{\sn ShapeType}{\sv 20}}'+; '{\sp{\sn lineWidth}{\sv ' + lcpensize + '}}'+; lcPenColor + ; '}}' Endif * Shape Case _tForceObjectType == OBJ_RECTANGLE OR (_tForceObjectType==-1 AND .ObjType = OBJ_RECTANGLE) && Rectangle, Box *!* -------------------------------------------------------- *!* -------------------------------------------------------- *!* -------------------------------------------------------- *!* 2011-08-12 - Jacques Parent *!* Let boxes be printed correctly on multiple lines *!* Not sure how it would react with rounded corners... IF nobjectcontinuationtype == 0 OR (.FillPat = 1 AND .Mode = 0) *!* Either the continuation is COMPLETE (0) OR the box must be filled. lcpensize = Alltrim(Str(9525*.pensize)) * CChalom 2010-01-21 * Included color tags for "Shapes" LOCAL lcPenColor, lcFillColor IF nobjectcontinuationtype == 0 If .PenRed = -1 IF .PenPat = 0 lcPenColor = '{\sp{\sn lineColor}{\sv ' + TRANSFORM(RGB(255, 255, 255)) + '}}' ELSE lcPenColor = "" ENDIF ELSE lcPenColor = '{\sp{\sn lineColor}{\sv ' + TRANSFORM(RGB(.PenRed, .PenGreen, .PenBlue)) + '}}' ENDIF ELSE *!* Set the pen color to the fill color! IF .FillRed = -1 IF .PenPat = 0 lcPenColor = '{\sp{\sn lineColor}{\sv ' + TRANSFORM(RGB(255, 255, 255)) + '}}' ELSE lcPenColor = "" ENDIF ELSE lcPenColor = '{\sp{\sn lineColor}{\sv ' + TRANSFORM(RGB(.FillRed, .FillGreen, .FillBlue)) + '}}' ENDIF ENDIF IF .FillPat = 1 AND (.Mode = 0 OR .FillRed <> -1) && Mode: 0 = Opaque background; 1 = Transparent LOCAL lnRGB IF .FillRed = -1 lnRGB = RGB(255,255,255) ELSE lnRGB = RGB(.FillRed, .FillGreen, .FillBlue) ENDIF lcFillColor = '{\sp{\sn fillColor}{\sv ' + TRANSFORM(lnRGB) + '}}' + ; '{\sp{\sn fRecolorFillAsPicture}{\sv 0}}{\sp{\sn fFilled}{\sv 1}}' ELSE lcFillColor = "" ENDIF *--- * CChalom 2010-07-20 * Included code for generic rounded shapes LOCAL lcRounded lcRounded = IIF(.OffSet = 0, ; "", ; '{\sp{\sn shapeType}{\sv 2}}') * Not used, allows setting the curvature parameter, change the value 40 * lcRounded = IIF(.OffSet = 0, ; "", ; '{\sp{\sn shapeType}{\sv 2}}' + ; '{\sp{\sn adjustValue}{\sv ' + ALLTRIM(TRANSFORM(.OffSet * 40)) + '}}') lcRTF = '{\shp{\*\shpinst' + ; '\shpleft' + Alltrim(Str(This.FrxToTwips(nleft)))+; '\shptop' + Alltrim(Str(This.FrxToTwips(ntop)))+; '\shpright' + Alltrim(Str(This.FrxToTwips(nleft + nwidth)))+; '\shpbottom' + Alltrim(Str(This.FrxToTwips(ntop + nheight)))+; '\shpfhdr0' + ; '\shpbxmargin' + ; '\shpbxignore' + ; '\shpbymargin' + ; '\shpbyignore' + ; lcRounded + ; '{\sp{\sn fline}{\sv 1}}{\sp{\sn fFlipH}{\sv 0}}{\sp{\sn fFilled}{\sv 0}}'+; '{\sp{\sn lineWidth}{\sv ' + lcpensize + '}}'+; lcFillColor + ; lcPenColor + ; '}}' ENDIF IF !EMPTY(lcRTF) = Fputs(This.handle, lcRTF) lcRTF = "" ENDIF *!* In case there is a continuation <> 0... DO CASE CASE nobjectcontinuationtype == 1 && Top *!* Translate into lines ** Top line This.RenderRTF(loFRXrecord, nleft, ntop, nwidth, 0, nobjectcontinuationtype, ccontentstoberendered, gdiplusimage, OBJ_LINE, tnConstHorizontalLine) ** Left line This.RenderRTF(loFRXrecord, nleft, ntop, 0, nheight, nobjectcontinuationtype, ccontentstoberendered, gdiplusimage, OBJ_LINE, tnConstVerticalLine) ** Right line This.RenderRTF(loFRXrecord, nleft + nwidth, ntop, 0, nheight, nobjectcontinuationtype, ccontentstoberendered, gdiplusimage, OBJ_LINE, tnConstVerticalLine) CASE nobjectcontinuationtype == 2 && Middle *!* Translate into lines ** Left line This.RenderRTF(loFRXrecord, nleft, ntop, 0, nheight, nobjectcontinuationtype, ccontentstoberendered, gdiplusimage, OBJ_LINE, tnConstVerticalLine) ** Right line This.RenderRTF(loFRXrecord, nleft + nwidth, ntop, 0, nheight, nobjectcontinuationtype, ccontentstoberendered, gdiplusimage, OBJ_LINE, tnConstVerticalLine) CASE nobjectcontinuationtype == 3 && Bottom *!* Translate into lines ** Bottom line This.RenderRTF(loFRXrecord, nleft, ntop + nheight, nwidth, 0, nobjectcontinuationtype, ccontentstoberendered, gdiplusimage, OBJ_LINE, tnConstHorizontalLine) ** Left line This.RenderRTF(loFRXrecord, nleft, ntop, 0, nheight, nobjectcontinuationtype, ccontentstoberendered, gdiplusimage, OBJ_LINE, tnConstVerticalLine) ** Right line This.RenderRTF(loFRXrecord, nleft + nwidth, ntop, 0, nheight, nobjectcontinuationtype, ccontentstoberendered, gdiplusimage, OBJ_LINE, tnConstVerticalLine) ENDCASE *!* -------------------------------------------------------- *!* -------------------------------------------------------- *!* -------------------------------------------------------- Case _tForceObjectType == OBJ_PICTURE OR (_tForceObjectType == -1 AND .ObjType = OBJ_PICTURE) LOCAL hdPict, strFile, lnFileSize, lhFile, objPict,; lnPictWidth, lnPictHeight, lnWidth, lnHeight, llLock, lncropr, lncropb * CChalom 2010-01-17 * Dealing with images in General fields * Saving the image to the disk in a Temp file * Using _Gdiplus.vcx that is already embedded in ReportOutput.App LOCAL lcTempImgFile IF GDIPlusImage!=0 && General field lcTempImgFile = GetEnv("TEMP") + "\" + Sys(2015) + ".Png" LOCAL loImage AS GpImage OF (HOME() + _ReportOutput) loImage = NEWOBJECT("GpImage", "_GdiPlus.vcx") loImage.SetHandle(GDIPlusImage) loImage.SaveToFile(lcTempImgFile,"image/jpeg") loImage = NULL * Replace the original empty file cContentsTobeRendered = lcTempImgFile ENDIF IF EMPTY(GDIPlusImage) AND EMPTY(cContentsTobeRendered) && Nothing to render && try drawing directly, from the original canvas lcTempImgFile = This.GetPictureFromListener(nLeft, nTop, nWidth, nHeight) cContentsTobeRendered = lcTempImgFile ENDIF *--- IF NOT EMPTY(cContentsTobeRendered) AND FILE(cContentsTobeRendered) * Picture size lcExt = JUSTEXT(cContentsTobeRendered) * CChalom 2010-02-19 * Changed the way to get the image dimensions and load its binaries LOCAL lnWidth, lnHeight LOCAL loVFPImg as Image loVFPImg = CREATEOBJECT("Image") loVFPImg.Picture = cContentsTobeRendered lnWidth = loVFPImg.Width * 7276 / 275 lnHeight = loVFPImg.Height * 7276 / 275 loVFPImg = NULL lnPictWidth = This.HiMetricToRTF(lnWidth) lnPictHeight = This.HiMetricToRTF(lnHeight) strFile = FILETOSTR(cContentsTobeRendered) CLEAR RESOURCES (cContentsTobeRendered) lhFile = STRCONV(strFile, 15) DO CASE CASE .General = 0 && Clip llLock = 1 lnWidth = MIN(nWidth, lnPictWidth) lnHeight = MIN(nHeight, lnPictHeight) lncropr = This.DecToProc(MAX(lnPictWidth - nWidth, 0)/lnPictWidth) lncropb = This.DecToProc(MAX(lnPictHeight - nHeight, 0)/lnPictHeight) CASE .General = 1 && Isometric llLock = 1 * Isometric Adjustment LOCAL lnHorFactor, lnVertFactor, lnResizeFactor m.lnHorFactor = m.nWidth / m.lnPictWidth m.lnVertFactor = m.nHeight / m.lnPictHeight m.lnResizeFactor = MIN(m.lnHorFactor, m.lnVertFactor) m.lnWidth = m.lnPictWidth * m.lnResizeFactor m.lnHeight = m.lnPictHeight * m.lnResizeFactor * lnWidth = MIN(nWidth, lnPictWidth) * lnHeight = MIN(nHeight, lnPictHeight) lncropb = 0 lncropr = 0 CASE .General = 2 && Stretch llLock = 0 lnWidth = nWidth lnHeight = nHeight lncropb = 0 lncropr = 0 ENDCASE lcRTF = '{\shp{\*\shpinst' + ; '\shpleft'+Alltrim(Str(This.FrxToTwips(nleft)))+; '\shptop'+Alltrim(Str(This.FrxToTwips(ntop)))+; '\shpright'+Alltrim(Str(This.FrxToTwips(nleft+lnWidth)))+; '\shpbottom'+Alltrim(Str(This.FrxToTwips(ntop+lnHeight)))+; '{\sp{\sn ShapeType}{\sv 75}}'+; '{\sp{\sn fline}{\sv 0}}'+; '{\sp{\sn fLockAspectRatio}{\sv '+STR(llLock,1)+'}}'+; '{\sp{\sn cropFromBottom}{\sv '+ALLTRIM(STR(lncropb))+'}}'+; '{\sp{\sn cropFromRight} {\sv '+ALLTRIM(STR(lncropr))+'}}'+; '{\sp{\sn pib}' + ; '{\sv ' + ; '{\pict' + ; '\wmetafile8\pic' + lcExt + '\picbpp4' + CHR(13)+; lhFile +'}'+; '}' + ; '}' + ; '{\sp{\sn pibFlags}{\sv 2}}' + ; '{\sp{\sn fUseShapeAnchor}{\sv 0}}' + ; '}}' ENDIF IF NOT EMPTY(lcTempImgFile) TRY DELETE FILE(lcTempImgFile) CATCH TO loExc SET STEP ON ENDTRY ENDIF OTHERWISE SET STEP ON Endcase *************** ENDWITH IF !EMPTY(lcRTF) = Fputs(This.handle, lcRTF) ENDIF ENDPROC PROCEDURE getpageimg #DEFINE OutputJPEG 102 #DEFINE OutputPNG 104 LOCAL loListener as ReportListener loListener = IIF(VARTYPE(This.oActiveListener)="O", This.oActiveListener, This) LOCAL lnPage lnPage = This.nCurrentPage - loListener.CommandClauses.RangeFrom + 1 DIMENSION This.aPagesImgs(lnPage) IF EMPTY(This.aPagesImgs(lnPage)) LOCAL lnDeviceType, lcFile, lnDeviceType, lnHandle lnDeviceType = OutputPNG lcFile = ADDBS(GETENV("TEMP")) + SYS(2015) + ".PNG" loListener.OutputPage(lnPage, lcFile, lnDeviceType) This.aPagesImgs(lnPage) = lcFile ENDIF RETURN This.aPagesImgs(lnPage) ENDPROC PROCEDURE getpicturefromlistener *!* 2011/02/25 CChalom *!* When we can't render the PDF text or image correctly, we still can get * an image of the object, and draw it to the PDF document LPARAMETERS tnX, tnY, tnWidth, tnHeight IF This.lDefaultMode RETURN ENDIF LOCAL lcFile lcFile = This.GetPageImg() IF EMPTY(lcFile) RETURN .F. && Could not load image ENDIF * Horizontal and Vertical factors to divide to convert to the correct coordinate LOCAL lnHor, lnVert lnHor = 9.972 lnVert = 9.996 lcNewFile = This.CropImage(lcFile, tnX / lnHor, tnY / lnVert, tnWidth / lnHor, tnHeight / lnVert, .T.) RETURN lcNewFile ENDPROC PROCEDURE cropimage Lparameters lcFile As String, tnX, tnY, lnWidth As Integer, lnHeight As Integer, tlFile Local loBmp As gpBitmap OF HOME() + "ffc\_gdiplus.vcx" loBmp = NEWOBJECT("GpBitmap", "_GdiPlus.vcx") loBmp.CreateFromFile(lcFile) lnHeight = MIN(lnHeight, loBmp.ImageHeight) lnWidth = MIN(lnWidth , loBmp.ImageWidth) LOCAL lhBitmap, lnStatus lhBitmap = 0 * Function used in the CropImage method DECLARE Long GdipCloneBitmapAreaI IN GDIPLUS.DLL AS pdfxGdipCloneBitmapAreaI Long x, Long y, Long nWidth, Long Height, Long PixelFormat, Long srcBitmap, Long @dstBitmap lnStatus = pdfxGdipCloneBitmapAreaI(tnX, tnY, lnWidth, lnHeight, loBmp.PixelFormat, loBmp.GetHandle(), @lhBitmap) IF (lnStatus <> 0) OR (lhBitmap = 0) loBmp = NULL * lnHandle = 0 RETURN "" ENDIF LOCAL loCropped As gpBitmap OF HOME() + "ffc\_gdiplus.vcx" loCropped = NEWOBJECT("GpBitmap", "_GdiPlus.vcx") loCropped.SetHandle(lhBitmap, .T.) && Owns handle, please destroy the Bmp object when releasing loCropped.SetResolution(loBmp.HorizontalResolution, loBmp.VerticalResolution) LOCAL lcEXT, lcEncoder lcEXT = UPPER(JUSTEXT(lcFile)) lcEncoder = IIF(lcEXT = "PNG", "image/png", "image/jpeg") LOCAL lcCroppedFile lcCroppedFile = FORCEEXT(This._cTempFolder + Sys(2015), lcEXT) loCropped.SaveToFile(lcCroppedFile, lcEncoder) loCropped = NULL loBMP = NULL This.oImages.Add(lcCroppedFile) RETURN lcCroppedFile ENDPROC PROCEDURE updateproperties IF NOT This.lObjTypeMode OR (VARTYPE(_Screen.oFoxyPreviewer) <> "O") RETURN ENDIF LOCAL loFP loFP = _Screen.oFoxyPreviewer IF VARTYPE(This.CommandClauses) = "O" *!* IF This.CommandClauses.Preview *!* This.lOpenViewer = .T. *!* ELSE *!* This.lOpenViewer = NVL(loFP.lOpenViewer, .T.) *!* ENDIF This.lOpenViewer = This.CommandClauses.Preview IF NOT EMPTY(This.CommandClauses.ToFile) This.TargetFileName = This.CommandClauses.ToFile ELSE IF VARTYPE(_Screen.oFoxyPreviewer) = "O" AND ; NOT EMPTY(_Screen.oFoxyPreviewer.cDestFile) AND ; EMPTY(This.TargetFileName) LOCAL lcDestFile lcDestFile = _Screen.oFoxyPreviewer.cDestFile IF NOT "\" $ lcDestFile lcDestFile = ALLTRIM(ADDBS(_Screen.oFoxyPreviewer.cOutputPath) + lcDestFile) ENDIF This.TargetFileName = lcDestFile ELSE LOCAL lcFile lcFile = This.TargetFileName IF EMPTY(lcFile) lcFile = PUTFILE("","","rtf") ENDIF IF EMPTY(lcFile) _ReportListener::CancelReport() * This.CancelReport() RETURN .F. ENDIF This.TargetFileName = lcFile ENDIF ENDIF ENDIF This.QUIETMODE = NVL(loFP.lQuietMode , .F.) IF VARTYPE(This.CommandClauses) = "O" IF This.CommandClauses.Preview This.lOpenViewer = .T. ENDIF IF NOT EMPTY(This.CommandClauses.ToFile) This.TargetFileName = This.CommandClauses.ToFile ENDIF ENDIF ENDPROC PROCEDURE stringfromunicode LPARAMETERS tcUnicode LOCAL n, lcUNValue, lnUNValue, lcNewContents lcUnValue = "" lcNewContents = "" * {\uc1\u20013 ?\u25991 ?\u31616 ?\u20307 ?\u27721 ?\u23383 ?-\u28436 ?\u31034 ?-Demo} YE_-Demo * .Expr = STRCONV(cContentsToBeRendered,6) * .Expr = STRTRAN(.Expr, CHR(13) + CHR(10), "<_CR_>") * .Expr = STRTRAN(.Expr, CHR(13), "<_CR_>") * .Expr = STRTRAN(.Expr, CHR(10), "<_CR_>") * .Expr = STRTRAN(.Expr, "<_CR_>", " \par ") LOCAL lnChars lnChars = LEN(tcUnicode) FOR n = 1 TO lnChars STEP 2 lcUNValue = SUBSTR(tcUnicode, n, 2) IF EMPTY(lcUNValue) EXIT ENDIF lnUNValue = CTOBIN(0h+lcUNValue,"2RS") IF lnUNValue = 10 && Carriage return - CHR(10) lcNewContents = lcNewContents + " \par " LOOP ENDIF lcNewContents = lcNewContents + '\u' + ALLTRIM(TRANSFORM(lnUNValue)) + ' ?' ENDFOR RETURN lcNewContents ENDPROC PROCEDURE Destroy IF This.lDefaultMode DODEFAULT() ENDIF ENDPROC PROCEDURE AfterReport IF This.lDefaultMode OR This.lObjTypeMode DODEFAULT() ELSE NODEFAULT ENDIF * Determine the ".WaitForNextReport" status if using "lObjTypeMode" IF This.lObjTypeMode TRY This.WaitForNextReport = This.CommandClauses.NoPageEject CATCH ENDTRY ENDIF ** Save the document to RTF IF NOT This.WaitForNextReport =FPUTS(This.Handle, '}') LOCAL llSaved llSaved = FCLOSE(This.Handle) IF llSaved IF This.lObjTypeMode _Screen.oFoxyPreviewer.lSaved = llSaved ENDIF IF This.lOpenViewer This.ShellExec(This.TargetFileName) ENDIF ENDIF ENDIF * CChalom * Reset the report page counter This.nPgCounter = 0 * Delete the pages files LOCAL n, lcFile FOR m.n = 1 TO ALEN(This.aPagesImgs,1) lcFile = This.aPagesImgs(m.n) IF NOT EMPTY(lcFile) TRY DELETE FILE (lcFile) CATCH ENDTRY ENDIF ENDFOR IF VARTYPE(This.oImages) = "O" && Cleanup Temporary Images Files LOCAL lcItem AS String FOR EACH lcItem IN This.oImages FOXOBJECT IF FILE(lcItem) LOCAL loExc as Exception TRY DELETE FILE (lcItem) CATCH TO loExc SET STEP ON ENDTRY ENDIF ENDFOR This.oImages = NULL ENDIF This.oActiveListener = "" * Delete the temporary copy of the FRX we created IF This.lObjTypeMode OR This.lDefaultMode USE IN SELECT(This.cFRXalias) TRY DELETE FILE (This.cTempFRX) CATCH ENDTRY ENDIF ENDPROC PROCEDURE Render LPARAMETERS nFRXRecno, nLeft, nTop, nWidth, nHeight, nObjectContinuationType, cContentsToBeRendered, GDIPlusImage LOCAL lnPageNo lnPageNo = This.PageNo IF This.lDefaultMode * CChalom 2010-01-25 * If the report page is not between the page ranges asked, just skip LOCAL lnRangeTo, tlNewPage tlNewPage = .F. IF This.PageNo > This.nGlobalPgCounter OR This.nPgCounter = 0 This.nPgCounter = This.nPgCounter + 1 This.nGlobalPgCounter = This.nGlobalPgCounter + 1 tlNewPage = .T. ENDIF lnRangeTo = This.CommandClauses.RangeTo IF lnRangeTo <> -1 AND NOT BETWEEN(This.nPgCounter, This.CommandClauses.RangeFrom, lnRangeTo) IF tlNewPage This.OldPageNo = This.PageNo &&_PageNo ENDIF NODEFAULT RETURN ENDIF * Moved the page change to the render method If This.OldPageNo != This.PageNo &&_PageNo This.OldPageNo = This.PageNo &&_PageNo IF This.lStarted && add a new page only if the report has already started = Fputs(This.handle,'\page') ENDIF Endif This.nCurrentPage = This.PageNo ELSE If This.OldPageNo != PAGE This.OldPageNo = PAGE IF This.lStarted && add a new page only if the report has already started = Fputs(This.handle,'\page') ENDIF Endif This.nCurrentPage = PAGE ENDIF * From PDFx by Luis Navas * Code to detect if report will run twice because of use of _PAGETOTAL If This.TwoPassProcess And This.CurrentPass=0 Then NODEFAULT RETURN EndIf This.lStarted = .T. IF This.lDefaultMode This.loFRXRecord = This.Getfrxrecord(nFRXRecno) ELSE LOCAL loFRX SCATTER MEMO NAME loFRX This.loFRXRecord = loFRX ENDIF * Here is calling to RTF output This.RenderRTF(This.loFRXRecord, nLeft, nTop, nWidth, nHeight, ; nObjectContinuationType, cContentsToBeRendered, GDIPlusImage) * CChalom 2010-01-17 * No need to call the default render event, because we'll passing everything to RTF NODEFAULT ENDPROC PROCEDURE BeforeReport IF This.lDefaultMode OR This.lObjTypeMode This.oActiveListener = This DODEFAULT() ENDIF This.PageSetup() This.RTF_Create() ENDPROC PROCEDURE Init LPARAMETERS tcRTFFileName IF VARTYPE(tcRTFFileName) = "C" AND FILE(tcRTFFileName) DELETE FILE(tcRTFFileName) ENDIF This.TargetFileName = tcRTFFileName This.nPgCounter = 0 IF This.lDefaultMode OR This.lObjTypeMode DODEFAULT() ELSE NODEFAULT ENDIF ENDPROC PROCEDURE LoadReport This.UpdateProperties() DODEFAULT() ENDPROC reportlistener pr_reportlistener.vcx Height = 23 Width = 23 FRXDataSession = -1 SendGDIPlusImage = 1 paper_letter = .F. handle = code_page = 1251 oldpageno = 1 borderwidth = 0 lofrxrecord = .NULL. waitfornextreport = .F. npgcounter = 0 nglobalpgcounter = 0 orecord = .NULL. targetfilename = lstarted = .F. _llandscape = .F. npagewidth = 0 npageheight = 0 ldefaultmode = .T. nmarginleft = 0 nmarginright = 0 nmargintop = 0 nmarginbottom = 0 ncurrentpage = 0 oactivelistener = .NULL. _ctempfolder = oimages = .NULL. lobjtypemode = .F. lopenviewer = .F. ctempfrx = cfrxalias = _memberdata = 551 EXCEPTION SET PRINTER TO NAME '&lcPrinter' Could not change the current printer.C Current Printer: Printer Failed Printer: TCPRINTERNAME LCPRINTER LLRETURN LOEXC SETERROR@ LENABLED PREVIEWFORM TOOLBAR REFRESH CAPTION FORMCAPTIONf MENUTOP MENUPREV MENUNEXT MENULAST MENUGOTO MENUSHOWPA MENUTOOLB CBOZOOMTTI CBOZOOMTTI m.oRef.ExtensionHandler.ActionGotoPage() m.oRef.ExtensionHandler.actionToolbarVisibility() MENUPRINT m.oRef.ExtensionHandler.ActionPrintEx() PRINTINGPR m.oRef.ExtensionHandler.DoCustomPrint() SAVEREPORT ON BAR 17 OF (m.cPopup) ACTIVATE POPUP &lcSaveMenu. SAVEASIMAG pr_Img.bmp m.oRef.ExtensionHandler.DoSaveType(1) SAVEASPDF pr_Pdf.bmp m.oRef.ExtensionHandler.DoSaveType(2) SAVEASHTML pr_Html.bmp m.oRef.ExtensionHandler.DoSaveType(3) SAVEASMHT pr_MHT.bmp m.oRef.ExtensionHandler.DoSaveType(8) SAVEASRTF pr_Word.bmp m.oRef.ExtensionHandler.DoSaveType(4) SAVEASXLS pr_Excel.bmp m.oRef.ExtensionHandler.DoSaveType(5) m.oRef.ExtensionHandler.DoSaveType(1) ON BAR 17 OF (m.cPopup) ACTIVATE POPUP &lcSaveMenu. SAVEASIMAG pr_Img.bmp m.oRef.ExtensionHandler.DoSaveType(1) SAVEASPDF pr_Pdf.bmp m.oRef.ExtensionHandler.DoSaveType(2) SAVEASHTML pr_Html.bmp m.oRef.ExtensionHandler.DoSaveType(3) SAVEASMHT pr_MHT.bmp m.oRef.ExtensionHandler.DoSaveType(8) SAVEASRTF pr_Word.bmp m.oRef.ExtensionHandler.DoSaveType(4) SAVEASXLS pr_Excel.bmp m.oRef.ExtensionHandler.DoSaveType(5) SAVEASTXT pr_1page.bmp m.oRef.ExtensionHandler.DoSaveType(6) SENDTOEMAI m.oRef.ExtensionHandler.DoSendEmail() MENUPROOF m.oRef.ExtensionHandler.DoProof() m.oRef.ExtensionHandler.DoSearch() FINDBACK FINDNEXT m.oRef.ExtensionHandler.DoSearchBack() m.oRef.ExtensionHandler.DoSearchAgain() SETUP m.oRef.ExtensionHandler.DoSetup() MENUCLOSE m.oRef.ExtensionHandler.ActionClose() LANGUAGE ENGLISH ON BAR 7 OF (m.cPopup) ACTIVATE POPUP &lcZoom2 ON BAR 8 OF (m.cPopup) ACTIVATE POPUP &lcPages2 whole page CBOZOOMWHO fit to width CBOZOOMPGW m.oRef.actionSetZoom( BAR() ) ONEPGMENU TWOPGMENU TWOPGMENU FOURPGMENU FOURPGMENU m.oRef.actionSetCanvasCount(1) m.oRef.actionSetCanvasCount(2) m.oRef.actionSetCanvasCount(4) CPOPUP INEXTBAR _GOHELPER GETLOC IMGBTN_TOP IMGBTN_PREV IMGBTN_NEXT IMGBTN_BOTT IMGBTN_GOTOPG LSHOWPAGECOUNT LPRINTVISIBLE LSHOWPRINTBTN IMGBTN_PRINT LPRINTERPREF LCIMGPRINTPREF IMGBTN_PRINTPREF LSAVETOFILE IMGBTN_SAVE LCSAVEMENU LEXTENDED _LCANSEARCH LSAVEASIMAGE LSAVEASPDF LSAVEASHTML LSAVEASMHT LSAVEASRTF LSAVEASXLS LSAVEASTXT LSENDTOEMAIL IMGBTN_EMAIL LSHOWMINIATURES IMGBTN_MINI LSHOWSEARCH IMGBTN_SEARCH _LSHOWSEARCHAGAIN IMGBTN_SEARCHBACK IMGBTN_SEARCHAGAIN LSHOWSETUP IMGBTN_SETUP IMGBTN_CLOSE LCZOOM2 LCPAGES2 LCITEM ZOOMLEVELS ZOOMLEVEL IPAGESALLOWED CANVASCOUNT} PreviewHelper _GOHELPER LEXTENDED _OLANG SETLANGUAGE CLANGUAGE TNVISIBLE PREVIEWFORM TOOLBAR TOOLBARISVISIBLE CREATETOOLBAR UPDATETOOLBAR SHOWTOOLBAR PREVIEWFORM TOOLBAR TOOLBARISVISIBLE CREATETOOLBAR UPDATETOOLBAR SHOWTOOLBARP CustomFrxGotoPageForm LOFORM IPAGENO OPARENTFORM PREVIEWFORM TOOLBAR SHOWTOOLBAR PAGENO CURRENTPAGE SETCURRENTPAGEq REPORTLISTENER OutputPage DialogPrinting _GOHELPER NPRINTERPROPTYPE _CORIGINALPRINTER CPRINTERNAME SETPRINTER SETPRINTERPROPS CLOSESHEETS PREVIEWFORM OREPORT COMMANDCLAUSES PROMPT PRINTPAGECURRENT CURRENTPAGE LOLISTENER ONPREVIEWCLOSE LEXTENDED CLEARCACHE RESTOREPARENT< NPAGENO EDEVICE NDEVICETYPE THIS _GOHELPER LPRINTED _GOHELPER LEXTENDED REPORTRELEASED LCALIAS LNSESSION LNRECNO PREVIEWFORM OREPORT CSTARTINGALIAS NSTARTINGSESSION NSTARTINGRECNO ERASETEMPFILES RELEASE LOEXC DESTROY ONPREVIEWCLOSE CLEARCACHE RESTOREPARENT HIDEFORM LCALIAS LNSESSION LNRECNO PREVIEWFORM OREPORT CSTARTINGALIAS NSTARTINGSESSION NSTARTINGRECNO ERASETEMPFILES RELEASE LOEXC _GOHELPER DESTROY RESTOREPARENT LCALIAS LNSESSION LNRECNO PREVIEWFORM OREPORT CSTARTINGALIAS NSTARTINGSESSION NSTARTINGRECNO ERASETEMPFILES RELEASE LOEXC{ PREVIEWFORM VISIBLE LOEXC HIDEFORM _GOHELPER _OPARENTFORM LOFORM CONTROLBOX TITLEBAR CLOSABLE PAINT PREVIEWFORM OREPORT ONPREVIEWCLOSEM REPORTLISTENER winspool CreateDC WIN32APIQ PR_CreateDC STRING PCHAR FoxyPreviewer Report PChar Printing Error trying to send the output to an alternate printer!C Please report to vfpimaging@hotmail.com Error LNPAGE LNPRINTWIDTH LNPRINTHEIGHT LNMAXWIDTH LNMAXHEIGHT LNHORMARGIN LNVERTMARGIN LNHORRES LNVERTRES LNPAPERFORM _GOHELPER OLISTENER NPRTPAPERSIZE GETFORMDIMENSIONS CPRINTERNAME CLOSESHEETS _LISDOTMATRIX ISDOTMATRIX CPRINTJOBNAME PRINTJOBNAME LLCHANGEDPRINTER _CORIGINALPRINTER LEXTENDED NCOPIES LREPEATINPAGE LCPRINTER LHPRINTER LOLISTENER LCDRIVER CREATEDC WIN32API PR_CREATEDC LNPRINTERDC LCDOCINFO LODOCNAME LCPRINTJOB GETADDR XFCSTARTDOC THIS SIZEPAGES OUTPUTPAGECOUNT XFCSTARTPAGE OUTPUTPAGE XFCENDPAGE XFCENDDOC XFCDELETEDC PREVIEWFORM OREPORT ONPREVIEWCLOSE LOEXC VISIBLE LPRINTED _LSENDTOPRINTER LUSELISTENER SETPRINTER ACTIONCLOSE _LNOWAIT DOOUTPUTp REPORTLISTENER TNHDC TNHORRES TNVERTRES LLSCALEADJUST LOLISTENER _GOHELPER OLISTENER LNHDC GETPAGEWIDTH GETPAGEHEIGHT XFCGETDEVICECAPS PR_Settings.scxJ PR_Settings.scxJ _GOHELPER CLOSESHEETS PREVIEWFORM TOOLBAR LLOLDVISIBLE VISIBLE SHOWTOOLBAR PR_SETTINGS _OSETTINGSSHEET NAME5 pr_previous.bmp pr_next.bmp pr_top.bmp pr_bottom.bmp pr_Locate.bmp pr_Print.bmp pr_PrintPref.bmp pr_gotopage.bmp pr_1page.bmp pr_2page.bmp pr_4page.bmp pr_close.bmp pr_close2.bmp pr_Save.bmp pr_Mail.bmp pr_Gear.bmp pr_Search.bmp pr_SearchAgain.bmp pr_SearchBack.bmp pr_previous_32.bmp pr_next_32.bmp pr_top_32.bmp pr_bottom_32.bmp pr_Locate_32.bmp pr_Print_32.bmp pr_PrintPref_32.bmp pr_gotopage_32.bmp pr_1page_32.bmp pr_2page_32.bmp pr_4page_32.bmp pr_close_32.bmp pr_close2_32.bmp pr_Save_32.bmp pr_Mail_32.bmp pr_Gear_32.bmp pr_Search_32.bmp pr_SearchAgain_32.bmp pr_SearchBack_32.bmp THIS _GOHELPER NBUTTONSIZE IMGBTN_PREV IMGBTN_NEXT IMGBTN_TOP IMGBTN_BOTT IMGBTN_MINI CIMGMINIATURES IMGBTN_PRINT CIMGPRINT IMGBTN_PRINTPREF CIMGPRINTPREF IMGBTN_GOTOPG IMGBTN_1PG IMGBTN_2PG IMGBTN_4PG IMGBTN_CLOSE CIMGCLOSE IMGBTN_CLOSE2 CIMGCLOSE2 IMGBTN_SAVE CIMGSAVE IMGBTN_EMAIL CIMGEMAIL IMGBTN_SETUP CIMGSETUP IMGBTN_SEARCH CIMGSEARCH IMGBTN_SEARCHAGAIN CIMGSEARCHAGAIN IMGBTN_SEARCHBACK CIMGSEARCHBACK CIMGMINIATURESBIG CIMGPRINTBIG CIMGPRINTPREFBIG CIMGCLOSEBIG CIMGCLOSE2BIG CIMGSAVEBIG CIMGEMAILBIG CIMGSETUPBIG CIMGSEARCHBIG CIMGSEARCHAGAINBIG CIMGSEARCHBACKBIG TOOLBAR lStarted lStarted- GetParent WIN32API SetParent WIN32API SetWindowPos WIN32API SynchPageNo SynchPageNo Refresh RefreshToolbar RenderPage RenderPage RestoreFromResource RestoreFromResource_Bind QueryUnload PreviewUnload2 Destroy PreviewUnload2 QueryUnload PreviewUnload REPORTLISTENER cOutputAlias ISTYLE LOTOOLBAR LLTOOLBARVISIBLE PREVIEWFORM TOOLBAR VISIBLE LOPREVIEWFORM ADDPROPERTY CHECKHELPERCLASS _GOHELPER OLISTENER OREPORT _NBTSIZE NBUTTONSIZE LABEL1 _PREVIEWVERSION CAPTION SETIMAGES DESKTOP GETPARENT WIN32API SETPARENT SETWINDOWPOS LNOLDPARENT DOCKED WIDTH MOVABLE SIZABLE LLNOWAIT LLTOPFORM TOPFORM _TOPFORM ICON CFORMICON ALLOWPRINTFROMPREVIEW SHOWWINDOW LCPARENTTITLE LCCAPTION LOFORM GETPARENTWINDOW FORMS CLOSABLE _OPARENTFORM COMMANDCLAUSES NOWAIT _LNOWAIT NDOCKTYPE INWINDOW WINDOWSTATE NWINDOWSTATE LOLISTENER NPAGETOTAL PAGETOTAL _CFRXNAME FRXFILENAME _CLAUSENRANGEFROM RANGEFROM _CLAUSENRANGETO RANGETO _CLAUSELSUMMARY SUMMARY _CLAUSECHEADING HEADING _LCANSEARCH LSTARTED UPDATETOOLBAR ACTIONSHOWTOOLBAR NSHOWTOOLBARF PREVIEWFORM TOOLBAR CREATETOOLBAR VISIBLEk FRXPREVIEWFORM.NEWOBJECT Canvas1 FoxyPreviewer CC VFP Complete mode Simplified mode6 .pageTotal = .currentPage = _PAGENO = .canvasCount = .pageHeight = .pageWidth = Report Clauses: .oReport.commandClauses.C Error #C Line Internal Error - IERROR CMETHOD ILINE PREVIEWFORM LLHASERROR LCHEADER LCMODE LCTEXT LCFIELD _GOHELPER LCVERSIONTEXT GETVFPVERSION CVERSION LEXTENDED LCPROPERTY LUVALUE PAGETOTAL CURRENTPAGE CANVASCOUNT PAGEHEIGHT PAGEWIDTH OREPORT COMMANDCLAUSES LCERRORMSG CANCELLED SUSPENDED5 REPPREVIEW MINILABEL %FP%C %LP%C PAGECAPTIO ICURRENTPAGE CMESSAGE LCREPORTNAME LCFORMCAPTION PREVIEWFORM CURRENTPAGE STARTOFFSET _GOHELPER LEXTENDED _CFRXNAME _ONAMES CTITLE LCTITLE GETLOC OREPORT COMMANDCLAUSES WINDOW CANVASCOUNT LNLASTPAGE PAGETOTAL CAPTION TOOLBAR AutoSizea AutoSize- Height commandbutton combobox spinner cntsearch1 REPPREVIEW PREVIEWFORM TOOLBAR LOCKSCREEN SETALL _GOHELPER _NBTSIZE LOCONTROL CONTROLS BASECLASS WIDTH HEIGHT CMDSEARCHVISIBILITY LCREPORTNAME _CFRXNAME CAPTION CTOOLBARTITLE GETLOC TOOLBAR MENUNEXT MENULAST MENUTOP MENUPREV COMMANDBUTTON LANGUAGE ENGLISH cmdGoto1 cmdGotoEx MENUGOTO cmdProof1 cmdProof MINIATURES COMBOBOX LANGUAGE ENGLISH CBOZOOMTTI CBOZOOMTTI whole page CBOZOOMWHO fit to width CBOZOOMPGW ONEPGTTIP TWOPGTTIP FOURPGTTIP OPTIONGROUP cmbPrinters1 cmbPrinters AVAILABLEP cPrtPrinterName cntCopies1 cntCopies cmdSave1 cmdSave SAVEREPORT cmbSave1 cmbSave SAVEASIMAG pr_Img.bmp SAVEASPDF pr_Pdf.bmp SAVEASRTF pr_Word.bmp SAVEASXLS pr_Excel.bmp SAVEASHTML pr_HTML.bmp SAVEASMHT pr_MHT.bmp SAVEASTXT pr_1page.bmp cmdEmail1 cmdEmail SENDTOEMAI cmdPrinterProps1 cmdPrinterProps PRINTINGPR cmdPrint1 cmdPrintEx PRINTREPOR cmdSetup1 cmdSetup SETUP cntSearch1 cntSearch FINDBACK FINDNEXT cmdExit1 cmdExit CLOSEREPOR Destroy ReportReleased TLVISIBLE PREVIEWFORM ALLOWPRINTFROMPREVIEW TOOLBAR LOCKSCREEN LNSIZE _GOHELPER _NBTSIZE CNTNEXT WIDTH HEIGHT CMDFORWARD PICTURE IMGBTN_NEXT TOOLTIPTEXT GETLOC CMDBOTTOM IMGBTN_BOTT CNTPREV CMDTOP IMGBTN_TOP CMDBACK IMGBTN_PREV LOCMDGOTO CMDGOTOPAGE VISIBLE ADDOBJECT CMDGOTO1 IMGBTN_GOTOPG LSHOWMINIATURES CMDPROOF1 LOCOMBO CBOZOOM LCITEM LISTCOUNT LISTITEM OPGPAGECOUNT LSHOWPAGECOUNT IMGBTN_1PG IMGBTN_2PG IMGBTN_4PG LPRINTVISIBLE LSHOWPRINTERS CMBPRINTERS1 FONTSIZE OREPORT CPRTPRINTERNAME VALUE DISPLAYVALUE LISTINDEX LSHOWCOPIES LSAVETOFILE CMDSAVE1 LNCMBINDEX CMBSAVE1 LSAVEASIMAGE ADDITEM NEWINDEX LEXTENDED _LCANSEARCH LSAVEASPDF LSAVEASRTF LSAVEASXLS LSAVEASHTML LSAVEASMHT LSAVEASTXT LSENDTOEMAIL CMDEMAIL1 LPRINTERPREF CMDPRINTERPROPS1 CMDPRINT LSHOWPRINTBTN CMDPRINT1 LSHOWSETUP CMDSETUP1 LSHOWSEARCH CNTSEARCH1 CMDSEARCH1 CMDSEARCHBACK1 CMDSEARCHAGAIN1 CMDCLOSE LSHOWCLOSE CMDEXIT1 NBUTTONSIZE CNTCOPIES1 SPNCOPIES1 LBLCOPIES1 ADJUSTCONTROLS REFRESH LCREPORTNAME LCTITLE _CFRXNAME _ONAMES SYNCHPAGENO- ACTIONCLOSE _GOHELPER REPORTRELEASED- ProofSheet GLOBALPREV EXCEPTION _GOHELPER CLOSESHEETS LLSHOWTOOLBAR PREVIEWFORM TOOLBAR VISIBLE SHOWTOOLBAR _OPROOFSHEET SETREPORT OREPORT CAPTION GETLOC NMAXMINIATUREITEM NMAXMINIATUREDISPLAY _OPARENTFORM SETPROOFCAPTION LOEXC LNPAGE CURRENTPAGE SETCURRENTPAGE6 TOOLBAR FINDBACK FINDNEXT TLVISIBLE LOTOOLBAR PREVIEWFORM TOOLBAR CNTSEARCH1 CMDSEARCHAGAIN1 VISIBLE LNWIDTH _GOHELPER _NBTSIZE CMDSEARCH1 WIDTH CMDSEARCHBACK1 LCTEXT LNSIZE _CTEXTTOFIND TOOLTIPTEXT GETLOC _LSHOWSEARCHAGAIN Search feature is currently unavailable for this report. FoxyPreviewer error PR_Search.scx PR_Search.scx Search feature is currently unavailable for this report. FoxyPreviewer error _GOHELPER CLOSESHEETS CLEARBOX LCTEXT LCREPORTALIAS LCALIAS PREVIEWFORM OREPORT COUTPUTALIAS TOOLBAR SHOWTOOLBAR PR_SEARCH _CTEXTTOFIND VISIBLE LLERROR CONTENTS HANDLEFIND CMDSEARCHVISIBILITY CLEARBOX LCTEXT LCALIAS LCREPORTALIAS PREVIEWFORM OREPORT COUTPUTALIAS _GOHELPER _CTEXTTOFIND CONTENTS HANDLEFIND CLEARBOX LCTEXT LCALIAS LCREPORTALIAS PREVIEWFORM OREPORT COUTPUTALIAS _GOHELPER _CTEXTTOFIND CONTENTS HANDLEFINDc NOTFOUND FINDTEXT TLFOUND TLAGAIN LHIGHLIGHTTEXT CMDSEARCHVISIBILITY _GOHELPER GETLOC PREVIEWFORM CURRENTPAGE TEMPSTOPREPAINT SETCURRENTPAGE SCROLLTOOBJECT WIDTH HEIGHT RENDERPAGES lineTop lineBott lineLeft lineRight LOFORM PREVIEWFORM LINETOP REMOVEOBJECT LINEBOTT LINELEFT LINERIGHT TNLEFT TNTOP TNWIDTH TNHEIGHT LNNEWTOP LNNEWLEFT LNVPOS LNHPOS LNVPTOP LNVPLEFT LNVPWIDTH LNVPHEIGHT PREVIEWFORM VIEWPORTTOP VIEWPORTLEFT VIEWPORTWIDTH VIEWPORTHEIGHT CANVAS1 SETVIEWPORT lineTop lineBott lineLeft lineRight LNPIXELSPERDPI960 LNHWND LNWIDTH LNHEIGHT PREVIEWFORM GETPIXELSPERDPI960 CANVAS1 LOFORM ADDOBJECT LNCOLOR TEMPSTOPREPAINT LINETOP WIDTH BORDERCOLOR BORDERWIDTH HEIGHT VISIBLE LINEBOTT LINELEFT LINERIGHT LHIGHLIGHTTEXTu TIPAGE TOCANVAS CLEARBOX LHIGHLIGHTTEXT PREVIEWFORM OREPORT COUTPUTALIAS HIGHLIGHTOBJECT WIDTH HEIGHT TNINDEX DOSAVETYPE _GOHELPER _LNOWAIT CDESTFILE LSAVED LEXTENDED DOOUTPUT< SAVEASIMAG Png;Bmp;Jpg;Gif;Tif;Emf SAVEASPDF SAVEASHTML Htm;Html SAVEASHTML Mht;Mhtml TEMP5 _IMAGES Safetyv SET SAFETY &lcSetSafe. SAVEASRTF Rtf;Doc Xml;Xls Xls;Xml SAVEASXLS SAVEASTXT Txt;Csv;Xl5 TNTYPE _GOHELPER LSAVED OLISTENER PREVIEWFORM OREPORT LCFILE LCREPORTNAME PRINTJOBNAME COUTPUTPATH CSAVEDEFNAME GETLOC LOLISTENER REPORT2PIC LOPENVIEWER _LSENDINGEMAIL OPENFILE DOMAKEPDFOFFLINE LEXTENDED DOMAKEHTMLOFFLINE LCTEMPHTMLFILE LCIMGPATH TOMHTML LCSETSAFE DOMAKERTFOFFLINE LCFILEEXT CEXCELDEFAULTEXTENSION DOMAKEXLSOFFLINE CDESTFILE ACTIONCLOSE PdfListener PR_PDFx.vcx PdfListener PR_PDFx.vcx PDFasImageListener PR_Pdfx.vcx PDFasImageListener PR_PDFx.vcx ERR_CREATI TCFILE _GOHELPER CDESTFILE LNPGMODE NPDFPAGEMODE LNTYPE LPDFASIMAGE LOLISTENER CCODEPAGE CTARGETFILENAME LEMBEDFONT LPDFEMBEDFONTS LCANPRINT LPDFCANPRINT LCANEDIT LPDFCANEDIT LCANCOPY LPDFCANCOPY LCANADDNOTES LPDFCANADDNOTES LENCRYPTDOCUMENT LPDFENCRYPTDOCUMENT CMASTERPASSWORD CPDFMASTERPASSWORD CUSERPASSWORD CPDFUSERPASSWORD LSHOWERRORS LPDFSHOWERRORS CSYMBOLFONTSLIST CPDFSYMBOLFONTSLIST CPDFAUTHOR CPDFTITLE CPDFSUBJECT CPDFKEYWORDS CPDFCREATOR LREPLACEFONTS LPDFREPLACEFONTS NPAGEMODE CDEFAULTFONT CPDFDEFAULTFONT QUIETMODE LQUIETMODE LCOUTPUTDBF LNWIDTH LNHEIGHT LLHASFJ OLISTENER GETFULLFRXDATA LHASFJ GETPAGEWIDTH GETPAGEHEIGHT OUTPUTFROMDATA DOFOXYTHERM LSAVED SETERROR GETLOC LOPENVIEWER _LSENDINGEMAIL OPENFILE REPORTLISTENER RTFreportlistener PR_RTFListener ERR_CREATI TCFILE _GOHELPER CDESTFILE LORTFLISTENER TARGETFILENAME QUIETMODE LQUIETMODE LCOUTPUTDBF LNWIDTH LNHEIGHT OLISTENER GETFULLFRXDATA GETPAGEWIDTH GETPAGEHEIGHT OUTPUTFROMDATA DOFOXYTHERM LSAVED SETERROR GETLOC LOPENVIEWER _LSENDINGEMAIL OPENFILE ExcelListener ExcelListener pr_ExcelListener.vcx Sheet PREPDATA PLEASEWAIT ERR_CREATI TCFILE _GOHELPER CDESTFILE LOXLSLISTENER CWORKBOOKFILE CWORKSHEETNAME CCODEPAGE LCONVERTTOXLS LEXCELCONVERTTOXLS LREPEATHEADERS LEXCELREPEATHEADERS LREPEATFOOTERS LEXCELREPEATFOOTERS LHIDEPAGENO LEXCELHIDEPAGENO LALIGNLEFT LEXCELALIGNLEFT NEXCELSAVEFORMAT LQUIETMODE DOFOXYTHERM GETLOC _RUNSTATUSTEXT LCOUTPUTDBF LNWIDTH LNHEIGHT OLISTENER GETFULLFRXDATA OUTPUTFROMDATA LSAVED SETERROR LOPENVIEWER _LSENDINGEMAIL OPENFILE HTMLListener PR_HTMLListener PR_ReportListener.vcx ERR_CREATI TCFILE _GOHELPER CDESTFILE LOLISTENER TARGETFILENAME QUIETMODE LQUIETMODE FXFEEDBACKCLASS _CTHERMCLASS LCOUTPUTDBF LNWIDTH LNHEIGHT OLISTENER GETFULLFRXDATA GETPAGEWIDTH GETPAGEHEIGHT OUTPUTFROMDATA LSAVED SETERROR GETLOC LOPENVIEWER _LSENDINGEMAIL OPENFILE$ REPORTLISTENER pr_HTMLListener2 PR_HTMLListener2 ERR_CREATI TCFILE TLTEMP _GOHELPER CDESTFILE LOHTMLLISTENER CTARGETFILENAME QUIETMODE LQUIETMODE LCOUTPUTDBF LNWIDTH LNHEIGHT OLISTENER GETFULLFRXDATA GETPAGEWIDTH GETPAGEHEIGHT OUTPUTFROMDATA DOFOXYTHERM LSAVED SETERROR GETLOC LOPENVIEWER _LSENDINGEMAIL OPENFILE Pdf;Rtf;Xls;Xml;Png;Tiff;Bmp;Gif;Emf;Jpg;Htm Pdf;Rtf;Xls;Xml;Png;Tiff;Bmp;Gif;Emf;Jpg;Htm TEMP5 SAVEAS ERR_CREATI _GOHELPER CLOSESHEETS LCFILE LCFOLDER LCEXTENSIONS LEXTENDED LEMAILAUTO CSAVEDEFNAME OLISTENER PRINTJOBNAME CEMAILTYPE _CFRXNAME GETLOC LSAVED CDESTFILE _LSENDINGEMAIL LCFILEFORMAT LOLISTENER PREVIEWFORM OREPORT REPORT2PIC SETERROR SENDREPORTTOEMAIL DOMAKEPDFOFFLINE DOMAKERTFOFFLINE DOMAKEXLSOFFLINE ACTIONCLOSE _LNOWAIT DOOUTPUT NKEYCODE NSHIFTALTCTRL COPIES LCCOPIESCAPTION _GOHELPER GETLOC LBLCOPIES1 CAPTION AUTOSIZE _NBTSIZE HEIGHT TOOLTIPTEXT SPNCOPIES1 LNTXTWIDTH FONTNAME FONTSIZE WIDTHN COMMANDBUTTON TLENABLED LOCONTROL CONTROLS ENABLED VALUE _GOHELPER NCOPIES _GOHELPER NCOPIES VALUE Keycompv {ENTER} CHINESE JAPANESE KOREAN {ALT+DNARROW} PARENT CMBSAVE1 VALUE SETFOCUS _GOHELPER CLANGUAGE PICTURE PARENT PREVIEWFORM EXTENSIONHANDLER IMGBTN_SAVE# VALUE NINDEX} VALUE LNINDEX LIST LISTINDEX NINDEX PARENT PREVIEWFORM EXTENSIONHANDLER DOSAVE PARENT PREVIEWFORM EXTENSIONHANDLER DOCUSTOMPRINT PICTURE PARENT PREVIEWFORM EXTENSIONHANDLER IMGBTN_PRINTPREF PARENT PREVIEWFORM EXTENSIONHANDLER DOSETUP PICTURE PARENT PREVIEWFORM EXTENSIONHANDLER IMGBTN_SETUP PARENT PREVIEWFORM EXTENSIONHANDLER DOSENDEMAIL PICTURE PARENT PREVIEWFORM EXTENSIONHANDLER IMGBTN_EMAILa PARENT PREVIEWFORM VISIBLE _GOHELPER LPRINTED CLOSESHEETS EXTENSIONHANDLER ACTIONCLOSE2 NBUTTON NSHIFT NXCOORD NYCOORD PICTURE PARENT PREVIEWFORM EXTENSIONHANDLER IMGBTN_CLOSE22 NBUTTON NSHIFT NXCOORD NYCOORD PICTURE PARENT PREVIEWFORM EXTENSIONHANDLER IMGBTN_CLOSE PICTURE PARENT PREVIEWFORM EXTENSIONHANDLER IMGBTN_CLOSE TOOLTIPTEXT PR_PRINTREPOR PARENT PREVIEWFORM EXTENSIONHANDLER ACTIONPRINTEX PICTURE PARENT PREVIEWFORM EXTENSIONHANDLER IMGBTN_PRINT PARENT PREVIEWFORM EXTENSIONHANDLER ACTIONGOTOPAGE COMMANDBUTTON TLENABLED LOCONTROL CONTROLS ENABLED PARENT PREVIEWFORM EXTENSIONHANDLER DOSEARCH" PICTURE PARENT PREVIEWFORM EXTENSIONHANDLER IMGBTN_SEARCH PARENT PREVIEWFORM EXTENSIONHANDLER DOSEARCHAGAIN" PICTURE PARENT PREVIEWFORM EXTENSIONHANDLER IMGBTN_SEARCHAGAIN PARENT PREVIEWFORM EXTENSIONHANDLER DOSEARCHBACK" PICTURE PARENT PREVIEWFORM EXTENSIONHANDLER IMGBTN_SEARCHBACK Printer COMBOBOX LCDEFPRINTER LCCURRPRINTER LNPRINTERS LAPRINTERS ADDITEM NEWINDEX LISTINDEX _CORIGINALPRINTER LCITEM LISTCOUNT LCVALUE LCORIGPRINTER VALUE _GOHELPER _CORIGINALPRINTER CPRINTERNAME PARENT PREVIEWFORM EXTENSIONHANDLER DOPROOF PICTURE PARENT PREVIEWFORM EXTENSIONHANDLER IMGBTN_MINI REPORTTITL GOTOPG_CAP NSTYLE PAGENO OPARENTFORM CURRENTPAGE PAGETOTAL CAPTION _GOHELPER GETLOC LBLCAPTION SHOWWINDOW AUTOCENTER VIEWPORTLEFT WIDTH VIEWPORTTOP HEIGHT SPNPAGENO SPINNERLOWVALUE SPINNERHIGHVALUE KEYBOARDLOWVALUE KEYBOARDHIGHVALUE VALUE_ GOTOPG_OK CANCEL CMDOK CAPTION _GOHELPER GETLOC CMDCANCELe VALUE SPINNERLOWVALUE SPINNERHIGHVALUE/ PARENT PAGENO SPNPAGENO VALUE HIDE PARENT THISFORM RELEASEF _GOHELPER CFORMICON ICON& NBUTTON NSHIFT NXCOORD NYCOORD MOUSEPOINTER< NBUTTON NSHIFT NXCOORD NYCOORD MOUSEPOINTER PARENT NCURRSHAPE PAGENO( THISFORM CURRENTPAGE PAGENO FIRST CTYPE PARENT NPAGESET NPAGES NMAXMINIATUREITEM REFRESHPAGEBTN FIRST CTYPE ENABLED PARENT NPAGESET NPAGES NMAXMINIATUREITEM PageSetFirst PageSetBtn pr_top.bmp MINIFIRSTT FIRST PageSetPrev PageSetBtn pr_previous.bmp MINIPREVTI PageSetNext PageSetBtn pr_next.bmp MININEXTTI PageSetLast PageSetBtn pr_bottom.bmp MINILASTTI PageSetCaption Label Arial ESCAPE ESCAPE _VFP.ACTIVEFORM.RELEASE() THIS ADDOBJECT NOTHERTHENPROOFOBJ PAGESETFIRST CAPTION PICTURE TOOLTIPTEXT _GOHELPER GETLOC CTYPE VISIBLE PAGESETPREV WIDTH PAGESETNEXT PAGESETLAST PAGESETCAPTION AUTOSIZE FONTNAME FONTSIZE FONTBOLD HEIGHT OLDESCFUNCTION ESCAPE# PAGESETNEXT REFRESH PAGESETPREV1 OREPORT REPORTLISTENER NPAGES OUTPUTPAGECOUNT} WINDOWSTATE LINACTIVE LSHOWDONE PAINT THIS LSHOWDONE VNEWVALUE NPAGESET NPAGES NMAXMINIATUREITEM NOTHERTHENPROOFOBJ OBJECTS COUNT VISIBLE SETPROOFCAPTION MINILABEL %FP%C %LP%C CMESSAGE NFIRSTPAGE NLASTPAGE NPAGESET NMAXMINIATUREITEM NPAGES _GOHELPER GETLOC PAGESETCAPTION CAPTION) ONEWVALUE REPORTLISTENER DORESIZEPROOFSHEET) NNEWITEM NMAXMINIATUREITEM DORESIZEPROOFSHEET REPORTLISTENER NPROOFWIDTH GETPAGEWIDTH NPROOFHEIGHT GETPAGEHEIGHT NMAXSCREENWTOCONSIDERE WIDTH NMAXSCREENHTOCONSIDERE HEIGHT NNBCOL NPAGES NNBROW NMAXMINIATUREITEM NBASEHEIGHT _GOHELPER _NBTSIZE AUTOCENTER This.Objects[m.i - ((This.nPageSet - 1) * This.nMaxMiniatureItem) + This.nOtherThenProofObj]b PAGECAPTIO REPORTLISTENER LSHOWDONE NPAGESET NMAXMINIATUREITEM NPAGES OBJECTS NOTHERTHENPROOFOBJ TOOLTIPTEXT _GOHELPER GETLOC OUTPUTPAGE ProofShape NSTYLE NPAGES NMAXMINIATUREITEM LSTARTED PAGESETFIRST VISIBLE PAGESETPREV PAGESETNEXT PAGESETLAST PAGESETCAPTION IROWOFFSET _GOHELPER _NBTSIZE ICOLOFFSET NPROOFWIDTH REPORTLISTENER GETPAGEWIDTH NPROOFHEIGHT GETPAGEHEIGHT ICOLCOUNT THISFORM WIDTH NCURCOL LSHOWDONE NPAGESET NOBJECTID NOTHERTHENPROOFOBJ ADDOBJECT OBJECTS HEIGHT PAGENOL ON KEY LABEL ESCAPE &EscFUNCTION CESCFUNCTION REPORTLISTENER ESCFUNCTION OLDESCFUNCTION] ScreenToClient user32Q PR_ScreenToClient CPOINT SCREENTOCLIENT USER32 PR_SCREENTOCLIENTM GetCursorPos user32Q PR_GetCursorPos CPOINT GETCURSORPOS USER32 PR_GETCURSORPOSQ PathFileExists shlwapiQ PR_PathFileExists PSZPATH PATHFILEEXISTS SHLWAPI PR_PATHFILEEXISTS6 GetFocus user32Q PR_GetFocus GETFOCUS USER32 PR_GETFOCUSg GetWindowText user32Q PR_GetWindowText LPSTRING GETWINDOWTEXT USER32 PR_GETWINDOWTEXTD GetActiveWindow user32Q PR_GetActiveWindow GETACTIVEWINDOW USER32 PR_GETACTIVEWINDOW MAPISendDocuments mapi32Q PR_MAPISendDocuments ULUIPARAM LPSZDELIMCHAR LPSZFULLPATHS LPSZFILENAMES ULRESERVED MAPISENDDOCUMENTS MAPI32 PR_MAPISENDDOCUMENTS NOCONSOLE noconsole PREVIEW preview TCCLAUSES LCCLAUSES TCPRINTER LNBINS LCBUFF LLDOTMATRIX PR_DEVICECAPABILITIES LOEXC DeviceCapabilities WinSpool.drvQ PR_DeviceCapabilities SPRINTER SPORT NCAPABILITY SRETURN PDEVMODE DEVICECAPABILITIES WINSPOOL PR_DEVICECAPABILITIESL MessageBeep Win32APIQ PR_MessageBeep NTYPE MESSAGEBEEP WIN32API PR_MESSAGEBEEP* HWINDOW PR_GETFOCUS GETWINTEXT HWINDOW LNBUFSIZE LCBUFFER PR_GETWINDOWTEXT PChar PCharC PChar PChar PChar PChar PChar PCharCC TCATTACHMENT TCRECIPIENT TCSUBJECT TCTEXT LCATTACHMENT LCRECIPIENT LCSUBJECT LCTEXT DECLMAPI HSESSION GETNEWSESSION LORCPEMAIL LOSNDBUF LCRCPBUF LOSUBJECT LONOTETEXT LORCPBUF LCMAPIMESSAGE LNRESULT LOATTACH LOATTPATH LOATTNAME LCATTSTRUCT NUM2DWORD GETADDR MAPISENDMAIL LLSUCCESS PR_MAPISHOWMESSAGE MAPILOGOFF LNRESULT LNSESSION LCSTOREDPATH MAPILOGON PR_MAPISHOWMESSAGE _GOHELPER LEMAILED LNVALUEC LCSTRING SETVALUE RELEASESTRING RtlMoveMemory kernel32Q Heap2Str LNSIZE LCBUFFER GETALLOCSIZE RTLMOVEMEMORY KERNEL32 HEAP2STRG GlobalSize kernel32 GLOBALSIZE KERNEL32 GlobalAlloc kernel32 RtlMoveMemory kernel32Q Str2Heap LCSTRING RELEASESTRING GLOBALALLOC KERNEL32 RTLMOVEMEMORY STR2HEAP LNSIZE HMEMZ GlobalFree kernel32 GLOBALFREE KERNEL32y MAPILogon mapi32 MAPILogoff mapi32 MAPISendMail mapi32 MAPILOGON MAPI32 MAPILOGOFF MAPISENDMAIL% ENGLISH FRENCH PORTUGUESE ALBANIAN CATALAN DANISH DUTCH FAEROESE FINNISH GALICIAN GERMAN ICELANDIC ITALIAN NORWEGIAN SPANISH SWEDISH windows-CC AERRORS LCCHARSET _GOHELPER CLANGUAGE CCODEPAGE CCHARSETC CDO.Configuration CDO.Message ERROR : From is Empty. ERROR : Subject is Empty. ERROR : To,CC and BCC all are Empty. ATACHNOTFO urn:schemas:mailheader:disposition-notification-to urn:schemas:mailheader:return-receipt-to Priority urn:schemas:mailheader:X-Priority urn:schemas:httpmail:importance CLEARERRORS CONFIGURATION LNIND LALIST LOHEADER LADUMMY SETCONFIGURATION GETERRORCOUNT CFROM ADDERROR CSUBJECT CBCC SETHEADER REPLYTO CREPLYTO SUBJECT CHTMLBODYURL CREATEMHTMLBODY CHTMLBODY HTMLBODY CTEXTBODY TEXTBODY HTMLBODYPART CHARSET CCHARSET TEXTBODYPART CATTACHMENT LCATTACHMENT _GOHELPER GETLOC ADDATTACHMENT LREADRECEIPT FIELDS UPDATE LPRIORITY VALUE BODYPART SHOWTHERM CLEARTHERMC NERRORCOUNT AERRORS NERRORCOUNTG TNERRORNO GETERRORCOUNT AERRORS% SMTPNOTSPE BADAUTHPRO INFOREQUIR http://schemas.microsoft.com/cdo/configuration/sendusing http://schemas.microsoft.com/cdo/configuration/smtpserver http://schemas.microsoft.com/cdo/configuration/smtpserverport http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout http://schemas.microsoft.com/cdo/configuration/smtpauthenticate http://schemas.microsoft.com/cdo/configuration/sendusername http://schemas.microsoft.com/cdo/configuration/sendpassword http://schemas.microsoft.com/cdo/configuration/urlgetlatestversion http://schemas.microsoft.com/cdo/configuration/smtpusessl CSERVER ADDERROR _GOHELPER GETLOC NAUTHENTICATE CUSERNAME CPASSWORD GETERRORCOUNT FIELDS NSERVERPORT NCONNECTIONTIMEOUT LURLGETLATESTVERSION LUSESSL UPDATE[ TCERRORMSG NERRORCOUNT AERRORS TCPREFIX TNERROR TCMETHOD TNLINE LCERRORMSG LALIST ADDERROR NERRORCOUNT@ TNERROR TCMETHOD TNLINE ADDONEERROR NERRORCOUNT urn:schemas:mailheader:x-mailer LOHEADER CXMAILER FIELDS UPDATE/ OTHERMFORM ITLFForm Therm ctl32_progressbar pr_ctl32_progressbar MSGSENDING _GOHELPER LQUIETMODE LOTHERMFORM LNTHERMMARGIN LITHERMHEIGHT LITHERMWIDTH LITHERMTOP LITHERMLEFT SCALEMODE HEIGHT HALFHEIGHTCAPTION WIDTH AUTOCENTER BORDERSTYLE CONTROLBOX CLOSABLE MAXBUTTON MINBUTTON MOVABLE ALWAYSONTOP ALLOWOUTPUT NEWOBJECT CAPTION GETLOC VISIBLE THERM MARQUEE MARQUEEANIMATIONSPEED MARQUEESPEED OTHERMFORM LCTYPE THIS CDESTFILE DESTROY Report Listener could not be accessed bitmap TOLISTENER TCDESTFILE TCFILEFORMAT LNPAGECOUNT LNFILETYPE LNDEVICETYPE _GOHELPER NPAGETOTAL PAGETOTAL LNPAGENO OUTPUTPAGE LCPATHFILE LCDESTFILE LCINDEX LLSUCCESSM PR_SendMail2.scx PR_SendMail.scx PR_SendMail2.scx DESTNOTDEF BADCONFIG SMTPNOTSPE BADCONFIG FROMEMPTY BADCONFIG SUBJEMPTY BADCONFIG CDO2000 Cdo2000
ERRSENDMAI MSGNOTSENT ERRSENDMAI MSGSUCCESS SENDEMAIL TCFILE TLDONOTEDITMESSAGE OFOXYPREVIEWER LOFP _GOHELPER CCODEPAGE CEMAILTO CSMTPSERVER LEMAILAUTO CEMAILTYPE CEMAILPRG NSMTPPORT LSMTPUSESSL CSMTPUSERNAME CSMTPPASSWORD CEMAILFROM CEMAILCC CEMAILBCC CEMAILSUBJECT CEMAILREPLYTO CEMAILBODY LREADRECEIPT LPRIORITY LEMAILED LLCANCELLED CLOSESHEETS LLVISIBLE LOTOOLBAR LOFORM _OEXHANDLER PREVIEWFORM TOOLBAR VISIBLE LCEMAILFORM NEMAILMODE SHOWTOOLBAR _OEMAILSHEET SETERROR GETLOC LOMAIL CSERVER NSERVERPORT LUSESSL NAUTHENTICATE CUSERNAME LAUTOSENDMAIL CPASSWORD DODECRYPT CFROM CSUBJECT CREPLYTO CHTMLBODY CTEXTBODY _CATTACHMENT CATTACHMENT CATTACHMENTS SEND LCMAILERR GETERRORCOUNT GETERROR LSILENTf OpenPrinter winspool.drv GetActiveWindow user32 DocumentProperties winspool.drv ClosePrinter winspool.drv Printer Could not open printer. Error TempCur TempCur RptFile LCRPTFILE LHWINDOW LCORIGDEVMODE LCMODIFIEDDEVMODE LCPRINTER LHPRINTER OPENPRINTER WINSPOOL GETACTIVEWINDOW USER32 DOCUMENTPROPERTIES CLOSEPRINTER TEMPCUR RPTFILE LCOLDEXPR LCOLDTAG LCOLDTAG2 TAG2 LCDEVMODE LNRESULT IDCANCEL LOEXCEPTION GdipDrawString GDIPLUS.DLLQ xfcGdipDrawString GRAPHICS LENGTH THEFONT LAYOUTRECT STRINGFORMAT BRUSH GDIPDRAWSTRING GDIPLUS XFCGDIPDRAWSTRING GdipMeasureString GDIPLUS.DLLQ xfcGdipMeasureString GRAPHICS LENGTH THEFONT LAYOUTRECT STRINGFORMAT BOUNDINGBOX CODEPOINTSFITTED LINESFILLED GDIPMEASURESTRING GDIPLUS XFCGDIPMEASURESTRINGk GdipRestoreGraphics GDIPLUS.DLLQ xfcGdipRestoreGraphics GRAPHICS STATE GDIPRESTOREGRAPHICS GDIPLUS XFCGDIPRESTOREGRAPHICSf GdipSaveGraphics GDIPLUS.DLLQ xfcGdipSaveGraphics GRAPHICS STATE GDIPSAVEGRAPHICS GDIPLUS XFCGDIPSAVEGRAPHICSq GdipSetPixelOffsetMode GDIPLUS.DLLQ xfcGdipSetPixelOffsetMode GRAPHICS PIXOFFSETMODE GDIPSETPIXELOFFSETMODE GDIPLUS XFCGDIPSETPIXELOFFSETMODE} GdipSetRenderingOrigin GDIPLUS.DLLQ xfcGdipSetRenderingOrigin GRAPHICS GDIPSETRENDERINGORIGIN GDIPLUS XFCGDIPSETRENDERINGORIGINm GdipSetSmoothingMode GDIPLUS.DLLQ xfcGdipSetSmoothingMode GRAPHICS SMOOTHINGMD GDIPSETSMOOTHINGMODE GDIPLUS XFCGDIPSETSMOOTHINGMODEu GdipSetStringFormatAlign GDIPLUS.DLLQ xfcGdipSetStringFormatAlign STRINGFORMAT ALIGN GDIPSETSTRINGFORMATALIGN GDIPLUS XFCGDIPSETSTRINGFORMATALIGNu GdipSetStringFormatFlags GDIPLUS.DLLQ xfcGdipSetStringFormatFlags STRINGFORMAT FLAGS GDIPSETSTRINGFORMATFLAGS GDIPLUS XFCGDIPSETSTRINGFORMATFLAGSu GdipSetTextRenderingHint GDIPLUS.DLLQ xfcGdipSetTextRenderingHint GRAPHICS GDIPSETTEXTRENDERINGHINT GDIPLUS XFCGDIPSETTEXTRENDERINGHINTo GdipSetWorldTransform GDIPLUS.DLLQ xfcGdipSetWorldTransform GRAPHICS MATRIX GDIPSETWORLDTRANSFORM GDIPLUS XFCGDIPSETWORLDTRANSFORM GdipStringFormatGetGenericTypographic GDIPLUS.DLLQ xfcGdipStringFormatGetGenericTypographic STRINGFORMAT% GDIPSTRINGFORMATGETGENERICTYPOGRAPHIC GDIPLUS XFCGDIPSTRINGFORMATGETGENERICTYPOGRAPHIC GdipTransformPoints GDIPLUS.DLLQ xfcGdipTransformPoints GRAPHICS DESTSPACE SRCSPACE PPOINT COUNT GDIPTRANSFORMPOINTS GDIPLUS XFCGDIPTRANSFORMPOINTS GdipTransformPointsI GDIPLUS.DLLQ xfcGdipTransformPointsI GRAPHICS DESTSPACE SRCSPACE PPOINT COUNT GDIPTRANSFORMPOINTSI GDIPLUS XFCGDIPTRANSFORMPOINTSIs GdipTranslateClip GDIPLUS.DLLQ xfcGdipTranslateClip GRAPHICS GDIPTRANSLATECLIP GDIPLUS XFCGDIPTRANSLATECLIPp GdipCloneStringFormat GDIPLUS.DLLQ xfcGdipCloneStringFormat STRINGFORMAT NEWFORMAT GDIPCLONESTRINGFORMAT GDIPLUS XFCGDIPCLONESTRINGFORMAT~ GdipCreateStringFormat GDIPLUS.DLLQ xfcGdipCreateStringFormat FORMATATTRIBUTES LANGUAGE STRINGFORMAT GDIPCREATESTRINGFORMAT GDIPLUS XFCGDIPCREATESTRINGFORMATe GdipDeleteStringFormat GDIPLUS.DLLQ xfcGdipDeleteStringFormat STRINGFORMAT GDIPDELETESTRINGFORMAT GDIPLUS XFCGDIPDELETESTRINGFORMATv GdipGetStringFormatAlign GDIPLUS.DLLQ xfcGdipGetStringFormatAlign STRINGFORMAT ALIGN GDIPGETSTRINGFORMATALIGN GDIPLUS XFCGDIPGETSTRINGFORMATALIGN GdipGetStringFormatDigitSubstitution GDIPLUS.DLLQ xfcGdipGetStringFormatDigitSubstitution STRINGFORMAT LANGUAGE SUBSTITUTE$ GDIPGETSTRINGFORMATDIGITSUBSTITUTION GDIPLUS XFCGDIPGETSTRINGFORMATDIGITSUBSTITUTIONv GdipGetStringFormatFlags GDIPLUS.DLLQ xfcGdipGetStringFormatFlags STRINGFORMAT FLAGS GDIPGETSTRINGFORMATFLAGS GDIPLUS XFCGDIPGETSTRINGFORMATFLAGS GdipGetStringFormatHotkeyPrefix GDIPLUS.DLLQ xfcGdipGetStringFormatHotkeyPrefix STRINGFORMAT HKPREFIX GDIPGETSTRINGFORMATHOTKEYPREFIX GDIPLUS XFCGDIPGETSTRINGFORMATHOTKEYPREFIX~ GdipGetStringFormatLineAlign GDIPLUS.DLLQ xfcGdipGetStringFormatLineAlign STRINGFORMAT ALIGN GDIPGETSTRINGFORMATLINEALIGN GDIPLUS XFCGDIPGETSTRINGFORMATLINEALIGN GdipGetStringFormatTabStopCount GDIPLUS.DLLQ xfcGdipGetStringFormatTabStopCount STRINGFORMAT COUNT GDIPGETSTRINGFORMATTABSTOPCOUNT GDIPLUS XFCGDIPGETSTRINGFORMATTABSTOPCOUNT GdipGetStringFormatTabStops GDIPLUS.DLLQ xfcGdipGetStringFormatTabStops STRINGFORMAT COUNT FIRSTTABOFFSET TABSTOPS GDIPGETSTRINGFORMATTABSTOPS GDIPLUS XFCGDIPGETSTRINGFORMATTABSTOPS| GdipGetStringFormatTrimming GDIPLUS.DLLQ xfcGdipGetStringFormatTrimming STRINGFORMAT TRIMMING GDIPGETSTRINGFORMATTRIMMING GDIPLUS XFCGDIPGETSTRINGFORMATTRIMMINGu GdipSetStringFormatAlign GDIPLUS.DLLQ xfcGdipSetStringFormatAlign STRINGFORMAT ALIGN GDIPSETSTRINGFORMATALIGN GDIPLUS XFCGDIPSETSTRINGFORMATALIGN GdipSetStringFormatDigitSubstitution GDIPLUS.DLLQ xfcGdipSetStringFormatDigitSubstitution STRINGFORMAT LANGUAGE SUBSTITUTE$ GDIPSETSTRINGFORMATDIGITSUBSTITUTION GDIPLUS XFCGDIPSETSTRINGFORMATDIGITSUBSTITUTIONu GdipSetStringFormatFlags GDIPLUS.DLLQ xfcGdipSetStringFormatFlags STRINGFORMAT FLAGS GDIPSETSTRINGFORMATFLAGS GDIPLUS XFCGDIPSETSTRINGFORMATFLAGS GdipSetStringFormatHotkeyPrefix GDIPLUS.DLLQ xfcGdipSetStringFormatHotkeyPrefix STRINGFORMAT HKPREFIX GDIPSETSTRINGFORMATHOTKEYPREFIX GDIPLUS XFCGDIPSETSTRINGFORMATHOTKEYPREFIX} GdipSetStringFormatLineAlign GDIPLUS.DLLQ xfcGdipSetStringFormatLineAlign STRINGFORMAT ALIGN GDIPSETSTRINGFORMATLINEALIGN GDIPLUS XFCGDIPSETSTRINGFORMATLINEALIGN GdipSetStringFormatMeasurableCharacterRanges GDIPLUS.DLLQ xfcGdipSetStringFormatMeasurableCharacterRanges STRINGFORMAT RANGECOUNT RANGES, GDIPSETSTRINGFORMATMEASURABLECHARACTERRANGES GDIPLUS XFCGDIPSETSTRINGFORMATMEASURABLECHARACTERRANGES GdipSetStringFormatTabStops GDIPLUS.DLLQ xfcGdipSetStringFormatTabStops STRINGFORMAT FIRSTTABOFFSET COUNT TABSTOPS GDIPSETSTRINGFORMATTABSTOPS GDIPLUS XFCGDIPSETSTRINGFORMATTABSTOPS{ GdipSetStringFormatTrimming GDIPLUS.DLLQ xfcGdipSetStringFormatTrimming STRINGFORMAT TRIMMING GDIPSETSTRINGFORMATTRIMMING GDIPLUS XFCGDIPSETSTRINGFORMATTRIMMING| GdipStringFormatGetGenericDefault GDIPLUS.DLLQ xfcGdipStringFormatGetGenericDefault STRINGFORMAT! GDIPSTRINGFORMATGETGENERICDEFAULT GDIPLUS XFCGDIPSTRINGFORMATGETGENERICDEFAULT GdipStringFormatGetGenericTypographic GDIPLUS.DLLQ xfcGdipStringFormatGetGenericTypographic STRINGFORMAT% GDIPSTRINGFORMATGETGENERICTYPOGRAPHIC GDIPLUS XFCGDIPSTRINGFORMATGETGENERICTYPOGRAPHICk CreateDC WIN32APIQ xfcCreateDC CDRIVER CDEVICE LPSZOUTPUT LPINITDATA CREATEDC WIN32API XFCCREATEDCF DeleteDC WIN32APIQ xfcDeleteDC DELETEDC WIN32API XFCDELETEDCE StartPage gdi32Q xfcStartPage STARTPAGE GDI32 XFCSTARTPAGEA EndPage gdi32Q xfcEndPage ENDPAGE GDI32 XFCENDPAGEP StartDoc gdi32Q xfcStartDoc STARTDOC GDI32 XFCSTARTDOC? EndDoc gdi32Q xfcEndDoc ENDDOC GDI32 XFCENDDOCY GetDeviceCaps gdi32Q xfcGetDeviceCaps NINDEX GETDEVICECAPS GDI32 XFCGETDEVICECAPS PROCEDURE LCPROC LNPOS LCFILE LCPATH CTEXTE CCLEF NLONGCLEF CRESULT ENGLISH ESPANIOL SPANISH FoxyPreviewer_Locs.dbf Could not load the localizations table. Error Language was not found! Make sure that the desired language is available in FoxyPreviewer_Locs.dbf Error TCLANGUAGE LCDBFFILE LNSELECT LANGUAGE LOCALLANG OFOXYPREVIEWER CCODEPAGE _INITSTATUSTEXT INITSTATUS _PREPASSSTATUSTEXT PREPSTATUS _RUNSTATUSTEXT RUNSTATUS _SECONDSTEXT SECONDS _CANCELINSTRTEXT CANCELINST _CANCELQUERYTEXT CANCELQUER _REPORTINCOMPLETETEXT REPINCOMPL _ATTENTIONTEXT ATTENTION LOLANG _OLANG _CLANGLOADED _Screen.oFoxyPreviewer._oLang. Could not locate the string ' ' in the localizations table. Please make sure that you have the latest version available of 'FoxyPreviewer_locs.dbf'. Error TCSTRING LCTRANSLL internetexplorer.application internetexplorer.application TCFILE LODOC VISIBLE NAVIGATE LNSECS LCINNERTEXT READYSTATE DOCUMENT BODY INNERTEXT EnumPrinterForms Internal Envelope Error loading printer information Printer: Form # Width: Height: Printer Info TCPRINTER TNWIDTH TNHEIGHT LLSHOWRESULT LOPRINTFORMS CUNIT NROUND LCPRINTER GETFORMLIST CERRORMESSAGE STARTMODE CAPIERRORMESSAGE LOONEFORM LCFORMNAME OFORMLIST COUNT FORMID WIDTH HEIGHT FORMNAME Collection WinApiSupport TCUNIT TNROUND CUNIT NROUND OFORMLIST LOADAPIDLLS HHEAP HEAPCREATE English Metric Internal English Metric Internal TCUNIT CUNIT NCOEFFICIENT NINCH2MM NCM2MM+ HHEAP HEAPDESTROY Unable to get printer handle for ' Unable to Enumerate Forms Unable to Enumerate Forms. TCPRINTERNAME TCFORMNAME LHPRINTER LLSUCCESS LNNEEDED LNNUMBEROFFORMS LNBUFFER LCFORMNAME CPRINTERNAME CFORMNAME CLEARERRORS NFORMNUMBER OFORMLIST REMOVE LNRESULT OPENPRINTER CERRORMESSAGE CAPIERRORMESSAGE WINAPIERRMSG GETLASTERROR ENUMFORMS HEAPALLOC HHEAP LOONEFORM ONEFORMOBJ LNPOINTER FORMID FORMFLAGS LONG2NUMFROMBUFFER FORMNAME STRZFROMBUFFER WIDTH CONVERTFORMDIMENSION HEIGHT RIGHT BOTTOM MARKSUPPORTEDFORMS HEAPFREE CLOSEPRINTER/ TNPOINTER LONG2NUMFROMBUFFER NCOEFFICIENT NROUNDi DeviceCapabilities failed. LNCOUNT LCBUFFERPAPERS LNINDEX LCSTR LNFORMID LOONEFORM DEVICECAPABILITIES CPRINTERNAME CERRORMESSAGE CAPIERRORMESSAGE WINAPIERRMSG GETLASTERROR OWAS SHORT2NUM OFORMLIST GETKEY ISSUPPORTED1 Empty FormFlags FormId FormName Width Height Right Bottom IsSupported- LOONEFORM# CERRORMESSAGE CAPIERRORMESSAGE HeapCreate WIN32API HeapAlloc WIN32API HeapFree WIN32API HeapDestroy WIN32API GetLastError kernel32 HEAPCREATE WIN32API HEAPALLOC HEAPFREE HEAPDESTROY GETLASTERROR KERNEL32W OpenPrinter WinSpool.Drv TCPRINTERNAME THPRINTER TCDEFAULT OPENPRINTER WINSPOOL ClosePrinter WinSpool.Drv THPRINTER CLOSEPRINTER WINSPOOL EnumForms winspool.drv THPRINTER TNLEVEL TNFORM TNBUF TNNEEDED TNRETURNED ENUMFORMS WINSPOOL DeviceCapabilities winspool.drv PDEVICE PPORT FWCAPABILITY POUTPUT PDEVMODE DEVICECAPABILITIES WINSPOOL TNNUM LCSTRING RTLPL2PSD TCLONG LNNUM RTLS2PLD TNPOINTER LNNUM RTLP2PLD TCLONG LNNUM RTLS2PL TNPOINTER LCSTR LNSTRPOINTER RTLP2PL LSTRCPY TNPOINTER LCRESULT LNSTRPOINTER LNLEN LONG2NUMFROMBUFFER LSTRLENW RTLP2PSZ TNPOINTER LCSTR LNSTRPOINTER LSTRCPYa RtlMoveMemory WIN32APIQ RtlPL2PS TCDEST TNSRC TNLEN RTLMOVEMEMORY WIN32API RTLPL2PS_ RtlMoveMemory WIN32APIQ RtlS2PL TNDEST TCSRC TNLEN RTLMOVEMEMORY WIN32API RTLS2PL_ RtlMoveMemory WIN32APIQ RtlP2PL TNDEST TNSRC TNLEN RTLMOVEMEMORY WIN32API RTLP2PL_ RtlMoveMemory WIN32APIQ RtlP2PS TCDEST TNSRC TNLEN RTLMOVEMEMORY WIN32API RTLP2PSB lstrcpy WIN32API TCDEST TNSRC LSTRCPY WIN32API7 lstrlenW WIN32API TNSRC LSTRLENW WIN32API6 lstrlen WIN32API TNSRC LSTRLEN WIN32API FormatMessage kernel32 TNERRORCODE FORMATMESSAGE KERNEL32 LCERRBUFFER LNNEWERR LNFLAG LCERRORMESSAGE 09.00.0000.2412 09.00.0000.3504 09.00.0000.5721 09.00.0000.5815 09.00.0000.6303 SP2 HF1 09.00.0000.6602 SP2 HF2 09.00.0000.7423 SP2 HF3 LCVERSION oFoxyThermForm oFoxyThermForm oFoxyThermForm _Screen.oFoxyThermForm.Thermb TNPERCENT TCLABELTEXT TCTITLETEXT ADDPROPERTY OFOXYTHERMFORM RELEASE CREATETHERM LOTHERMFORM THERMLABEL CAPTION THERM MARQUEE VALUE VISIBLE ATLForm Therm ctl32_progressbar PR_ctl32_progressbar.vcx ThermLabel Label LOFORM OFOXYTHERMFORM LNBORDER LITHERMHEIGHT LITHERMWIDTH LITHERMTOP LITHERMLEFT SCALEMODE HEIGHT HALFHEIGHTCAPTION WIDTH AUTOCENTER BORDERSTYLE CONTROLBOX CLOSABLE MAXBUTTON MINBUTTON MOVABLE ALWAYSONTOP ALLOWOUTPUT NEWOBJECT THERMLABEL VISIBLE FONTBOLD ALIGNMENT THERM MARQUEESPEED MARQUEEANIMATIONSPEED CAPTIOND BringWindowToTop Win32API ShowWindow Win32API GetCurrentThreadId kernel32 GetWindowThreadProcessId user32 GetCurrentThreadId kernel32 AttachThreadInput user32 GetForegroundWindow user32 FindWindow Win32API TOFORM BRINGWINDOWTOTOP WIN32API SHOWWINDOW GETCURRENTTHREADID KERNEL32 GETWINDOWTHREADPROCESSID USER32 ATTACHTHREADINPUT GETFOREGROUNDWINDOW FINDWINDOW LNHWND LNFORETHREAD LNAPPTHREAD Datasessionv Fixedv PreviewHelpera ERRNOPRINTER SET FIXED &lcSetFixed. pr_FRXOutput.Prg FXLISTENER PR_ReportListener.vcx FOXYLISTENER PR_ReportListener.vcx _GDIPLUS.VCXC Classlibv _GdiPlus.vcx FOXYLISTENERCC PR_ReportListener.vcx _GDIPLUS.VCXC Classlibv _GdiPlus.vcx PROCEDUREv _oReportOutput("1")b pr_FRXOutput Could not find the 'ReportOutput.App' file. This file is needed to have the new features of FoxyPreviewer.C Please make sure to set the global variable '_REPORTOUTPUT' with the full path of this file or save it in a folder that your app can reach FoxyPreviewer not loaded! cSuccessor lQuietMode lShowSearch lShowClose lShowSetup nThermType lOpenViewer lPrintVisible lShowPrintBtn lShowPageCount lSaveToFile _cLanguageFromDBF _cOrigRepPreview _cLocalPath lSendToEmail lShowMiniatures lPrinterPref lSaveAsImage lSaveAsHTML lSaveAsMHT lSaveAsRTF lSaveAsXLS lSaveAsPDF lSaveAsTXT nCanvasCount lEmailAuto cEmailType cEmailPRG lShowPrinters nEmailMode cSMTPUserName cSMTPPassword nSMTPPort cSMTPServer lSMTPUseSSL cEmailTo cEmailSubject cEmailBody cEmailFrom cEmailBodyFile cAttachments cSaveDefName cEmailCC cEmailBCC cEmailReplyTo cVersion v2.99 RC 2012.06.20 nVersion lSilent nButtonSize cOutputPath nPrinterPropType lDirectPrint nSearchPages nZoomLevel nWindowState nDockType nMaxMiniatureDisplay nShowToolBar cFormIcon cTitle cToolbarTitle lPrinted- lEmailed- lSaved- cDestFile- cAdressTable cAdressSearch cImgPrint cImgPrintPref cImgSave cImgClose cImgClose2 cImgEmail cImgSetup cImgMiniatures cImgSearch cImgSearchAgain cImgSearchBack cImgPrintBig cImgPrintPrefBig cImgSaveBig cImgCloseBig cImgClose2Big cImgEmailBig cImgSetupBig cImgMiniaturesBig cImgSearchBig cImgSearchAgainBig cImgSearchBackBig lPDFEmbedFonts lPDFCanPrint lPDFCanEdit lPDFCanCopy lPDFCanAddNotes lPDFEncryptDocument lPDFAsImage cPDFMasterPassword cPDFUserPassword cPDFAuthor cPDFTitle cPDFSubject cPDFKeywords cPDFCreator lPDFShowErrors cPDFSymbolFontsList cPDFDefaultFont nPDFPageMode lPDFReplaceFonts lExpandFields cPrintJobName lShowCopies nCopies lReadReceipt lPriority cEncryptPROCEDURE cDecryptPROCEDURE cCryptKey cExcelDefaultExtension lExcelConvertToXLS lExcelRepeatHeaders lExcelRepeatFooters lExcelHidePageNo lExcelAlignLeft nExcelSaveFormat cCodePage lRepeatInPage cWatermarkImage nWatermarkType nWatermarkTransparency nWatermarkWidthRatio nWatermarkHeightRatio _MemberData _MemberData _MemberData _InitStatusTextC INITSTATUS _PrepassStatusTextC PREPSTATUS _RunStatusTextC RUNSTATUS _SecondsTextC SECONDS _CancelInstrTextC CANCELINST _CancelQueryTextC CANCELQUER _ReportIncompleteTextC REPINCOMPL _AttentionTextC ATTENTION CCODEPAGE _oLang _cLangLoaded ENGLISH _oDestScreen Empty lEnableLanguagea lEnableTabGenerala lEnableTabControlsa lEnableTabOutputa lEnableTabEmaila lEnableTabPDFa lEnableTabXLSa lEnableChkPrintPrefa lEnableCmbPrintPrefTypea lEnableChkCopiesa lEnableChkSavetoFilea lEnableChkPrintersa lEnableChkEmaila lEnableChkMiniaturesa lEnableChkSearcha lEnableChkSettingsa lEnableChkSaveAsImagea lEnableChkSaveAsPDFa lEnableChkSaveAsRTFa lEnableChkSaveAsHTMLa lEnableChkSaveAsMHTa lEnableChkSaveAsXLSa lEnableChkSaveAsTXTa lEnableCmbEmailTypea lEnableCmbAttachmentTypea lEnableChkEmbedFontsa lEnableChkPDFasImagea lShowLanguagea lShowTabGenerala lShowTabControlsa lShowTabOutputa lShowTabEmaila lShowTabPDFa lShowTabXLSa lShowTabXLSa oSettingsDlg oFoxyPreviewer oFoxyPreviewer oFoxyPreviewer _oReportOutput("1")b Could not load the FOXYPREVIEWER report factory Error SET FIXED &lcSetFixed. _oReportOutput("1") FOXYLISTENER _oReportOutput("1") FOXYLISTENER Could not load the FOXYPREVIEWER report factory (2)C Please check the version of your 'REPORTOUTPUT.APP' file, and make sure to be using the latest version released in VFP9 SP2. Replace your current version with the new one. Error SET FIXED &lcSetFixed. _oReportOutput("10")b PdfListener PR_PDFX.vcx PdfListener PR_PDFX.vcx PdfListenerCC PR_PDFX.vcx _oReportOutput("11")b PdfasImageListener PR_PDFX.vcx PdfasImageListener PR_PDFX.vcx PdfasImageListenerCC PR_PDFX.vcx _oReportOutput("12")b PdfasImageListener PR_PDFX.vcx RTFreportlistener PR_RTFListener RTFreportlistenerCC PR_RTFListener _oReportOutput("13")b REPORTLISTENER ExcelListener pr_ExcelListener.vcx ExcelListenerCC pr_ExcelListener.vcx Sheet _oReportOutput("14")b MSXML2.XSLTEMPLATE.4.0 REPORTLISTENER pr_HTMLListener pr_reportlistener.vcx pr_HTMLListenerCC pr_ReportListener.vcx _oReportOutput("15")b REPORTLISTENER pr_HTMLListener15 pr_reportlistener.vcx pr_HTMLListener15CC pr_ReportListener.vcx _oReportOutput("0")b FXLISTENER PR_ReportListener.vcx FOXYLISTENER PR_ReportListener.vcx FOXYLISTENERCC PR_ReportListener.vcx TCSYS16 TCLOCALPATH LNSESSION LCSETFIXED LOHELPER LEXTENDED GAPRINTERS SETERROR GETLOC LOLISTENER FXFEEDBACKCLASS _CTHERMCLASS QUIETMODE LQUIETMODE _OREPORTOUTPUT REMOVE LCREPORTOUTPUT LOSETTINGS LCDEFAULTSETFILE CLANGUAGE STARTMODE ADDPROPERTY _MEMBERDATA CCODEPAGE LOSETDLG OFOXYPREVIEWER LOPREVLISTENER CLASS LOPDFLISTENER LOBJTYPEMODE LOPDFLISTENER2 LISTENERTYPE LORTFLISTENER LOXLSLISTENER LOUTPUTTOCURSOR CWORKSHEETNAME LCONVERTTOXLS LEXCELCONVERTTOXLS LREPEATHEADERS LEXCELREPEATHEADERS LREPEATFOOTERS LEXCELREPEATFOOTERS LHIDEPAGENO LEXCELHIDEPAGENO LALIGNLEFT LEXCELALIGNLEFT LLXLSERROR LOTESTXML4 LOHTMLLISTENER$ COPYIMAGEFILESTOEXTERNALFILELOCATION LOPRINTLISTENER PROCEDUREvf FOXYPREVIEWER. LCPROC LNPROCS LCCURPROC PR_REPORTLISTENERCC Classlibvf PR_REPORTLISTENER _GDIPLUSCC Classlibvf _GDIPLUS PR_REPORTLISTENER _GDIPLUSl CDO.Message file:// Source file does not exist! Error CDO.Configuration CDO.Message TCSOURCE TCDESTINATION LCFILENAME LOSTREAM LOMSG LOCONFIG CONFIGURATION CREATEMHTMLBODY GETSTREAM SAVETOFILEg _ReportOutputConfig TALKv DATASESSIONv TALKv ReportListener OutputConfig AND (C LOCATE FOR ObjType = 100 AND (ObjCode = m.iType) &cFilter. AND (NOT DELETED()) Exception Configuration table specified to VFP Report Output Application is not found or is in the wrong format. OutputConfig ListenerType PUBLIC &tvReference. IF PEMSTATUS(&tvReference.,"ListenerType",5) AND UPPER(m.oTemp.BaseClass) == UPPER(m.oTemp.Class) &tvReference..ListenerType = m.iType ListenerType TVTYPE TVREFERENCE TVUNLOAD OTEMP ITYPE IINDEX CTYPE CCONFIGTABLE LSUCCESS LSETTALKBACKON LSAFETY CFILTER CCLASS CMODULE OCONFIG OERROR LSTRINGVAR LOBJECTMEMBER IPARAMS IUNLOAD ISELECT ISESSION LSETTALKBACKONDEFAULTSESSION VRETURN EXECUTE REPORTOUTPUTCONFIG REPORTOUTPUTCLEANUP UNLOADLISTENER REPORTOUTPUTDECLAREREFERENCE CHECKPUBLICLISTENERCOLLECTION _OREPORTOUTPUT TESTLISTENERREFERENCE GETCONFIGOBJECT GETCONFIGTABLE OUTPUTCONFIG VERIFYCONFIGTABLE OBJTYPE OBJCODE OBJINFO OBJNAME OBJVALUE GETSUPPORTEDLISTENERINFO MESSAGE HANDLEERROR BASECLASS CLASS LISTENERTYPE OUTPUTTYPE TISELECT TLRESETTALKDEFAULTSESSION TISESSION TLRESETTALK EXECUTE TOREF! PR_FXListener PR_ReportListener.VCX PR_FXListener PR_ReportListener.VCX ReportListener PR_HTMLListener PR_ReportListener.VCX PR_XMLListener PR_ReportListener.VCX PR_DebugListener PR_ReportListener.VCX TITYPE TCCLASS TCLIB TCMODULE DATASESSIONv session SAFETYv OutputConfigCC DEBUGLISTENER PR_ReportListener.VCX DebugListener PR_ReportListener.VCX Output Configuration Table Output Configuration Table TNTYPE TVREFERENCE TVUNLOAD ISESSION OSESSION OERROR OCONFIG LSUCCESS CTYPE IINDEX CHECKPUBLICLISTENERCOLLECTION _OREPORTOUTPUT REMOVE LSAFETY EXECUTE DATASESSIONID GETCONFIGOBJECT CREATECONFIGTABLE OBJTYPE OBJCODE OBJNAME OBJVALUE GETCONFIGTABLE HANDLEERROR PR_XMLListener PR_ReportListener.VCX PR_UtilityReportListener PR_ReportListener.VCX VFP Report Output Application TOCFG LCMODULE QUIETMODE APPNAME9 m.tvReferenceb TIPARAMS TVREFERENCE TLOBJECTMEMBER TLSTRINGVAR IDOTPOS Collectionf TITYPE LUNLOAD CTYPE _OREPORTOUTPUT CLASS IINDEX COUNT GETKEY REMOVE An unknown error has occurred in VFP Report Output Application ERRORNO MESSAGE DETAILS Collectionf Collection _oReportOutput TCTYPE TIINDEX IINDEX _OREPORTOUTPUT CLASS COUNT GETKEY TISESSION TCLANGUAGE PR_SETLANGUAGE$ ERRSENDMAI MSGNOTSENT ERROR Error sending emailC Message was not sent Error TNMAPIERRNO LCMESSAGE LCMAPIMSG PR_MAPI_GETMESSAGETEXT _GOHELPER GETLOCx One or more files could not be located. No message was sent. An attachment could not be written to a temporary file. Check directory permissions. One or more unspecified errors occurred while sending the message. It is not known if the message was sent. There was insufficient memory to proceed. There was no default logon, and the user failed to log on successfully when the logon dialog box was displayed. No message was sent. The user canceled one of the dialog boxes. No message was sent. The user had too many sessions open simultaneously. No session handle was returned. A recipient matched more than one of the recipient descriptor structures and MAPI_DIALOG was not set. No message was sent. The specified attachment was not found. No message was sent. The type of a recipient was not MAPI_TO, MAPI_CC, or MAPI_BCC. No message was sent. One or more recipients were invalid or did not resolve to any address. The text in the message was too large. No message was sent. There were too many file attachments. No message was sent. There were too many recipients. No message was sent. A recipient did not appear in the address list. No message was sent. TNERR LCRET lPrinted_Assign% lSaved_Assign lEmailed_Assign cDestFile_Assign DoEncrypt DoDecrypt OpenFile UpdateProperties UpdateSettings nThermType_AssignK( cLanguage_Assign SetLanguage SetError GetLocQ. DESTROY CloseSheets AddReport CallReportJ6 RestorePrinterA= RunReport DoOutputkF SendReportToEmail ReportReleased|b ClearCache1d SetPrinter STB_Handler AddBarsToMenu CheckHelperClass}~ ActionShowToolbar4 actionToolbarVisibilityx ActionGotoPage DoCustomPrintZ DialogPrinting ActionClose^ PreviewUnload PreviewUnload2 HideFormM RestoreParent ActionPrint ActionPrintExg SizePages DoSetup SetImagesH RestoreFromResource_Bind" HandledError SynchPageNo: RefreshToolbarf UpdateToolbar ParentClosed] DoProof CmdSearchVisibility DoSearch DoSearchAgain DoSearchBack} HandleFind ClearBox ScrollToObject HighLightObject) RenderPageL PAINTF DoSaveM DoSaveType DoMakePDFOffline DoMakeRTFOffline DoMakeXLSOffline DoMakeHTMLOffline_old- DoMakeHTMLOfflineF DoSendEmail HandledKeyPress RELEASE DESTROY AdjustControls Enabled_Assign" INTERACTIVECHANGE CLICK INIT" DROPDOWN VALID CLICK CLICKg CLICK! INITx CLICK MOUSEENTER MOUSELEAVEG INITK RIGHTCLICK CLICK CLICKK AdjustControls Enabled_Assign CLICK7 CLICK INITU! CLICK INIT " VALID CLICK INIT:' INITW* spnpageno.LOSTFOCUS cmdok.CLICK cmdcancel.CLICK Init3, MOUSELEAVE MOUSEENTER CLICK CLICK REFRESH// RefreshPageBtnm6 SetReport RESIZE*7 ACTIVATE QUERYUNLOAD nPageSet_assign,8 SetProofCaptionM: ReportListener_Assigns; nMaxMiniatureItem_Assign DoResizeProofSheet9< PAINT SHOW1A DESTROY PR_ScreenToClienteF PR_GetCursorPos PR_PathFileExists PR_GetFocus H PR_GetWindowTextbH PR_GetActiveWindow PR_MAPISendDocuments CleanClauses IsDotMatrix9K PR_DeviceCapabilities,L PR_MessageBeep-M GetParentWindow GetWinText PR_SendMailEx getNewSession num2dwordRU INIT}U DESTROY getAddr getValue)V getAllocSize!W setValue ReleaseString DeclMapiRY SENDj[ ClearErrors GetErrorCount GetError"d SetConfiguration AddError{i AddOneError ERRORbk SetHeader ClearTherm ShowTherm BEFOREREPORT Report2Pic SendCDOMail!v SetPrinterPropsN xfcGdipDrawString xfcGdipMeasureString xfcGdipRestoreGraphicsE xfcGdipSaveGraphics xfcGdipSetPixelOffsetMode xfcGdipSetRenderingOrigin xfcGdipSetSmoothingModeQ xfcGdipSetStringFormatAlign xfcGdipSetStringFormatFlags xfcGdipSetTextRenderingHint xfcGdipSetWorldTransform xfcGdipStringFormatGetGenericTypographicN xfcGdipTransformPointsC xfcGdipTransformPointsI@ xfcGdipTranslateClipA xfcGdipCloneStringFormat xfcGdipCreateStringFormat xfcGdipDeleteStringFormat xfcGdipGetStringFormatAlignr xfcGdipGetStringFormatDigitSubstitutionF xfcGdipGetStringFormatFlagsf xfcGdipGetStringFormatHotkeyPrefix: xfcGdipGetStringFormatLineAlign- xfcGdipGetStringFormatTabStopCount xfcGdipGetStringFormatTabStops xfcGdipGetStringFormatTrimming xfcGdipSetStringFormatAlign xfcGdipSetStringFormatDigitSubstitution xfcGdipSetStringFormatFlags xfcGdipSetStringFormatHotkeyPrefix xfcGdipSetStringFormatLineAlign xfcGdipSetStringFormatMeasurableCharacterRanges xfcGdipSetStringFormatTabStops xfcGdipSetStringFormatTrimming xfcGdipStringFormatGetGenericDefault xfcGdipStringFormatGetGenericTypographic xfcCreateDC xfcDeleteDCS xfcStartPage xfcEndPage1 xfcStartDoc xfcEndDoc xfcGetDeviceCapsv GetCurPath PR_SetLanguage PR_GetLoc GetInnerTextFromHTML( GetFormDimensions cUnit_Assign Destroy> GetFormList ConvertFormDimension. MarkSupportedForms OneFormObj ClearErrors) LoadApiDllsw OpenPrinters ClosePrinter EnumFormsz DeviceCapabilitiesK Num2Long Long2Num Long2NumFromBuffer Short2NumD StrZFromBuffer StrZFromBufferW\ StrZCopy_ RtlPL2PS RtlS2PL RtlP2PL RtlP2PS lstrcpyU lstrlenW lstrlen WinApiErrMsgg GetVfpVersion DoFoxyTherm: CreateTherm BringWindowToFront1 LoadF InitY Destroy"4 ClearSetProc>4 ClearSetClassLib,5 ToMHTML PR_FRXOUTPUT ReportOutputCleanup TestListenerReference GetSupportedListenerInfo ReportOutputConfig>J GetConfigObject ReportOutputDeclareReference UnloadListenerWT HandleError CheckPublicListenerCollection Execute cLanguage_Assign PR_MAPIShowMessage PR_MAPI_GetMessageText Printer FOXYLISTENER wwrite.ico ENGLISH Printer v2.99 RC 2012.06.20 FOXYTHERM ?GotData?9FoxIt!!! PDFx / FoxyPreviewer Helvetica CPRINTERNAME LSAVETOFILE LSENDTOEMAIL LPRINTVISIBLE LSHOWCOPIES LSHOWMINIATURES LSHOWCLOSE LSHOWPRINTBTN LSHOWPAGECOUNT LPRINTERPREF LSAVEASIMAGE LSAVEASHTML LSAVEASRTF LSAVEASXLS LSAVEASPDF LSAVEASTXT LSAVEASMHT LQUIETMODE CDESTFILE LPRINTED LSAVED LEMAILED NPAGETOTAL NCOPIES CTITLE CTOOLBARTITLE OLISTENER CDEFAULTLISTENER CSUCCESSOR NCANVASCOUNT NZOOMLEVEL NWINDOWSTATE NDOCKTYPE CFORMICON LUSELISTENER LEMAILAUTO CEMAILTYPE CEMAILPRG CSAVEDEFNAME CSMTPSERVER NSMTPPORT LSMTPUSESSL CSMTPUSERNAME CSMTPPASSWORD CEMAILTO CEMAILSUBJECT CEMAILBODY CEMAILFROM CEMAILCC CEMAILBCC CEMAILREPLYTO LAUTOSENDMAIL NBUTTONSIZE CCODEPAGE LPDFASIMAGE NMAXMINIATUREDISPLAY CLANGUAGE NSHOWTOOLBAR LSHOWSETUP LSHOWPRINTERS LSHOWSEARCH LSILENT CERRORS LEXTENDED _CLAUSENRANGEFROM _CLAUSENRANGETO _CLAUSENPRINTRANGEFROM _CLAUSENPRINTRANGETO _CLAUSELSUMMARY _CLAUSECHEADING _CFRXNAME _CFRXFULLNAME _OREPORTS _OCLAUSES _OALIASES _ONAMES _OPROOFSHEET _OSETTINGSSHEET _OEMAILSHEET _CORIGINALPRINTER _LSENDTOPRINTER _LNOWAIT _OLDREPORTOUTPUT _OEXHANDLER _OCALLER _OPARENTFORM _DE_NAME _OREPORT _LSENDINGEMAIL _CDEFAULTFOLDER _LISDOTMATRIX _OLANG _NBTSIZE _ALANGUAGES _ALANGLOCAL _LANGINDEX COUTPUTPATH _COUTPUTALIAS _CTEXTTOFIND _NINDEX _LCANSEARCH _LSHOWSEARCHAGAIN NPRINTERPROPTYPE LDIRECTPRINT _TOPFORM NVERSION CVERSION NSEARCHPAGES _CTHERMCLASS NTHERMTYPE CDECRYPTPROCEDURE CENCRYPTPROCEDURE CCRYPTKEY _CATTACHMENT CATTACHMENTS LREADRECEIPT LPRIORITY NEMAILMODE CEMAILBODYFILE LPDFEMBEDFONTS LPDFCANPRINT LPDFCANEDIT LPDFCANCOPY LPDFCANADDNOTES LPDFENCRYPTDOCUMENT CPDFMASTERPASSWORD CPDFUSERPASSWORD LOPENVIEWER NPDFPAGEMODE LPDFSHOWERRORS CPDFSYMBOLFONTSLIST CPDFAUTHOR CPDFTITLE CPDFSUBJECT CPDFKEYWORDS CPDFCREATOR CPDFDEFAULTFONT LPDFREPLACEFONTS CADRESSTABLE CADRESSSEARCH LEXCELCONVERTTOXLS LEXCELREPEATHEADERS LEXCELREPEATFOOTERS LEXCELHIDEPAGENO LEXCELALIGNLEFT NEXCELSAVEFORMAT _SETUDFPARMS CIMGPRINT CIMGPRINTPREF CIMGSAVE CIMGCLOSE CIMGCLOSE2 CIMGEMAIL CIMGSETUP CIMGMINIATURES CIMGSEARCH CIMGSEARCHAGAIN CIMGSEARCHBACK CIMGPRINTBIG CIMGPRINTPREFBIG CIMGSAVEBIG CIMGCLOSEBIG CIMGCLOSE2BIG CIMGEMAILBIG CIMGSETUPBIG CIMGMINIATURESBIG CIMGSEARCHBIG CIMGSEARCHAGAINBIG CIMGSEARCHBACKBIG _SETTINGSFILE _LALREADYOPENED _SYS16 _CLOCALPATH _CORIGREPPREVIEW _CLANGLOADED _PREVIEWVERSION OSETTINGSDLG LEXPANDFIELDS CPRINTJOBNAME CEXCELDEFAULTEXTENSION _INITSTATUSTEXT _PREPASSSTATUSTEXT _RUNSTATUSTEXT _SECONDSTEXT _CANCELINSTRTEXT _CANCELQUERYTEXT _REPORTINCOMPLETETEXT _ATTENTIONTEXT LREPEATINPAGE CWATERMARKIMAGE NWATERMARKTYPE NWATERMARKTRANSPARENCY NWATERMARKWIDTHRATIO NWATERMARKHEIGHTRATIO pr_previous.bmp pr_next.bmp pr_top.bmp pr_bottom.bmp pr_Locate.bmp pr_Print.bmp pr_PrintPref.bmp pr_gotopage.bmp pr_1page.bmp pr_2page.bmp pr_4page.bmp pr_close.bmp pr_close2.bmp pr_Save.bmp pr_Mail.bmp pr_Gear.bmp pr_Search.bmp pr_SearchAgain.bmp pr_SearchBack.bmp PREVIEWFORM LHIGHLIGHTTEXT _CREATINGCANVASES IMGBTN_PREV IMGBTN_NEXT IMGBTN_TOP IMGBTN_BOTT IMGBTN_MINI IMGBTN_PRINT IMGBTN_PRINTPREF IMGBTN_GOTOPG IMGBTN_1PG IMGBTN_2PG IMGBTN_4PG IMGBTN_CLOSE IMGBTN_CLOSE2 IMGBTN_SAVE IMGBTN_EMAIL IMGBTN_SETUP IMGBTN_SEARCH IMGBTN_SEARCHAGAIN IMGBTN_SEARCHBACK9 WIDTH BORDERWIDTH HEIGHT VISIBLEA CAPTION WIDTH _GOHELPER _NBTSIZE HEIGHT SPECIALEFFECTx BACKSTYLE BORDERWIDTH HEIGHT WIDTH VISIBLE SPNCOPIES1 SPNCOPIES LBLCOPIES1 LBLCOPIES WIDTH HEIGHT SPECIALEFFECT INCREMENT SPINNERHIGHVALUE SPINNERLOWVALUE KEYBOARDHIGHVALUE KEYBOARDLOWVALUE VISIBLE3 AUTOSIZE BACKSTYLE VISIBLE: pr_Save.bmp PICTURE VISIBLEI HEIGHT WIDTH VISIBLE NINDEX? pr_PrintPref.bmp PICTURE VISIBLE: pr_Gear.bmp PICTURE VISIBLE: pr_Mail.bmp PICTURE VISIBLEO pr_close.bmp PICTURE VISIBLEO pr_Print.bmp PICTURE VISIBLE> pr_gotopage.bmp PICTURE VISIBLEz BACKSTYLE BORDERWIDTH HEIGHT WIDTH VISIBLE CMDSEARCH1 CMDSEARCH CMDSEARCHAGAIN1 CMDSEARCHAGAIN CMDSEARCHBACK1 CMDSEARCHBACK< pr_Search.bmp PICTURE VISIBLEA pr_SearchAgain.bmp PICTURE VISIBLE@ pr_SearchBack.bmp PICTURE VISIBLE 220,140 WIDTH COLUMNCOUNT COLUMNLINES ROWSOURCETYPE COLUMNWIDTHS STYLE VISIBLE _CORIGINALPRINTER< pr_Locate.bmp PICTURE VISIBLE BACKSTYLE BORDERWIDTH frxgotopageform spnPageno lblCaption cmdOK cmdCancel DESKTOP HEIGHT WIDTH SHOWWINDOW DOCREATE AUTOCENTER BORDERSTYLE CLOSABLE MAXBUTTON MINBUTTON ALWAYSONTOP ALLOWOUTPUT PAGENO PAGETOTAL OPARENTFORM SHAPE LEFT BACKSTYLE ZORDERSET STYLE SPNPAGENO SPINNER INPUTMASK LBLCAPTION LABEL AUTOSIZE CMDOK CMDREPORT DEFAULT SPECIALEFFECT CMDCANCEL CANCEL/ wwrite.ico SHOWTIPS_ proofshape HEIGHT WIDTH PAGENO NAMEU HEIGHT _GOHELPER _NBTSIZE WIDTH CAPTION CTYPE proofsheet HEIGHT WIDTH SCROLLBARS DOCREATE AUTOCENTER SHOWWINDOW DESKTOP CURRENTPAGE REPORTLISTENER LSTARTED NPAGES LPAINTED NCURRSHAPE NPAGESET LSHOWDONE LINACTIVE NOTHERTHENPROOFOBJ NMAXMINIATUREITEM OLDESCFUNCTIONP VFP CDO 2000(CDOSYS) mailer Ver 1.1 2009 AERRORS NERRORCOUNT CXMAILER CFROM CREPLYTO CATTACHMENT CSUBJECT CHTMLBODY CTEXTBODY CHTMLBODYURL CCHARSET CSERVER NSERVERPORT LUSESSL NCONNECTIONTIMEOUT NAUTHENTICATE CUSERNAME CPASSWORD LURLGETLATESTVERSION LREADRECEIPT LPRIORITY OTHERMFORM SHOWWINDOW' CDESTFILE LISTENERTYPE% Internal ffffff9@ HHEAP NINCH2MM NCM2MM NCOEFFICIENT CPRINTERNAME CUNIT NROUND CAPIERRORMESSAGE CERRORMESSAGE OFORMLIST OWAS CFORMNAME NFORMNUMBERI SHOWWINDOW SHOWINTASKBARD DATASESSION VISIBLE ALLOWOUTPUT CLANGUAGE PreviewHelper CUSTOM)y ExtensionHandler CUSTOM1 BoxLine Line\ cmdReport COMMANDBUTTON cntCopies CONTAINER? spnCopies SPINNER lblCopies LABEL! cmdSave cmdReport{ cmbSave COMBOBOX cmdPrinterProps cmdReport8 cmdSetup cmdReport cmdEmail cmdReport cmdExit cmdReport- cmdPrintEx cmdReport cmdGotoEx cmdReport cntSearch CONTAINERK cmdSearch cmdReportP cmdSearchAgain cmdReport cmdSearchBack cmdReport cmbPrinters COMBOBOXO cmdProof cmdReport6 cntCanvas Container CustomFrxGotoPageForm frmReport frmReport proofshape SHAPE2 PageSetBtn COMMANDBUTTON proofsheet frmReport? PChar CUSTOM cdo2000 CUSTOM ITLFForm FormC ExportListener REPORTLISTENERc EnumPrinterForms Custom WinApiSupport Custom^ ATLForm FoxyInitForm CustomP Customa EXCEPTION OBJECT ENDTEXT LPARAMETERS oFoxcode LOCAL lcPurpose IF oFoxcode.Location = 0 RETURN "FoxyPreview" ENDIF oFoxcode.valuetype = "V" <> TO lcScript TEXTMERGE NOSHOW ********************************************************************** * FoxyPreview sample script SET PROCEDURE TO FoxyPreviewer.prg ADDITIVE LOCAL loReport AS ReportHelper OF FoxyPreviewer.prg loReport = CREATEOBJECT("PreviewHelper") WITH loReport as ReportHelper * Add the FRX and clauses here .AddReport(_Samples + "\Solution\Reports\colors.frx") * .AddReport(_Samples + "\Solution\Reports\wrapping.frx", "NODIALOG FOR title = [S]") * Optional available parameters .cDestFile = "" && the destination file (image, htm, pdf, etc) && if using this property, the preview window will not open, and the && output file will be automatically generated .cTitle = "Report custom title" && The preview window title .lSendToEmail = .T. && adds the send to email button .lSaveToFile = .T. && adds the save to file button .lShowCopies = .T. && shows the copies spinner .lShowMiniatures = .T. && shows the miniatures page .lShowSearch = .T. && shows the search buttons .nCopies = 3 && The quantity of copies to be printed .lPrintVisible = .T. && shows the print button in the toolbar .lPrinterPref = .T. && shows the Printer preferences button .nShowToolBar = 1 && 1 = Visible (default), 2 = Invisible, 3 = Use resource .lShowSetup = .T. .lShowPrinters = .T. && determines if the available printers combo will be shown * Output types allowed in the "Save as..." button from the toolbar .lSaveAsImage = .T. .lSaveAsHTML = .T. .lSaveAsRTF = .T. .lSaveAsXLS = .T. .lSaveAsPDF = .T. .lSaveAsTXT = .T. .nCanvasCount = 1 && initial nr of pages rendered on the preview form. && Valid values are 1 (default), 2, or 4. .nZoomLevel = 5 && initial zoom level of the preview window. Possible values are: && 1-10%, 2-25%, 3-50%, 4-75%, 5-100% default, 6-150% ; && 7-200%, 8-300%, 9-500%, 10-whole page .nDockType = .F. && Default = False - means to keep the current dock settings from the resource * 1 Undocks the toolbar or form. * 0 Positions the toolbar or form at the top of the main Visual FoxPro window. * 1 Positions the toolbar or form at the left side of the main Visual FoxPro window. * 2 Positions the toolbar or form at the right side of the main Visual FoxPro window. * 3 Positions the toolbar or form at the bottom of the main Visual FoxPro window. .cFormIcon = "" && the icon used in the dialogs .lUseListener = .T. && Determines if ReportBehavior80 will be used for printing (dotmatrix) .cLanguage = "SPANISH" .nButtonSize = 1 && 1=16x16 pixels (default), 2=32x32 pixels * PDF options .lPDFasImage = .F. .nPDFPageMode = 0 && Default = 0, 0 = Normal view, 1 = Show the outlines pane, 2 = Show the thumbnails pane * Email options .lEmailAuto = .T. && Automatically generates the report output file .cEmailType = "PDF" && The file type to be used in Emails (PDF, RTF, HTML, XML or XLS) .cEmailPRG = "" .nEmailMode = 1 && 1 = MAPI, 2 = CDOSYS, 3 = Custom procedure .cSMTPServer = "" .nSMTPPort = 25 .lSMTPUseSSL = .F. .cSMTPUserName = "" .cSMTPPassword = "" .cEmailTo = "" .cEmailSubject = "" .cEmailBody = "" .cEmailFrom = "" .cEmailCC = "" .cEmailBCC = "" .cEmailReplyTo = "" .lAutoSendMail= .F. && Send an email automatically when processing the report * Execute the report preview .RunReport() MESSAGEBOX("Report was " + IIF(.lPrinted, "", "NOT ") + "printed !",64, "Attention !") * Check also .lSaved and .lEmailed ENDWITH loReport = NULL RELEASE loReport ********************************************************************** <> RETURN lcScript FoxyPreview FOXYPREVIEW LNSELECT LOEXC LCFOXCODE LCSYSTEMFOXCODE LODATA LCTEXT LCENDTEXT LCSCRIPT ABBREV aWM_J6_K8_L9_M:_M;_M<^L8\^` u5s5s-3-3m V ^[ AAx;> q[Kq[Kq[Kq[Kq[Kq[KvbR}j[ R?g33 opBM6 'Cv%H \deDl ???%%%%%%%%%%%%%%%%%%%%%%%% xuuuss zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz bH4bH4bH4bH4bH4bH4bH4bH4bH4bH4bH4bH4bH4 Y0k<& cI5cI5cI5 teKg|~ !This program cannot be run in DOS mode. .text `.rdata @.data .rsrc @.reloc T$$A; T$ ~s FFDPAu$ N`RPQ 8FDPAu$ >FDPAt >FDPAu! >FDPAu$ >FDPAu$ 8FDPAu! 8FDPAuN >FDPAu$ >FDPAu$ V$WSR 8FDPAt WLSVR ?FDPAu$ WPSVR ?FDPAu$ 8FDPAu! SUVW3 >FDPAu( HtGHt >FDPAu$ ^Du!j ^Du!j >FDPAu$ >FDPAu$ >FDPAu$ 8FDPAu! 8FDPAu$ 8FDPAu! 8FDPAu$ >FDPAu$ 8FDPAu! 8FDPAu$ >FDPAu$ >FDPAu! L$8QP >FDPAu$ 8FDPAu$ 8FDPAt 8FDPAt 8FDPAt 8FDPAu >FDPA ;FDPAu1S >FDPAu$ ^h[_3 V`QPR F(_^[ >FDPAu$ >FDPAu$ >FDPAu$ t ;Flw >FDPAu* =FDPAt >FDPAu( _[t U >FDPAu$ >FDPAu$ >FDPAt L$,RPQ L$N^n~ /?O_o > deflate 1.2.3 Copyright 1995-2005 Jean-loup Gailly 1.2.3 Qkkbal wn>Jj Z* , #jT$ [-&LMb#{' w+OQvr R1h58 )\ZEo^m/ H*0"ZOW l!;b F mj>zjZ l6qnk IiGM>nw 1A26b ewh/?y 1wsHp #bML" vQO+t ^oEZ_ OZw3(? V_:X1: NJ2"v O*9y] inflate 1.2.3 Copyright 1995-2005 Mark Adler e+000 GAIsProcessorFeaturePresent KERNEL32 FlsFree FlsSetValue FlsGetValue FlsAlloc kernel32.dll CorExitProcess mscoree.dll runtime error TLOSS error SING error DOMAIN error R6029 - This application cannot run using the active version of the Microsoft .NET Runtime Please contact the application's support team for more information. R6028 - unable to initialize heap R6027 - not enough space for lowio initialization R6026 - not enough space for stdio initialization R6025 - pure virtual function call R6024 - not enough space for _onexit/atexit table R6019 - unable to open console device R6018 - unexpected heap error R6017 - unexpected multithread lock error R6016 - not enough space for thread data This application has requested the Runtime to terminate it in an unusual way. Please contact the application's support team for more information. R6009 - not enough space for environment R6008 - not enough space for arguments R6002 - floating point not loaded Microsoft Visual C++ Runtime Library Runtime Error! Program: (8PX 700WP `h```` ppxxxx (null) AuthenticAMD ?X&eB ?h6_~ ?7Tf( =\uI= ]vQ<)8 |)P!?Ua0 Eb2]A= hb?O2 2ieO= |W8A= np?z u?^p?o4 Pex?0 y1~?|" V%A+= ?|I7Z# >,'1D= ?g)([|X>= ?IT$7 :h"?bC @H#?43 Ax#?uN}* r7Yr7= .K="= F0$?3=1 H`$?h| &?~YK| sU0&?W :]=O> CqTR; AiFC. <{Q}< hI{L[ <8bunz8 ?(FN\ K<?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~ GetProcessWindowStation GetUserObjectInformationA GetLastActivePopup GetActiveWindow MessageBoxA user32.dll floor exp10 log10 1#QNAN 1#INF 1#IND 1#SNAN Program: A buffer overrun has been detected which has corrupted the program's internal state. The program cannot safely continue execution and must now be terminated. Buffer overrun detected! A security error of unknown cause has been detected which has corrupted the program's internal state. The program cannot safely continue execution and must now be terminated. Unknown security failure detected! HH:mm:ss dddd, MMMM dd, yyyy MM/dd/yy December November October September August April March February January Saturday Friday Thursday Wednesday Tuesday Monday Sunday _nextafter _logb frexp _hypot _cabs ldexp atan2 SunMonTueWedThuFriSat JanFebMarAprMayJunJulAugSepOctNovDec HeapAlloc HeapFree GetSystemTimeAsFileTime GetCurrentThreadId GetCommandLineA GetVersionExA EnterCriticalSection LeaveCriticalSection GetProcAddress GetModuleHandleA DeleteCriticalSection HeapDestroy HeapCreate VirtualFree VirtualAlloc HeapReAlloc GetLastError ReadFile SetFilePointer SetHandleCount GetStdHandle GetFileType GetStartupInfoA WriteFile CloseHandle TlsAlloc SetLastError TlsFree TlsSetValue TlsGetValue ExitProcess TerminateProcess GetCurrentProcess GetModuleFileNameA FreeEnvironmentStringsA GetEnvironmentStrings FreeEnvironmentStringsW WideCharToMultiByte GetEnvironmentStringsW UnhandledExceptionFilter RtlUnwind InitializeCriticalSection InterlockedExchange VirtualQuery SetStdHandle FlushFileBuffers GetACP GetOEMCP GetCPInfo CreateFileA LoadLibraryA LCMapStringA MultiByteToWideChar LCMapStringW QueryPerformanceCounter GetTickCount GetCurrentProcessId GetLocaleInfoA GetStringTypeA GetStringTypeW SetEndOfFile HeapSize RaiseException VirtualProtect GetSystemInfo KERNEL32.dll LIBHPDF.DLL HPDF_AddPage HPDF_AddPageLabel HPDF_CreateExtGState HPDF_CreateOutline HPDF_Destination_SetFit HPDF_Destination_SetFitB HPDF_Destination_SetFitBH HPDF_Destination_SetFitBV HPDF_Destination_SetFitH HPDF_Destination_SetFitR HPDF_Destination_SetFitV HPDF_Destination_SetXYZ HPDF_Encoder_GetByteType HPDF_Encoder_GetType HPDF_Encoder_GetUnicode HPDF_Encoder_GetWritingMode HPDF_ExtGState_SetAlphaFill HPDF_ExtGState_SetAlphaStroke HPDF_ExtGState_SetBlendMode HPDF_Font_GetAscent HPDF_Font_GetBBox HPDF_Font_GetCapHeight HPDF_Font_GetDescent HPDF_Font_GetEncodingName HPDF_Font_GetFontName HPDF_Font_GetUnicodeWidth HPDF_Font_GetXHeight HPDF_Font_MeasureText HPDF_Font_TextWidth HPDF_Free HPDF_FreeDoc HPDF_FreeDocAll HPDF_GetCurrentEncoder HPDF_GetCurrentPage HPDF_GetEncoder HPDF_GetError HPDF_GetErrorDetail HPDF_GetFont HPDF_GetInfoAttr HPDF_GetPageByIndex HPDF_GetPageLayout HPDF_GetPageMode HPDF_GetStreamSize HPDF_GetVersion HPDF_GetViewerPreference HPDF_HasDoc HPDF_Image_GetBitsPerComponent HPDF_Image_GetColorSpace HPDF_Image_GetHeight HPDF_Image_GetSize2 HPDF_Image_GetSize HPDF_Image_GetWidth HPDF_Image_SetColorMask HPDF_Image_SetMaskImage HPDF_InsertPage HPDF_LinkAnnot_SetBorderStyle HPDF_LinkAnnot_SetHighlightMode HPDF_LoadJpegImageFromFile HPDF_LoadPngImageFromFile2 HPDF_LoadPngImageFromFile HPDF_LoadRawImageFromFile HPDF_LoadRawImageFromMem HPDF_LoadTTFontFromFile2 HPDF_LoadTTFontFromFile HPDF_LoadType1FontFromFile HPDF_New HPDF_NewDoc HPDF_NewEx HPDF_Outline_SetDestination HPDF_Outline_SetOpened HPDF_Page_Arc HPDF_Page_BeginText HPDF_Page_Circle HPDF_Page_Clip HPDF_Page_ClosePath HPDF_Page_ClosePathEofillStroke HPDF_Page_ClosePathFillStroke HPDF_Page_ClosePathStroke HPDF_Page_Concat HPDF_Page_CreateDestination HPDF_Page_CreateLinkAnnot HPDF_Page_CreateTextAnnot HPDF_Page_CreateURILinkAnnot HPDF_Page_CurveTo2 HPDF_Page_CurveTo3 HPDF_Page_CurveTo HPDF_Page_DrawImage HPDF_Page_Ellipse HPDF_Page_EndPath HPDF_Page_EndText HPDF_Page_Eoclip HPDF_Page_Eofill HPDF_Page_EofillStroke HPDF_Page_ExecuteXObject HPDF_Page_Fill HPDF_Page_FillStroke HPDF_Page_GRestore HPDF_Page_GSave HPDF_Page_GetCMYKFill HPDF_Page_GetCMYKStroke HPDF_Page_GetCharSpace HPDF_Page_GetCurrentFont HPDF_Page_GetCurrentFontSize HPDF_Page_GetCurrentPos2 HPDF_Page_GetCurrentPos HPDF_Page_GetCurrentTextPos2 HPDF_Page_GetCurrentTextPos HPDF_Page_GetDash HPDF_Page_GetFillingColorSpace HPDF_Page_GetFlat HPDF_Page_GetGMode HPDF_Page_GetGStateDepth HPDF_Page_GetGrayFill HPDF_Page_GetGrayStroke HPDF_Page_GetHeight HPDF_Page_GetHorizontalScalling HPDF_Page_GetLineCap HPDF_Page_GetLineJoin HPDF_Page_GetLineWidth HPDF_Page_GetMiterLimit HPDF_Page_GetRGBFill HPDF_Page_GetRGBStroke HPDF_Page_GetStrokingColorSpace HPDF_Page_GetTextLeading HPDF_Page_GetTextMatrix HPDF_Page_GetTextRaise HPDF_Page_GetTextRenderingMode HPDF_Page_GetTextRise HPDF_Page_GetTransMatrix HPDF_Page_GetWidth HPDF_Page_GetWordSpace HPDF_Page_LineTo HPDF_Page_MeasureText HPDF_Page_MoveTextPos2 HPDF_Page_MoveTextPos HPDF_Page_MoveTo HPDF_Page_MoveToNextLine HPDF_Page_Rectangle HPDF_Page_SetCMYKFill HPDF_Page_SetCMYKStroke HPDF_Page_SetCharSpace HPDF_Page_SetDash HPDF_Page_SetExtGState HPDF_Page_SetFlat HPDF_Page_SetFontAndSize HPDF_Page_SetGrayFill HPDF_Page_SetGrayStroke HPDF_Page_SetHeight HPDF_Page_SetHorizontalScalling HPDF_Page_SetLineCap HPDF_Page_SetLineJoin HPDF_Page_SetLineWidth HPDF_Page_SetMiterLimit HPDF_Page_SetRGBFill HPDF_Page_SetRGBStroke HPDF_Page_SetRotate HPDF_Page_SetSize HPDF_Page_SetSlideShow HPDF_Page_SetTextLeading HPDF_Page_SetTextMatrix HPDF_Page_SetTextRaise HPDF_Page_SetTextRenderingMode HPDF_Page_SetTextRise HPDF_Page_SetWidth HPDF_Page_SetWordSpace HPDF_Page_ShowText HPDF_Page_ShowTextNextLine HPDF_Page_ShowTextNextLineEx HPDF_Page_Stroke HPDF_Page_TextOut HPDF_Page_TextRect HPDF_Page_TextWidth HPDF_ReadFromStream HPDF_ResetError HPDF_ResetStream HPDF_SaveToFile HPDF_SaveToStream HPDF_SetCompressionMode HPDF_SetCurrentEncoder HPDF_SetEncryptionMode HPDF_SetErrorHandler HPDF_SetInfoAttr HPDF_SetInfoDateAttr HPDF_SetOpenAction HPDF_SetPageLayout HPDF_SetPageMode HPDF_SetPagesConfiguration HPDF_SetPassword HPDF_SetPermission HPDF_SetViewerPreference HPDF_TextAnnot_SetIcon HPDF_TextAnnot_SetOpened HPDF_UseCNSEncodings HPDF_UseCNSFonts HPDF_UseCNTEncodings HPDF_UseCNTFonts HPDF_UseJPEncodings HPDF_UseJPFonts HPDF_UseKREncodings HPDF_UseKRFonts DN*1DR(zD CN*1D Too many bytes for PNG signature. Potential overflow in png_zalloc() libpng error: %s libpng error: %s, offset=%d libpng error no. %s: %s libpng warning: %s libpng warning no. %s: %s Unknown zlib error zlib version error zlib memory error 1.2.3 Incompatible libpng version in application and library Application is running with png.c from libpng-%.20s Application was compiled with png.h from libpng-%.20s Missing PLTE before IDAT Missing IHDR before IDAT PNG file corrupted by ASCII conversion Not a PNG file Ignoring extra png_read_update_info() call; row buffer not reallocated Extra compressed data Decompression error Not enough image data Invalid attempt to read row data png_do_dither returned rowbytes=0 png_do_rgb_to_gray found nongray pixel NULL row buffer for row %ld, pass %d Call to NULL read function Read Error same structure. Resetting write_data_fn to NULL. It's an error to set both read_data_fn and write_data_fn in the Out of Memory! Error decoding compressed text PNG unsigned integer out of range. CRC error Unknown zTXt compression type %d Not enough memory for text. Incomplete compressed datastream in %s chunk Data error in compressed datastream in %s chunk Buffer error in compressed datastream in %s chunk Not enough memory to decompress chunk Not enough memory to decompress chunk.. Not enough memory to decompress chunk. Invalid IHDR chunk Out of place IHDR Truncating incorrect info tRNS chunk length Truncating incorrect tRNS chunk length Invalid palette chunk Ignoring PLTE chunk in grayscale PNG Duplicate PLTE chunk Invalid PLTE after IDAT Missing IHDR before PLTE Incorrect IEND chunk length No image in file gamma = (%d/100000) Ignoring incorrect gAMA value when sRGB is also present Ignoring gAMA chunk with gamma=0 Incorrect gAMA chunk length Duplicate gAMA chunk Out of place gAMA chunk Invalid gAMA after IDAT Missing IHDR before gAMA Incorrect sBIT chunk length Duplicate sBIT chunk Out of place sBIT chunk Invalid sBIT after IDAT Missing IHDR before sBIT Invalid cHRM white point gx=%f, gy=%f, bx=%f, by=%f wx=%f, wy=%f, rx=%f, ry=%f Ignoring incorrect cHRM value when sRGB is also present Invalid cHRM blue point Invalid cHRM green point Invalid cHRM red point Incorrect cHRM chunk length Duplicate cHRM chunk Missing PLTE before cHRM Invalid cHRM after IDAT Missing IHDR before cHRM incorrect gamma=(%d/100000) Unknown sRGB intent Incorrect sRGB chunk length Duplicate sRGB chunk Out of place sRGB chunk Invalid sRGB after IDAT Missing IHDR before sRGB Profile size field missing from iCCP chunk Ignoring truncated iCCP profile. Ignoring nonzero compression type in iCCP chunk Malformed iCCP chunk Duplicate iCCP chunk Out of place iCCP chunk Invalid iCCP after IDAT Missing IHDR before iCCP Invalid sPLT after IDAT sPLT chunk requires too much memory sPLT chunk too long sPLT chunk has bad length malformed sPLT chunk Missing IHDR before sPLT Duplicate tRNS chunk Invalid tRNS after IDAT tRNS chunk not allowed with alpha channel Zero length tRNS chunk Missing PLTE before tRNS Incorrect tRNS chunk length Missing IHDR before tRNS Duplicate bKGD chunk Missing PLTE before bKGD Invalid bKGD after IDAT Incorrect bKGD chunk index value Incorrect bKGD chunk length Missing IHDR before bKGD Duplicate hIST chunk Missing PLTE before hIST Invalid hIST after IDAT Incorrect hIST chunk length Missing IHDR before hIST Duplicate pHYs chunk Invalid pHYs after IDAT Incorrect pHYs chunk length Missing IHDR before pHYs Duplicate oFFs chunk Invalid oFFs after IDAT Incorrect oFFs chunk length Missing IHDR before oFFs Duplicate pCAL chunk Invalid pCAL after IDAT No memory for pCAL params. Unrecognized equation type for pCAL chunk Invalid pCAL parameters for equation type Invalid pCAL data No memory for pCAL purpose. Missing IHDR before pCAL Duplicate sCAL chunk Invalid sCAL after IDAT Invalid sCAL data malformed height string in sCAL chunk malformed width string in sCAL chunk Out of memory while processing sCAL chunk Missing IHDR before sCAL Duplicate tIME chunk Incorrect tIME chunk length Out of place tIME chunk Insufficient memory to process text chunk. Not enough memory to process text chunk. No memory to process text chunk. Missing IHDR before tEXt Insufficient memory to store zTXt chunk. Not enough memory to process zTXt chunk. Unknown compression type in zTXt chunk Zero length zTXt chunk Out of memory processing zTXt chunk. Missing IHDR before zTXt unknown critical chunk invalid chunk type Ignoring bad adaptive filter type Extra compression data Extra compressed data. Decompression Error Row has too many bytes to allocate in memory. Ignoring attempt to set negative chromaticity value Ignoring attempt to set chromaticity value exceeding 21474.83 Setting gamma=0 Limiting gamma to 21474.83 Setting negative gamma to zero Invalid palette size, hIST allocation skipped. Insufficient memory for hIST chunk data. Invalid filter method in IHDR Unknown filter method in IHDR MNG features are not allowed in a PNG datastream Unknown compression method in IHDR Unknown interlace method in IHDR Invalid color type/bit depth combination in IHDR Invalid color type in IHDR Invalid bit depth in IHDR Width is too large for libpng to process pixels Invalid image size in IHDR image size exceeds user limits in IHDR Image width or height is zero in IHDR Insufficient memory for pCAL parameter. Insufficient memory for pCAL params. Insufficient memory for pCAL units. Insufficient memory for pCAL purpose. Invalid palette length Insufficient memory to process iCCP profile. Insufficient memory to process iCCP chunk. iTXt chunk not supported. No memory for sPLT palettes. Out of memory processing unknown chunk. Out of memory while processing unknown chunk. too many length or distance symbols incorrect length check incorrect data check invalid distance too far back invalid distance code invalid literal/length code invalid distances set invalid literal/lengths set invalid bit length repeat invalid code lengths set invalid stored block lengths invalid block type header crc mismatch unknown header flags set incorrect header check invalid window size unknown compression method incompatible version buffer error insufficient memory data error stream error file error stream end need dictionary z?aUY zc%C1 -64OS 0u0|0 1.252l2p2t2x2|2 3(3,3034383<3@3D3H3L3P3T3X3\3`3d3$4 3;3Q3 406P6b6 7*8~8 9A:R: 566A6H6S6Z6e6l6w6 7 7*7 1*1C1P1d1}1 2i9s9 >)?U? :5:p: ;$">8>J> 151V1l1 3#3M3T3 5I5[5n5 5 686E6T6 8U9w9 :a;h;o; <-<@8?4 44585<5@5D5 ===h= >(?a? 3@4E4 556u6 1&272O2 2D3R3j3z3 4/4H4 8_9s9 B? 4,5O5U5 7%7\7 8,9O9U9 9O:c: ;#;X; 0S1m1 1n2<3 4:5R5j5 727J7b7 9*9B9 ;2;J;b; =.>H> 2'2v2 2N3g3 9:9S9 ;";-;2;?;D;[;`;k;p;}; <4<99>&? 0*0B0!1O2 565R5i5w5 :4:r:.; 0:1o1 1*2>3R3Y3`3e3 3C4f4s4 4 5#5J5 5=6e6 7>7a7t7y7 818>8C8 0>C>W>/?4???D?p? 0(0?0V0 0)161 3Z3{3 8%858 9*949K9[9 ;+;;; <,<7y> 1'2?2J2T2k2 2%3,3T3l3w3 41464R4W4s4x4 898?8g8 9;9e9l9 9L:Q:m:r: =(>H? 1o2t2 3(3-3M3R3r3w3 4+404L4Q4m4r4 5(6H7h8L9Q9q9v9 :*:/:O:T:t:y: ;);.;J;O;k;p; >6>;>[>`> <0A0]0b0~0 3e4o4u4 6&6A6 ;&;7; 5*5/5?5D5 5 797J7e7 8 8p8t8x8|8 :E:[: ;-;W; ;)B>o> 1X2\2`2d2h2l2p2 : ;(;i;x;~; '>3>;>I> ?T?Y? 0I1}1 4B4w4 4/5U5 9:9m9 <>#>/>>>J>Y>e>t> >I?b?{? +030;0C0K0S0[0c0 181D1P1a1k1{1 3+3I3_3 4*4`4v4 =$=.=B=N=j=q= >,>6>J>V>r>|> ?&?/?R? 0'0]1F2y2 9);e; ;R>i> 2y3W5 5_7h7l7p7t7x7|7 o> 3;4I4 1$191 2"2f2y2 :0:8:A:S:a:m: :6;<;M;~; ;"<`?E?T?]?n? 0$0G0 2'242 3N4k4 4k5w5 6C7A8J8e8z8 979I9O9X9g9 :(:1:S:Z:i: ;&;3;:;@;H;N;Y;a; >(>3>9>>>D>Q>n>t> ?,?2?C? 6!656 9c:q: :H;`;g;o;t;x;|; >3>c>u>z> ?$?*?;?@?K?P?j? -030?0o0~0 1(1z1P2i2 2-343B3L3e3q3}3 4T4d4p4w4 4o5t5 5D6}6 607E7d7v7 <$=?=P= 0^1x1 3'3V3 3E4N4T4 5P5W5u5{5 5,656@6{6 8Y8e8}8 9/:7: :?;l; 2H2e2y2 6+7e7 8%838f8y8 9/:1;B>X>t> >(?@?G?O?T?X?\? 60<0@0D0H0 0 131e1l1p1t1x1|1 7&7+74797l7 9+929C9J9X9l9 :>:k:{: :(;D; ;#<5< =f=t= =%>9> ?G?p? 0%040K0`0 2!2;2G2Y2g2 3#3C3I3j3p3 4+494C4P4Z4g4p4y4 5#5/5^5o5 6Y7f7q7w7 9%9-9D9R9W9a9 :$:):F:V:n: %>4>=>F>s> ?%?-? 6 8$8u8 9 9B9}9 3!3%3)3-3135393=3A3 4+4Z4~4 5"6/6 7Y7Y879 <*<4<<9{: :0;s;}; 0 1G1 2>2C2d2 2U3@5 2$2,242<2D2L2T2\2d2l2t2|2 3$3,343<3D3L3T3\3d3l3t3|3 4$4,444<4D4L4T4\4d4l4t4|4 5$5,545<5D5L5T5\5d5l5t5|5 6$6,646<6D6L6T6\6d6l6t6|6 7$7,747<7D7L7T7\7d7l7t7|7 8$8,848<8D8L8T8\8d8l8t8|8 9$9,949<9D9L9T9\9d9l9t9|9 :$:,:4:<:D:L:T:\:d:l:t:|: ;$;,;4;<;D;L;T;\;d;l;t;|; <$<,<4<<$>,>4><>D>L>T>\>d>l>t>|> ?$?,?4?$>,>4><>D>L>T>\>d>l>t>|> ?$?,?4?7B7F7J7N7R7V7Z7^7b7f7j7n7r7v7z7~7 7(8084888<8@8D8H8L8P8T8X8\8`8d8h8l8p8t8x8|8 9<9D9L9T9\9d9l9t9|9 gggg` vvvvp gggg` vvvvp gggg` vvvvp gggg` gggg` wwwwwwwwwwwp gggggggggg`p vvvvvvvvvvpp gggggggggg`p vvvvvvvvvvpp gggggggggg`p vvvvvvvvvvpp gggggggggg`p vvvvvvvvvvpp gggggggggg`p vvvvvvvvvvpp gggggggggg`p vvvvvvvvvvpp gggggggggg`p vvvvvvvvvvpp gggggggggg`p vvvvvvvvvvpp gggggggggg`p wwwww wwwww wwwww gggggggggg`p vvvvvvvvvvpp gggggggggg`p PLATFORM UNIQUEID TIMESTAMP CLASS CLASSLOC BASECLASS OBJNAME PARENT PROPERTIES PROTECTED METHODS OBJCODE RESERVED1 RESERVED2 RESERVED3 RESERVED4 RESERVED5 RESERVED6 RESERVED7 RESERVED8 COMMENT Class WINDOWS _1WE14QM5X1087766862 COMMENT RESERVED VERSION = 3.00 frxpreview.hf; foxpro_reporting.hn< frxpreview_loc.hv=}GO7 excellistener frxpreview.h Pixels Class fxlistener excellistener coutputalias coutputdbf loutputtocursor closeondeactivate nlastpercent cworkbookfile cworksheetname applyexcelstyleprogram cexcelstyle waitfornextreport ldefaultmode cfrxalias lobjtypemode targetfilename lopenviewer ccodepage ctempfrx lalignleft nexcelsaveformat setstrictdate *isnumber *xml_numberformat *xml_file_header *xml_style *xml_workbook_header *xml_worksheet_header *xml_row_header *xml_row_footer *xml_cell *xml_table_header *xml_workbook_footer *xml_worksheet_footer *xml_stylenumber *xml_type *xml_styles_header *xml_styles_footer *xml_table_footer *xml_encode *calcbandnumbers *xextractexcelcol *applyexcelstyle *islonghorizontalline *isshorthorizontalline *calcbasefilename *calcnextfilename *xml_names_header *xml_name *xml_names_footer *outputfromdata *updateproperties *topurexlsusingexcel *topurexlsusingoo *showtherm 0123456789.,$ 0123456789.,$ TCCONTENTS LLISNUMBER LCALIAS LLALLDIGITS LCTEST LNTIMES LNPOS LNOLDPOS LNLOOP SETPOINT SETSEPARATOR` NUMBER ###,###,##0 ########0 DATETIME Short Date String TCCONTENTS LCTYPE XML_TYPE LCPOINT LCSEPAR SETPOINT SETSEPARATOR LCFORMAT ISO-8859-1 CP950 CP936 UTF-8 Windows-CC >"?> LCRETVAL LCCODEPAGE LCENCODING THIS CCODEPAGE LCONVERTTOUTF8 ss:FontName="CC ss:Size="CCC 000000 ss:Color="# ss:Bold="1" ss:Italic="1" ss:Format="C LEFTCC ss:Horizontal="Left" CENTERCC ss:Horizontal="Center" RIGHTCC ss:Horizontal="Right" "Bottom" SINGLE "Continuous" FFFFFF ss:Pattern=CCC "Solid" ss:Color=CCC "#FFFFFF" ss:PatternColor= >/> <> >/> <> >/> LCFONT PASTYLES LCTEXTCOLOR LCBOLD LCITALIC LCFAMILY LCNUMBERFORMAT LCHORIZONTALALIGNMENT LABORDERS LABORDER LCPOSITION LCLINESTYLE LCWEIGHT LCBORDER LCBORDERS LAINTERIOR LCINTERIOR LCPATTERN LCCOLOR LCPATTERNCOLOR LCRETVALW LCRETVALi TCWORKSHEETNAME LCRETVAL LCRETVAL C DATETIME STRING @L 9999_ @L 99_ @L 99_ T00:00:00.000 NUMBER Currency STRING STRING ss:MergeAcross="CC 99999 STRING <> TNROWS TNCOLS LCRETVAL LCCOLUMNS EXCELCOL EXCELROW COUTPUTALIAS PACOLDATA# C LCRETVAL@ Number DateTime Short Date TCCONTENTS LCTYPE LCNUMBERFORMAT LCKEY XML_TYPE XML_NUMBERFORMAT FONTFACE FONTSIZE FONTSTYLE CEXCELALIGNMENT CEXCELBORDER CEXCELINTERIOR PASTYLES String DateTime Number DateTime String String TCCONTENTS LCTYPE LCSETDATE SETDATEANSI ISNUMBER C C C TCCONTENTS TCCHAR LCVALUE WINDOWS WINDOWS LABANDS LNVPOS LNSELECT G_PIXELSIZE G_BANDHEIGHT G_BANDFUDGE OBJCODE HEIGHT THIS CFRXALIAS PLATFORM OBJTYPE LNVPOSBOTTOM 0000000 TCCOMMENTT &tcExcelStyle.(tnOption,This) TCEXCELSTYLE TNOPTION COUTPUTALIAS; TCEXPR9 TCEXPR REP_C @L 99_ REP_C @L 99_ REP_??. TCWORKBOOK LCFILENAME LADIR TCEXTENSION @L 99_ @L 99_ TCWORKBOOK LCBASENAME LCFILENAME LADIR C 0 FOR lnLoop = 1 TO lnTimes lnPos = AT(This.SetSeparator, lcTest, lnLoop) IF lnLoop > 1 IF lnPos - lnOldPos <> 4 RETURN .F. && Not a number ENDIF ENDIF lnOldPos = lnPos ENDFOR IF LEN(lcTest) - AT(This.SetSeparator, lcTest, lnTimes) <> 3 RETURN .F. && Not a number ENDIF ENDIF ENDIF * 06/09/09 Generic method using value of FillChar in report file! *!* lcAlias = ALIAS() *!* llIsNumber = &lcAlias..FillChar = 'N' DO CASE *!* CASE &lcAlias..FillChar = 'N' *!* llIsNumber = .T. *!* CASE &lcAlias..FillChar = 'C' *!* llIsNumber = .F. * 02/01/07 Case added by Andrus Moor to handle dd.mm.yyyy date format. * Not very satisfying... need to devise something more explicit and general. * CASE OCCURS('.', tcContents) > 1 * CChalom - Check XML_Type method, a new checking was added there * 2010/08/08 Fix by Jaketon / CChalom, when SET("POINT") = "," *!* CASE FillChar = "N" *!* llIsNumber = .T. CASE (" " $ tcContents) OR ("%" $ tcContents) llIsNumber = .F. CASE llAllDigits AND LEN(CHRTRAN(tcContents, ".,$", "")) > 15 && Excel can't deal with numbers of more than 15 positions llIsNumber = .F. CASE OCCURS(This.SetPoint, tcContents) > 0 AND ; OCCURS(This.SetSeparator, tcContents) > 0 AND ; (AT(This.SetPoint, tcContents) < AT(This.SetSeparator, tcContents)) llIsNumber = .F. CASE OCCURS(This.SetPoint, tcContents) > 1 llIsNumber = .F. CASE LEN(tcContents) = 0 llIsNumber = .F. * 2011-02-23 Fix by Julio Laborin (Mexico) * CASE LEN(CHRTRAN(tcContents, '0123456789.,$', '')) = 0 CASE llAllDigits AND LEFT(tcContents, 2) = "0" + This.SetPoint llIsNumber = .T. CASE LEFT(tcContents, 1) = "0" AND NOT EMPTY(SUBSTR(tcContents,2,1)) AND (SUBSTR(tcContents,2,1) <> This.SetPoint) llIsNumber = .F. CASE llAllDigits AND SUBSTR(tcContents,1,1) <> "0" llIsNumber = .T. CASE llAllDigits AND VAL(tcContents) = 0 llIsNumber = .T. OTHERWISE llIsNumber = (LEFT(tcContents,1) = '-' AND LEN(CHRTRAN(SUBSTR(tcContents,2),'0123456789.,$','')) = 0) ENDCASE RETURN llIsNumber ENDPROC PROCEDURE xml_numberformat LPARAMETERS tcContents LOCAL lcType lcType = UPPER(This.Xml_Type(tcContents)) DO CASE CASE lcType = 'NUMBER' * IF AT(',',tcContents) > 0 * lcFormat = '###,###,##0' * ELSE * lcFormat = '########0' * ENDIF * IF AT('.',tcContents) > 0 * lcFormat = lcFormat + '.' + REPLICATE('0',LEN(tcContents) - AT('.',tcContents)) * ENDIF * 2010/08/08 Fix by Jaketon / CChalom, when SET("POINT") = "," LOCAL lcPoint, lcSepar lcPoint = This.SetPoint lcSepar = This.SetSeparator IF AT(lcSepar, tcContents) > 0 lcFormat = '###,###,##0' * lcFormat = '###' + lcSepar + '###' + lcSepar + '##0' ELSE lcFormat = '########0' ENDIF IF AT(lcPoint, tcContents) > 0 * lcFormat = lcFormat + lcPoint + REPLICATE('0',LEN(tcContents) - AT(lcPoint, tcContents)) lcFormat = lcFormat + "." + REPLICATE('0',LEN(tcContents) - AT(lcPoint, tcContents)) ENDIF CASE lcType = 'DATETIME' lcFormat = 'Short Date' OTHERWISE lcFormat = 'String' ENDCASE RETURN lcFormat ENDPROC PROCEDURE xml_file_header LOCAL lcRetVal, lcCodePage, lcEncoding IF EMPTY(This.cCodePage) lcCodePage = TRANSFORM(CPCURRENT()) ELSE lcCodePage = ALLTRIM(This.cCodePage) ENDIF * Let's use ISO-8859-1 instead of Windows-1252, to make it compatible with LibreOffice * Still need checking from people that use different CodePages DO CASE CASE "1252" $ lcCodePage lcEncoding = "ISO-8859-1" CASE INLIST(lcCodePage, "CP950", "CP936", "950", "936") && Chinese lcEncoding = "UTF-8" This.lConvertToUTF8 = .T. * lcEncoding = "GB2312" OTHERWISE * lcEncoding = "Windows-" + IIF("CP" $ lcCodePage, "", "CP") + lcCodePage && comment by amaximum lcEncoding = "Windows-" + IIF(LEFT(lcCodePage, 2) = "CP", SUBSTR(lcCodePage, 3), lcCodePage) ENDCASE TEXT TO lcRetVal TEXTMERGE NOSHOW PRETEXT 2 >"?> ENDTEXT *!* * Original code from Alejandro Sosa *!* TEXT TO lcRetVal NOSHOW PRETEXT 2 *!* *!* *!* ENDTEXT * Cancelled Andrus Moor'update because the resulting header would not allow the * XML to be opened by LIBREOFFICE * 02/01/07 Change by andrus Moor *!* TEXT TO lcRetVal TEXTMERGE NOSHOW PRETEXT 2 *!* >"?> *!* *!* ENDTEXT RETURN lcRetVal + CHR(13) + CHR(10) *!* Microsoft's *!* ISO Code Page Charts *!* Globalization site: GlobalDev *!* ISO Code Pages at Microsoft's site *!* ISO/IEC 8859-1 (Latin 1) *!* ISO/IEC 8859-2 (Latin 2) *!* ISO/IEC 8859-3 (Latin 3) *!* ISO/IEC 8859-4 (Baltic) *!* ISO/IEC 8859-5 (Cyrillic) *!* ISO/IEC 8859-6 (Arabic) *!* ISO/IEC 8859-7 (Greek) *!* ISO/IEC 8859-8 (Hebrew) *!* ISO/IEC 8859-9 (Turkish) *!* ISO/IEC 8859-15 (Latin 9) ENDPROC PROCEDURE xml_style LPARAMETERS tnID *!* IF "936" $ This.cCodepage && We are not setting fonts for Chinese *!* && Let's allow Excel to use the one it has default for the language *!* lcFont = "" *!* ELSE *!* lcFont = IIF(EMPTY(paStyles[tnId-20,2]),'',[ ss:FontName="] + ALLTRIM(paStyles[tnId-20,2]) + ["]) *!* ENDIF lcFont = IIF(EMPTY(paStyles[tnId-20,2]),'',[ ss:FontName="] + ALLTRIM(paStyles[tnId-20,2]) + ["]) * 2010.01.30 - CChalom: Fix in the name of the field, correct = "Size" lcFont = lcFont + IIF(EMPTY(paStyles[tnId-20,3]),'',[ ss:Size="] + ALLTRIM(TRANSFORM(paStyles[tnId-20,3])) + ["]) *lcFont = lcFont + IIF(EMPTY(paStyles[tnId-20,3]),'',[ ss:FontSize="] + ALLTRIM(TRANSFORM(paStyles[tnId-20,3])) + ["]) * 2010.01.30 - CChalom: Create a tag for the text color LOCAL lcTextColor lcTextColor = ALLTRIM(GETWORDNUM(paStyles[tnId-20,9],3,",")) IF NOT EMPTY(lcTextColor) AND lcTextColor <> "000000" lcFont = lcFont + IIF(EMPTY(lcTextColor),'',[ ss:Color="#] + lcTextColor + ["]) ENDIF lcBold = IIF(BITTEST(paStyles[tnId-20,4],0), [ ss:Bold="1"],'') lcItalic = IIF(BITTEST(paStyles[tnId-20,4],1), [ ss:Italic="1"],'') lcFamily = '' && IIF(EMPTY(lcBold) AND EMPTY(lcItalic),'',[ x:Family="Modern"]) lcFont = lcFont + lcFamily + lcBold + lcItalic lcNumberFormat = IIF(EMPTY(paStyles[tnId-20,6]),'',[ ss:Format="] + paStyles[tnId-20,6] + ["]) *lcHorizontalAlignment = IIF(paStyles[tnId-20,7] = 2,[ ss:Horizontal="Center"],'') DO CASE CASE 'LEFT' $ UPPER(paStyles[tnId-20,7]) lcHorizontalAlignment = [ ss:Horizontal="Left"] CASE 'CENTER' $ UPPER(paStyles[tnId-20,7]) lcHorizontalAlignment = [ ss:Horizontal="Center"] CASE 'RIGHT' $ UPPER(paStyles[tnId-20,7]) lcHorizontalAlignment = [ ss:Horizontal="Right"] OTHERWISE lcHorizontalAlignment = '' ENDCASE *!* ExcelBorders format: Top,Single,1;Bottom,Double,3 *!* *!* *!* *!* LOCAL laBorders[1],laBorder[1],i,j,lcPosition,lcLineStyle,lcWeight,lcBorder,lcBorders ALINES(laBorders,paStyles[tnId-20,8],1,';') IF EMPTY(laBorders[1]) lcBorders = '' lcBorders = '' FOR m.i = 1 TO ALEN(laBorders,1) ALINES(laBorder,laBorders[m.i],1,',') DIMENSION laBorder[3] IF EMPTY(laBorder[1]) LOOP ENDIF lcPosition = IIF(EMPTY(laBorder[1]),["Bottom"],["]+laBorder[1]+["]) lcLineStyle = IIF(EMPTY(laBorder[2]) OR UPPER(laBorder[2]) = 'SINGLE',["Continuous"],["]+laBorder[2]+["]) lcWeight = IIF(EMPTY(laBorder[3]),["1"],["]+laBorder[3]+["]) lcBorder = [] lcBorders = lcBorders + lcBorder ENDFOR lcBorders = lcBorders + '' ENDIF *!* Interior properties. *!* Color = Background Color *!* Pattern = "Solid" --> no pattern, "Gray125", "ThinVert ss:Pattern="Solid"Stripe" *!* PatternColor *!* Samples: *!* Solid,FFFF00 *!* *!* Gray125,FFFFFF,000000 *!* *!* ThinVertStripe,FFFF00,00FF00 *!* LOCAL laInterior[1],lcPosition,lcLineStyle,lcWeight,lcInterior ALINES(laInterior,paStyles[tnId-20,9],1,',') DIMENSION laInterior[3] * 2010.01.30 - CChalom: Modified to create the tag only for non white background IF EMPTY(laInterior[1]) OR laInterior[2] = "FFFFFF" lcInterior = '' lcPattern = [ ss:Pattern=] + IIF(EMPTY(laInterior[1]),["Solid"],["]+laInterior[1]+["]) lcColor = [ ss:Color=] + IIF(EMPTY(laInterior[2]),["#FFFFFF"],["#]+laInterior[2]+["]) lcPatternColor = IIF(EMPTY(laInterior[3]),[],[ ss:PatternColor=] + ["#]+laInterior[3]+["]) lcInterior = '' ENDIF TEXT TO lcRetVal NOSHOW TEXTMERGE PRETEXT 2 ENDTEXT RETURN lcRetVal + CHR(13) + CHR(10) ENDPROC PROCEDURE xml_workbook_header LOCAL lcRetVal TEXT TO lcRetVal NOSHOW PRETEXT 2 ENDTEXT RETURN lcRetVal + CHR(13) + CHR(10) ENDPROC PROCEDURE xml_worksheet_header LPARAMETERS tcWorksheetName LOCAL lcRetVal TEXT TO lcRetVal NOSHOW TEXTMERGE PRETEXT 2 ENDTEXT RETURN lcRetVal + CHR(13) + CHR(10) ENDPROC PROCEDURE xml_row_header LOCAL lcRetVal TEXT TO lcRetVal TEXTMERGE NOSHOW PRETEXT 2 ENDTEXT RETURN lcRetVal + CHR(13) + CHR(10) ENDPROC PROCEDURE xml_row_footer RETURN '' + CHR(13) + CHR(10) ENDPROC PROCEDURE xml_cell LPARAMETERS tcContents, tcUnicode, tnStyleNumber tcContents = ALLTRIM(tcContents) LOCAL lcOrigContents, lcStyle lcOrigContents = tcContents lcStyle = UPPER(paStyles[tnStyleNumber-20,5]) LOCAL lcRetVal IF lcStyle = 'DATETIME' * lcSetDate = SET("Date") * SET DATE (This.SetDate) tcContents = CTOD(tcContents) * SET DATE TO BRITISH IF EMPTY(tcContents) lcStyle = "STRING" tcContents = lcOrigContents ELSE *1899-12-31T14:49:56.000 tcContents = TRANSFORM(YEAR(tcContents),'@L 9999') ; + '-' + TRANSFORM(MONTH(tcContents),'@L 99') ; + '-' + TRANSFORM(DAY(tcContents),'@L 99') ; + 'T00:00:00.000' ENDIF * SET DATE TO &lcSetDate ENDIF * 2010/08/08 Fix by Jaketon / CChalom, when SET("POINT") = "," IF lcStyle = 'NUMBER' tcContents = CHRTRAN(tcContents, This.SetSeparator, '') && quito simbolos de separaci tcContents = CHRTRAN(tcContents, This.SetPoint ,'.') && Reemplazo , por puntos * 2012/05/30 Fix by RGBean to allow flexible Currency and ()'s for Negative *-- tcContents = CHRTRAN(tcContents,'$+','+') tcContents = CHRTRAN(tcContents, SET('Currency',1), '') && Kill any Currency character(s) IF AT('(', tcContents) > 0 AND AT(')', tcContents) > 0 && ()'s used for negative tcContents = CHRTRAN(tcContents,'()','') && Kill the ()'s tcContents = '-'+ALLTRIM(tcContents) && Make it a negative value ENDIF ENDIF LOCAL llUseUnicode llUseUnicode = (lcStyle = 'STRING') and ("?" $ tcContents) *!* IF (This.lUseUnicode = .F.) AND (lcStyle = 'STRING') *!* IF (NOT EMPTY(tcContents)) AND (NOT EMPTY(CHRTRANC(tcContents, "?", ""))) *!* This.lUseUnicode = .T. *!* ENDIF *!* ENDIF LOCAL llChinese llChinese = ("936" $ This.cCodePage) * IF lcStyle = 'STRING' AND (This.lUseUnicode OR ("?" $ tcContents)) AND (NOT llChinese) IF lcStyle = 'STRING' AND (llUseUnicode) AND (NOT llChinese) LOCAL n, lcUNValue, lnUNValue, lcNewContents lcUnValue = "" lcNewContents = "" LOCAL lnChars lnChars = (LEN(tcContents) * 2) FOR n = 1 TO lnChars STEP 2 lcUNValue = SUBSTR(tcUnicode, n, 2) IF EMPTY(lcUNValue) EXIT ENDIF lnUNValue = CTOBIN(0h+lcUNValue,"2RS") lcNewContents = lcNewContents + '&#' + ALLTRIM(TRANSFORM(lnUNValue)) + ';' ENDFOR tcContents = lcNewContents ENDIF *!* IF UPPER(paStyles[tnStyleNumber-20,5]) = 'STRING' AND (NOT "1251" $ This.cCodePage) AND (This.lUseUnicode = .F.) *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* tcContents = This.Xml_Encode(tcContents,' *!* ENDIF LOCAL lcMergeAcross lcMergeAcross = IIF(EMPTY(nExcelMergeAcross),'',[ ss:MergeAcross="] + ALLTRIM(TRANSFORM(nExcelMergeAcross),'99999') + ["]) lcData = IIF(lcStyle = 'STRING' AND EMPTY(tcContents),'', ; '' + tcContents + '') * 21/06/08 ExcelInsertFormula *TEXT TO lcRetVal TEXTMERGE NOSHOW PRETEXT 2 *> ss:StyleID="<<'s'+TRANSFORM(tnStyleNumber,'@L 99')>>"><> *ENDTEXT LOCAL lcInsertFormula,lcNamedCell lcInsertFormula = IIF(EMPTY(cExcelInsertFormula),'',[ ss:Formula="] + ALLTRIM(cExcelInsertFormula) + ["]) * 21/06/08 ExcelNamedCell 17832.98 lcNamedCell = '' IF !EMPTY(cExcelNamedCell) lcNamedCell = [] * REPLACE cExcelNamedRange WITH ALLTRIM(cExcelNamedCell) + [;] ; + [=Sheet1!R] + ALLTRIM(TRANSFORM(ExcelRow)) ; + [C] + ALLTRIM(TRANSFORM(ExcelCol)) ENDIF *TEXT TO lcRetVal TEXTMERGE NOSHOW PRETEXT 2 *> ss:StyleID="<<'s'+TRANSFORM(tnStyleNumber,'@L 99')>>" <> ><> *ENDTEXT lcRetVal = [] + lcData ; + lcNamedCell + [] RETURN lcRetVal + CHR(13) + CHR(10) *!* *!* 2006-10-05T00:00:00.000 *!* *!* *!* Puro texto Bold *!* ENDPROC PROCEDURE xml_table_header LPARAMETERS tnRows,tnCols LOCAL lcRetVal,ja[1],i,lcColumns * * SELECT MAX(ExcelCol),MAX(ExcelRow) ; FROM (This.cOutputAlias) ; INTO ARRAY ja lcColumns = '' ASORT(paColData,1,ALEN(paColData),0) FOR m.i = 1 TO ALEN(paColData,1) IF EMPTY(paColData[m.i,1]) LOOP ENDIF * Column1 = Column number * Column2 = AutoFitWidth (.T. / .F.) * Column3 = Column width lcColumns = lcColumns + CHR(13) + CHR(10) + [] ENDFOR *!* TEXT TO lcRetVal TEXTMERGE NOSHOW PRETEXT 2 *!* <> *!* ENDTEXT TEXT TO lcRetVal TEXTMERGE NOSHOW PRETEXT 2
<> ENDTEXT RETURN lcRetVal + CHR(13) + CHR(10) ENDPROC PROCEDURE xml_workbook_footer RETURN '' + CHR(13) + CHR(10) ENDPROC PROCEDURE xml_worksheet_footer LOCAL lcRetVal TEXT TO lcRetVal NOSHOW PRETEXT 2 ENDTEXT RETURN lcRetVal + CHR(13) + CHR(10) ENDPROC PROCEDURE xml_stylenumber LPARAMETERS tcContents LOCAL lcType,lcNumberFormat,lcKey,i lcType = This.Xml_Type(tcContents) lcNumberFormat = IIF(lcType = 'Number',This.Xml_NumberFormat(tcContents),'') lcNumberFormat = IIF(lcType = 'DateTime','Short Date',lcNumberFormat) lcKey = UPPER(PADR(FontFace,20)+TRAN(FontSize,'99')+TRAN(FontStyle,'99') ; + PADR(lcType,10) + PADR(lcNumberFormat,20)) + PADR(cExcelAlignment,30) ; + PADR(cExcelBorder,50) + PADR(cExcelInterior,50) i = ASCAN(paStyles,lcKey,1,ALEN(paStyles,1),1,1 + 2 + 4 + 8) IF i = 0 i = ALEN(paStyles,1)+1 DIMENSION paStyles[i,ALEN(paStyles,2)] paStyles[i,2] = FontFace paStyles[i,3] = FontSize paStyles[i,4] = FontStyle paStyles[i,5] = lcType paStyles[i,6] = lcNumberFormat paStyles[i,7] = cExcelAlignment && Alignment paStyles[i,8] = cExcelBorder && Border paStyles[i,9] = cExcelInterior && Interior color and pattern paStyles[i,1] = lcKey ENDIF RETURN 20 + i ENDPROC PROCEDURE xml_type LPARAMETERS tcContents tcContents = ALLTRIM(tcContents) LOCAL lcType,lcSetDate *lcSetDate = SET("Date") *SET DATE TO BRITISH DO CASE * CChalom - Check XML_Type method, a new checking was added there * Checks if the date type is ANSI CASE (OCCURS('.', tcContents) = 2) AND ; This.SetDateAnsi AND ; (OCCURS(':', tcContents) = 2) && Probably a DateTime, NOT a Number ! lcType = 'String' CASE (OCCURS('.', tcContents) = 2) AND ; This.SetDateAnsi AND ; (LEN(GETWORDNUM(tcContents, 2, ".")) = 2) AND CTOD(tcContents) # {} && updated 2012/02/07 - aMaximum lcType = 'DateTime' CASE This.IsNumber(tcContents) lcType = 'Number' CASE AT('/',tcContents,2) > 0 AND AT('/',tcContents,3) = 0 * Make sure a string with two slashes is not interpreted as a date unless it is a date tcContents = CTOD(tcContents) IF VARTYPE(tcContents) = 'D' AND !EMPTY(tcContents) lcType = 'DateTime' ELSE lcType = 'String' endif OTHERWISE lcType = 'String' ENDCASE *SET DATE TO &lcSetDate RETURN lcType ENDPROC PROCEDURE xml_styles_header RETURN '' + CHR(13) + CHR(10) ENDPROC PROCEDURE xml_styles_footer RETURN '' + CHR(13) + CHR(10) ENDPROC PROCEDURE xml_table_footer RETURN '
' + CHR(13) + CHR(10) ENDPROC PROCEDURE xml_encode LPARAMETERS tcContents,tcChar * tcContents = STRTRAN(tcContents,tcChar,'&#' + ALLTRIM(TRANSFORM(ASC(tcChar))) + ';') lcValue = CTOBIN(0h+STRCONV(tcChar,5),"2RS") tcContents = STRTRAN(tcContents,tcChar,'&#' + ALLTRIM(TRANSFORM( lcValue)) + ';') RETURN tcContents ENDPROC PROCEDURE calcbandnumbers * This routine places in frx.User the number of the report band to which each element belongs * When OBJTYPE = 9 (a band), the following values are used: * 0 = Title * 1 = Page header * 2 = Column header * 3 = Group header * 4 = Detail * 5 = Group footer * 6 = Column footer * 7 = Page footer * 8 = Summary * NOTES: * Frx.VPos contains the vertical position of the report elements AS THEY APPEAR IN REPORT DESIGNER * In order to determine the band to which report elements belong we need to know the top of each band IN REPORT DESIGNER * Frx.Height contains the height of report bands, but we must calculate VPos for each band. * "Report Bands" refer to report designer areas that contain fields and labels. They are numbered as above. * "Title Bands" refer to report designer areas that contain titles such as Detail, Page Header * Procedure: * Store VPos of "title bands" in array. * Store in User field the number of the report band to which each report element belongs LOCAL laBands[1],lnVpos,i,lnSelect * These constants come from VFP program convert.prg m.g_pixelsize = 96 && logical pixels per inch m.g_bandheight = ((19/m.g_pixelsize) * 10000) m.g_bandfudge = 4350 * Metrics for various objects, report bands, etc. #DEFINE c_radhght 1.308 #DEFINE c_chkhght 1.308 #DEFINE c_listht 1.000 #DEFINE c_adjfld 0.125 #DEFINE c_adjlist 0.125 #DEFINE c_adjtbtn 0.769 #DEFINE c_adjrbtn 0.308 #DEFINE c_vchkbox 0.154 #DEFINE c_vradbtn 0.154 #DEFINE c_vlist 0.500 #DEFINE c_hpopup 1.000 #DEFINE c_adjbox 0.500 #DEFINE c_chkpixel 12 laBands = 0 SELECT RECNO(),ObjCode,000000.000,Height ; FROM (This.cFRXalias) ; WHERE Platform = 'WINDOWS' ; AND ObjType = 9 ; INTO ARRAY laBands lnVPosBottom = - m.g_bandheight && - (m.g_bandfudge/m.g_pixelsize) FOR m.i = 1 TO ALEN(laBands,1) lnVPosBottom = lnVPosBottom + laBands[m.i,4] + m.g_bandheight + (m.g_bandfudge/m.g_pixelsize) laBands[m.i,3] = lnVPosBottom ENDFOR * Make cursor readwrite SELECT * ; FROM (This.cFRXalias) ; INTO CURSOR Frx1 READWRITE USE IN (This.cFRXalias) SELECT * ; FROM Frx1 ; INTO CURSOR (This.cFRXalias) READWRITE USE IN Frx1 SCAN FOR Platform = 'WINDOWS' AND (ObjType = 5 OR ObjType = 8) FOR m.i = 1 TO ALEN(laBands,1) IF VPos < laBands[m.i,3] * Store in User the number of the band to which report element belongs REPLACE User WITH TRANSFORM(laBands[m.i,2],'999') EXIT ENDIF ENDFOR ENDSCAN ENDPROC PROCEDURE xextractexcelcol LPARAMETERS tcComment RETURN '0000000' ENDPROC PROCEDURE applyexcelstyle LPARAMETERS tcExcelStyle,tnOption SELECT (this.cOutputAlias) IF !EMPTY(tcExcelStyle) &tcExcelStyle.(tnOption,This) ENDIF RETURN *!* **** Moved to an outside procedure **** *!* * My Default ExcelStyle *!* * 0 = Title *!* * 1 = Page header *!* * 2 = Column header *!* * 3 = Group header *!* * 4 = Detail *!* * 5 = Group footer *!* * 6 = Column footer *!* * 7 = Page footer *!* * 8 = Summary *!* tcOutputAlias = This.cOutputAlias *!* DO CASE *!* CASE tnOption = 1 && Before extracting comments *!* CASE tnOption = 2 && Before assigning row *!* DELETE ALL FOR (cUser = ' 0' OR cUser = ' 1') ; *!* AND ('FECHA DE IMPRESION:' $ cExpr OR 'FECHA DE IMPRESI N:' $ cExpr ; *!* OR 'PAGINA:' $ cExpr OR 'P GINA:' $ cExpr ; *!* OR cExpr = 'DATE()' OR cExpr = 'DATETIME()' OR cExpr = 'TIME()' OR cExpr = '_PAGENO') *!* * DELETE ALL FOR (cUser = ' 0' OR cUser = ' 1') ; *!* AND ('PAGINA:' $ cExpr OR 'P GINA:' $ cExpr OR cExpr = '_PAGENO') *!* * DELETE ALL FOR (cUser = ' 0' OR cUser = ' 1') ; *!* AND ('FECHA DE IMPRESION:' $ cExpr OR 'FECHA DE IMPRESI N:' $ cExpr ; *!* OR cExpr = 'DATE()' OR cExpr = 'TIME()') ; *!* AND nPageNo > 1 *!* CASE tnOption = 3 && Before assigning col *!* CASE tnOption = 4 && After assigning row and column *!* * Cursores con las filas y columnas *!* SELECT DISTINCT ExcelRow,LEFT(User,3) AS User ; *!* FROM (tcOutputAlias) ; *!* INTO ARRAY laRowUser *!* CREATE CURSOR ExcelCols (ExcelCol N(3)) *!* FOR i = 1 TO pnMaxCol *!* INSERT INTO ExcelCols (ExcelCol) VALUES(i) *!* ENDFOR *!* * Lista de celdas con ----- or ===== *!* SELECT ExcelRow,ExcelCol,Contents,User,nExcelUnderlinedColCount ; *!* FROM (tcOutputAlias) ; *!* WHERE LEFT(cContents,5) = '=====' OR LEFT(cContents,5) = '-----' ; *!* INTO CURSOR DashedCells READWRITE *!* * Borramos celdas con ----- or ===== *!* DELETE &tcOutputAlias ; *!* FROM DashedCells ; *!* WHERE &tcOutputAlias..ExcelRow = DashedCells.ExcelRow AND &tcOutputAlias..ExcelCol = DashedCells.ExcelCol *!* * Cells to underline (one line above ----- or =====) *!* SELECT ExcelRow - 1 AS ExcelRow,ExcelCol,Contents,User,nExcelUnderlinedColCount,.F. AS lNueva ; *!* FROM DashedCells ; *!* INTO CURSOR UnderlinedCells READWRITE *!* * Add line extensions *!* SCAN FOR INT(LEN(ALLTRIM(Contents)) / 8) > 1 AND !lNueva *!* lnRecno = RECNO() *!* lnExcelRow = ExcelRow *!* lcContents = LEFT(Contents,5) *!* FOR i = 1 TO MIN(INT(LEN(ALLTRIM(Contents)) / 8),MAX(1,nExcelUnderlinedColCount)) *!* lnExcelCol = UnderlinedCells.ExcelCol + i *!* IF lnExcelCol > pnMaxCol *!* EXIT *!* ENDIF *!* *!* SELECT (tcOutputAlias) *!* *!* LOCATE FOR ExcelRow = lnExcelRow AND ExcelCol = lnExcelCol *!* *!* IF EOF() *!* *!* SELECT UnderlinedCells *!* *!* LOCATE FOR ExcelRow = lnExcelRow AND ExcelCol = lnExcelCol *!* *!* IF EOF() *!* *!* j = ASCAN(laRowUser,lnExcelRow,1,ALEN(laRowUser,1),1,8) *!* *!* lcUser = IIF(j > 0,laRowUser[j,2],User) *!* *!* INSERT INTO UnderlinedCells (ExcelRow,ExcelCol,Contents,User) VALUES (lnExcelRow,lnExcelCol,lcContents,lcUser) *!* *!* GOTO (lnRecno) IN UnderlinedCells *!* *!* ENDIF *!* *!* ENDIF *!* LOCATE FOR ExcelRow = lnExcelRow AND ExcelCol = lnExcelCol *!* IF EOF() *!* j = ASCAN(laRowUser,lnExcelRow,1,ALEN(laRowUser,1),1,8) *!* lcUser = IIF(j > 0,laRowUser[j,2],User) *!* INSERT INTO UnderlinedCells (ExcelRow,ExcelCol,Contents,User,lNueva) VALUES (lnExcelRow,lnExcelCol,lcContents,lcUser,.T.) *!* ENDIF *!* GOTO (lnRecno) IN UnderlinedCells *!* ENDFOR *!* ENDSCAN *!* *!* * Add missing cells that need to be underlined *!* SELECT U.* ; *!* FROM UnderlinedCells U ; *!* WHERE NOT EXISTS (SELECT OA.ExcelRow,OA.ExcelCol ; *!* FROM (tcOutputAlias) OA ; *!* WHERE OA.ExcelRow = U.ExcelRow ; *!* AND OA.ExcelCol = U.ExcelCol) ; *!* INTO CURSOR MissingCells *!* SELECT (tcOutputAlias) *!* APPEND FROM DBF('MissingCells') FIELDS ExcelRow,ExcelCol,User *!* SET ORDER TO RowCol *!* * Perform underline *!* SELECT UnderlinedCells *!* SET RELATION TO TRANSFORM(ExcelRow,'@L 999999') + TRANSFORM(ExcelCol,'@L 999999') INTO (tcOutputAlias) *!* REPLACE ALL &tcOutputAlias..cExcelBorder WITH 'Bottom,' ; *!* + IIF(LEFT(ALLTRIM(Contents),5)='=====','Double,3','') *!* SET RELATION TO *!* * Eliminate dashed Excel rows that became empty (move up following cells) *!* SELECT (tcOutputAlias) *!* SET ORDER TO *!* SELECT DISTINCT ExcelRow + 0000000 AS ExcelRow ; *!* FROM DashedCells ; *!* WHERE ExcelRow NOT IN (SELECT ExcelRow ; *!* FROM (tcOutputAlias)) ; *!* GROUP BY 1 ; *!* ORDER BY 1 ; *!* INTO CURSOR RenglonesParaEliminar READWRITE *!* APPEND BLANK *!* REPLACE ExcelRow WITH 9999999 *!* GO TOP *!* lnFirstRow = 0 *!* SCAN *!* SELECT (tcOutputAlias) *!* REPLACE ALL ExcelRow WITH ExcelRow - RECNO('RenglonesParaEliminar') + 1 ; *!* FOR BETWEEN(ExcelRow,lnFirstRow,RenglonesParaEliminar.ExcelRow) *!* lnFirstRow = RenglonesParaEliminar.ExcelRow *!* ENDSCAN *!* * If nExcelMergeAcross >=99 merges to rightmost column *!* SELECT (tcOutputAlias) *!* REPLACE ALL nExcelMergeAcross WITH pnMaxCol - ExcelCol ; *!* FOR nExcelMergeAcross >=99 *!* * Font *!* REPLACE ALL FontFace WITH 'Arial', ; *!* FontSize WITH MAX(FontSize,10) && Minimum font is 10 *!* REPLACE ALL FontSize WITH 16 ; *!* FOR (cUser = ' 0' OR cUser = ' 1') ; *!* AND ObjType = 8 ; *!* AND 'SIS.CNOMBRE' $ cExpr *!* REPLACE ALL FontStyle WITH 1 ; *!* FOR cUser <= ' 2' ; *!* AND (ObjType = 5 OR ObjType = 8) *!* REPLACE ALL FontStyle WITH 1 + 2 ; *!* FOR cUser = ' 3' ; *!* AND (ObjType = 5 OR ObjType = 8) *!* * Group Footer *!* * Creamos celdas vacias que faltan *!* LOCAL laRowsGroupFooter[1] *!* laRowsGroupFooter = 0 *!* lcCols = 0 *!* SELECT DISTINCT ExcelRow ; *!* FROM (tcOutputAlias) ; *!* WHERE cUser = ' 5' ; *!* INTO ARRAY laRowsGroupFooter *!* FOR i = 1 TO ALEN(laRowsGroupFooter,1) *!* IF EMPTY(laRowsGroupFooter[i]) *!* LOOP *!* ENDIF *!* lnRow = laRowsGroupFooter[i] *!* FOR lnCol = 1 TO pnMaxCol *!* LOCATE FOR ExcelRow = lnRow AND ExcelCol = lnCol *!* IF EOF() *!* APPEND BLANK *!* REPLACE ExcelRow WITH lnRow, ; *!* ExcelCol WITH lnCol, ; *!* User WITH ' 5', ; *!* cUser WITH ' 5' *!* ENDIF *!* ENDFOR *!* ENDFOR *!* *!* * Decoramos GroupFooter ( User = ' 5') *!* * Font y background *!* REPLACE ALL FontStyle WITH 1 ; *!* FOR cUser = ' 5' ; *!* AND (ObjType = 5 OR ObjType = 8) *!* REPLACE ALL cExcelInterior WITH 'Solid,'; *!* + RIGHT(TRANSFORM(RGB(192,192,192),'@0'),6) + ',' ; *!* + RIGHT(TRANSFORM(RGB(0,0,0),'@0'),6) ; *!* FOR cUser = ' 5' *!* * Bordes arriba y abajo *!* LOCAL laGroupFooters[1,2] *!* laGroupFooters[1,1] = 0 *!* laGroupFooters[1,2] = '' *!* SELECT DISTINCT ExcelRow,SPACE(8) AS cExcelBorder ; *!* FROM (tcOutputAlias) ; *!* WHERE cUser = ' 5' ; *!* INTO ARRAY laGroupFooters *!* lnLastRow = 0 *!* FOR i = 1 TO ALEN(laGroupFooters,1) *!* IF EMPTY(laGroupFooters[i,1]) *!* LOOP *!* ENDIF *!* DO CASE *!* CASE lnLastRow = 0 *!* laGroupFooters[i,2] = 'Top,Single,1' *!* CASE laGroupFooters[i,1] = lnLastRow + 1 *!* laGroupFooters[i,2] = 'Top,Single,1' *!* OTHERWISE && laGroupFooters[i,1] > lnLastRow + 1 *!* laGroupFooters[i-1,2] = laGroupFooters[i-1,2] ; *!* + IIF(EMPTY(laGroupFooters[i-1,2]),'',';') ; *!* + 'Bottom,Double,3' *!* laGroupFooters[i,2] = 'Top,Single,1' *!* ENDCASE *!* lnLastRow = laGroupFooters[i,1] *!* ENDFOR *!* laGroupFooters[ALEN(laGroupFooters,1),2] = laGroupFooters[ALEN(laGroupFooters,1),2] ; *!* + IIF(EMPTY(laGroupFooters[ALEN(laGroupFooters,1),2]),'',';') ; *!* + 'Bottom,Double,3' *!* *!* lnRecno = 0 *!* SCAN FOR User = ' 5' *!* i = ASCAN(laGroupFooters,ExcelRow,1,ALEN(laGroupFooters,1),1,8) *!* IF i = 0 *!* LOOP *!* ENDIF *!* REPLACE cExcelBorder WITH laGroupFooters[i,2] *!* lnRecno = RECNO() *!* ENDSCAN *!* ENDCASE ENDPROC PROCEDURE islonghorizontalline LPARAMETERS tcExpr RETURN !EMPTY(tcExpr) AND EMPTY(CHRTRAN(ALLTRIM(tcExpr),[=-"],[])) AND LEN(ALLTRIM(tcExpr)) > 15 ENDPROC PROCEDURE isshorthorizontalline LPARAMETERS tcExpr RETURN !EMPTY(tcExpr) AND EMPTY(CHRTRAN(ALLTRIM(tcExpr),[=-"],[])) AND LEN(tcExpr) < 15 ENDPROC PROCEDURE calcbasefilename LPARAMETERS tcWorkbook LOCAL i,lcFileName IF EMPTY(tcWorkbook) * Calc default name FOR m.i = 1 TO 9 IF !FILE(FORCEEXT('REP_'+TRANSFORM(m.i,'@L 99'),'xls')) lcFileName = FORCEEXT('REP_'+TRANSFORM(m.i,'@L 99'),'xls') EXIT ENDIF ENDFOR IF EMPTY(lcFileName) LOCAL laDir[1,3] ADIR(laDir,'REP_??.'+tcExtension) FOR m.i = 1 TO ALEN(laDir,1) laDir[m.i,3] = DTOS(laDir[m.i,3]) ENDFOR ASORT(laDir,3) lcFileName = FORCEEXT(PADR(laDir[1,1],50),'xls') ENDIF lcFileName = FORCEEXT(JUSTFNAME(tcWorkbook),'xls') ENDIF RETURN lcFileName ENDPROC PROCEDURE calcnextfilename LPARAMETERS tcWorkbook LOCAL lcBaseName,lcFileName,i lcBaseName = JUSTSTEM(tcWorkbook) IF AT(lcBaseName,'_',2) > 0 lcBaseName = LEFT(lcBaseName,AT(lcBaseName,'_',2) - 1) ENDIF lcFileName = '' FOR m.i = 1 TO 9 IF !FILE(lcBaseName + '_' + TRANSFORM(i,'@L 99') + '.xls') lcFileName = lcBaseName + '_' + TRANSFORM(i,'@L 99') + '.xls' EXIT ENDIF ENDFOR IF EMPTY(lcFileName) LOCAL laDir[1,3] ADIR(laDir,lcBaseName + '_??' + '.XLS') FOR m.i = 1 TO ALEN(laDir,1) laDir[m.i,3] = DTOS(laDir[m.i,3]) ENDFOR ASORT(laDir,3) lcFileName = FORCEEXT(laDir[1,1],'xls') ENDIF RETURN lcFileName ENDPROC PROCEDURE xml_names_header * 21/06/08 Added RETURN '' + CHR(13) + CHR(10) ENDPROC PROCEDURE xml_name LPARAMETERS tnID * 21/06/08 Added * * LOCAL lcRetVal,laItems[1] lcRetVal = '' *SET STEP ON ALINES(laItems,paNames[tnID],1 + 2,';') IF !EMPTY(laItems[1]) AND !EMPTY(laItems[2]) lcRetVal = lcRetVal + [ ] + CHR(13) + CHR(10) ENDIF RETURN lcRetVal ENDPROC PROCEDURE xml_names_footer * 21/06/08 Added RETURN '' + CHR(13) + CHR(10) ENDPROC PROCEDURE outputfromdata LPARAMETERS toListener, tcOutputDBF &&, tnWidth, tnHeight This.ShowTherm(1) IF VARTYPE(toListener) <> "O" MESSAGEBOX("Invalid parameter. Report listener not available", 16, "Error") RETURN ENDIF IF EMPTY(toListener.cFRXAlias) MESSAGEBOX("The helper FRX table is not available. Output can't be created", 16, "Error") RETURN ENDIF LOCAL lnSelect, lnOrigDataSession lnSelect = SELECT() lnOrigDataSession = SET("Datasession") * Ensure we are at the correct DataSession SET DATASESSION TO (toListener.ListenerDataSession) * SET DATASESSION TO (toListener.CurrentDataSession) * Generate XLS using the stored information This.lDefaultMode = .F. * Make a copy of the FRX table and manipulate it SELECT * FROM (toListener.cFRXAlias) INTO CURSOR FRXCopy READWRITE SELECT FRXCopy This.cFRXalias = "FRXCopy" * Initialize class * "BeforeReport" IF EMPTY(this.cOutputDBF) this.cOutputDBF = ADDBS(SYS(2023)) + SYS(2015) + '.dbf' ENDIF IF EMPTY(this.cOutputAlias) this.cOutputAlias = STRTRAN(JUSTSTEM(this.cOutputDBF), ' ', '_') ENDIF * Store in Frx.User the number of the band to which each field belongs This.CalcBandNumbers() * Don't reprint group header on each page (not working yet) REPLACE ALL NoRepeat WITH .F. ; FOR objType = 9 AND (ObjCode = 3 OR ObjCode = 5) GO TOP LOCAL lcRenderAlias lcRenderAlias = toListener.cOutputAlias LOCAL lnPgFrom, lnPgTo lnPgFrom = _goHelper._ClausenRangeFrom && = loListener.COMMANDCLAUSES.RangeFrom lnPgTo = IIF(_goHelper._ClausenRangeTo = -1, 999999, _goHelper._ClausenRangeTo) && = loListener.COMMANDCLAUSES.RangeTo && -1 = All pages SELECT FRXRECNO as nFRXRecno, ; RA.LEFT as nLeft, ; TOP as nTop, ; WIDTH as nWidth, ; HEIGHT as nHeight, ; UNCONTENTS as Contents, ; UNCONTENTS as UNContents, ; PAGE as nPageNo ; FROM (lcRenderAlias) RA ; WHERE BETWEEN(Page, lnPgFrom, lnPgTo) ; INTO CURSOR (This.cOutputAlias) ; READWRITE INDEX ON nFrxRecno TAG nFrxRecno * REPLACE ALL Contents WITH STRCONV(CONTENTS,6 ,1256) * Replacing the Render event REPLACE ALL Contents WITH ; strt(strt(strt(STRCONV(Contents, 6),'&','&'),'>','>' ),'<','<') *!* SELECT (This.cOutputAlias) *!* BROWSE * Finalize This.AfterReport() * Clean up USE IN SELECT(This.cOutputAlias) USE IN SELECT(This.cFRXalias) CATCH TO loExc SET STEP ON ENDTRY * Restore DataSession and Alias SET DATASESSION TO (lnOrigDataSession) SELECT (lnSelect) This.ShowTherm() ENDPROC PROCEDURE updateproperties IF NOT This.lObjTypeMode OR (VARTYPE(_Screen.oFoxyPreviewer) <> "O") RETURN ENDIF LOCAL loFP loFP = _Screen.oFoxyPreviewer IF VARTYPE(This.CommandClauses) = "O" *!* IF This.CommandClauses.Preview *!* This.lOpenViewer = .T. *!* ELSE *!* This.lOpenViewer = NVL(loFP.lOpenViewer, .T.) *!* ENDIF This.lOpenViewer = This.CommandClauses.Preview IF NOT EMPTY(This.CommandClauses.ToFile) This.TargetFileName = This.CommandClauses.ToFile ELSE IF VARTYPE(_Screen.oFoxyPreviewer) = "O" AND ; NOT EMPTY(_Screen.oFoxyPreviewer.cDestFile) AND ; EMPTY(This.TargetFileName) LOCAL lcDestFile lcDestFile = _Screen.oFoxyPreviewer.cDestFile IF NOT "\" $ lcDestFile lcDestFile = ALLTRIM(ADDBS(_Screen.oFoxyPreviewer.cOutputPath) + lcDestFile) ENDIF This.TargetFileName = lcDestFile ELSE LOCAL lcFile lcFile = This.TargetFileName IF EMPTY(lcFile) lcFile = PUTFILE("","","xls;xml") ENDIF IF EMPTY(lcFile) _ReportListener::CancelReport() * This.CancelReport() RETURN .F. ENDIF This.TargetFileName = lcFile ENDIF ENDIF ENDIF This.QUIETMODE = NVL(loFP.lQuietMode , .F.) IF VARTYPE(This.CommandClauses) = "O" IF This.CommandClauses.Preview This.lOpenViewer = .T. ENDIF IF NOT EMPTY(This.CommandClauses.ToFile) This.TargetFileName = This.CommandClauses.ToFile ENDIF ENDIF ENDPROC PROCEDURE topurexlsusingexcel LPARAMETERS tcSource, tcDestination * File format specific * http://support.sas.com/documentation/cdl/en/acpcref/63184/HTML/default/viewer.htm#a003103761.htm *!* Excel 4 files, only one spreadsheet is allowed per file *!* Excel 4, Excel 5, and Excel 95 limits are 256 columns, and 16,384 rows *!* Excel 97, 2000, 2002, 2003 limits are 256 columns, and 65,536 rows *!* Excel 2007 limits are 16,384 columns, and 1,048,576 rows. *!* Excel 95 files are treated as the same format as Excel 5 files. *!* Excel 2000, 2002, and 2003 files with an .xls file extension are treated as the same format as Excel 97 files. *!* Excel 2007 has three different file extensions, .xlsb, .xlsm, and .xlsx. *!* See also: http://www.rondebruin.nl/saveas.htm #DEFINE xlAddIn 18 #DEFINE xlCSV 6 #DEFINE xlCSVMac 22 #DEFINE xlCSVMSDOS 24 #DEFINE xlCSVWindows 23 #DEFINE xlDBF2 7 #DEFINE xlDBF3 8 #DEFINE xlDBF4 11 #DEFINE xlDIF 9 #DEFINE xlExcel2 16 #DEFINE xlExcel2FarEast 27 #DEFINE xlExcel3 29 #DEFINE xlExcel5 39 #DEFINE xlExcel7 39 #DEFINE xlExcel8 56 #DEFINE xlExcel9795 43 #DEFINE xlExcel4Workbook 35 #DEFINE xlIntlAddIn 26 #DEFINE xlIntlMacro 25 #DEFINE xlWorkbookNormal -4143 #DEFINE xlSYLK 2 #DEFINE xlTemplate 17 #DEFINE xlCurrentPlatformText -4158 #DEFINE xlTextMac 19 #DEFINE xlTextMSDOS 21 #DEFINE xlTextPrinter 36 #DEFINE xlTextWindows 20 #DEFINE xlWJ2WD1 14 #DEFINE xlWK1 5 #DEFINE xlWK1ALL 31 #DEFINE xlWK1FMT 30 #DEFINE xlWK3 15 #DEFINE xlWK4 38 #DEFINE xlWK3FM3 32 #DEFINE xlWKS 4 #DEFINE xlWorks2FarEast 28 #DEFINE xlWQ1 34 #DEFINE xlWJ3 40 #DEFINE xlWJ3FJ3 41 #DEFINE xlUnicodeText 42 #DEFINE xlHtml 44 IF EMPTY(tcSource) tcSource = GETFILE("xml", "Spreadsheet file") ENDIF IF EMPTY(tcSource) RETURN .F. ENDIF IF EMPTY(tcDestination) tcDestination = FORCEEXT(tcSource, "xls") ENDIF LOCAL loExcel AS "excel.application" LOCAL llReturn AS Logical loExcel = CREATEOBJECT("excel.application") loExcel.AlertBeforeOverwriting = .F. loExcel.DisplayAlerts = .F. * http://msdn.microsoft.com/en-us/library/bb179167(v=office.12).aspx * http://msdn.microsoft.com/en-us/library/bb214129%28v=office.12%29.aspx loExcel.Workbooks.Open(tcSource) loExcel.ActiveWorkbook.SaveAs(tcDestination, This.nExcelSaveFormat) && Excel 97 type && The file format to use when you save the file. && For a list of valid choices, see the XlFileFormat enumeration. && For an existing file, the default format is the last file format specified; && for a new file, the default is the format of the version of Excel being used. loExcel.ActiveWindow.Close(.T.) loExcel.Quit loExcel = NULL llReturn = .T. CATCH TO loExc llReturn = .F. ENDTRY RETURN llReturn ENDPROC PROCEDURE topurexlsusingoo LPARAMETERS tcSource, tcDestination IF EMPTY(tcSource) tcSource = GETFILE("xml", "Spreadsheet file") ENDIF IF EMPTY(tcSource) RETURN ENDIF IF EMPTY(tcDestination) tcDestination = FORCEEXT(tcSource, "xls") ENDIF LOCAL llReturn llReturn = PR_OOXML2XLS(tcSource, tcDestination) CATCH llReturn = .F. ENDTRY RETURN llReturn ENDPROC PROCEDURE showtherm LPARAMETERS tnValue, tcText, tcTitle IF VARTYPE(_goHelper) = "O" IF NOT _goHelper.lQuietMode IF EMPTY(tnValue) =DoFoxyTherm() RETURN ENDIF IF EMPTY(tcTitle) tcTitle = _goHelper._RunStatusText ENDIF IF EMPTY(tcText) tcText = _goHelper.GetLoc("PLEASEWAIT") + " " + TRANSFORM(tnValue)+ "%" ENDIF =DoFoxyTherm(tnValue, tcText, tcTitle) ENDIF ENDIF ENDPROC PROCEDURE setfrxdatasession IF PEMSTATUS(This, "lDefaultMode", 5) AND (This.lDefaultMode = .F.) RETURN ENDIF IF (THIS.FRXDataSession > -1) AND (THIS.FRXDataSession # SET("DATASESSION")) TRY SET DATASESSION TO (THIS.FRXDataSession) CATCH WHEN .T. THIS.ResetToDefault("FRXDataSession") THIS.resetDataSession() ENDTRY ENDIF ENDPROC PROCEDURE LoadReport This.UpdateProperties() DODEFAULT() ENDPROC PROCEDURE AfterReport This.ShowTherm(3) IF This.lDefaultMode * Setup This.setFRXDataSession() SET SAFETY OFF && FrxDataSession has safety on SET DELETED ON ENDIF * Add field to Frx with RECNO() SELECT (This.cFRXalias) ALTER TABLE (This.cFRXalias) ADD COLUMN nRecno N(5) REPLACE ALL nRecno WITH RECNO() INDEX ON nRecno TAG nRECNO * Add fields from Frx and other fields to (this.cOutputAlias) * 21/06/08 Add , and options * SELECT 00000 AS ExcelRow,000 AS ExcelCol, ; UPPER(PADR(Expr,100)) AS cExpr,PADR(User,3) AS cUser,PADR(UPPER(Contents),100) AS cContents, ; OA.*, ; 00000 AS nExcelColRequest,00000 AS nExcelSpecialColRequest,00000 AS nExcelMergeAcross, ; 00000.00 AS nExcelColWidth,SPACE(50) AS cExcelAlignment, ; SPACE(100) AS cExcelBorder,SPACE(100) AS cExcelInterior, ; 0 AS nUnderlinedColCount, ; .F. AS lDelete, ; Frx.* ; FROM (this.cOutputAlias) OA ; JOIN Frx ON OA.nFrxRecno = Frx.nRecno ; INTO CURSOR (this.cOutputAlias) READWRITE nSecs = SECONDS() LOCAL lcFRXalias lcFRXAlias = This.cFRXalias SELECT 00000 AS ExcelRow,000 AS ExcelCol, ; UPPER(PADR(Expr,100)) AS cExpr,PADR(User,3) AS cUser,PADR(UPPER(Contents),100) AS cContents, ; OA.*, ; 00000 AS nExcelColRequest,00000 AS nExcelSpecialColRequest,00000 AS nExcelMergeAcross, ; 00000.00 AS nExcelColWidth,SPACE(50) AS cExcelAlignment, ; SPACE(100) AS cExcelBorder,SPACE(100) AS cExcelInterior, ; SPACE(100) AS cExcelInsertFormula,SPACE(100) AS cExcelNamedRange,SPACE(100) AS cExcelNamedCell, ; 0 AS nUnderlinedColCount, ; .F. AS lDelete, ; &lcFRXAlias..* ; FROM (this.cOutputAlias) OA ; JOIN (This.cFRXalias) ON (OA.nFrxRecno = &lcFRXalias..nRecno ; AND NOT INLIST(ObjType, 6, 7, 17)) ; && skip Line, Shape, Picture INTO CURSOR (this.cOutputAlias) READWRITE INDEX ON nFrxRecno TAG nFrxRecno INDEX ON ObjType TAG ObjType ADDITIVE INDEX ON ExcelRow TAG ExcelRow ADDITIVE INDEX ON ExcelCol TAG ExcelCol ADDITIVE INDEX ON nPageNo TAG nPageNo ADDITIVE INDEX ON cExpr TAG cExpr ADDITIVE INDEX ON cUser TAG cUser ADDITIVE INDEX ON TRANSFORM(ExcelRow,'@L 999999') + TRANSFORM(ExcelCol,'@L 999999') TAG RowCol ADDITIVE INDEX ON TRANSFORM(nPageNo,'@L 999999') + TRANSFORM(ExcelRow,'@L 999999') + TRANSFORM(ExcelCol,'@L 999999') ; TAG PagRowCol ADDITIVE IF (NOT This.lRepeatHeaders) OR (NOT This.lRepeatFooters) LOCAL lnMinPage, lnMaxPage SELECT MIN(nPageNo), MAX(nPageNo) FROM (this.cOutputAlias) INTO ARRAY laPages lnMinPage = laPages(1) lnMaxPage = laPages(2) * Header = 1 * Footer = 7 * Eliminate all page headers except from the 1st page IF NOT This.lRepeatHeaders DELETE ALL FOR (cUser = ' 1' AND nPageNo > lnMinPage) ENDIF * Eliminate all page headers footers except from the last page IF NOT This.lRepeatFooters DELETE ALL FOR (cUser = ' 7' AND nPageNo < lnMaxPage) ENDIF ENDIF * Ommit Page numbers, because we have a single document IF NOT This.lHidePageNo DELETE ALL FOR ("_PAGENO" $ UPPER(EXPR)) ENDIF * Eliminate items in bands 0,1,2 if nPage > 1 DELETE ALL FOR (cUser < ' 3' AND nPageNo > 1) OR ; (EMPTY(cContents) AND INLIST(ObjType, 5, 8)) && Label or Field * Determine row height and col width in report (not Excel) PRIVATE pnRowHeight,pnColWidth pnRowHeight = 120 && Should be calculated SELECT nWidth,COUNT(nWidth) ; FROM (This.cOutputAlias) ; WHERE ObjType = 8 ; GROUP BY 1 ; ORDER BY 2 DESC ; INTO CURSOR Widths pnColWidth = IIF(_TALLY > 0,nWidth,400) SELECT (this.cOutputAlias) * Codify report colors as Solid,xxxxxx and store in cExcelInterior * 01/01/07 Correction by Andrus Moor, since color columns in frx file can have value -1 * REPLACE ALL cExcelInterior WITH 'Solid,'; + RIGHT(TRANSFORM(RGB(FillRed,FillGreen,FillBlue),'@0'),6) + ',' ; + RIGHT(TRANSFORM(RGB(PenRed,PenGreen,PenBlue),'@0'),6) ; FOR FillRed # 255 OR FillGreen # 255 OR FillBlue # 255 ; OR PenRed # 0 OR PenGreen # 0 OR PenBlue # 0 * REPLACE ALL cExcelInterior WITH 'Solid,'; + RIGHT(TRANSFORM(RGB(FillBlue,FillGreen,FillRed),'@0'),6) + ',' ; + RIGHT(TRANSFORM(RGB(PenBlue,PenGreen,PenRed),'@0'),6) ; FOR ( FillRed # 255 OR FillGreen # 255 OR FillBlue # 255 ; OR PenRed # 0 OR PenGreen # 0 OR PenBlue # 0 ) ; AND FillRed # -1 AND FillGreen # -1 AND FillBlue #-1 ; AND PenRed # -1 AND PenGreen # -1 AND PenBlue # -1 * 2010.01.30 - CChalom: Check if the color of the current field is not default * 2010.01.30 - CChalom: Fix the color generation was inverted values *!* * Mode: 0 = Opaque background; 1 = Transparent *!* IF lnMode = 1 && Transparent *!* This._Stat = HPDF_Page_Stroke(.oPage) *!* ELSE && 0 = Opaque *!* This._Stat = HPDF_Page_FillStroke(.oPage) *!* ENDIF SCAN FOR ((FillRed > -1 OR PenRed > -1) AND (Mode = 0)) && Opaque IF (PenRed + PenGreen + PenBlue <> 0) OR ; (FillRed + FillGreen + FillBlue <> 765) REPLACE cExcelInterior WITH ('Solid,' ; + RIGHT(TRANSFORM(RGB(IIF(FillBlue=-1,255,FillBlue), ; IIF(FillGreen=-1,255,FillGreen), IIF(FillRed=-1,255,FillRed)),'@0'),6) + ',' ; + RIGHT(TRANSFORM(RGB(MAX(PenBlue,0),MAX(PenGreen,0),MAX(PenRed,0)),'@0'),6)) ENDIF ENDSCAN * Codify Offset as Horizontal Alignment for fields IF This.lAlignLeft ELSE REPLACE ALL cExcelAlignment WITH IIF(Offset=0,'Horizontal,Left',IIF(Offset=1,'Horizontal,Right','Horizontal,Center')) ; FOR ObjType = 8 * REPLACE ALL cExcelAlignment WITH IIF(EMPTY(Picture),'Horizontal,Left',IIF(Picture=["@J"],'Horizontal,Right', ; IIF(Picture=["@I"],'Horizontal,Center','Horizontal,Left'))) ; FOR ObjType = 5 REPLACE ALL cExcelAlignment WITH 'Horizontal,Left' FOR ObjType = 5 && Label ENDIF * Run ExcelStyle routine (1 - Before extracting comments) This.ApplyExcelStyle(This.cExcelStyle,1) * Developer can indicate properties by placing values in Comment field in this format: 18 * To get numeric 1 or 0 must write it as 1. or 0., otherwise Fox interprets as .T. / .F. * 18 - Indicates ExcelCol for this and other items with same Left * 18 - Indicates ExcelCol for one item only * Cajas_Per1;=Sheet1!R10C7 - Indicates NameOfRange,Range, as defined by Excel * =+(RC[-4]+RC[-3]) / Cajas_Per2 - Indicates formula to insert This.ShowTherm(15) nSecs = SECONDS() LOCAL lcComment SCAN FOR !EMPTY(Comment) lcComment = '' TRY lcComment = ' ' + Comment + ' ' lcComment = XMLTOCURSOR(lcComment) CATCH ENDTRY SELECT (this.cOutputAlias) TRY REPLACE nExcelColRequest WITH XMLResult.ExcelCol CATCH ENDTRY TRY REPLACE nExcelSpecialColRequest WITH XMLResult.ExcelSpecialCol CATCH ENDTRY TRY IF (VARTYPE(XMLResult.ExcelDelete) = 'C' AND UPPER(XMLResult.ExcelDelete) = '.T.') ; OR XMLResult.ExcelDelete DELETE ENDIF CATCH ENDTRY TRY REPLACE nExcelColWidth WITH XMLResult.ExcelColWidth CATCH ENDTRY TRY REPLACE cExcelAlignment WITH XMLResult.ExcelAlignment CATCH ENDTRY TRY REPLACE cExcelAlignment WITH XMLResult.ExcelAlign CATCH ENDTRY TRY REPLACE nExcelMergeAcross WITH XMLResult.ExcelMergeAcross CATCH ENDTRY TRY REPLACE cExcelBorder WITH XMLResult.ExcelBorder CATCH ENDTRY TRY REPLACE cExcelInterior WITH XMLResult.ExcelInterior CATCH ENDTRY TRY REPLACE nExcelUnderlinedColCount WITH XMLResult.ExcelUnderlinedColCount CATCH ENDTRY * 21/06/08 Add ExcelInsertFormula, ExcelNamedCell and ExcelNamedRange options * cExcelInsertFormula TRY REPLACE cExcelInsertFormula WITH XMLResult.ExcelInsertFormula CATCH ENDTRY TRY REPLACE cExcelNamedRange WITH XMLResult.ExcelNamedRange CATCH ENDTRY TRY REPLACE cExcelNamedCell WITH XMLResult.ExcelNamedCell CATCH ENDTRY TRY USE IN XMLResult CATCH ENDTRY ENDSCAN * Run ExcelStyle routine (2 - Before assigning row) This.ApplyExcelStyle(This.cExcelStyle,2) * Calc rows ExcelRow * User contains band number SELECT DISTINCT nPageNo,nTop,LEFT(User,3) AS User,0000000 AS ExcelRow ; FROM (this.cOutputAlias) ; INTO CURSOR PageTop READWRITE INDEX ON TRANSFORM(nPageNo,'@L 999999') + TRANSFORM(nTop,'@L 999999') TAG PagTop LOCAL lnLastTop,lnLastRow,lnLastPageNo, llSkipped, lnOldPage, llNewPage lnLastTop = 0 lnLastRow = 1 lnLastPageNo = 1 lnOldPage = 1 SCAN * Page header is ignored after page 1 llSkipped = .F. llNewPage = .F. * 2010.01.30 - CChalom: Skip one line if new page IF nPageNo > lnOldPage lnOldPage = nPageNo lnLastRow = lnLastRow + 1 llNewPage = .T. ENDIF IF nPageNo > 1 && # lnLastPageNo IF VAL(User) < 3 LOOP ELSE * If new page adjust last top lnLastPageNo = nPageNo IF llNewPage lnLastTop = nTop - pnRowHeight ENDIF ENDIF ENDIF * There may be empty rows above this one DO WHILE nTop > lnLastTop + pnRowHeight lnLastTop = lnLastTop + pnRowHeight lnLastRow = lnLastRow + 1 llSkipped = .T. ENDDO * nTop may be so close that is is considered same row IF nTop < lnLastTop + .5 * pnRowHeight * No change in lnLastTop ELSE IF NOT llSkipped && Only if we are already in the page lnLastRow = lnLastRow + 1 ENDIF ENDIF lnLastTop = nTop REPLACE ExcelRow WITH lnLastRow * WAIT WINDOW NOWAIT 'Calculando renglones...' ENDSCAN SELECT (This.cOutputAlias) SET RELATION TO TRANSFORM(nPageNo,'@L 999999') + TRANSFORM(nTop,'@L 999999') INTO PageTop REPLACE ALL ExcelRow WITH PageTop.ExcelRow This.ShowTherm(25) * Run ExcelStyle routine (3 - Before assigning col) This.ApplyExcelStyle(This.cExcelStyle,3) * Calc cols LOCAL lnLastLeft,lnLastCol,llAssignedCol,lnExcelCol * cParseOrder indicates parsing order for two cells with same nLeft * Parse from report top * TRANSFORM(100-nExcelColRequest-nExcelSpecialColRequest,'@L 999') AS cParseOrder ; SELECT DISTINCT nLeft,0000000 AS ExcelCol,nExcelColRequest,nExcelSpecialColRequest, ; '9' AS cParseOrder ; FROM (This.cOutputAlias) ; INTO CURSOR Lefts READWRITE REPLACE ALL cParseOrder WITH '2' ; FOR nExcelColRequest > 0 REPLACE ALL cParseOrder WITH '1' ; FOR nExcelSpecialColRequest > 0 INDEX ON TRANSFORM(nLeft,'@L 999999') + cParseOrder TAG LefOrd lnLastLeft = 0 lnLastCol = 0 LOCAL laCount[1] SCAN IF nLeft = lnLastLeft * DELETE * LOOP ENDIF * WAIT WINDOW NOWAIT 'Calculando columnas...' lnThisLeft = nLeft llAssignedCol = .F. lnExcelCol = 0 * Lefts.nExcelSpecialColRequest is col request for this item only IF Lefts.nExcelSpecialColRequest > 0 * Make sure that requested cell is not occupied lnExcelCol = Lefts.nExcelSpecialColRequest SELECT COUNT(*) ; FROM (this.cOutputAlias) A ; JOIN (this.cOutputAlias) B ON A.ExcelRow = B.ExcelRow ; WHERE A.ExcelCol = lnExcelCol ; AND B.ExcelCol = 0 ; AND B.nLeft = lnThisLeft ; AND B.nExcelSpecialColRequest = lnExcelCol ; INTO ARRAY laCount IF laCount > 0 * There was a clash. Don't assign. * SET STEP ON ELSE * Accept request REPLACE ExcelCol WITH lnExcelCol REPLACE ALL ExcelCol WITH lnExcelCol ; FOR nLeft = lnThisLeft ; AND nExcelSpecialColRequest = lnExcelCol ; IN (this.cOutputAlias) LOOP ENDIF ENDIF IF Lefts.nExcelColRequest > 0 * Make sure that cell is not occupied lnExcelCol = Lefts.nExcelColRequest SELECT COUNT(*) ; FROM (this.cOutputAlias) A ; JOIN (this.cOutputAlias) B ON A.ExcelRow = B.ExcelRow ; WHERE A.ExcelCol = lnExcelCol ; AND B.nLeft = lnThisLeft ; INTO ARRAY laCount IF laCount > 0 * There was a clash. Don't assign. ELSE * Accept request lnLastCol = MAX(lnExcelCol,lnLastCol) lnLastLeft = nLeft REPLACE ExcelCol WITH lnExcelCol REPLACE ALL ExcelCol WITH lnExcelCol ; FOR nLeft = lnThisLeft ; AND EMPTY(ExcelCol) ; IN (this.cOutputAlias) LOOP ENDIF ENDIF * Haven't assigned Excel column yet, so do it here * If Left is very close it may be considered same col, except if it causes overlap IF nLeft < lnLastLeft + .75 * pnColWidth AND lnLastCol # 0 * Make sure it doesn't cause two fields in same cell SELECT COUNT(*) ; FROM (this.cOutputAlias) A ; JOIN (this.cOutputAlias) B ON A.ExcelRow = B.ExcelRow ; WHERE A.ExcelCol = lnLastCol ; AND B.nLeft = lnThisLeft ; AND EMPTY(B.ExcelCol) ; INTO ARRAY laCount IF laCount > 0 lnLastCol = lnLastCol + 1 lnLastLeft = nLeft ELSE * No change either in lnLastCol or lnLastLeft ENDIF ELSE lnLastCol = lnLastCol + 1 lnLastLeft = nLeft ENDIF REPLACE ExcelCol WITH lnLastCol REPLACE ALL ExcelCol WITH lnLastCol ; FOR nLeft = lnThisLeft ; AND EMPTY(ExcelCol) ; IN (this.cOutputAlias) ENDSCAN This.ShowTherm(30) nSecs = SECONDS() * Calc how many columns exist LOCAL ja[1] SELECT MAX(ExcelCol) ; FROM (this.cOutputAlias) ; INTO ARRAY ja PRIVATE pnMaxCol pnMaxCol = ja * Extract ExcelColWidths requested PRIVATE paColData DIMENSION paColData[1,2] lnColData = 0 SELECT (this.cOutputAlias) * This could follow the real Width of the fields, but does not provide a good result * REPLACE ALL nexcelcolwidth WITH CEILING(nWidth / 70) SCAN FOR !EMPTY(nExcelColWidth) IF ASCAN(paColData,ExcelCol,1,ALEN(paColData,1),1,8) > 0 LOOP ENDIF lnColData = lnColData + 1 DIMENSION paColData[lnColData,3] paColData[lnColData,1] = ExcelCol paColData[lnColData,2] = .F. && AutoFitWidth paColData[lnColData,3] = nExcelColWidth ENDSCAN * Run ExcelStyle routine (4 - After assigning row and column) This.ApplyExcelStyle(This.cExcelStyle,4) This.cWorkbookFile = ALLTRIM(This.cWorkbookFile) luWorkbook = FORCEPATH(This.CalcBaseFileName(This.cWorkbookFile), ; IIF(EMPTY(JUSTPATH(This.cWorkbookFile)),FULLPATH(CURDIR()),FULLPATH(JUSTPATH(This.cWorkbookFile)))) lcWorkSheetName = IIF(EMPTY(This.cWorksheetName),'Sheet1',This.cWorksheetName) lcOpciones = '' * Erase previous file if not ADDITIVE llEraseOK = .T. IF NOT EMPTY(luWorkbook) AND NOT 'ADDITIVE' $ lcOpciones AND FILE(luWorkbook) * Erase inside TRY/CATCH because it may be in use TRY ERASE (luWorkbook) CATCH * Couldn't erase file, so leave a workbook open without saving * WAIT WINDOW NOWAIT 'No pude borrar copia anterior de ' + luWorkbook llEraseOK = .F. ENDTRY ENDIF IF !llEraseOK luWorkbook = FORCEPATH(This.CalcNextFileName(luWorkbook),FULLPATH(CURDIR())) IF NOT EMPTY(luWorkbook) AND NOT 'ADDITIVE' $ lcOpciones AND FILE(luWorkbook) * Erase inside TRY/CATCH because it may be in use TRY ERASE (luWorkbook) CATCH * Couldn't erase file, so leave a workbook open without saving * WAIT WINDOW NOWAIT 'No pude borrar copia anterior de ' + luWorkbook llEraseOK = .F. ENDTRY ENDIF ENDIF * Place data in Excel by writing file in XML format DIMENSION paStyles[1,10] && Array to save styles * Column1 = Key * Column2 = FontFace * Column3 = FontSize * Column4 = FontStyle * Column5 = DataType * Column6 = NumberFormat * Column7 = HorizontalAlignment * Column8 = Borders * Column9 = Colors * Key = PADR(FontFace,20)+TRAN(FontSize,'99') + PADR(DataType,10) + PADR(NumberFormat,20) SELECT FontFace,FontSize,FontStyle ; FROM (This.cFRXalias) ; && (this.cOutputAlias) does not contain ObjType = 1 AND ObjCode = 53 WHERE Platform = 'WINDOWS ' ; AND ObjType = 1 AND ObjCode = 53 ; INTO ARRAY ja paStyles[1,2] = IIF(EMPTY(ja[1]),'Lucida Console',ja[1]) paStyles[1,3] = IIF(EMPTY(ja[2]),10,MIN(ja[2] + 3,10)) && 3 points larger that in report up to 10 paStyles[1,4] = ja[3] paStyles[1,5] = '' paStyles[1,6] = '' paStyles[1,7] = '' && Alignment paStyles[1,8] = '' && Border paStyles[1,9] = '' && Colors paStyles[1,1] = UPPER(PADR(paStyles[1,2],20)+TRAN(paStyles[1,3],'99')+TRAN(paStyles[1,4],'99') ; + PADR(paStyles[1,5],10) + PADR(paStyles[1,6],20)) + PADR(paStyles[1,7],30) ; + PADR(paStyles[1,8],50) + PADR(paStyles[1,9],50) * Create styles array and XML for table items LOCAL lcXmlTable,lcCRLF,lnLastRow lcXmlTable = This.xml_Table_Header() lcCRLF = CHR(13)+CHR(10) lnLastRow = 0 SELECT (This.cOutputAlias) SET ORDER TO RowCol LOCAL liLastRow, liLastCol, liCurrRow, liCurrCol, liRec STORE 0 TO liLastRow, liLastCol, liCurrRow, liCurrCol SCAN liRec = RECNO() liCurrRow = ExcelRow liCurrCol = ExcelCol IF liCurrRow = liLastRow AND liCurrCol = liLastCol && 2 elements in the same cell IF liRec > 1 SKIP -1 lcPrevContents = Contents DELETE SKIP + 1 REPLACE Contents WITH (ALLTRIM(lcPrevContents) + " / " + Contents) ENDIF ENDIF liLastRow = ExcelRow liLastCol = ExcelCol ENDSCAN LOCAL llIncomplete llIncomplete = liLastRow > 65530 *MESSAGEBOX("Step 6 - " + TRANSFORM(SECONDS() - nSecs)) nSecs = SECONDS() This.ShowTherm(40) LOCAL lnRecs, ln12, ln25, ln37, ln50, ln62, ln75, ln87, ln100 lnRecs = RECCOUNT() ln25 = INT(lnRecs/4) ln12 = INT(ln25/2) ln37 = ln25 + ln12 ln50 = INT(lnrecs/2) ln62 = ln50 + ln12 ln75 = ln25 + ln50 ln87 = ln75 + ln12 SCAN FOR NOT DELETED() * WAIT WINDOW NOWAIT 'Preparando para guardar... (' + TRANSFORM(ExcelRow) + ',' + TRANSFORM(ExcelCol) + ')' * If ExcelRow = 0 element belongs to page header of later page IF ExcelRow = 0 OR ExcelRow > 65530 LOOP ENDIF * If new row, close last row (if open) and open new. IF lnLastRow # ExcelRow IF lnLastRow # 0 lcXmlTable = lcXmlTable + This.Xml_Row_Footer() ENDIF lnLastRow = ExcelRow lcXmlTable = lcXmlTable + This.Xml_Row_Header() ENDIF lnStyleNumber = This.Xml_StyleNumber(Contents) lcXmlTable = lcXmlTable + This.Xml_Cell(Contents, UNCONTENTS, lnStyleNumber) && 2011-12-29 Passing the Unicode as well IF RECNO() = ln12 This.ShowTherm(48) ENDIF IF RECNO() = ln25 This.ShowTherm(55) ENDIF IF RECNO() = ln37 This.ShowTherm(62) ENDIF IF RECNO() = ln50 This.ShowTherm(70) ENDIF IF RECNO() = ln62 This.ShowTherm(77) ENDIF IF RECNO() = ln75 This.ShowTherm(85) ENDIF IF RECNO() = ln87 This.ShowTherm(92) ENDIF ENDSCAN This.ShowTherm(97) lcXmlTable = lcXmlTable + This.Xml_Row_Footer() lcXmlTable = lcXmlTable + This.xml_Table_Footer() LOCAL lcXML lcXML = This.Xml_File_Header() lcXML = lcXML + This.Xml_Workbook_Header() lcXML = lcXML + This.Xml_Styles_Header() FOR m.i = 21 TO 20 + ALEN(paStyles,1) lcXML = lcXML + This.Xml_Style(m.i) ENDFOR lcXML = lcXML + This.Xml_Styles_Footer() * 21/06/08 Adding NamedRange(s) *Cajas_Per2,=Sheet1!R10C13 DIMENSION paNames[1] && Array to save NamedRanges paNames = '' SELECT DISTINCT cExcelNamedRange ; FROM (this.cOutputAlias) ; WHERE !EMPTY(cExcelNamedRange) ; INTO ARRAY paNames IF !EMPTY(paNames) lcXML = lcXML + This.Xml_Names_Header() FOR m.i = 1 TO ALEN(paNames,1) lcXML = lcXML + This.Xml_Name(m.i) ENDFOR lcXML = lcXML + This.Xml_Names_Footer() ENDIF lcXML = lcXML + This.Xml_Worksheet_Header(lcWorkSheetName) * Since we finished processing, now it's nice to set the StrictDate back to the original SET STRICTDATE TO (This.SetStrictDate) LOCAL lcTempFile, lnHandle lcTempFile = ADDBS(GETENV("TEMP")) + "FP_" + SYS(2015) + ".XML" lnHandle = FCREATE(lcTempFile) IF lnHandle <= 0 =MESSAGEBOX("Error creating file: " + lcTempFile, "Error") RETURN ENDIF =FPUTS(lnHandle, lcXML) * lcXML = lcXML + lcXmlTable =FPUTS(lnHandle, lcXMLTable) * lcXML = lcXML + This.Xml_Worksheet_Footer() =FPUTS(lnHandle, This.Xml_Worksheet_Footer()) * lcXML = lcXML + This.Xml_Workbook_Footer() =FPUTS(lnHandle, This.Xml_Workbook_Footer()) This.ShowTherm(99) LOCAL llSaved llSaved = FCLOSE(lnHandle) * Check if we need to convert to UTF-8 IF This.lConvertToUTF8 TRY LOCAL lcXMLWks, lcOldSetSafe lcXMLWKS = FILETOSTR(lcTempFile) lcOldSetSafe = SET("Safety") SET SAFETY OFF =STRTOFILE(STRCONV(lcXMLWKS,9) , lcTempFile, 4) SET SAFETY &lcOldSetSafe. CATCH ENDTRY ENDIF * Save sheet IF NOT EMPTY(This.TargetFileName) This.cWorkbookFile = This.TargetFileName ENDIF IF (UPPER(JUSTEXT(This.cWorkbookFile)) = "XML") OR ; (NOT This.lConvertToXLS) llSaved = .F. TRY RENAME (lcTempFile) TO (This.cWorkbookFile) * llSaved = (STRTOFILE(lcXml, This.cWorkbookFile)) > 0 INKEY(.1) llSaved = .T. CATCH ENDTRY ELSE *!* LOCAL lcTempFile *!* lcTempFile = ADDBS(GETENV("TEMP")) + "FP_" + SYS(2015) + ".XML" *!* llSaved = (STRTOFILE(lcXml, lcTempFile)) > 0 This.ShowTherm(100, IIF(VARTYPE(_goHelper)="O", _goHelper.GetLoc("xlConv2xls"), "")) INKEY(.1) IF llSaved llSaved = .F. llSaved = This.ToPureXLSUsingExcel(lcTempFile, This.cWorkbookFile) && 1st try, using Excel automation IF NOT llSaved llSaved = This.ToPureXLSUsingOO(lcTempFile, This.cWorkbookFile) && 2nd try, using OpenOffice automation ENDIF IF NOT llSaved && If we didnt manage to use Excel or OO automation to convert, then && we'll keep it as XML TRY RENAME (lcTempFile) TO (This.cWorkbookFile) llSaved = .T. CATCH llSaved = (STRTOFILE(FILETOSTR(lcTempFile), This.cWorkbookFile)) > 0 ENDTRY INKEY(.1) ENDIF * Erase the temp file IF FILE(lcTempFile) TRY ERASE (lcTempFile) CATCH ENDTRY ENDIF ENDIF ENDIF IF llSaved IF This.lObjTypeMode _Screen.oFoxyPreviewer.lSaved = llSaved ENDIF IF This.lOpenViewer AND NOT EMPTY(This.TargetFileName) This.ShellExec(This.TargetFileName) ENDIF ENDIF IF llIncomplete IF VARTYPE(_goHelper) <> "O" MESSAGEBOX("Report is too big to be exported to the Excel format." + CHR(13) + ; "Please revise the created document because it will be incomplete!", 48, "Attention") ELSE MESSAGEBOX(_goHelper.GetLoc("XLTOOBIG"), 48, _goHelper.GetLoc("ATTENTION")) ENDIF ENDIF IF This.lDefaultMode THIS.setCurrentDataSession() DODEFAULT() ENDIF * Delete the temporary copy of the FRX we created IF This.lObjTypeMode USE IN SELECT(This.cFRXalias) TRY DELETE FILE (This.cTempFRX) CATCH ENDTRY ENDIF USE IN SELECT("LEFTS") USE IN SELECT("PAGETOP") CATCH ENDTRY ENDPROC PROCEDURE Init declare integer GetDeviceCaps in WIN32API integer HDC, integer item declare integer GetDC in WIN32API integer hWnd declare integer ReleaseDC in WIN32API integer hWnd, integer HDC DECLARE INTEGER GetWindowDC IN WIN32API INTEGER hwnd DODEFAULT() * 2010/08/08 Fix by Jaketon / CChalom, when set point = "," * I needed to store the original settings because the ReportListener class * changes the settings during run This.AddProperty("SetSeparator", SET("Separator")) This.AddProperty("SetPoint", SET("Point")) This.AddProperty("SetDate", SET("Date")) This.AddProperty("SetDateAnsi", INLIST(SET("Date"),"ANSI","GERMAN")) This.AddProperty("lConvertToXLS" , .T.) This.AddProperty("lRepeatHeaders", .T.) This.AddProperty("lRepeatFooters", .T.) This.AddProperty("lHidePageNo" , .F.) This.AddProperty("lUseUnicode" , .F.) && 2011-12-29 This.AddProperty("lConvertToUTF8", .F.) && 2011-12-31 * Developer can indicate properties by placing values in Comment field in this format: 18 * To get numeric 1 or 0 must write it as 1. or 0., otherwise Fox interprets as .T. / .F. * 18 - Indicates ExcelCol for this and other items with same Left * 18 - Indicates ExcelCol for one item only * Cajas_Per1;=Sheet1!R10C7 - Indicates NameOfRange,Range, as defined by Excel * =+(RC[-4]+RC[-3]) / Cajas_Per2 - Indicates formula to insert *!* ExcelBorders format: Top,Single,1;Bottom,Double,3 *!* *!* *!* *!* * Codify report colors as Solid,xxxxxx and store in cExcelInterior *!* Interior properties. *!* Color = Background Color *!* Pattern = "Solid" --> no pattern, "Gray125", "ThinVert ss:Pattern="Solid"Stripe" *!* PatternColor *!* Samples: *!* Solid,FFFF00 *!* *!* Gray125,FFFFFF,000000 *!* *!* ThinVertStripe,FFFF00,00FF00 *!* *Cajas_Per2,=Sheet1!R10C13 ENDPROC PROCEDURE BeforeReport * Code is inspired by Dorin Valisescu's CursorListener IF This.lDefaultMode OR This.lObjTypeMode DODEFAULT() ENDIF IF this.lOutputToCursor IF EMPTY(this.cOutputDBF) this.cOutputDBF = ADDBS(SYS(2023)) + SYS(2015) + '.dbf' ENDIF IF EMPTY(this.cOutputAlias) this.cOutputAlias = STRTRAN(JUSTSTEM(this.cOutputDBF), ' ', '_') ENDIF This.setFRXDataSession() IF This.lObjTypeMode * Make a copy of the FRX table and manipulate it This.cTempFRX = ADDBS(SYS(2023)) + "FRX_" + SYS(2015) + '.dbf' This.cFRXalias = "CopyFRX" SELECT FRX COPY TO (This.cTempFRX) USE (This.cTempFRX) SHARED AGAIN IN 0 ALIAS (This.cFRXalias) ENDIF * Store in Frx.User the number of the band to which each field belongs This.CalcBandNumbers() * Don't reprint group header on each page (not working yet) REPLACE ALL NoRepeat WITH .F. ; FOR objType = 9 AND (ObjCode = 3 OR ObjCode = 5) GO TOP CREATE CURSOR (this.cOutputAlias) (nFrxRecno N(4,0),nLeft I, nTop I, nWidth I, nHeight I, ; Contents M NOCPTRANS, UNCONTENTS M NOCPTRANS, nPageNo I) INDEX ON nFrxRecno TAG nFrxRecno ENDIF THIS.setCurrentDataSession() This.SetDate = SET("Date") This.SetStrictDate = SET("Strictdate") SET STRICTDATE TO 0 ENDPROC PROCEDURE Render LPARAMETERS nFRXRecno, nLeft, nTop, nWidth, nHeight, nObjectContinuationType, cContentsToBeRendered, GDIPlusImage * From PDFx by Luis Navas * Code to detect if report will run twice because of use of _PAGETOTAL If This.TwoPassProcess And This.CurrentPass=0 Then NODEFAULT RETURN EndIf IF this.lOutputToCursor LOCAL cContents WITH this IF EMPTY(cContentsToBeRendered) cContents = '' ELSE * 01/01/07 Correction by Andus Moor: Created XML file caused encoding error for some data * cContents = STRCONV(cContentsToBeRendered, 6) * 02/01/07 Second conversion by Andrus Moor * cContents = STRCONV(strt(strt(strt(cContentsToBeRendered,'&','&'),'>','>' ),'<','<'),9) * cContents = STRCONV(strt(strt(strt(cContentsToBeRendered,'&','&'),'>','>' ),'<','<'),6) * 14/06/10 Fix by CChalom * Need first to convert the contents before converting to HTML tags LOCAL lcTmpContent lcTmpContent = STRCONV(cContentsToBeRendered, 6) cContents = strt(strt(strt(lcTmpContent,'&','&'),'>','>' ),'<','<') ENDIF This.setFRXDataSession() IF NOT EMPTY(cContents) INSERT INTO (.cOutputAlias) (nFrxRecno, nLeft, nTop, nWidth, nHeight, Contents, UNCONTENTS, nPageNo) ; VALUES (m.nFrxRecno,m.nLeft,m.nTop,m.nWidth,m.nHeight,m.cContents, m.cContentsToBeRendered, .PageNo) ENDIF this.setCurrentDataSession() SELECT (this.drivingAlias) ENDWITH ENDIF DODEFAULT(nFRXRecno, nLeft, nTop, nWidth, nHeight, nObjectContinuationType, cContentsToBeRendered, GDIPlusImage) ENDPROC PROCEDURE Destroy * 02/10/06 Alex. This code was in Dorin's cursorListener. * It is not necessary because we keep directory table in FrxDatasession which doesn't exist. *this.resetDataSession() *IF USED(this.cOutputAlias) * USE IN (this.cOutputAlias) *ENDIF DODEFAULT() ENDPROC PROCEDURE DoStatus LPARAMETERS cMessage RETURN * This code comes from, Dorin's to use Carlos Alloati's therm LOCAL loParentForm, lcCaption, lcParentFormName NODEFAULT IF (NOT (THIS.QuietMode or ; (THIS.IsRunning AND THIS.CommandClauses.NoDialog))) IF this.nlastpercent <> CEILING(this.percentDone*100) this.nlastpercent = CEILING(this.percentDone*100) ELSE RETURN ENDIF IF EMPTY(cMessage) OR ISNULL(cMessage) cMessage = "" ENDIF lcCaption = EVALUATE(THIS.ThermCaption) IF ((NOT ISNULL(THIS.ThermForm)) OR (THIS.CreateTherm()) ) WITH THIS.ThermForm IF THIS.IsRunning .Closable = .F. .Movable = .F. ENDIF .Therm.Value = CEILING(THIS.PercentDone * 100) .ThermLabel.Caption = lcCaption IF NOT .Visible loParentForm = THIS.GetParentWindowRef() DO CASE CASE VARTYPE(loParentForm) # "O" AND (NOT _SCREEN.Visible) lcParentFormName = "MACDESKTOP" CASE VARTYPE(loParentForm) # "O" lcParentFormName = "SCREEN" CASE (NOT loParentForm.Visible) AND ; (loParentForm.DeskTop OR NOT EMPTY(loParentForm.MacDesktop) OR ; loParentForm.ShowWindow = 2 OR (NOT _SCREEN.Visible)) * in many cases, * they've probably made a programming error, * the parent should be visible according to * the requirements of REPORT FORM ... IN WINDOW * if it's a WINDOW clause they * have no need to show it, might not be an error * Either way, they should see the therm * to know that the report is progressing lcParentFormName = "MACDESKTOP" CASE (NOT loParentForm.Visible) * same comment as above lcParentFormName = "SCREEN" OTHERWISE lcParentFormName = loParentForm.Name ENDCASE SHOW WINDOW (.Name) IN WINDOW (lcParentFormName) .AlwaysOnTop = .T. .AutoCenter = .T. .Visible = .T. ENDIF ENDWITH ENDIF ENDIF ENDPROC PROCEDURE setfrxdatasessionenvironment NODEFAULT THIS.setFRXDataSession() SET SEPARATOR TO (This.SetSeparator) SET POINT TO (This.SetPoint) SET TALK OFF ENDPROC reportlistener pr_reportlistener.vcx 0FRXDataSession = -1 coutputalias = coutputdbf = loutputtocursor = .T. closeondeactivate = .T. nlastpercent = 0 cworkbookfile = cworksheetname = applyexcelstyleprogram = cexcelstyle = waitfornextreport = .F. ldefaultmode = .T. cfrxalias = FRX lobjtypemode = .F. targetfilename = lopenviewer = .F. ccodepage = ctempfrx = lalignleft = .F. nexcelsaveformat = 43 setstrictdate = 0 _memberdata = 869 ]4[}_ Z!p:l Z&|9'g1 dJ6dJ6dJ6f PLATFORM UNIQUEID TIMESTAMP CLASS CLASSLOC BASECLASS OBJNAME PARENT PROPERTIES PROTECTED METHODS OBJCODE RESERVED1 RESERVED2 RESERVED3 RESERVED4 RESERVED5 RESERVED6 RESERVED7 RESERVED8 COMMENT Class WINDOWS _18Q0OF4291061424627v COMMENT RESERVED WINDOWS _16V109SEN1061424706 COMMENT RESERVED VERSION = 3.00 frxcursor Pixels _frxcursor.h foxpro_reporting.h Pixels _frxcursor.h foxpro_reporting.h _frxcursor.h resettextmerge frxdevicehelper _frxcursor.h This class knows how to read printer environment information. Usage: x = NEWOBJECT( "frxDeviceHelper" ) IF x.LoadDeviceInfo( cDRIVER, cDEVICE, frx.TAG2 ) ? x.DpiX ? x.DpiY : etc Class gProvides methods to translate and manipulate various values in label and report tables (LBXs and FRXs) custom frxdevicehelper ~dpix Logical pixels-per-inch in the X dimension dpiy Logical pixels-per-inch in the Y dimension offsetx Physical printable page left margin offsety Physical printable page top margin actualx Physical width of page in device units actualy Physical length of page in device units mmx Horizontal page size in millimeters mmy Vertical page size in millimeters printablex Horizontal page width in pixels printabley Vertical page length in pixels _memberdata XML Metadata for customizable properties orientation 0=Portrait, 1=Landscape errormessage Occurs when the Valid event returns false (.F.), and provides a means to display an error message. *loaddeviceinfo Parses out print device parameters into member properties given specific device information: Parameters: cDriver, cDevice, cDevMode. Assumes current VFP default printer if no parameters specified. *loadfromfrx Loads printer device parameters from an FRX cursor header record. Restores recno and selected alias. Params: [ cFrxAlias ] (assumes "frx" if none specified.) *loadfromstrings Loads printer device parameters from string variables. Params: cExpr, cTag *loadfromhdc PRINTER Unable to create device context. CreateIC() returned 0. LCDRIVER LCDEVICE LCDEVMODE ERRORMESSAGE LRETVAL VRESULT CREATEIC LOADFROMHDC DELETEDC MESSAGE- WINDOWS LCFRXALIAS ERRORMESSAGE CURSEL CURREC LRETVAL PLATFORM OBJTYPE OBJCODE LOADFROMSTRINGS TAG26 DRIVER= DEVICE= TCEXPR TCTAG2 CLINE CDRIVER LDRIVER CDEVICE LDEVICE LOADDEVICEINFO TIHDC GETDEVICECAPS OFFSETX OFFSETY PRINTABLEX PRINTABLEY ACTUALX ACTUALY GetLastError win32api SetLastError win32api CreateIC gdi32 GetDeviceCaps gdi32 DeleteDC gdi32 GETLASTERROR WIN32API SETLASTERROR CREATEIC GDI32 GETDEVICECAPS DELETEDC loaddeviceinfo, loadfromfrx loadfromstrings loadfromhdcO custom Class custom frxcursor screendpi Contains the working DPI of the ReportDesigner. Currently hard-coded to 96. _memberdata XML Metadata for customizable properties quietmode Allows runtime users of frxCursor to specify whether the class displays error messages and other user feedback. *inttobinstring Returns a string of bytes, the binary version of a given integer. *binstringtoint Returns a numeric equivalent of a given binary number given in byte string form. *hasprotectionflag Returns .T. if the given binary data contains a specific bit set. Parameters: cBytes, iBit *frutopixels Returns the pixel value of a given measurement in FRUs. *pixelstofru Returns the FRU value of a given measurement in pixels. *getfrutextwidth Returns the width of a given string in FRUs. Parameters: cText, cTypeface, iSize [, cStyle ] *getfrutextheight Reutrns the height of a given string in FRUs. Parameters: cText, cTypeface, iSize [, cStyle ] *gorec Restores record pointer with bounds checking. Parameters: i, cAlias *getreportattribute Returns the value of a given report/header attribute. The FRX cursor must be open. Parameters: cToken [, iAlternate] *createbandcursor Creates a cursor with alias "bands" containing records of information for each band in the report. Assumes source alias is "FRX" unless specified. Parameters: [cFrxAlias] *hasband Returns .T. if the report has the specified band type. Calls .createBandCursor() if necessary. Parameters: iObjCode *hasdetailheader Returns .T. if the specified detail band has an associated detail header band. Calls .createBandCursor() if necessary. Parameters: cUniqueId *createobjectcursor Creates a cursor (default alias: "objects") of records for each object record in the report alias. Parameters: [ cFrxAlias [, cDestinationAlias [, iFilterMode ]]] *createobjcursorrecord Called from .createObjectCursor(). Parameter: cDestinationAlias *charsettolocale Converts a given Font Charset to a candidate locale Id for use with the STRCONV() function. Parameters: nCharSet *getbandfor Returns a SCATTER NAME band object for the specified object ID. Calls .createObjectCursor() if necessary. Parameters: cObjectID [, lStart] *synchobjectpositions Updates VPOS values in the FRX cursor for each object, based on which band the object starts in, and the current height of each band as expressed in the bands cursor. Assumes: band and object cursors exist; current alias is frx cursor; no recno restore. *getobjectsinband Returns a collection of UNIQUEIDs (or RECNOs) for each object in a given band. Calls .createObjectCursor() if necessary. Parameters: cBandId [, lRecnos] *insertdataenvrecord Inserts a data environment object record into an FRX cursor. Assumes that the record pointer is appropriately located. Parameters: ID, NAME, EXPR, CODE *insertband Inserts a band record into an frx cursor. Assumes that the FRX is currently selected and that the record pointer is located appropriately. Parameter: iObjCode *inserttitleband Inserts a title band into the frx cursor. Parameter: lBreakToNewPage *insertsummaryband Inserts a summary band into the frx cursor. Parameters: lBreakToNewPage, lPageHeader, lPageFooter *insertdetailband Inserts a detail band into the frx cursor. Assumes: the record pointer is located appropriately. Parameters: none *insertdetailheaderfooter Inserts detail header and footer bands into the frx cursor. Assumes: record pointer is located on the detail band record. Parameters: none *setcolumncount Adds or removes columns (and column header/footer records) from the FRX cursor. Assumes: the frx cursor is selected. Parameters: iColumns *creategroupcursor Creates a cursor with the alias "groups" containing records of information about each data group in the specified report cursor, default "frx". Parameters: [cFrxAlias] *createvariablecursor Creates a cursor with the alias "vars" containing records of information for each report variable in the report. Parameters: [cFrxAlias] *createcalcresetoncursor Creates a cursor with alias "reset_on" that contains records of information for each prompt in the Calculation Reset combobox. Parameters: [cFrxAlias] *createdefaultprintenvcursor Creates a one-row cursor with the same structure as the FRX. Default parameters are "frx", "defPrnEnv". Parameters: [ cFrxAlias [, cDestinationAlias]] *getselectedobjectcount Returns the number of selected objects in the frx cursor. Parameter: [cFrxAlias] *pushprintenvtocursor Saves the current printer environment to a cursor. Parameter: cSavedInAlias *popprintenv Restores the printer environment from a previously saved cursor. See .PushPrintEnvToCursor() method. Assumes: previously saved cursor is currently selected. *getfrxtimestamp Returns a FOX system file timestamp from a datetime value, any data type. Parameter: [vDateTime] *gettimestampstring Returns a readable string version of a Fox system timestamp, using current date settings. Parameter: iStamp *inttobin Returns a binary form of an integer. Parameter: iNumber *bintoint Returns the integer form of binary data. Parameter: cBinary *gettargettypetext Returns a readable string version of a target Type+Code. Parameters: iObjectType, iObjectCode *getunitvaluefromfru Returns a given unit value for a given value in FRUs, depending on the units. Parameters: nFruValue, iUnits *stripquotes Returns a string with embraced string delimiters removed. Parameters: cString *getmetadatadomdoc Returns a reference to an MSXml.DomDocument with the metadata xml loaded. Assumes FRX is located on desired record. *islayoutcontrol *unpackmemberdata Parameters: [cFrxAlias], [cMetaAlias]. Defaults to 'frx', 'memberdata' *packupmemberdata Parameters: [cFrxAlias], [cMetaAlias]. Defaults to 'frx', 'memberdata' *unpackfrxmemberdata *getfrxrecdisplayname Returns a readable string version of the current record in the current alias. (Assumes current alias is an FRX structure.) *xmlstrtocursor *cursortoxmlstr *quietmode_assign *generateevaluatecontentsscript Provides generated EvaluateContents code based on specified MemberData record usage. *generateadjustobjectsizescript Provides generated AdjustObjectSize code based on specified MemberData record usage. *resettextmerge Restores a saved set of delimiters and other characteristics of the SET TEXTMERGE command. ]screendpi = 96 _memberdata = 4363 quietmode = .F. Name = "frxcursor" custom dpix = 0 dpiy = 0 offsetx = 0 offsety = 0 actualx = 0 actualy = 0 mmx = 0 mmy = 0 printablex = 0 printabley = 0 _memberdata = 1735 orientation = 0 errormessage = ("") Name = "frxdevicehelper" CBYTES CBYTE IRETURN CBINSTRING IFLAGBIT IPROTFLAGS BINSTRINGTOINT? IPIXELS THIS SCREENDPI% THIS SCREENDPI CTEXT CTYPEFACE ISIZE CSTYLE IWIDTH PIXELSTOFRUk CTEXT CTYPEFACE ISIZE CSTYLE IHEIGHT PIXELSTOFRUc CALIAS WINDOWS UNITS MULTICOLUMN COLUMNCOUNT PROTECTION SNAKED_COLUMNS CURSEL CURREC VRETVAL OBJTYPE PLATFORM RULER FRX_RULER_FRUS UNITS_FRU_LOC UNITS_INCHES_LOC UNITS_METRIC_LOC UNITS_PIXELS_LOC UNITS_CHARACTERS_LOC ORDER BOTTOM GOREC datasessionv datasessionv bands bands Collection Collection WINDOWS bands TCFRXALIAS TISESSION CURSEL CURREC CURSESSION BANDS UNIQUEID OBJTYPE OBJCODE EXPR BANDLABEL START HEIGHT P_START P_STOP P_HEIGHT R_START R_STOP RESETTOTAL BAND_SEQ REL_BAND_ID REC_NO NSTART ISTART IDETAILCOUNT CSUFFIX IBANDCOUNT OGROUP OHEADER LCTITLEID LCSUMMARYID PLATFORM GETTARGETTYPETEXT COUNT REMOVE FRUTOPIXELS IREC CFOOTERID CBANDID CHEADERID GOREC bands IOBJCODE CREATEBANDCURSOR CURSEL LRETVAL BANDS OBJCODE bands CUNIQUEID CREATEBANDCURSOR CURSEL LRETVAL BANDS UNIQUEID OBJTYPE OBJCODE objects datasessionv datasessionv bands create cursor &tcDestAlias ( UNIQUEID c(10), OBJTYPE N(2,0), OBJCODE n(3,0), EXPR M, VPOS n(9,3), HPOS n(9,3), HEIGHT n(9,3), WIDTH n(9,3), OBJNAME c(50), LOCALE_ID i, P_START i, P_STOP i, P_HEIGHT i, BAND_OFFSET i, START_BAND_ID c(10), END_BAND_ID c(10), BANDLABEL c(75), SELECTED l, OBJ_PICT c(12), BAND_SEQ i, REC_NO i, TYPE_SEQ i, CTYPE c(10) ) WINDOWS WINDOWS WINDOWS WINDOWS TCFRXALIAS TCDESTALIAS TIFILTER TLRUNTIMEMODE TISESSION CURSEL CURREC CURSESSION CREATEBANDCURSOR OBJTYPE PLATFORM CREATEOBJCURSORRECORD IGRPSTART IGRPCOUNT CURPOS GOREC Label pslabel.bmp Field pseditbx.bmp psline.bmp Rectangle pshape.bmp Picture/OLE Bound psolebnd.bmp Grouped Objects group2.bmp Indeterminate behavior Resolved as Page Header TCDESTALIAS TLRUNTIMEMODE SRCALIAS LISGROUP REC_NO OBJNAME GETFRXRECDISPLAYNAME OBJTYPE CTYPE OBJ_PICT LOCALE_ID CHARSETTOLOCALE RESOID TYPE_SEQ UNIQUEID OBJCODE HEIGHT P_START FRUTOPIXELS P_HEIGHT P_STOP WIDTH SELECTED CURPOS BANDS R_START START_BAND_ID BANDLABEL BAND_OFFSET BAND_SEQ R_STOP END_BAND_ID REL_BAND_ID NCHARSET datasessionv datasessionv objects COBJECTID LSTART ISESSION CURSESSION CREATEOBJECTCURSOR CURSEL OBAND OBJECTS UNIQUEID BANDS START_BAND_ID END_BAND_ID WINDOWS bands4 objects4 CURSEL CURREC OBJTYPE PLATFORM UNIQUEID OBJECTS BANDS START_BAND_ID PIXELSTOFRU P_START BAND_OFFSET GORECh datasessionv datasessionv Collection objects CBANDID LRECNOS ISESSION OBANDOBJECTS CURSEL CURSESSION CREATEOBJECTCURSOR OBJECTS START_BAND_ID REC_NO UNIQUEIDs WINDOWS LIOBJTYPE LCNAME LCEXPR LCMETHODS PLATFORM OBJTYPE ENVIRON CURPOSz WINDOWS LIOBJCODE PLATFORM UNIQUEID OBJTYPE OBJCODE NOREPEAT PAGEBREAK COLBREAK RESETPAGE PLAIN CURPOSD LNEWPAGE INSERTBAND HEIGHT PAGEBREAKx LNEWPAGE LPAGEHEADER LPAGEFOOTER OBJTYPE OBJCODE INSERTBAND HEIGHT PAGEBREAK EJECTBEFOR EJECTAFTER INSERTBAND WINDOWS WINDOWS PLATFORM UNIQUEID OBJTYPE OBJCODE' WINDOWS WINDOWS WINDOWS WINDOWS WINDOWS WINDOWS WINDOWS WINDOWS ICOLS LHASCOLBANDS CURREC CFRXALIAS OBJTYPE PLATFORM OBJCODE GOREC CREATEOBJECTCURSOR UNIQUEID NOREPEAT PAGEBREAK COLBREAK RESETPAGE PLAIN CURPOS CREATEBANDCURSOR SYNCHOBJECTPOSITIONS$ datasessionv datasessionv UNITS groups groups MULTICOLUMN WINDOWS insert into groups values ( &tcFrxAlias..UNIQUEID, &tcFrxAlias..EXPR, m.iPaginate, &tcFrxAlias..NOREPEAT, m.nThreshold, "" ) WINDOWS replace FOOTER_ID with &tcFrxAlias..UNIQUEID TCFRXALIAS TISESSION CURSESSION CURSEL IUNITS GETREPORTATTRIBUTE GROUPS UNIQUEID PAGINATE REPRINT THRESH FOOTER_ID IPAGINATE ICURREC NTHRESHOLD LISMULTICOL OBJTYPE OBJCODE PLATFORM PAGEBREAK RESETPAGE COLBREAK GETUNITVALUEFROMFRU WIDTH GOREC2 datasessionv datasessionv reset_on WINDOWS locate for RESETTOTAL = &tcFrxAlias..RESETTOTAL insert into vars values ( &tcFrxAlias..UNIQUEID, &tcFrxAlias..NAME, &tcFrxAlias..EXPR, &tcFrxAlias..TAG, &tcFrxAlias..UNIQUE, &tcFrxAlias..TOTALTYPE+1, recno("reset_on"), recno(m.tcFrxAlias) ) TCFRXALIAS TISESSION CURSESSION CURSEL CREATECALCRESETONCURSOR UNIQUEID VARNAME VALUE_TO_STORE INITIAL_VALUE RELEASE_VAR CALC_TYPE RESET_ON REC_NO ICURREC IRESETON OBJTYPE PLATFORM GORECK datasessionv datasessionv reset_on reset_on reset_on Report reset_on WINDOWS reset_on Column reset_on Column WINDOWS reset_on WINDOWS insert into reset_on values ( &tcFrxAlias..UNIQUEID, &tcFrxAlias..OBJCODE, "Group: " + trim(&tcFrxAlias..EXPR), 5 + m.iNum ) WINDOWS reset_on WINDOWS insert into reset_on values ( &tcFrxAlias..UNIQUEID, &tcFrxAlias..OBJCODE, "Detail " + transform(m.iNum), 79 + m.iNum ) TCFRXALIAS TISESSION CURSESSION CURSEL CURREC IGROUPCOUNT IDETAILCOUNT RESET_ON UNIQUEID OBJCODE PROMPT_TEXT RESETTOTAL OBJTYPE PLATFORM GORECG datasessionv datasessionv defPrnEnv WINDOWS LCFRXALIAS LCPEALIAS LISESSION CURSEL CURSESSION OBJTYPE PLATFORM WINDOWS LCFRXALIAS CURSEL CURREC SELCOUNT CURPOS PLATFORM OBJTYPEc CREGISTERALIAS CURSEL RESULT RESULT TVDATETIME LTDATETIME LVFOXTIMESTAMP LVTEMP INTTOBIN BINTOINT~ tiStampb RETURN TTOC({^&lcYear./&lcMonth./&lcDay. &lcHour.:&lcMinute.:&lcSecond.}) TISTAMP LNYEAROFFSET LCYEAR LCMONTH LCDAY LCHOUR LCMINUTE LCSECOND TNINTEGER LNINTEGER LCBINARY LNDIVISOR LNCOUNT TCBINARY LCINTEGER LNINTEGER LNCOUNT LNSTRLEN Multiple Selection Comment Report/Global Workarea Index Relation Label Rectangle Field Title Page Header Column Header Group Header Detail Group Footer Column Footer Page Footer Summary Detail Header Detail Footer Unknown band type Grouped Objects Picture/OLE Bound Variable Printer Driver Setup Font Resource Data Environment Cursor Unknown Target type NOBJTYPE NOBJCODE NFRUVALUE IUNITS LCVALUE MSXml.DomDocument LCFRXALIAS CURSEL STYLE LOADXML& IOBJTYPE datasessionv datasessionv memberdata TCFRXALIAS TCMETAALIAS TIDATASESSION LCXML LIBYTES LISELECT LIDATASESSION LLSUCCESS STYLE THIS QUIETMODE REPORTDATA CURSORTOXMLSTR DATASESSIONv DATASESSIONv memberdata |NAME|TYPE|SCRIPT|EXECUTE|EXECWHEN|CLASS|CLASSLIB|DECLASS|DECLASSLIB| WINDOWS The metadata for a report definition row (ID: ) is invalid. Metadata instructions for this item will be ignored. FoxPro Reporting The metadata for some report definition rows could not be loaded. Some dynamic report features may be missing, or a report run may not conclude successfully. FoxPro Reporting TCFRXALIAS TCMETAALIAS TIDATASESSION TLOMITINDEX CURSEL LIROWS LCATTRIBUTES LIINDEX LCTEMPALIAS LISELECT LLERROR LIDATASESSION FRXRECNO EXECWHEN EXECUTE CLASS CLASSLIB DECLASS DECLASSLIB SCRIPT PLATFORM STYLE THIS QUIETMODE MESSAGE UNIQUEID Report/Global Rectangle Title Page Header Column Header Group Header Detail Group Footer Column Footer Page Footer Summary Detail Header Detail Footer Grouped Objects Unknown Target type [CCO_ TLINCLUDERECNO RETVAL OBJTYPE STRIPQUOTES PICTURE OBJCODE HPOSs Do you want to replace the metadata with a valid default XML fragment? FoxPro Reporting |NAME|TYPE|SCRIPT|EXECUTE|EXECWHEN|CLASS|CLASSLIB|DECLASS|DECLASSLIB| ADD COLUMN alter table (m.tcMetaAlias) &cAddColumns TCXML TCMETAALIAS CURSEL LIROWS CADDCOLUMNS CSTANDARDSET SCRIPT EXECUTE EXECWHEN CLASS CLASSLIB DECLASS DECLASSLIB TMPALIAS THIS QUIETMODE MESSAGE DELETEDv lcXml lcXml TCMETAALIAS LCXML LIBYTES5 TVNEWVAL THIS QUIETMODEi DATASESSIONv DATASESSIONv memberdata .FRXRecno FRXRecno = CC AND Type = ' ' AND Name = ' Microsoft.VFP.Reporting.Builder.EvaluateContents LOCATE FOR &lcConditions. TEXTMERGE TEXTMERGEv TEXTMERGE TEXTMERGE LPARAMETERS m.toListener, m.tP1, m.tP2 * <<"generated user-dynamic code" >> * <<"for EvaluateContents method">> * FRXRECNO: <>, EXPR: <> * <<"the following code translates from the standard">> * <<"fxMemberDataScript.ApplyFx parameters, which are used">> * <<"so you can cut and paste the CASEs below into">> * <<"Memberdata standard script later if you want to">> LOCAL m.nFRXRecno, m.oProps m.nFRXRecno = m.tP1 m.oProps = m.tP2 m.oProps.Reload = .T. SET DATASESSION TO (m.toListener.CurrentDataSession) * <<"Conditions are evaluated in the Current (Report) datasession.">> DO CASE SCAN ALL FOR &lcConditions. CASE <> && <<"user condition: ">> <> * <<"Expression required for this item. ">> * <<"Combinations of any 2 out of the 3 delimiter types (" +["]+ ",',[]) permitted within expressions.">> IF TYPE(<>< LCRESULTd VNEWVAL THIS ISRUNNING VERIFYNCNAME CSSCLASSATTR SYNCHXSLTPROCESSORUSERd VNEWVAL THIS ISRUNNING VERIFYNCNAME ANCHORATTR SYNCHXSLTPROCESSORUSERd VNEWVAL THIS ISRUNNING VERIFYNCNAME TITLEATTR SYNCHXSLTPROCESSORUSERd VNEWVAL THIS ISRUNNING VERIFYNCNAME LINKATTR SYNCHXSLTPROCESSORUSERd VNEWVAL THIS ISRUNNING VERIFYNCNAME CSSCLASSOVERRIDEATTR SYNCHXSLTPROCESSORUSER ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 .?=&# TCVALUE TLENCODEURLCONTROLCHARS TLENCODESPACE LCRESULT LCCHAR LCOKCHARS TCVAL TLXMLENCODE LCVAL LCTEMPVAL LAVALS LIINDEX LISEPARATORS URLSTRINGENCODE XMLRAWCONVH LOBJTYPEMODE OFOXYPREVIEWER COMMANDCLAUSES LOPENVIEWER PREVIEW TOFILE TARGETFILENAME CDESTFILE LCDESTFILE COUTPUTPATH LCFILE _REPORTLISTENER CANCELREPORT QUIETMODE LQUIETMODE Microsoft.XMLDOM Microsoft.XMLDOM Microsoft.VFP.Reporting.Builder.AdvancedProperty HTML.Metatag.HTTP-EQUIV /VFPData/reportdata [@name=' ' and @execwhen=' HTML.Metatag.HTTP-EQUIV ']/@execute //meta content HTML.Metatag.HTTP-EQUIV HTML.Metatag.HTTP-EQUIV RUNCOLLECTOR SETFRXDATASESSION MEMBERDATAALIAS LVVALUE LCEXPR LISELECT LOXML LOXMLTEMP LONODE FRXHEADERRECNO LOADXML STYLE FRXRECNO EXECWHEN DECLASS EXECUTE SELECTSINGLENODE SELECTNODES GETATTRIBUTE EVALUATEUSEREXPRESSION GETKEY FRXRecno Microsoft.VFP.Reporting.Builder.AdvancedProperty HTML.CSSClass.OverrideFRX Microsoft.VFP.Reporting.Builder.AdvancedProperty HTML.CSSClass.ExtendFRX Microsoft.VFP.Reporting.Builder.AdvancedProperty HTML.Link Microsoft.VFP.Reporting.Builder.AdvancedProperty HTML.Alt-Title Microsoft.VFP.Reporting.Builder.AdvancedProperty HTML.Anchor TNLEFT TNTOP TNWIDTH TNHEIGHT TNOBJECTCONTINUATIONTYPE LCINFO LCVAL LIRECNO SETFRXDATASESSION MEMBERDATAALIAS FRXRECNO EXECWHEN DECLASS EVALUATEUSEREXPRESSION EXECUTE CSSCLASSOVERRIDEATTR CSSCLASSATTR LINKATTR PATHENCODE TITLEATTR ANCHORATTR @id='description' @id=' Document.Description @id='author' @id=' Document.Author @id='keywords' @id=' Document.Keywords @id='title' @id=' Document.Title @id='copyright' @id=' Document.Copyright @id='date' @id=' Document.Date @id='css_sheet' @id=' HTML.CSSFile @id='http-equiv' @id=' HTML.Metatag.HTTP-EQUIV @idref @DTEXT @DTYPE @PLINK @FNAME @FSIZE @FSTYLE @title @anchor @hlink LCRESULT GETDEFAULTUSERXSLTASSTRING HEIGHTATTR WIDTHATTR LEFTATTR TOPATTR CONTATTR IDREFATTRIBUTE IDATTRIBUTE IMAGESRCATTR DATATEXTATTR DATATYPEATTR PAGEIMAGEATTR PENALPHAATTR PENREDATTR PENGREENATTR PENBLUEATTR FILLALPHAATTR FILLREDATTR FILLGREENATTR FILLBLUEATTR FONTNAMEATTR FONTSIZEATTR FONTSTYLEATTR TITLEATTR CSSCLASSATTR CSSCLASSOVERRIDEATTR ANCHORATTR LINKATTR XSLTPROCESSORUSERM HTML Listener APPNAME HADERROR7 FRXRecno Microsoft.VFP.Reporting.Builder.AdvancedProperty HTML.CSSClass.OverrideFRX Microsoft.VFP.Reporting.Builder.AdvancedProperty HTML.CSSClass.ExtendFRX Microsoft.VFP.Reporting.Builder.AdvancedProperty HTML.Link Microsoft.VFP.Reporting.Builder.AdvancedProperty HTML.Alt-Title Microsoft.VFP.Reporting.Builder.AdvancedProperty HTML.Anchor TONODE TNLEFT TNTOP TNWIDTH TNHEIGHT TNOBJECTCONTINUATIONTYPE LCVAL LIRECNO SETFRXDATASESSION MEMBERDATAALIAS FRXRECNO EXECWHEN DECLASS EVALUATEUSEREXPRESSION EXECUTE SETATTRIBUTE CSSCLASSOVERRIDEATTR CSSCLASSATTR LINKATTR PATHENCODE TITLEATTR ANCHORATTR Microsoft.VFP.Reporting.Builder.AdvancedProperty HTML.PrintablePageLink Microsoft.VFP.Reporting.Builder.AdvancedProperty HTML.TextAreasOff useTextAreaForStretchingText useTextAreaForStretchingText useTextAreaForStretchingText OLDPAGEIMAGETYPE XMLMODE LLSETTING LISELECT SETFRXDATASESSION MEMBERDATAALIAS EXECWHEN EVALUATESTRINGTOBOOLEAN EXECUTE PAGEIMAGETYPE LISTENERTYPE SUPPORTSPAGEIMAGES! MAKEEXTERNALFILELOCATIONREACHABLE ISSUCCESSOR COMMANDCLAUSES NOPAGEEJECT XSLTPARAMETERS GETKEY OLDTEXTAREASETTING ADJUSTXSLTPARAMETER RESETDATASESSION TLCALLEDEARLY OLDPAGEIMAGETYPE PAGEIMAGETYPE RESETDATASESSION LOBJTYPEMODE LLSAVED TARGETFILENAME OFOXYPREVIEWER LSAVED LOPENVIEWER SHELLEXECh useTextAreaForStretchingText OLDTEXTAREASETTING ADJUSTXSLTPARAMETER UPDATEPROPERTIES getdefaultuserxsltasstring, cssclassattr_assign anchorattr_assign: titleattr_assign linkattr_assign cssclassoverrideattr_assignS urlstringencode pathencode updateproperties fillruncollector getrawformattinginfo getdefaultuserxslt setdomformattinginfo BeforeReport AfterReport applyusertransformtooutput LoadReport! TCNODE TLOPEN TCIDREF TVFORMATTING LCNODE IDATTRIBUTE IDREFATTRIBUTE TCNODE TCVALUE TVIDREF TVFORMATTING LCVALUE LCNODE XMLRAWCONV XMLRAWTAGD m.lcValue = STRTRAN(m.tcValue, '&', '&' ) m.lcValue = STRTRAN(m.lcValue, '<', '<' ) m.lcValue = STRTRAN(m.lcValue, '>', '>' ) m.lcValue = STRTRAN(m.lcValue, '"', '"' ) m.lcValue = STRTRAN(m.lcValue, ['], ''' ) TCVALUE LCVALUE LICHAR TCCONTENTS TARGETHANDLEX VNEWVAL THIS ISRUNNING INCLUDEBREAKSINDATAb VNEWVAL THIS ISRUNNING XMLMODE INCLUDEPAGE ISRUNNING DATANODES PAGENODES COLUMNNODES CURRENTBAND CURRENTPAGE CURRENTCOLUMN EVALUATECONTENTSVALUES SUCCESSORGFXNORENDER CLEARSTATUS Msxml2.FreeThreadedDOMDocument.4.0 |DOCUMENT| |ELEMENT| COLLECTION externalFileLocation TVSOURCE TVPROCESSOR TVPARAMCOLLECTION TVFRXALIAS LOSOURCE LOPROCESSOR LCRETURN LLSUCCESS LIPARAM LISESSION LLCHARSETSINUSE FRXCHARSETSINUSE FIXMSXMLOBJECTFORDTDS LOADXML PARSEERROR REASON NODETYPESTRING LOADPROCESSOROBJECT CREATEPROCESSOR STYLESHEET BASECLASS COUNT ADDPARAMETER GETKEY EXTERNALFILELOCATION INPUT TRANSFORM OUTPUT VNEWVAL CURRENTDOCUMENTE VNEWVAL THIS ISRUNNING VERIFYNCNAME IDATTRIBUTEE VNEWVAL THIS ISRUNNING VERIFYNCNAME IDREFATTRIBUTE VNEWVAL XSLTPROCESSORRDL STYLESHEET LOPROCESSOR LOADPROCESSOROBJECT VNEWVAL XSLTPROCESSORUSER STYLESHEET LOPROCESSOR LOADPROCESSOROBJECTf QuietMode RESETREPORT CLOSETARGETFILE NOPAGEEJECT HADERROR RESETTODEFAULT CURRENTDOCUMENT? TCNAME LLVALID LICHAR LCCHAR9 VNEWVAL THIS INCLUDEFORMATTINGINLAYOUTOBJECTSD VNEWVAL THIS ISRUNNING INCLUDEBANDSWITHNOOBJECTS Nodes Nodes LISELECT LLSUCCESS NODES OBJTYPE VERIFYNCNAME OBJVALUE VNEWVAL THIS ISRUNNING NOPAGEEJECT DATASESSIONv Msxml2.XSLTemplate.4.0 Msxml2.FreeThreadedDOMDocument.4.0 TCVAL LORETURN LOPROCESSOR LOSTYLESHEET LISESSION RESETDATASESSION FIXMSXMLOBJECTFORDTDS LOADXML PARSEERROR REASON STYLESHEET FRXRecno FRXRecno Microsoft.VFP.Reporting.Builder.AdvancedProperty HTML.PrintablePageLink TNLEFT TNTOP TNWIDTH TNHEIGHT TNOBJECTCONTINUATIONTYPE LCINFO CONTATTR INCLUDEFORMATTINGINLAYOUTOBJECTS LEFTATTR TOPATTR WIDTHATTR HEIGHTATTR SETFRXDATASESSION LLPAGEIMAGES CURRENTPAGEIMAGEFILENAME MEMBERDATAALIAS INCLUDEDATATYPEATTRIBUTES FORMATTINGCHANGES DTEXT DATATYPEATTR DTYPE DATATEXTATTR XMLRAWCONV FRXRECNO EXECWHEN EVALUATESTRINGTOBOOLEAN EXECUTE PAGEIMAGEATTR VNEWVAL THIS ISRUNNING VERIFYNCNAME TOPATTRE VNEWVAL THIS ISRUNNING VERIFYNCNAME LEFTATTRE VNEWVAL THIS ISRUNNING VERIFYNCNAME HEIGHTATTRE VNEWVAL THIS ISRUNNING VERIFYNCNAME WIDTHATTRE VNEWVAL THIS ISRUNNING VERIFYNCNAME CONTATTRJ DATASESSIONv VFPDataSource ORDERv DESCC FILTERv SKIPv VFPDataSource SELECT &lcResult FROM (m.lcAlias) LEFT JOIN Bands ON &lcAlias..UniqueID = Bands.UniqueID LEFT JOIN Objects ON &lcAlias..UniqueID = Objects.UniqueID WHERE Platform = "WINDOWS" AND NOT DELETED() INTO CURSOR VFPFRXLayoutObject READWRITE VFPFRXLayoutObject.Tagb VFPFRXLayoutObject.Tag2b VFPFRXLayoutObject.Fontfaceb Nodes VFPFRXLayoutNode attrC VFPFRXLayoutNode THIS.C attribute nodename XMLAdapter VFPFRXLayoutObject VFPFRXLayoutNode VFPFRXMemberData VFPDataSource lcResult Microsoft.XMLDOM VFPFRXCommand THIS.CommandClauses.C false OutputTypeC appName targetFileName VFPFRXPrintJob pagewidth pageheight pagedesignC whole printable6 printresolutionCC PRINTER printresolution TCNODENAME TLASSTRING LISELECTCURRENT LISELECTFRX LISESSION LIFLDS LIDBFS LIINDEX1 LIINDEX2 LAFLDS LADBFS LARELS LCALIAS LCKEY LLDESC LCFILTER LCREL LIRELS LCSKIP LCRESULT LLWHOLEPAGE ONODE OCOMMAND SETFRXDATASESSION INCLUDEDATASOURCESINVFPRDL VFPDATASOURCE THE_ALIAS RPT_DRIVER THE_DBF THE_ORDER ORDER_DESC THE_FILTER THE_SKIP FLDS THE_FIELD THE_TYPE THE_PARENT THE_TARGET THE_EXPR SETCURRENTDATASESSION LIINDEX LCDBF LITAG DRIVINGALIAS PREPAREFRXCOPY GETFRXLAYOUTOBJECTFIELDLIST REMOVEFRXCOPY VFPFRXLAYOUTOBJECT OBJTYPE FONTFACE NODES OBJVALUE OBJCODE OBJINFO VFPFRXLAYOUTNODE RESPECTCURSORCP ADDTABLESCHEMA MEMBERDATAALIAS RESPECTNESTING XMLSCHEMALOCATION TOXML RESETDATASESSION LOADXML SELECTSINGLENODE COMMANDCLAUSES CREATEELEMENT SETATTRIBUTE OUTPUTTYPE APPNAME TARGETFILENAME APPENDCHILD SHAREDPAGEWIDTH SHAREDPAGEHEIGHT PRINTJOBNAME VNEWVAL INCLUDEDATASOURCESINVFPRDL TOBJTYPE TNAME TPICTURE TOFFSET TPATHED LCRETURN LCFILE COMMANDCLAUSES APPLYUSERTRANSFORM XSLTPROCESSORUSER APPLYRDLTRANSFORM LVPROCESSOR XMLMODE XSLTPROCESSORRDL SAVETARGETFILENAME APPLYXSLT TARGETFILENAME XSLTPARAMETERSr VNEWVAL THIS ISRUNNING APPLYUSERTRANSFORM XSLTPROCESSORUSER GETDEFAULTUSERXSLT FRXRecno FRXRecno Microsoft.VFP.Reporting.Builder.AdvancedProperty HTML.PrintablePageLink TONODE TNLEFT TNTOP TNWIDTH TNHEIGHT TNOBJECTCONTINUATIONTYPE SETATTRIBUTE CONTATTR INCLUDEFORMATTINGINLAYOUTOBJECTS LEFTATTR TOPATTR WIDTHATTR HEIGHTATTR LLPAGEIMAGES SETFRXDATASESSION CURRENTPAGEIMAGEFILENAME MEMBERDATAALIAS INCLUDEDATATYPEATTRIBUTES FORMATTINGCHANGES DTEXT DATATYPEATTR DTYPE DATATEXTATTR FRXRECNO EXECWHEN EXECUTE PAGEIMAGEATTR APPLYUSERTRANSFORM XSLTPROCESSORUSER2 Title Title Band nodename Page Header Band nodename Column Header Band nodename Group Header Band nodename Detail Band nodename Group Footer Band nodename Column Footer Band nodename Page Footer Band nodename Summary Summary Band nodename Detail Header Band nodename Detail Footer Band nodename VFP-Report Report root nodename Text object nodename Expression object nodename Picture object nodename Shape object nodename Line object nodename Variable nodename FontRes FontResource nodename DataEnv DataEnvironment nodename DE-Cursor DE-Cursor nodename DE-Relation DE-Relation nodename Group Group selector nodename Reports XML Document root nodename Report scope data root nodename VFP-RDL RDL layout description root nodename Pages Pages collection root nodename Columns Column collection root nodename Run property set root nodename OBJTYPE COLLECTION VNEWVAL XSLTPARAMETERS BASECLASS RECNO() AS FrxRecno, .PLATFORM, .NAME, .EXPR, .OFFSET, .VPOS, .HPOS, .HEIGHT, .OBJTYPE, .TAG, .TAG2, .PENSIZE, .PENPAT, .FILLPAT, .WIDTH, .STYLE, .PICTURE, .ORDER, .COMMENT, .FILLCHAR, .PENRED, .PENGREEN, .PENBLUE, .FILLRED, .FILLGREEN, .FILLBLUE, .FONTFACE, .FONTSTYLE, .FONTSIZE, .MODE, .FLOAT, .STRETCH, .STRETCHTOP, BITTEST( .FONTSTYLE, 0 ) AS FontBold, BITTEST( .FONTSTYLE, 1 ) AS FontItalic, BITTEST( .FONTSTYLE, 3 ) AS FontUnderline, BITTEST( .FONTSTYLE, 7 ) AS FontStrikeThrough, THIS.GetPathedImageInfo( .ObjType, .Name, .Picture, .Offset) AS UnpathedImg, THIS.GetPathedImageInfo( .ObjType, .Name, .Picture, .Offset, .T.) AS PathedImg, .TOP, .BOTTOM, .NOREPEAT, .PAGEBREAK, .COLBREAK, .RESETPAGE, .GENERAL, .SPACING, .SWAPHEADER, .SWAPFOOTER, .EJECTBEFOR, .EJECTAFTER, .TOTALTYPE, .RESETTOTAL, .DOUBLE, .RESOID,1) AS FONTCHARSET, .SUPALWAYS, .SUPOVFLOW, .SUPRPCOL, .SUPGROUP, .SUPVALCHNG, .SUPEXPR, .USER, OBJECTS.UniqueID AS ObjID, OBJECTS.ObjName, Objects.Locale_ID, OBJECTS.START_BAND_ID,OBJECTS.BAND_OFFSET,OBJECTS.END_BAND_ID, BANDS.UNIQUEID AS BandID,BANDS.OBJCODE AS BandType,Bands.BANDLABEL,Bands.START, Bands.STOP,Bands.BAND_SEQ,Bands.REL_BAND_ID, ( .ObjType=9 AND (NOT .Plain)) AS BandStretch TCALIAS LCALIAS LCFILE COMMANDCLAUSES PREPAREFRXSWAPCOPY TARGETFILENAME TCALIAS LCFILE REMOVEFRXSWAPCOPYD DATASESSIONv Collection TVVALUE TSKEY TLREMOVEONLY LIINDEX LISESSION XSLTPARAMETERS RESETDATASESSION COUNT GETKEY REMOVE Nodes FrxNodes XXXX6 DATASESSIONv Microsoft.XMLDOM PCCO_ THIS.runCollector.Baseclassb THIS.runCollector.C COLLECTION THIS.runCollector[C TLASSTRING LCITEM LVVALUE LISESSION SETFRXDATASESSION NODES OBJVALUE RESETDATASESSION LOADXML SETCURRENTDATASESSION RUNCOLLECTOR LCFIELD1 LCFIELD2 LIINDEX LISELECT ADDRUNNODE LAMEMBERS BASECLASS COUNT GETKEY DOCUMENTELEMENT property m.vValue.XMLb TVVALUEEXPR TCPROPERTYNAME ONODE VVALUE CREATEELEMENT SETATTRIBUTE EVALUATEUSEREXPRESSION APPENDCHILD DOCUMENTELEMENT9 TVNEWVAL INCLUDEDATATYPEATTRIBUTESE VNEWVAL THIS ISRUNNING VERIFYNCNAME DATATYPEATTRE VNEWVAL THIS ISRUNNING VERIFYNCNAME DATATEXTATTR] FORMATTINGCHANGES INCLUDEDATATYPEATTRIBUTES FRXRECNO DTEXT DTYPER TVALC VNEWVAL THIS ISRUNNING VERIFYNCNAME PAGEIMAGEATTR0 TCVAL" XMLMODE XSLTPROCESSORRDL ProhibitDTD- TOXML VALIDATEONPARSE RESOLVEEXTERNALS SETPROPERTY DATASESSIONv TCALIAS LISESSION LISELECT LITALLY LIREC LCALIAS LLSWITCHSESSIONS FRXDATASESSION SETFRXDATASESSION OBJTYPE DOUBLE RESOIDE CALLEVALUATECONTENTS INCLUDEDATATYPEATTRIBUTES XMLMODE LLRESETQUIETMODE HADERROR QUIETMODE APPLYUSERTRANSFORM APPLYRDLTRANSFORM$ Nodes FrxNodes XXXX6 NBANDOBJCODE NFRXRECNO INVOKEONCURRENTPASS TARGETHANDLE LCBAND LONODE LCIDREF LLFORMATBREAKBAND LOOBJECTS LLOMITBAND SETFRXDATASESSION NODES OBJVALUE INCLUDEBANDSWITHNOOBJECTS FRXCURSOR GETOBJECTSINBAND UNIQUEID FRXDATASESSION COUNT SETCURRENTDATASESSION INCLUDEBREAKSINDATA CURRENTBAND XMLRAWTAG WRITERAW CURRENTPAGE PAGENODES CURRENTCOLUMN COLUMNNODES RESETDATASESSION INCLUDEPAGEf RESETDOCUMENT COLUMNNODES CURRENTBAND CURRENTCOLUMN CURRENTDOCUMENT CURRENTPAGE DATANODES PAGENODES XSLTPROCESSORRDL XSLTPROCESSORUSER XSLTPARAMETERS SAFETYv TCDBF TLOVERWRITE HADERROR LISELECT LLSAFETYON OBJTYPE OBJCODE FRXNODES INSERTXMLCONFIGRECORDS XML Listener READCONFIGURATION APPNAME RESETDOCUMENT APPLYUSERTRANSFORM GETDEFAULTUSERXSLT HADERRORC Nodes FrxNodes XXXX6 Nodes FrxNodes XXXX6 Nodes FrxNodes XXXX6 Nodes ObjType XXXX6 TLCALLEDEARLY SETFRXDATASESSION TARGETHANDLE HADERROR FILLRUNCOLLECTOR LCNODE XMLMODE CURRENTBAND XMLRAWTAG WRITERAW INCLUDEBREAKSINDATA PAGENODES NODES OBJVALUE COLUMNNODES GETRUNNODECONTENTS NOPAGEEJECT COMMANDCLAUSES CURRENTDOCUMENT RUNCOLLECTORRESETLEVEL RESETRUNCOLLECTOR RESETREPORT RESETDOCUMENT APPLYUSERTRANSFORM APPLYRDLTRANSFORM APPLYUSERTRANSFORMTOOUTPUT RESETDATASESSIONo NERROR CMETHOD NLINE CLOSETARGETFILE ISRUNNING QUIETMODE CANCELREPORTh RENDER Nodes ObjType XXXX6 XXXXa NFRXRECNO NLEFT NWIDTH NHEIGHT NOBJECTCONTINUATIONTYPE CCONTENTSTOBERENDERED GDIPLUSIMAGE SUCCESSORGFXNORENDER APPLYFX INVOKEONCURRENTPASS TARGETHANDLE LCNODE LONODE LCFORMATTINGINFO LCCONTENTS LLTEXTTYPE LOBANDREF LIBANDRECNO SETFRXDATASESSION OBJTYPE INCLUDEBREAKSINDATA CURRENTPAGE CURRENTCOLUMN NODES OBJVALUE GETRAWFORMATTINGINFO XMLRAWNODE CURRENTBAND FRXCURSOR GETBANDFOR UNIQUEID FRXDATASESSION XMLRAWTAG SHAREDPAGENO PAGENO SETCURRENTDATASESSION BEFOREBAND WRITERAW RESETDATASESSIONN Nodes FrxNodes XXXX6 NBANDOBJCODE NFRXRECNO TLCONTINUEDBAND INCLUDEPAGE INCLUDEPAGEINOUTPUT INVOKEONCURRENTPASS TARGETHANDLE LCBAND LONODE LCIDREF LLFORMATBREAKBAND LCINTERRUPTEDBAND LLOMITBAND LOOBJECTS SETFRXDATASESSION INCLUDEBANDSWITHNOOBJECTS FRXCURSOR GETOBJECTSINBAND UNIQUEID FRXDATASESSION COUNT NODES OBJVALUE SETCURRENTDATASESSION SHAREDPAGENO PAGENO INCLUDEBREAKSINDATA CURRENTBAND WRITERAW XMLRAWTAG CURRENTPAGE CURRENTCOLUMN RESETDATASESSION SaveTargetFileName Nodes _ReportOutputConfig OBJECTS-a UniqueID UniqueID Nodes FrxNodes XXXX6 Nodes ObjType XXXX6 Nodes FrxNodes XXXX6 Nodes FrxNodes XXXX6 Nodes FrxNodes XXXX6 Nodes FrxNodes XXXX6 WINDOWS Required FRX cursor is not available. Required FRX cursor is not available. HADERROR SETFRXDATASESSION ISSUCCESSOR SUCCESSORGFXNORENDER! CHECKCOLLECTIONFORSPECIFIEDMEMBER GFXNORENDERCLASS GFXNORENDERCLASSLIB LISELECT LCDOCUMENT LCREPORT LCRDL LCPAGE LCCOL LCDATA LONODE LOPARENT TARGETHANDLE APPLYUSERTRANSFORM APPLYRDLTRANSFORM VERIFYTARGETFILE TARGETFILENAME TARGETFILEEXT ADDPROPERTY OPENTARGETFILE CONFIGURATIONTABLE NODES VERIFYNODENAMES VERIFYATTRIBUTENAMES INCLUDEBANDSWITHNOOBJECTS XMLMODE LOADFRXCURSOR FRXCURSOR CREATEOBJECTCURSOR FRXDATASESSION BANDS UNIQUEID OBJECTS ISRUNNING OBJVALUE INCLUDEBREAKSINDATA CURRENTDOCUMENT WRITERAW XMLRAWTAG XMLRAWCONV COMMANDCLAUSES GETVFPRDLCONTENTS PAGENODES COLUMNNODES AFTERREPORT! INITIALIZEFORMATTINGCHANGESCURSOR FORMATTINGCHANGES PLATFORM OBJTYPE FRXRECNO DOMESSAGE LASTERRORMESSAGE RESETDATASESSION; INCLUDEPAGE XMLMODE TWOPASSPROCESS CURRENTPASS OBJTYPE OBJTYPE FRXNODES OBJTYPE+OBJCODE+IIF(OBJTYPE=C 9999999_ 9999999_ SAFETYv FIXEDv INDEX ON &lcIndex TAG &lcTag At least one required index tag is missing C from the configuration table. At least one required index tag is missing C from the configuration table. ObjType TCALIAS LLRETURN LAREQUIRED LIINDEX LISELECT LITAG LCTAG LCINDEX LLSAFETYON LLFIXEDON LCMESSAGE THIS DOMESSAGE LASTERRORMESSAGE INSERTXMLCONFIGRECORDST VNEWVAL THIS.CommandClauses.Fileb THIS.CommandClauses.NoPageEjectb NoPageEject- COMMANDCLAUSES FRXRecno FRXRecno NFRXRECNO OOBJPROPERTIES INVOKEONCURRENTPASS TARGETHANDLE SETFRXDATASESSION FORMATTINGCHANGES EVALUATECONTENTSVALUES FRXRECNO INCLUDEDATATYPEATTRIBUTES VALUE DTYPE DTEXT FORMATDATAVALUE RESETDATASESSION RUNCOLLECTOR DATASESSIONv Collection Microsoft.XMLDOM Microsoft.XMLDOM /VFPData/reportdata [@name=' ' and @execwhen=' ']/@execute Microsoft.VFP.Reporting.Builder.AdvancedProperty RUNCOLLECTOR LISESSION RESETDATASESSION SETFRXDATASESSION MEMBERDATAALIAS LVVALUE LCEXPR LISELECT LOXML LOXMLTEMP FRXHEADERRECNO LOADXML STYLE FRXRECNO EXECUTE EXECWHEN DECLASS EVALUATEUSEREXPRESSION SELECTSINGLENODE DOCUMENTELEMENT GETKEY TVNEWVAL RUNCOLLECTORRESETLEVEL xmlrawtag, xmlrawnode xmlrawconv~ writeraw includebreaksindata_assign# xmlmode_assign resetreport7 applyxslt| currentdocument_assign idattribute_assign1 idrefattribute_assign xsltprocessorrdl_assign0 xsltprocessoruser_assign resetdocument verifyncname includeformattinginlayoutobjects_assign includebandswithnoobjects_assignk verifynodenames verifyattributenames nopageeject_assign loadprocessorobject getrawformattinginfo topattr_assign leftattr_assign heightattr_assign widthattr_assign contattr_assign getvfprdlcontentsy includedatasourcesinvfprdl_assign getpathedimageinfo54 applyusertransformtooutput applyusertransform_assignM9 getdefaultuserxslt setdomformattinginfo synchxsltprocessoruser insertxmlconfigrecords xsltparameters_assignPG getfrxlayoutobjectfieldlist9H preparefrxcopy removefrxcopy adjustxsltparameterMQ getrunnodecontents addrunnode includedatatypeattributes_assign'[ datatypeattr_assign datatextattr_assign initializeformattingchangescursor formatdatavalue:] pageimageattr_assign evaluatestringtoboolean applyrdltransform_accessO^ fixmsxmlobjectfordtds frxcharsetsinuseU_ resetcallevaluatecontents closetargetfile`b setfrxdatasessionenvironmentEc opentargetfilemc AfterBand}c Destroy createconfigtable j Initpk AfterReportal ErrorIr Render BeforeBand BeforeReport invokeoncurrentpass5 verifyconfigtable targetfileext_assign setfrxrunstartupconditionsi EvaluateContents- resetruncollector fillruncollector runcollectorresetlevel_assign ^5PROCEDURE createtherm #define CTLCOLOR_MSGBOX 0 #define CTLCOLOR_EDIT 1 #define CTLCOLOR_LISTBOX 2 #define CTLCOLOR_BTN 3 #define CTLCOLOR_DLG 4 #define CTLCOLOR_SCROLLBAR 5 #define CTLCOLOR_STATIC 6 #define CTLCOLOR_MAX 7 #define COLOR_SCROLLBAR 0 #define COLOR_BACKGROUND 1 #define COLOR_ACTIVECAPTION 2 #define COLOR_INACTIVECAPTION 3 #define COLOR_MENU 4 #define COLOR_WINDOW 5 #define COLOR_WINDOWFRAME 6 #define COLOR_MENUTEXT 7 #define COLOR_WINDOWTEXT 8 #define COLOR_CAPTIONTEXT 9 #define COLOR_ACTIVEBORDER 10 #define COLOR_INACTIVEBORDER 11 #define COLOR_APPWORKSPACE 12 #define COLOR_HIGHLIGHT 13 #define COLOR_HIGHLIGHTTEXT 14 #define COLOR_BTNFACE 15 #define COLOR_BTNSHADOW 16 #define COLOR_GRAYTEXT 17 #define COLOR_BTNTEXT 18 #define COLOR_INACTIVECAPTIONTEXT 19 #define COLOR_BTNHIGHLIGHT 20 #if("4" $ OS()) #define COLOR_3DDKSHADOW 21 #define COLOR_3DLIGHT 22 #define COLOR_INFOTEXT 23 #define COLOR_INFOBK 24 #define COLOR_DESKTOP COLOR_BACKGROUND #define COLOR_3DFACE COLOR_BTNFACE #define COLOR_3DSHADOW COLOR_BTNSHADOW #define COLOR_3DHIGHLIGHT COLOR_BTNHIGHLIGHT #define COLOR_3DHILIGHT COLOR_BTNHIGHLIGHT #define COLOR_BTNHILIGHT COLOR_BTNHIGHLIGHT #endif IF ISNULL(THIS.ThermForm) DECLARE INTEGER GetSysColor IN Win32API INTEGER LOCAL m.liThermTop, m.liThermLeft, m.liThermWidth, m.liThermHeight, m.liSession m.liSession = SET("DATASESSION") THIS.resetDataSession() THIS.ThermForm = CREATEOBJECT("FORM") WITH THIS.ThermForm .ScaleMode = SCALEMODE_PIXELS .Height = THIS.ThermFormHeight .HalfHeightCaption = .T. .Width = THIS.ThermFormWidth .AutoCenter = .T. .BorderStyle = BORDER_DOUBLE && fixed dialog .ControlBox = .F. .Closable = (NOT THIS.IsRunning) .MaxButton = .F. .MinButton = .F. .Movable = (NOT THIS.IsRunning) .AlwaysOnTop = .T. .AllowOutput = .F. .AddObject("ThermBack","shape") .AddObject("ThermLabel","label") .AddObject("ThermShape","shape") m.liThermHeight = .Height - (THIS.ThermMargin* 2) m.liThermWidth = .Width - (THIS.ThermMargin*2) ENDWITH THIS.setCurrentDataSession() THIS.SetThermFormCaption() m.liThermTop = THIS.ThermMargin m.liThermLeft = THIS.ThermMargin WITH THIS.ThermForm.ThermBack .Top = m.liThermTop .Left = m.liThermLeft .Height = m.liThermHeight .Width = m.liThermWidth .Visible = .T. .BorderStyle = BORDER_SINGLE .BackStyle = 0 ENDWITH WITH THIS.ThermForm.ThermLabel .Top = (.Parent.Height - .Height) /2 .Autosize = .T. .BackStyle = FILLSTYLE_SOLID .Caption = "" .Visible = .T. .ForeColor = GetSysColor( COLOR_MENUTEXT ) ENDWITH WITH THIS.ThermForm.ThermShape .Top = m.liThermTop +1 .Left = m.liThermLeft+1 .Height = m.liThermHeight -2 .Width = 0 .Visible = .T. .BorderStyle = BORDER_NONE .BackStyle = FILLSTYLE_SOLID .FillStyle = FILLSTYLE_SOLID .BackColor = .Parent.BackColor .FillColor = GetSysColor(COLOR_HIGHLIGHT) .DrawMode = DRAWMODE_MERGE_PEN_NOT ENDWITH SET DATASESSION TO (m.liSession) ENDIF RETURN NOT ISNULL(THIS.ThermForm) ENDPROC PROCEDURE secondstext_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "C" THIS.SecondsText = m.vNewVal ENDIF ENDPROC PROCEDURE thermformcaption_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "C" THIS.ThermFormCaption = m.vNewVal THIS.SetThermFormCaption() ENDIF ENDPROC PROCEDURE thermformheight_assign LPARAMETERS m.vNewVal IF (NOT THIS.IsRunning) AND VARTYPE(m.vNewVal) = "N" AND ; BETWEEN(m.vNewVal,30,SYSMETRIC(SYSMETRIC_SCREENHEIGHT )-30) AND ; INT(m.vNewVal) # THIS.ThermFormHeight THIS.thermformheight = INT(m.vNewVal) IF THIS.ThermMargin > THIS.ThermFormHeight/4 THIS.ThermMargin = THIS.ThermFormHeight/4 ENDIF THIS.thermForm = NULL ENDIF ENDPROC PROCEDURE thermformwidth_assign LPARAMETERS m.vNewVal IF (NOT THIS.IsRunning) AND VARTYPE(m.vNewVal) = "N" AND ; BETWEEN(m.vNewVal,100,SYSMETRIC( SYSMETRIC_SCREENWIDTH )-100) AND ; INT(m.vNewVal) # THIS.ThermFormWidth THIS.thermformwidth = INT(m.vNewVal) IF THIS.ThermMargin > THIS.ThermFormWidth/4 THIS.ThermMargin = THIS.ThermFormWidth/4 ENDIF THIS.ThermForm = NULL ENDIF ENDPROC PROCEDURE thermmargin_assign LPARAMETERS m.vNewVal IF (NOT THIS.IsRunning) AND VARTYPE(m.vNewVal) = "N" AND ; BETWEEN(m.vNewVal,1,MIN(THIS.ThermFormHeight/4,THIS.ThermFormWidth/4)) AND ; INT(m.vNewVal) # THIS.ThermMargin THIS.thermmargin = INT(m.vNewVal) THIS.thermForm = NULL ENDIF ENDPROC PROCEDURE includeseconds_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "L" THIS.includeseconds = m.vNewVal ENDIF ENDPROC PROCEDURE getparentwindowref LOCAL m.loForm, m.loTopForm, m.lcInWindow * first top form in the list * will be the current top form. ASSERT TYPE("_SCREEN.ActiveForm") # "O" OR ; INLIST(_SCREEN.ActiveForm.ShowWindow, 0,1,2) m.loTopForm = NULL IF TYPE("THIS.CommandClauses.InWindow") = "C" m.lcInWindow = UPPER(ALLTRIM(THIS.CommandClauses.InWindow)) ENDIF IF EMPTY(lcInWindow) AND TYPE("THIS.CommandClauses.Window") = "C" m.lcInWindow = UPPER(ALLTRIM(THIS.CommandClauses.Window)) ENDIF IF NOT EMPTY(m.lcInWindow) FOR EACH m.loForm IN _SCREEN.Forms FOXOBJECT IF m.loForm.ShowWindow = 2 AND ; UPPER(m.loForm.Name) == m.lcInWindow m.loTopForm = m.loForm EXIT ENDIF ENDFOR ENDIF DO CASE CASE VARTYPE(m.loTopForm) = "O" * already found CASE _SCREEN.FormCount = 0 OR ; (TYPE("_SCREEN.ActiveForm") = "O" AND ; _SCREEN.ActiveForm.ShowWindow = 0 ) && ShowWindow In Screen m.loTopForm = _SCREEN CASE (TYPE("_SCREEN.ActiveForm") = "O" AND ; _SCREEN.ActiveForm.ShowWindow = 2 ) && ShowWindow As Top Form m.loTopForm = _SCREEN.ActiveForm OTHERWISE FOR EACH m.loForm IN _SCREEN.Forms FOXOBJECT IF m.loForm.ShowWindow = 2 m.loTopForm = m.loForm EXIT ENDIF ENDFOR IF VARTYPE(m.loTopForm) # "O" m.loTopForm = _SCREEN ENDIF ENDCASE IF VARTYPE(m.loTopForm) # "O" OR ; EMPTY(m.loTopForm.Name) m.loTopForm = NULL ENDIF RETURN m.loTopForm ENDPROC PROCEDURE setthermformcaption IF NOT ISNULL(THIS.ThermForm) IF EMPTY(THIS.ThermFormCaption) IF TYPE("THIS.CommandClauses.File") = "C" LOCAL m.cName IF EMPTY(THIS.PrintJobName) m.cName = PROPER(JUSTFNAME(THIS.CommandClauses.File)) ELSE m.cName = THIS.PrintJobName ENDIF THIS.ThermForm.Caption = ; m.cName + ": " + OUTPUTCLASS_CANCEL_INSTRUCTIONS_LOC ELSE THIS.ThermForm.Caption = "" ENDIF ELSE THIS.ThermForm.Caption = THIS.ThermFormCaption ENDIF ENDIF ENDPROC PROCEDURE thermcaption_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "C" LOCAL m.lcType, m.cMessage m.cMessage = "" TRY m.lcType = VARTYPE(EVALUATE(m.vNewVal)) IF m.lcType = "C" THIS.ThermCaption = m.vNewVal ENDIF CATCH ENDTRY ENDIF ENDPROC PROCEDURE initstatustext_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "C" THIS.InitStatusText = m.vNewVal ENDIF ENDPROC PROCEDURE prepassstatustext_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "C" THIS.PrepassStatusText = m.vNewVal ENDIF ENDPROC PROCEDURE runstatustext_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "C" THIS.RunStatusText = m.vNewVal ENDIF ENDPROC PROCEDURE resetuserfeedback LPARAMETERS m.tlResetTimes THIS.CurrentRecord = 0 THIS.PercentDone = 0 IF m.tlResetTimes THIS.ReportStartRunDateTime= DATETIME() THIS.ReportStopRunDateTime= DTOT({}) ENDIF ENDPROC PROCEDURE getreportscopedriver LOCAL m.liSelect, m.lcAlias, ; m.liSkips, laSkips[1] THIS.designatedDriver = THIS.drivingAlias * used later if we have to cancel report as * a Successor THIS.setFRXDataSession() IF USED("frx") m.liSelect = SELECT(0) m.lcAlias = "" SELECT FRX * first look for any target alias that * is the same as the driver SCAN ALL FOR ObjType = FRX_OBJTYP_BAND AND ; Objcode = FRX_OBJCOD_DETAIL AND ; TYPE(Expr) = "C" AND ; NOT (EMPTY(Expr) OR DELETED()) m.lcAlias = ALLTRIM(Expr) THIS.setCurrentDataSession() m.lcAlias = UPPER(EVALUATE(m.lcAlias)) THIS.setFRXDataSession() IF m.lcAlias == UPPER(THIS.drivingAlias) EXIT ENDIF ENDSCAN IF m.lcAlias == UPPER(THIS.drivingAlias) SELECT (m.liSelect) * if the driver is also a target alias, * don't touch. * otherwise: ELSE LOCATE FOR ObjType = FRX_OBJTYP_BAND AND ; Objcode = FRX_OBJCOD_DETAIL AND ; Platform = FRX_PLATFORM_WINDOWS AND ; NOT (EMPTY(Expr) OR DELETED()) IF FOUND() * use the first detail band, on the theory * that people are going to put pre-processing * calculations before other bands, * so an early band has the best chance to be * the right driver. m.lcAlias = ALLTRIM(Expr) THIS.setCurrentDataSession() THIS.drivingAlias = UPPER(EVALUATE(m.lcAlias)) THIS.setFRXDataSession() SELECT (m.liSelect) ELSE * adjust the driver based on any * one to many relationships we can find. SELECT (m.liSelect) THIS.setCurrentDataSession() m.lcAlias = THIS.drivingAlias m.liSelect = SELECT(0) DO WHILE NOT EMPTY(m.lcAlias) SELECT (m.lcAlias) m.liSkips = ALINES(laSkips,SET("SKIP"),",") IF m.liSkips = 0 OR EMPTY(laSkips[1]) THIS.drivingAlias = m.lcAlias m.lcAlias = "" ELSE m.lcAlias = laSkips[1] * it doesn't really matter how many lines there * are in the array; this is not going to be perfect * but we can't predict which child * has the most records. ENDIF ENDDO SELECT (m.liSelect) ENDIF ENDIF RETURN .F. ENDIF ENDPROC PROCEDURE synchstatus LPARAMETERS m.nBandObjCode, m.nFRXRecNo IF THIS.isRunning AND (NOT THIS.hadError) AND ; THIS.frxBandRecno = m.nFRXRecNo THIS.setCurrentDataSession() IF THIS.drivingAliasCurrentRecno # RECNO(THIS.drivingAlias) THIS.currentRecord = THIS.CurrentRecord + 1 THIS.drivingAliasCurrentRecno = RECNO(THIS.drivingAlias) ENDIF IF THIS.currentRecord >= THIS.CommandClauses.RecordTotal IF THIS.CurrentPass = 0 AND THIS.TwoPassProcess THIS.resetUserFeedback() ELSE THIS.currentRecord = THIS.CommandClauses.RecordTotal ENDIF ENDIF THIS.UpdateStatus() THIS.resetDataSession() ENDIF ENDPROC PROCEDURE thermprecision_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "N" THIS.thermPrecision = ABS(INT(m.vNewVal)) ENDIF ENDPROC PROCEDURE setfrxrunstartupconditions DODEFAULT() IF TYPE("THIS.CommandClauses.Summary") # "L" ADDPROPERTY(THIS.CommandClauses,"Summary",.F.) ENDIF IF TYPE("THIS.CommandClauses.RecordTotal") # "N" ADDPROPERTY(THIS.CommandClauses,"RecordTotal",0) ENDIF ENDPROC PROCEDURE BeforeBand LPARAMETERS m.nBandObjCode, m.nFRXRecNo DODEFAULT(m.nBandObjCode, m.nFRXRecNo) IF THIS.successorSys2024 = "Y" AND ; THIS.CurrentPass = LISTENER_FULLPASS * user cancelled during the prepass, * we need to re-cancel. THIS.setCurrentDataSession() IF USED(THIS.designatedDriver) GO BOTTOM IN (THIS.designatedDriver) ENDIF ENDIF THIS.synchStatus(m.nBandObjCode,m.nFRXRecNo) THIS.resetDataSession() ENDPROC PROCEDURE UnloadReport IF THIS.IsRunning THIS.IsRunning = .F. THIS.PopGlobalSets() ENDIF THIS.ReportStopRunDateTime = DATETIME() THIS.ClearStatus() THIS.ThermForm = NULL DODEFAULT() THIS.resetDataSession() ENDPROC PROCEDURE DoStatus LPARAMETERS m.cMessage LOCAL m.loParentForm, m.lcCaption, m.lcParentFormName NODEFAULT IF (NOT (THIS.QuietMode or ; (THIS.IsRunning AND THIS.CommandClauses.NoDialog))) IF EMPTY(m.cMessage) OR ISNULL(m.cMessage) m.cMessage = "" ENDIF m.lcCaption = EVALUATE(THIS.ThermCaption) IF ((NOT ISNULL(THIS.ThermForm)) OR (THIS.CreateTherm()) ) WITH THIS.ThermForm IF THIS.IsRunning .Closable = .F. .Movable = .F. ENDIF .ThermShape.Width = MAX( (((THIS.PercentDone/100) * .ThermBack.Width)-2) ,0) IF NOT .Visible m.loParentForm = THIS.GetParentWindowRef() DO CASE CASE VARTYPE(m.loParentForm) # "O" AND (NOT _SCREEN.Visible) m.lcParentFormName = "MACDESKTOP" CASE VARTYPE(m.loParentForm) # "O" m.lcParentFormName = "SCREEN" CASE (NOT m.loParentForm.Visible) AND ; (m.loParentForm.DeskTop OR NOT EMPTY(m.loParentForm.MacDesktop) OR ; m.loParentForm.ShowWindow = 2 OR (NOT _SCREEN.Visible)) * in many cases, * they've probably made a programming error, * the parent should be visible according to * the requirements of REPORT FORM ... IN WINDOW * if it's a WINDOW clause they * have no need to show it, might not be an error * Either way, they should see the therm * to know that the report is progressing m.lcParentFormName = "MACDESKTOP" CASE (NOT m.loParentForm.Visible) * same comment as above m.lcParentFormName = "SCREEN" OTHERWISE m.lcParentFormName = m.loParentForm.Name ENDCASE SHOW WINDOW (.Name) IN WINDOW (m.lcParentFormName) .AlwaysOnTop = .T. .AutoCenter = .T. .Visible = .T. ENDIF .ThermLabel.Visible = .F. .ThermLabel.Caption = m.lcCaption .ThermLabel.Left = (.Width - .ThermLabel.Width) /2 && must be after visible .ThermLabel.Visible = .T. ENDWITH ENDIF ENDIF ENDPROC PROCEDURE ClearStatus NODEFAULT IF NOT ISNULL(THIS.ThermForm) IF THIS.ThermForm.Visible THIS.ThermForm.Visible = .F. ENDIF ENDIF IF NOT ISNULL(THIS.Successor) THIS.Successor.ClearStatus() ENDIF ENDPROC PROCEDURE BeforeReport DODEFAULT() * THIS.ResetUserFeedback(.T.) THIS.DrivingAliasCurrentRecno = 0 THIS.IsRunning = .T. THIS.resetDataSession() ENDPROC PROCEDURE Init IF DODEFAULT() THIS.InitStatusText = OUTPUTCLASS_INITSTATUS_LOC THIS.PrepassStatusText = OUTPUTCLASS_PREPSTATUS_LOC THIS.RunStatusText = OUTPUTCLASS_RUNSTATUS_LOC THIS.SecondsText = OUTPUTCLASS_TIME_SECONDS_LOC THIS.thermCaption = OUTPUTCLASS_THERMCAPTION_LOC RETURN (NOT THIS.HadError) RETURN .F. ENDIF ENDPROC PROCEDURE AfterReport IF SYS(2024) # "Y" IF THIS.IsRunning OR TYPE("THIS.CommandClauses.RecordTotal") = "N" THIS.CurrentRecord = THIS.CommandClauses.RecordTotal ENDIF THIS.UpdateStatus() ENDIF THIS.IsRunning = .F. THIS.ClearStatus() THIS.designatedDriver = "" THIS.successorSys2024 = "N" THIS.ThermForm = NULL THIS.ReportStopRunDateTime = DATETIME() THIS.PopGlobalSets() DODEFAULT() ENDPROC PROCEDURE CancelReport IF THIS.IsRunning AND ; (THIS.QuietMode OR ; (THIS.pageLimit > 0 AND THIS.PageNo > THIS.pageLimit) OR ; (NOT THIS.AllowModalMessages) OR ; THIS.DoMessage(OUTPUTCLASS_REPORT_CANCELQUERY_LOC,; MB_ICONQUESTION+MB_YESNO) = IDYES ) IF THIS.isSuccessor AND NOT EMPTY(THIS.designatedDriver) * make an exception for this Listener * to the rule that Successors don't * handle cancelling the report, because * this guy's job is to handle user intervention: THIS.successorSys2024 = "Y" LOCAL m.liSession m.liSession = SET("DATASESSION") THIS.setCurrentDataSession() IF USED(THIS.designatedDriver) GO BOTTOM IN (THIS.designatedDriver) ENDIF SET DATASESSION TO (m.liSession) ENDIF DODEFAULT() IF SYS(2024) = "Y" OR THIS.IsSuccessor THIS.ThermForm = NULL IF (THIS.pageLimit = -1 OR THIS.PageNo <= THIS.pageLimit) THIS.DoMessage(OUTPUTCLASS_REPORT_INCOMPLETE_LOC, ; MB_ICONEXCLAMATION) THIS.lastErrorMessage = OUTPUTCLASS_REPORT_INCOMPLETE_LOC ENDIF ENDIF NODEFAULT ENDIF ENDPROC PROCEDURE pushglobalsets DODEFAULT() IF (NOT INLIST(_VFP.StartMode,2,3,5)) PUSH KEY CLEAR LOCAL m.lcRef SET MESSAGE TO "" THIS.SetNotifyCursor = (SET("Notify",2) = "ON") IF THIS.SetNotifyCursor SET NOTIFY CURSOR OFF ENDIF THIS.OnEscapeCommand = ON("ESCAPE") m.lcRef = SYS(2015) PUBLIC &lcRef. STORE THIS TO (m.lcRef) ON ESCAPE &lcRef..CancelReport() THIS.EscapeReference = m.lcRef THIS.SetEscape = (SET("ESCAPE")="OFF") IF THIS.SetEscape SET ESCAPE ON ENDIF ENDIF ENDPROC PROCEDURE popglobalsets DODEFAULT() IF (NOT INLIST(_VFP.StartMode,2,3,5)) LOCAL m.lcRef m.lcRef = THIS.EscapeReference IF (NOT EMPTY(m.lcRef)) AND ; TYPE(m.lcRef) = "O" * push occurred earlier STORE NULL TO (m.lcRef) RELEASE &lcRef. THIS.escapeReference = "" m.lcRef = THIS.OnEscapeCommand ON ESCAPE &lcRef POP KEY IF THIS.SetNotifyCursor SET NOTIFY CURSOR ON ENDIF IF THIS.SetEscape SET ESCAPE OFF ENDIF ENDIF ENDIF ENDPROC PROCEDURE getfrxstartupinfo DODEFAULT() LOCAL m.llFRXAvailable, m.lcAlias m.llFRXAvailable = THIS.getReportScopeDriver() IF m.llFRXAvailable THIS.SetFRXDataSession() THIS.FRXBandRecno = 0 SELECT FRX IF THIS.CommandClauses.Summary * don't use groups unless * we're forced to by Summary. * Group usage will not work if * there's a group on .T. or some * other nonsensical expression that * doesn't change. LOCATE FOR ObjType = FRX_OBJTYP_BAND AND ; Objcode = FRX_OBJCOD_GROUPHEADER AND ; Platform = FRX_PLATFORM_WINDOWS AND ; NOT DELETED() DO WHILE NOT EOF() * find the innermost group THIS.FRXBandRecno = RECNO() CONTINUE ENDDO IF THIS.frxBandRecno = 0 * no groups in a Summary report * doesn't make a lot of sense, but * can happen. LOCATE FOR ObjType = FRX_OBJTYP_BAND AND ; Objcode = FRX_OBJCOD_PAGEHEADER AND ; Platform = FRX_PLATFORM_WINDOWS AND ; NOT DELETED() IF NOT EOF() THIS.FRXBandRecno = RECNO() ENDIF ENDIF ENDIF IF THIS.FRXBandRecno = 0 * not a Summary report. * look for the appropriate detail * using the report driver LOCATE FOR ObjType = FRX_OBJTYP_BAND AND ; Objcode = FRX_OBJCOD_DETAIL AND ; Platform = FRX_PLATFORM_WINDOWS AND ; TYPE(Expr) = "C" AND ; NOT (EMPTY(Expr) OR DELETED()) DO WHILE NOT EOF() m.lcAlias = ALLTRIM(Expr) THIS.SetCurrentDataSession() m.lcAlias = UPPER(EVALUATE(m.lcAlias)) THIS.SetFRXDataSession() IF m.lcAlias == UPPER(THIS.DrivingAlias) THIS.FRXBandRecno = RECNO() ENDIF CONTINUE && try not to use the first detail band ENDDO ENDIF IF THIS.frxBandRecno = 0 * couldn't match up a band with * the known driver LOCATE FOR ObjType = FRX_OBJTYP_BAND AND ; Objcode = FRX_OBJCOD_DETAIL AND ; Platform = FRX_PLATFORM_WINDOWS AND ; EMPTY(Expr) AND NOT DELETED() IF NOT EOF() THIS.FRXBandRecno = RECNO() ELSE IF THIS.FRXBandRecno = 0 LOCATE FOR ObjType = FRX_OBJTYP_BAND AND ; Platform = FRX_PLATFORM_WINDOWS AND ; Objcode = FRX_OBJCOD_DETAIL AND ; NOT DELETED() IF NOT EOF() THIS.FRXBandRecno = RECNO() ENDIF ENDIF ENDIF ENDIF ENDIF THIS.setCurrentDataSession() ENDPROC PROCEDURE UpdateStatus NODEFAULT * the THIS.IsRunning check here * make sure that this code doesn't * run if the Engine calls UpdateStatus * after we're through IF THIS.isRunning LOCAL m.liRecTotal, m.lnNewPercent, m.llShow m.liRecTotal = THIS.CommandClauses.RecordTotal IF m.liRecTotal > 0 m.lnNewPercent = ROUND(THIS.CurrentRecord/m.liRecTotal,(THIS.ThermPrecision + 2) ) * 100 IF (THIS.PercentDone # m.lnNewPercent) THIS.PercentDone = m.lnNewPercent m.llShow = .T. #IF OUTPUTCLASS_DEBUGGING ? THIS.PercentDone, THIS.CurrentRecord, m.liRecTotal, THIS.PageTotal ? REPL(OUTPUTCLASS_STATUSCHAR_PCT_DONE,INT(THIS.PercentDone/100* OUTPUTCLASS_ONE_HUNDRED_PCT_MARK))+ ; REPL(OUTPUTCLASS_STATUSCHAR_PCT_NOT_DONE,MAX(FLOOR(OUTPUTCLASS_ONE_HUNDRED_PCT_MARK - ; (OUTPUTCLASS_ONE_HUNDRED_PCT_MARK *THIS.PercentDone/100)),0) ) #ENDIF ENDIF ELSE m.llShow = .T. ENDIF IF m.llShow THIS.DoStatus( IIF(THIS.CurrentPass = LISTENER_PREPASS AND THIS.TwoPassProcess,; THIS.PrepassStatusText, ; THIS.RunStatusText) ) ENDIF ENDIF ENDPROC PROCEDURE LoadReport IF DODEFAULT() THIS.ResetUserFeedback(.T.) IF NOT (THIS.QuietMode OR ; (TYPE("THIS.CommandClauses.NoDialog") = "L" AND ; THIS.CommandClauses.NoDialog) ) THIS.DoStatus(THIS.initStatusText) * NB: a user can call LoadReport manually, * hence the need for a TYPE() check here. ENDIF THIS.PushGlobalSets() THIS.ClearStatus() RETURN .F. ENDIF ENDPROC PROCEDURE AfterBand LPARAMETERS m.nBandObjCode, m.nFRXRecNo DODEFAULT(m.nBandObjCode, m.nFRXRecNo) THIS.synchStatus(m.nBandObjCode,m.nFRXRecNo) THIS.resetDataSession() ENDPROC PROCEDURE Destroy STORE NULL TO THIS.thermForm DODEFAULT() ENDPROC PROCEDURE readconfiguration_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "N" AND NOT THIS.IsRunning THIS.ReadConfiguration = m.vNewVal ENDIF ENDPROC PROCEDURE setconfiguration LPARAMETERS m.tlCalledFromInit IF NOT THIS.IsRunning * do some config work, don't change sessions -- * at this point we don't have our private session * if we're being called in the Init LOCAL m.liSelect, m.lcPEM, m.llOpened, m.lcOrder, m.liType, m.llQuiet m.liSelect = SELECT(0) IF NOT USED("OutputConfig") * if called from Init, * do this in quietmode * because the caller has no * opportunity to * turn off the message m.llQuiet = (m.tlCalledFromInit AND NOT THIS.QuietMode) IF m.llQuiet THIS.QuietMode = .T. ENDIF THIS.GetConfigTable() IF m.llQuiet THIS.QuietMode = .F. ENDIF * CChalom * Sometimes users erase one of the Configuration table files, like the CDX, FPT or DBF * So let's check if it's safe IF FILE(THIS.ConfigurationTable) AND ; FILE(FORCEEXT(THIS.ConfigurationTable, "CDX")) AND ; FILE(FORCEEXT(THIS.ConfigurationTable, "FPT")) USE (THIS.ConfigurationTable) ALIAS "OutputConfig" IN 0 AGAIN NOUPDATE SHARED m.llOpened = .T. ELSE m.llOpened = .F. ENDIF ELSE m.lcOrder = ORDER("OutputConfig") SET ORDER TO ObjCode ENDIF IF (NOT THIS.HadError) AND THIS.VerifyConfigTable("OutputConfig") SELECT OutputConfig m.liType = THIS.ConfigurationObjtype SCAN FOR ObjType = m.liType AND ; NOT(DELETED() OR ; ObjName == "" OR ; ObjValue =="" ) IF PEMSTATUS(THIS,ObjName,5) m.lcPEM = UPPER(PEMSTATUS(THIS,ObjName,3)) DO CASE CASE lcPEM == "PROPERTY" STORE EVAL(ObjValue) TO ("THIS."+ObjName) CASE INLIST("|"+lcPEM+"|","|METHOD|","|EVENT|") EVAL("THIS."+ObjName+"("+ObjValue+")") OTHERWISE ENDCASE ENDIF ENDSCAN IF m.llOpened USE IN OutputConfig ELSE SET ORDER TO (m.lcOrder) IN OutputConfig ENDIF ENDIF SELECT (m.liSelect) ENDIF ENDPROC PROCEDURE getconfigtable LPARAMETERS m.tlForceExternal LOCAL m.lcDBF, m.lcPath m.lcDBF = "" IF m.tlForceExternal OR (NOT EMPTY(SYS(2000,FULLPATH(FORCEEXT(OUTPUTCLASS_EXTERNALDBF,"DBF"))))) m.lcDBF = FULLPATH(FORCEEXT(OUTPUTCLASS_EXTERNALDBF,"DBF")) m.lcDBF = FORCEEXT(OUTPUTCLASS_INTERNALDBF,"DBF") ENDIF * CChalom * Sometimes users erase one of the COnfiguration table files, like the CDX, FPT or DBF * So let's check if it's safe LOCAL llIsDBF llIsDBF = FILE(m.lcDBF) AND ; FILE(FORCEEXT(m.lcDBF, "CDX")) AND ; FILE(FORCEEXT(m.lcDBF, "FPT")) IF NOT llIsDBF && One or more files are missing, so it's safer to delete them all TRY DELETE FILE (m.lcDBF) CATCH ENDTRY TRY DELETE FILE (FORCEEXT(m.lcDBF, "CDX")) CATCH ENDTRY TRY DELETE FILE (FORCEEXT(m.lcDBF, "FPT")) CATCH ENDTRY ENDIF * IF NOT (FILE(m.lcDBF) OR THIS.IsRunning) IF NOT (llIsDBF OR THIS.IsRunning) m.lcPath = THIS.GetPathForExternals() * this may be the internal *or* external dbf name; * we could be testing and not yet built into an app, * so accept either, before the next test: m.lcDBF = FORCEPATH(m.lcDBF,m.lcPath) IF NOT FILE(m.lcDBF) * now force to the external name: m.lcDBF = FORCEEXT(FORCEPATH(OUTPUTCLASS_EXTERNALDBF,m.lcPath),"DBF") * now check again IF NOT FILE(m.lcDBF) THIS.CreateConfigTable(m.lcDBF) IF FILE(m.lcDBF) THIS.DoMessage(OUTPUTCLASS_CONFIGTABLECREATED_LOC) ENDIF ENDIF ENDIF ENDIF IF NOT FILE(m.lcDBF) m.lcDBF = "" ENDIF THIS.ConfigurationTable = m.lcDBF RETURN m.lcDBF ENDPROC PROCEDURE createconfigtable LPARAMETERS m.tcDBF, m.tlOverWrite LOCAL m.liSelect, m.lcFile m.lcFile = FORCEEXT(m.tcDBF,"DBF") IF (NOT EMPTY(SYS(2000,m.lcFile))) AND m.tlOverWrite ERASE (m.lcFile) RECYCLE ERASE (FORCEEXT(m.lcFile,"FPT")) RECYCLE ERASE (FORCEEXT(m.lcFile,"CDX")) RECYCLE ENDIF m.liSelect = SELECT(0) SELECT 0 CREATE TABLE (m.lcFile) FREE ; (objtype i, ; objcode i, ; objname v(60), ; objvalue v(60), ; objinfo m) IF NOT EMPTY(ALIAS()) && can happen if SAFETY ON and they decide not to overwrite INDEX ON Objtype TAG ObjType INDEX ON ObjCode TAG ObjCode INDEX ON ObjName TAG ObjName INDEX ON ObjValue TAG ObjValue INDEX ON DELETED() TAG OnDeleted INSERT INTO (ALIAS()) VALUES ; (OUTPUTCLASS_OBJTYPE_CONFIG,0,'DoMessage','"Welcome to the demo run!",64','Sample initialization/config method call') DELETE NEXT 1 INSERT INTO (ALIAS()) VALUES ; (OUTPUTCLASS_OBJTYPE_CONFIG,0,'TargetFileName','"xxx"','Sample initialization/config property') DELETE NEXT 1 USE ENDIF SELECT (m.liSelect) ENDPROC PROCEDURE opentargetfile THIS.VerifyTargetFile() THIS.TargetHandle = FCREATE(THIS.TargetFileName) IF THIS.TargetHandle < 0 OR THIS.HadError THIS.HadError = .T. THIS.DoMessage(OUTPUTCLASS_NOFILECREATE_LOC,MB_ICONSTOP ) THIS.lastErrorMessage = OUTPUTCLASS_NOFILECREATE_LOC ENDIF RETURN (NOT THIS.HadError) ENDPROC PROCEDURE verifytargetfile LOCAL m.lcFile m.lcFile = ALLTR(CHRTRAN(CHRTRAN(THIS.TargetFileName,; OUTPUTCLASS_FILENAME_CHARS_DISALLOWED,"_"),"/","\")) * embracing chrtran for slashes is necessary because of FULLPATH behavior. IF NOT DIRECTORY(JUSTPATH(m.lcFile)) m.lcFile = FULLPATH(ALLTR(m.lcFile)) ENDIF IF DIRECTORY(m.lcFile) * we have to generate a filename m.lcFile = FORCEPATH(SYS(2015), m.lcFile) ENDIF THIS.TargetFileName = m.lcFile IF JUSTEXT(THIS.TargetFileName) == "" AND ; RIGHT(THIS.TargetFileName,1) # "." THIS.TargetFileExt = CHRTRAN(THIS.TargetFileExt,; OUTPUTCLASS_FILENAME_CHARS_DISALLOWED,"_") THIS.TargetFileName = FORCEEXT(THIS.TargetFileName, ; THIS.TargetFileExt) ENDIF IF NOT EMPTY(SYS(2000,THIS.TargetFileName)) ERASE (THIS.TargetFileName) NORECYCLE ENDIF ENDPROC PROCEDURE targetfileext_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "C" AND NOT THIS.IsRunning THIS.targetfileext = m.vNewVal ENDIF ENDPROC PROCEDURE targetfilename_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "C" AND NOT THIS.IsRunning THIS.targetfilename = m.vNewVal ENDIF ENDPROC PROCEDURE targethandle_assign LPARAMETERS m.vNewVal * Readonly during report run IF VARTYPE(m.vNewVal) = "N" AND NOT THIS.IsRunning THIS.targethandle = m.vNewVal ENDIF ENDPROC PROCEDURE closetargetfile LOCAL laDummy[1] IF THIS.TargetHandle > -1 =FCLOSE(THIS.TargetHandle) THIS.TargetHandle = -1 IF ADIR(laDummy,THIS.TargetFileName) = 1 AND ; laDummy[1,2] > 0 * NB: have to check this as well as * error because some COM errors may not * end up in THIS.HadError. * if continuation, update status rather than * modal message IF THIS.HadError THIS.DoMessage(OUTPUTCLASS_CREATEERRORS_LOC,MB_ICONEXCLAMATION ) THIS.lastErrorMessage = OUTPUTCLASS_CREATEERRORS_LOC ELSE *IF THIS.DoMessage( OUTPUTCLASS_SUCCESS_LOC + ; IIF(SYS(2024)="Y",CHR(13)+OUTPUTCLASS_REPORT_INCOMPLETE_LOC,""),; MB_ICONINFORMATION + MB_YESNO ) = IDYES * _CLIPTEXT = THIS.TargetFileName * ENDIF ENDIF ELSE THIS.DoMessage(OUTPUTCLASS_NOCREATE_LOC,MB_ICONSTOP ) THIS.lastErrorMessage = OUTPUTCLASS_NOCREATE_LOC ENDIF ENDIF ENDPROC PROCEDURE verifyconfigtable LPARAMETERS m.tcAlias, m.tcFailureMsgTable, m.tcFailureMsgIndexes IF EMPTY(m.tcAlias) OR VARTYPE(m.tcAlias) # "C" RETURN .F. ENDIF LOCAL m.lcTable, m.lcMessage, m.lcAlias, m.liSelect, ; m.llReturn, m.liTagCount, laRequired[1], laKeys[1], ; m.liFound, m.llExactOff, m.llSafetyOn m.llReturn = ; TYPE(m.tcAlias+".OBJTYPE") = "N" AND ; TYPE(m.tcAlias+".OBJCODE") = "N" AND ; TYPE(m.tcAlias+".OBJNAME") = "C" AND ; TYPE(m.tcAlias+".OBJVALUE") = "C" AND ; TYPE(m.tcAlias+".OBJINFO") = "M" * additional fields may be included and order * is not significant IF NOT m.llReturn m.lcMessage = IIF(EMPTY(m.tcFailureMsgTable),; OUTPUTCLASS_CONFIGTABLEWRONG_LOC, ; m.tcFailureMsgTable) + ; CHR(13)+CHR(13)+ ; DBF(m.tcAlias) ENDIF IF m.llReturn IF (SET("EXACT") = "OFF") SET EXACT ON m.llExactOff = .T. ENDIF m.liSelect = SELECT(0) SELECT (m.tcAlias) * check for required keys... DIME laRequired[5] laRequired[1] = "OBJTYPE" laRequired[2] = "OBJCODE" laRequired[3] = "OBJNAME" laRequired[4] = "OBJVALUE" laRequired[5] = "DELETED()" IF TAGCOUNT() > 0 DIME laKeys[TAGCOUNT()] FOR m.liTagCount = 1 TO TAGCOUNT() laKeys[m.liTagCount] = UPPER(KEY(m.liTagCount)) ENDFOR FOR m.liTagCount = 1 TO ALEN(laRequired) m.liFound = ASCAN(laKeys,UPPER(laRequired[m.liTagCount])) IF m.liFound = 0 m.llReturn = .F. EXIT ENDIF ENDFOR ELSE m.llReturn = .F. ENDIF IF NOT m.llReturn m.llSafetyOn = (SET("SAFETY") = "ON") SET SAFETY OFF TRY USE (DBF(m.tcAlias)) EXCLU ALIAS (m.tcAlias) INDEX ON Objtype TAG ObjType INDEX ON ObjCode TAG ObjCode INDEX ON ObjName TAG ObjName INDEX ON ObjValue TAG ObjValue INDEX ON DELETED() TAG OnDeleted m.llReturn = .T. CATCH ENDTRY IF m.llSafetyOn SET SAFETY ON ENDIF IF m.llReturn DIME laKeys[TAGCOUNT()] FOR m.liTagCount = 1 TO TAGCOUNT() laKeys[m.liTagCount] = UPPER(KEY(m.liTagCount)) ENDFOR FOR m.liTagCount = 1 TO ALEN(laRequired) m.liFound = ASCAN(laKeys,UPPER(laRequired[m.liTagCount])) IF m.liFound = 0 m.llReturn = .F. EXIT ENDIF ENDFOR ENDIF USE (DBF(m.tcAlias)) SHARED ALIAS (m.tcAlias) ENDIF IF NOT m.llReturn m.lcMessage = IIF(EMPTY(m.tcFailureMsgIndexes),; OUTPUTCLASS_CONFIGINDEXMISSING_LOC, ; m.tcFailureMsgTable) + CHR(13) FOR m.liTagCount = 1 TO ALEN(laRequired) m.lcMessage = m.lcMessage + CHR(13) + ; laRequired[m.liTagCount] ENDFOR ENDIF IF m.llExactOff SET EXACT OFF ENDIF SELECT (m.liSelect) ENDIF IF NOT(m.llReturn) THIS.DoMessage(m.lcMessage,MB_ICONSTOP ) THIS.lastErrorMessage = m.lcMessage ENDIF RETURN m.llReturn ENDPROC PROCEDURE configurationobjtype_access * readonly property RETURN OUTPUTCLASS_OBJTYPE_CONFIG ENDPROC PROCEDURE externalfilelocation_assign LPARAMETERS m.vNewVal IF THIS.isRunning AND NOT EMPTY(THIS.externalFileLocation) RETURN ENDIF IF VARTYPE(m.vNewVal) = "C" THIS.externalFileLocation = ALLTRIM(m.vNewVal) IF NOT EMPTY(THIS.externalFileLocation) THIS.externalFileLocation = ADDBS(THIS.externalFileLocation) ENDIF ENDIF ENDPROC PROCEDURE pageimagetype_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "N" AND ; (m.vNewVal = 0 OR ; INLIST(m.vNewVal,; LISTENER_DEVICE_TYPE_EMF,; LISTENER_DEVICE_TYPE_TIF,; LISTENER_DEVICE_TYPE_JPG,; LISTENER_DEVICE_TYPE_GIF,; LISTENER_DEVICE_TYPE_PNG,; LISTENER_DEVICE_TYPE_BMP,; LISTENER_DEVICE_TYPE_MTIF)) THIS.pageImageType = m.vNewVal THIS.pageImageExtension = THIS.getPageImageExtension() ENDIF ENDPROC PROCEDURE getpageimageextension LOCAL lcExt m.lcExt = "" DO CASE CASE INLIST(THIS.pageImageType,; LISTENER_DEVICE_TYPE_TIF,; LISTENER_DEVICE_TYPE_MTIF) m.lcExt = "TIF" CASE THIS.pageImageType = LISTENER_DEVICE_TYPE_JPG m.lcExt = "JPG" CASE THIS.pageImageType = LISTENER_DEVICE_TYPE_GIF m.lcExt = "GIF" CASE THIS.pageImageType = LISTENER_DEVICE_TYPE_PNG m.lcExt = "PNG" CASE THIS.pageImageType = LISTENER_DEVICE_TYPE_BMP m.lcExt = "BMP" ENDCASE RETURN m.lcExt ENDPROC PROCEDURE generatepageimagefilename LPARAMETERS m.tiPage, m.tlFullPath LOCAL lcFileName m.lcFileName = FORCEEXT(JUSTSTEM(THIS.targetFileName) + ; "_" + ; PADL(TRANSFORM(m.tiPage),; OUTPUTFILE_MAX_FILEPLACES ,"0"), ; THIS.pageImageExtension) IF m.tlFullPath RETURN FULLPATH(FORCEPATH( m.lcFileName,THIS.ExternalFileLocation),; ADDBS(JUSTPATH(THIS.TargetFileName))) RETURN FORCEPATH(m.lcFileName,THIS.externalFileLocation) ENDIF ENDPROC PROCEDURE supportspageimages LPARAMETERS tcMethodToken DO CASE CASE THIS.isSuccessor OR EMPTY(THIS.pageImageType) RETURN .F. CASE EMPTY(m.tcMethodToken) RETURN THIS.ListenerType # LISTENER_TYPE_DEF * this indicates the set we are supporting in total CASE m.tcMethodToken = "OUTPUTPAGE" RETURN INLIST(THIS.ListenerType,LISTENER_TYPE_PRN,LISTENER_TYPE_PAGED) CASE INLIST(m.tcMethodToken,"AFTERREPORT","UNLOADREPORT") RETURN INLIST(THIS.ListenerType,LISTENER_TYPE_PRV,LISTENER_TYPE_ALLPGS) ENDCASE ENDPROC PROCEDURE outputpageimage LPARAMETERS m.tiPage LOCAL m.lcFile, m.llError IF THIS.pageImageType = LISTENER_DEVICE_TYPE_MTIF m.lcFile = THIS.generatePageImageFilename(1, .T.) IF m.tiPage = 1 IF NOT EMPTY(SYS(2000,m.lcFile)) ERASE (m.lcFile) NORECYCLE ENDIF THIS.OutputPage(m.tiPage,m.lcFile,LISTENER_DEVICE_TYPE_TIF ) ELSE THIS.OutputPage(m.tiPage,m.lcFile,LISTENER_DEVICE_TYPE_MTIF ) ENDIF ELSE m.lcFile = THIS.generatePageImageFilename(m.tiPage, .T.) IF NOT EMPTY(SYS(2000,m.lcFile)) ERASE (m.lcFile) NORECYCLE ENDIF THIS.OutputPage(m.tiPage,m.lcFile,THIS.pageImageType) ENDIF CATCH WHEN .T. m.llError = .T. ENDTRY RETURN (NOT m.llError) ENDPROC PROCEDURE currentpageimagefilename_assign LPARAMETERS m.tvNewVal IF VARTYPE(m.tvNewVal) # "C" THIS.currentPageImageFilename = "" THIS.currentPageImageFilename = m.tvNewVal ENDIF ENDPROC PROCEDURE makeexternalfilelocationreachable IF EMPTY(THIS.externalFileLocation) THIS.externalFileLocation = "." ENDIF IF NOT DIRECTORY(FULLPATH(THIS.ExternalFileLocation,ADDBS(JUSTPATH(THIS.TargetFileName)))) TRY MD (FULLPATH(THIS.ExternalFileLocation,ADDBS(JUSTPATH(THIS.TargetFileName)))) CATCH LOCAL m.llRunning m.llRunning = THIS.isRunning THIS.isRunning = .F. THIS.externalFileLocation = "." THIS.isRunning = m.llRunning ENDTRY ENDIF ENDPROC PROCEDURE BeforeBand LPARAMETERS m.nBandObjCode, m.nFRXRecNo IF (m.nBandObjCode = FRX_OBJCOD_PAGEHEADER OR ; m.nBandObjCode = FRX_OBJCOD_TITLE) AND ; THIS.supportsPageImages() * Note: this assignment does not occur in * OutputPageImage, because we don't know * what listener mode (PRN vs cached) we're in. * The point of this property is to make the value * available either way, as it will eventually be * used by OutputPageImage no matter when that occurs, * during the run of the report. LOCAL lcFile, liPageNo m.lcFile = "" DO CASE CASE THIS.pageImageType = LISTENER_DEVICE_TYPE_MTIF m.liPageNo = 1 CASE THIS.CommandClauses.RangeFrom < 2 IF THIS.isSuccessor m.liPageNo = THIS.sharedPageNo ELSE m.liPageNo = THIS.PageNo ENDIF OTHERWISE IF THIS.isSuccessor m.liPageNo = (THIS.sharedPageNo - THIS.CommandClauses.RangeFrom) + 1 ELSE m.liPageNo = (THIS.PageNo - THIS.CommandClauses.RangeFrom) + 1 ENDIF ENDCASE m.lcFile = THIS.generatePageImageFileName(m.liPageNo) THIS.currentPageImageFilename = m.lcFile IF NOT ISNULL(THIS.successor) THIS.successor.currentPageImageFilename = m.lcFile ENDIF ENDIF IF THIS.sharedPageNo = 1 AND ; m.nBandObjCode = FRX_OBJCOD_PAGEHEADER AND ; (NOT EMPTY(THIS.pageImageType)) AND ; (EMPTY(THIS.currentPageImageFilename)) AND ; ((NOT THIS.TwoPassProcess) OR THIS.CurrentPass = LISTENER_FULLPASS) THIS.DoMessage(OUTPUTFILE_NOIMAGEFILES_LOC,MB_ICONEXCLAMATION) ENDIF DODEFAULT(m.nBandObjCode, m.nFRXRecNo) ENDPROC PROCEDURE BeforeReport THIS.currentPageImageFilename ="" IF (NOT EMPTY(THIS.pageImageType)) AND ; (NOT THIS.supportsPageImages()) IF (NOT THIS.isSuccessor) THIS.ListenerType = LISTENER_TYPE_PAGED ENDIF ENDIF IF THIS.supportsPageImages() THIS.makeExternalFileLocationReachable() ENDIF IF NOT ISNULL(THIS.successor) THIS.successor.AddProperty("currentPageImageFilename","") ENDIF DODEFAULT() IF INLIST(THIS.ReadConfiguration,; OUTPUTCLASS_READCONFIG_REPORT,; OUTPUTCLASS_READCONFIG_BOTH) THIS.SetConfiguration() ENDIF THIS.resetDataSession() ENDPROC PROCEDURE setfrxdatasessionenvironment DODEFAULT() SET DELETED ON SET EXCLUSIVE OFF SET TALK OFF ENDPROC PROCEDURE Destroy THIS.CloseTargetFile() DODEFAULT() ENDPROC PROCEDURE Init IF DODEFAULT() * NB: this one doesn't necessarily need its * own AppName LOC'd value, because * it is basically an abstract layer * and should not be instantiated directly. * Doesn't hurt, though. THIS.appName = OUTPUTFILE_APPNAME_LOC IF INLIST(THIS.ReadConfiguration,; OUTPUTCLASS_READCONFIG_INIT,; OUTPUTCLASS_READCONFIG_BOTH) THIS.SetConfiguration(.T.) ENDIF RETURN .F. ENDIF RETURN NOT THIS.HadError ENDPROC PROCEDURE AfterReport DODEFAULT() IF (NOT THIS.CommandClauses.NOPAGEEJECT) AND ; THIS.supportsPageImages("AFTERREPORT") LOCAL m.lcFileLocation, m.liPage, m.lcFile m.lcFileLocation = THIS.ExternalFileLocation THIS.makeExternalFileLocationReachable() FOR m.liPage = 1 TO THIS.OutputPageCount IF NOT THIS.outputPageImage(m.liPage) EXIT ENDIF NEXT THIS.externalFileLocation = m.lcFileLocation ENDIF ENDPROC PROCEDURE OutputPage LPARAMETERS nPageNo, eDevice, nDeviceType, nLeft, nTop, nWidth, nHeight, nClipLeft, nClipTop, nClipWidth, nClipHeight IF THIS.supportsPageImages("OUTPUTPAGE") IF m.nDeviceType < 100 * ascertain that this is the native call; have to make * sure it's not recursive... THIS.OutputPageImage(m.nPageNo) ENDIF IF m.nDeviceType > 99 DODEFAULT(nPageNo, eDevice, nDeviceType) ENDIF ENDIF ENDPROC PROCEDURE createhelperobjects LPARAMETERS m.tlCalledFromBeforeReport * see note in CheckCollectionMembers method about parameter, which * is not used here but could provide significant information to * subclasses * NB this method creates only required helpers, not optional FX objects * which is handled in CheckCollectionMembers EXTERNAL CLASS _GDIPLUS.VCX LOCAL liSession m.liSession = SET("DATASESSION") THIS.resetDataSession() THIS.ensureCollection() THIS.ensureCollection(.T.) SET DATASESSION TO (m.liSession) IF VARTYPE(THIS.FFCGraphics) # "O" AND THIS.GFXs.Count > 0 THIS.FFCGraphics =; THIS.getObjectInstance("GpGraphics","_GDIPlus.VCX","", .T.,"GP", .T.) IF NOT ISNULL(THIS.FFCGraphics) THIS.FFCGraphics.QuietOnError = THIS.QuietMode ENDIF ENDIF ENDPROC PROCEDURE needgfxs LPARAMETERS m.tcProgram,; m.tP1, m.tP2, m.tP3, m.tP4, m.tP5, m.tP6, ; m.tP7, m.tP8, m.tP8, m.tP10, m.tP11, m.tP12 * hook * a subclass could evaluate conditions, * such as whether any objects have custom properties * requiring GFX activity. RETURN .T. ENDPROC PROCEDURE sendfx LPARAMETERS m.tcProgram, ; m.tP1, m.tP2, m.tP3, m.tP4, m.tP5, ; m.tP6, m.tP7, m.tP8, m.tP9, m.tP10, ; m.tP11, m.tP12) LOCAL m.loFX, m.liRenderBehavior, m.liTemp, m.lcMethodToken m.liRenderBehavior = OUTPUTFX_DEFAULT_RENDER_BEHAVIOR IF THIS.IsSuccessor * Only the lead does this work. RETURN m.liRenderBehavior ENDIF m.lcMethodToken = THIS.upperMethodName(m.tcProgram) IF VARTYPE(THIS.FXs) = "O" AND THIS.FXs.Count > 0 * The order of the * invocation of this method, * which precedes the DODEFAULT() * in each event, * makes the results available * for all Successors. FOR EACH m.loFX IN THIS.FXs FOXOBJECT IF VARTYPE(m.loFX) = "O" && contract API is checked in LoadReport and BeforeReport && but the object could release itself midway through a run THIS.setCurrentDataSession() m.loFX.ApplyFX(THIS,m.lcMethodToken, ; @tP1, @tP2, @tP3, @tP4, @tP5, @tP6, ; @tP7, @tP8, @tP9, @tP10, @tP11, @tP12) ENDIF NEXT ENDIF IF VARTYPE(THIS.GFXs) = "O" AND THIS.GFXs.Count > 0 AND ; THIS.NeedGFXs(m.lcMethodToken,; m.tP1, m.tP2, m.tP3, m.tP4, m.tP5, ; m.tP6, m.tP7, m.tP8, m.tP9, m.tP10, ; m.tP11, m.tP12) FOR EACH m.loFX IN THIS.GFXs FOXOBJECT IF VARTYPE(m.loFX) = "O" && contract API is checked in LoadReport and BeforeReport && but the object could release itself midway through a run THIS.setCurrentDataSession() m.liTemp = INT(VAL(TRANSFORM(m.loFX.ApplyFX(THIS, m.lcMethodToken, ; @tP1, @tP2, @tP3, @tP4, @tP5, @tP6, ; @tP7, @tP8, @tP9, @tP10, @tP11, @tP12)))) IF m.liTemp > m.liRenderBehavior && behavior is cumulative m.liRenderBehavior = INT(m.liTemp) ENDIF ENDIF NEXT ENDIF RETURN m.liRenderBehavior && this value only affects calls during Render method ENDPROC PROCEDURE checkcollectionmembers LPARAMETERS m.tlCalledFromBeforeReport * NB: use of this argument and * no distinction made between calls from * BeforeReport and LoadReport at this level, * this distinction is made available for subclasses * that might not have all materials prepared for * creation of required collection members during Load. LOCAL m.liIndex, m.loX, m.loXs as Collection THIS.getFeedbackFXObject() THIS.getMemberDataScriptFXObject() THIS.getRotateGFXObject() THIS.getNoRenderGFXObject() m.loXs = THIS.FXs FOR m.liIndex = 1 TO THIS.FXs.Count m.loX = loXs.Item(m.liIndex) IF VARTYPE(m.loX) # "O" OR ; (NOT PEMSTATUS(m.loX,"ApplyFX",5)) loXs.Remove(m.liIndex) ENDIF m.loXs = THIS.GFXs FOR m.liIndex = 1 TO THIS.GFXs.Count m.loX = loXs.Item(liIndex) IF VARTYPE(m.loX) # "O" OR ; (NOT PEMSTATUS(m.loX,"ApplyFX",5)) loXs.Remove(m.liIndex) ENDIF STORE NULL TO m.loX, m.loXs ENDPROC PROCEDURE uppermethodname LPARAMETERS m.tcProgram LOCAL m.lcProgram m.lcProgram = UPPER(TRANSFORM(m.tcProgram)) RETURN SUBSTR(m.lcProgram,RAT(".",m.lcProgram) + 1) ENDPROC PROCEDURE cancelrequested_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "L" THIS.cancelRequested = m.vNewVal ENDIF ENDPROC PROCEDURE fxfeedbackclass_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "C" AND NOT EMPTY(m.vNewVal) THIS.fxFeedbackClass = m.vNewVal ENDIF ENDPROC PROCEDURE fxfeedbackclasslib_assign LPARAMETERS vNewVal IF VARTYPE(m.vNewVal) = "C" AND NOT EMPTY(m.vNewVal) THIS.fxFeedbackClassLib = m.vNewVal ENDIF ENDPROC PROCEDURE fxfeedbackmodule_assign LPARAMETERS vNewVal IF VARTYPE(m.vNewVal) = "C" THIS.fxFeedbackModule = m.vNewVal ENDIF ENDPROC PROCEDURE getfeedbackfxobject LPARAMETERS m.tlQuiet IF (NOT THIS.QuietMode) AND ; (NOT THIS.isSuccessor) AND ; (TYPE("THIS.CommandClauses.NoDialog") # "L" OR ; (NOT THIS.CommandClauses.NoDialog)) THIS.addCollectionMember(; THIS.fxFeedbackClass,; THIS.fxFeedbackClassLib,; THIS.fxFeedbackModule, .T.) IF NOT THIS.checkCollectionForSpecifiedMember(; THIS.fxFeedbackClass,; THIS.fxFeedbackClassLib) IF _VFP.StartMode = 0 AND NOT m.tlQuiet * THIS.DoMessage(OUTPUTFX_USERFEEDBACK_UNAVAILABLE_LOC,MB_ICONEXCLAMATION) ENDIF THIS.QuietMode = .T. ENDIF ENDIF ENDPROC PROCEDURE classpath_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "C" AND ; DIRECTORY(m.vNewVal) IF NOT EMPTY(m.vNewVal) m.vNewVal = ADDBS(m.vNewVal) ENDIF THIS.classPath = m.vNewVal THIS.ResetToDefault("classPath") ENDIF ENDPROC PROCEDURE getobjectinstance LPARAMETERS m.tcClass, m.tcClassLib, m.tcModule, ; m.tlAssignUniqueNameToObject, ; m.tcNamePrefix, m.tlMandatoryObject IF VARTYPE(m.tcClass) # "C" OR EMPTY(m.tcClass) IF m.tlMandatoryObject THIS.DoMessage(OUTPUTFX_REQUIREDOBJECTDEF_MISSING_LOC,MB_ICONEXCLAMATION) ENDIF RETURN NULL ENDIF LOCAL m.loX,m.lcForceVCX, m.lcForceFXP, m.lcUseThisLib, m.lcExternalsPath, m.liSession liSession = SET("DATASESSION") THIS.ResetDataSession() m.lcForceVCX = FORCEEXT(m.tcClassLib,"VCX") m.lcForceFXP = STRTRAN(m.tcClassLib,".PRG",".FXP") m.lcExternalsPath = THIS.getPathForExternals() m.loX = NULL DO CASE CASE FILE(m.tcClassLib) OR ; FILE(m.lcForceVCX) OR ; ATC(FULLPATH(m.lcForceVCX) + " ALIAS ",SET("CLASSLIB")) > 0 OR ; ATC("\" + JUSTFNAME(m.lcForceVCX) + " ALIAS ",SET("CLASSLIB")) > 0 OR ; ATC(m.tcClassLib,SET("PROCEDURE")) > 0 OR ; ATC(m.lcForceFXP,SET("PROCEDURE")) > 0 m.lcUseThisLib = m.tcClassLib CASE FILE(FORCEPATH(m.tcClassLib,m.lcExternalsPath)) OR ; FILE(FORCEPATH(m.lcForceVCX,m.lcExternalsPath)) OR ; FILE(FORCEPATH(m.lcForceFXP,m.lcExternalsPath)) m.lcUseThisLib = FORCEPATH(m.tcClassLib,m.lcExternalsPath) CASE FILE(FORCEPATH(m.tcClassLib,HOME(0)+"FFC\")) OR ; FILE(FORCEPATH(m.lcForceVCX,HOME(0)+"FFC\")) FILE(FORCEPATH(m.lcForceFXP,HOME(0)+"FFC\")) m.lcUseThisLib = FORCEPATH(m.tcClassLib,HOME(0) + "FFC\") CASE FILE(FORCEPATH(m.tcClassLib,HOME(0)+"FFC\" + THIS.classPath)) OR ; FILE(FORCEPATH(m.lcForceVCX,HOME(0)+"FFC\" + THIS.classPath)) FILE(FORCEPATH(m.lcForceFXP,HOME(0)+"FFC\" + THIS.classPath)) m.lcUseThisLib = FORCEPATH(m.tcClassLib,HOME(0) + "FFC\" + THIS.classPath) OTHERWISE m.lcUseThisLib = m.tcClassLib * may error, but if it's a required object, * it *should* error. ENDCASE m.loX = NEWOBJECT(m.tcClass, m.lcUseThisLib, ; IIF(VARTYPE(m.tcModule)="C",m.tcModule,"")) IF (NOT ISNULL(m.loX)) AND m.tlAssignUniqueNameToObject m.tcNamePrefix = IIF(VARTYPE(m.tcNamePrefix) = "C", ; m.tcNamePrefix, "FXH") m.loX.Name = m.tcNamePrefix + SYS(2015) ENDIF CATCH TO err m.loX = NULL #IF OUTPUTCLASS_DEBUGGING SUSPEND #ENDIF ENDTRY IF m.tlMandatoryObject AND ISNULL(m.loX) THIS.DoMessage(OUTPUTFX_REQUIREDOBJECT_UNAVAILABLE_LOC,MB_ICONEXCLAMATION) ENDIF SET DATASESSION TO (m.liSession) RETURN m.loX ENDPROC PROCEDURE checkcollectionforspecifiedmember LPARAMETERS m.tcClass, m.tcClassLib, m.tlInGFX, m.tlReturnRef LOCAL m.liIndex, m.loXs, m.loX, m.lcForceVCX, m.lcClassLib, ; m.lcClass, m.lcThisLib, m.llFound, m.loRef THIS.ensureCollection(m.tlInGFX) IF m.tlInGFX m.loXs = THIS.GFXs m.loXs = THIS.FXs ENDIF m.loRef = NULL m.lcClass = UPPER(m.tcClass) IF NOT EMPTY(m.tcClassLib) m.lcClassLib = UPPER(JUSTFNAME(m.tcClassLib)) m.lcForceVCX = FORCEEXT(lcClassLib,"VCX") m.lcForceFXP = STRTRAN(lcClassLib,".PRG",".FXP") ENDIF FOR m.liIndex = 1 TO m.loXs.Count m.loX = loXs.Item(liIndex) m.lcThisLib = UPPER(JUSTFNAME(loX.ClassLibrary)) IF UPPER(loX.Class) == m.lcClass AND ; (EMPTY(m.lcClassLib) OR ; m.lcThisLib == m.lcClassLib OR ; m.lcThisLib == m.lcForceVCX OR ; m.lcThisLib == m.lcForceFXP) m.llFound = .T. m.loRef = m.loX EXIT ENDIF IF m.tlReturnRef RETURN m.loRef RETURN m.llFound ENDIF ENDPROC PROCEDURE addcollectionmember LPARAMETERS m.tcClass, m.tcClassLib,m.tcModule,m.tlSingleton, m.tlInGFX, m.tlRequired LOCAL m.loX, m.lExists, m.liReturn m.liReturn = OUTPUTFX_ADDCOLLECTION_NOACTION IF m.tlSingleton m.lExists = THIS.checkCollectionForSpecifiedMember(m.tcClass,m.tcClassLib,m.tlInGFX) * checkCollectionForSpecifiedMember will have done this already THIS.ensureCollection(m.tlInGFX) ENDIF IF NOT m.lExists m.loX = THIS.getObjectInstance(; m.tcClass,; m.tcClassLib,; m.tcModule, ; .T., IIF(tlInGFX,"GFX","FX"),tlRequired) IF ISNULL(m.loX) m.liReturn = OUTPUTFX_ADDCOLLECTION_FAILURE ELSE IF (NOT PEMSTATUS(m.loX,"ApplyFX",5)) m.liReturn = OUTPUTFX_ADDCOLLECTION_UNSUITABLE ELSE IF tlInGFX THIS.GFXs.Add(m.loX) ELSE THIS.FXs.Add(m.loX) ENDIF m.liReturn = OUTPUTFX_ADDCOLLECTION_SUCCESS ENDIF ENDIF ENDIF RETURN m.liReturn ENDPROC PROCEDURE getpathforexternals * this is mostly for standalone use * first figure out where to put it * with the idea of not littering * the disk too much based on CURDIR(). * For app pieces, look for a container module * and put it there. * if there isn't one, * put it with the VCX LOCAL m.liLevel, m.lcSys16, m.lcPath IF ":" $ THIS.classPath * explicit path m.lcPath = THIS.classPath FOR m.liLevel = PROGRAM(-1) TO 1 STEP -1 m.lcSys16 = UPPER(SYS(16,m.liLevel)) IF INLIST(RIGHT(m.lcSys16,3),"APP","EXE","DLL") m.lcPath = JUSTPATH(m.lcSys16) EXIT ENDIF ENDFOR IF (NOT EMPTY(lcPath)) AND ; (NOT EMPTY(THIS.classPath)) AND ; DIRECTORY(FULLPATH(THIS.classPath,ADDBS(lcPath))) m.lcPath = FULLPATH(THIS.classPath,ADDBS(lcPath)) ENDIF ENDIF IF EMPTY(m.lcPath) m.lcPath = JUSTPATH(THIS.ClassLibrary) IF (NOT EMPTY(lcPath)) AND ; (NOT EMPTY(THIS.classPath)) AND ; DIRECTORY(FULLPATH(THIS.classPath,ADDBS(lcPath))) m.lcPath = FULLPATH(THIS.classPath,ADDBS(lcPath)) ENDIF ENDIF IF NOT DIRECTORY(m.lcPath) m.lcPath = "" ELSE m.lcPath = ADDBS(m.lcPath) ENDIF RETURN m.lcPath ENDPROC PROCEDURE ffcgraphics_assign LPARAMETERS m.tvNewVal DO CASE CASE ISNULL(m.tvNewVal) AND (NOT THIS.isRunning) THIS.FFCGraphics = m.tvNewVal CASE VARTYPE(m.tvNewVal) = "O" LOCAL laDummy[1] IF ACLASS(laDummy,m.tvNewVal) > 0 AND ; ASCAN(laDummy,"GpGraphics",1,ALEN(laDummy),1, 7) > 0 && case insensitive, exact on THIS.FFCGraphics = m.tvNewVal ENDIF OTHERWISE * don't ENDCASE ENDPROC PROCEDURE getmemberdatascriptfxobject THIS.setFRXDataSession() IF USED(THIS.memberDataAlias) AND ; RECCOUNT(THIS.memberDataAlias) > 0 SELECT (THIS.memberDataAlias) LOCATE FOR (NOT EMPTY(Execute)) IF NOT EOF() THIS.addCollectionMember(; THIS.fxMemberDataScriptClass,; THIS.fxMemberDataScriptClassLib,; THIS.fxMemberDataScriptModule, .T.) IF NOT THIS.checkCollectionForSpecifiedMember(; THIS.fxMemberDataScriptClass,; THIS.fxMemberDataScriptClassLib) THIS.DoMessage(OUTPUTFX_SCRIPTING_UNAVAILABLE_LOC,MB_ICONEXCLAMATION) ENDIF ENDIF IF USED("FRX") SELECT FRX ENDIF ENDIF ENDPROC PROCEDURE fxmemberdatascriptclass_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "C" AND NOT EMPTY(m.vNewVal) THIS.fxMemberDataScriptClass = m.vNewVal ENDIF ENDPROC PROCEDURE fxmemberdatascriptclasslib_assign LPARAMETERS vNewVal IF VARTYPE(m.vNewVal) = "C" AND NOT EMPTY(m.vNewVal) THIS.fxMemberDataScriptClassLib = m.vNewVal ENDIF ENDPROC PROCEDURE fxmemberdatascriptmodule_assign LPARAMETERS vNewVal IF VARTYPE(m.vNewVal) = "C" THIS.fxMemberDataScriptModule = m.vNewVal ENDIF ENDPROC PROCEDURE frxcursor_access IF (NOT THIS.IsRunning) AND ; ISNULL(THIS.frxCursor) AND THIS.loadFRXCursor THIS.frxCursor = ; THIS.getObjectInstance("FRXCursor","_FRXCURSOR.VCX","", .T.,"frx", .T.) IF ISNULL(THIS.frxCursor) THIS.loadFRXCursor = .F. ELSE THIS.frxCursor.QuietMode = THIS.QuietMode ENDIF ENDIF RETURN THIS.frxCursor ENDPROC PROCEDURE frxcursor_assign LPARAMETERS m.vNewVal IF ISNULL(m.vNewVal) OR (NOT THIS.IsRunning) THIS.frxcursor = m.vNewVal ENDIF ENDPROC PROCEDURE loadfrxcursor_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "L" AND NOT THIS.IsRunning THIS.loadfrxcursor = m.vNewVal ENDIF ENDPROC PROCEDURE memberdataalias_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "C" AND NOT EMPTY(m.vNewVal) THIS.memberDataAlias = m.vNewVal ENDIF ENDPROC PROCEDURE creatememberdatacursor IF USED("FRX") SELECT FRX LOCATE FOR Platform = FRX_PLATFORM_WINDOWS AND NOT (EMPTY(Style) OR DELETED()) IF EOF() THIS.loadFrxCursor = .F. ELSE THIS.loadFRXCursor = .T. DO CASE CASE (NOT THIS.loadFRXCursor) OR ISNULL(THIS.FRXCursor) * message already taken care of CASE PEMSTATUS(THIS.FRXCursor,"UnpackFRXMemberdata",5) THIS.FRXCursor.UnpackFRXMemberData("FRX",THIS.memberDataAlias,THIS.FRXDataSession) OTHERWISE THIS.DoMessage(OUTPUTFX_SCRIPTING_UNAVAILABLE_LOC ,MB_ICONEXCLAMATION) ENDCASE ENDIF ENDIF ENDPROC PROCEDURE runcollectorresetlevel_assign LPARAMETERS tvNewVal IF VARTYPE(m.tvNewVal) = "N" AND ; INLIST(m.tvNewVal,OUTPUTFX_RUNCOLLECTOR_RESET_NEVER , ; OUTPUTFX_RUNCOLLECTOR_RESET_ONREPORT,; OUTPUTFX_RUNCOLLECTOR_RESET_ONCHAIN) THIS.runCollectorResetLevel = m.tvNewVal ENDIF ENDPROC PROCEDURE getfrxrecno LPARAMETERS m.tcMethodToken,m.tP1, m.tP2 LOCAL m.liFRXRecno, m.liSession m.liFRXRecno = 0 DO CASE CASE INLIST(m.tcMethodToken,"BEFOREREPORT","AFTERREPORT","LOADREPORT","UNLOADREPORT") IF THIS.frxHeaderRecno = -1 * this is an early call. find the value early if possible m.liSession = SET("DATASESSION") THIS.setFRXDataSession() IF USED("FRX") SELECT FRX LOCATE FOR ObjType = FRX_OBJTYP_REPORTHEADER AND ; Platform = FRX_PLATFORM_WINDOWS AND ; NOT DELETED() THIS.frxHeaderRecno = RECNO() ELSE THIS.frxHeaderRecno = 1 ENDIF SET DATASESSION TO (m.liSession) ENDIF m.liFRXRecNo = THIS.frxHeaderRecno CASE INLIST(m.tcMethodToken,"BEFOREBAND","AFTERBAND") AND ; VARTYPE(m.tP2) = "N" && Band events m.liFRXRecNo = m.tP2 CASE VARTYPE(m.tP1) = "N" && Render, other events m.liFRXRecNo = m.tP1 OTHERWISE * called inappropriately ENDCASE RETURN m.liFRXRecno ENDPROC PROCEDURE getrotategfxobject THIS.setFRXDataSession() IF USED(THIS.memberDataAlias) AND RECCOUNT(THIS.memberDataAlias) > 0 SELECT (THIS.memberDataAlias) LOCATE FOR Type = FRX_BLDR_MEMBERDATATYPE AND ; Name == FRX_BLDR_NAMESPACE_ROTATE AND ; NOT EMPTY(Execute) IF NOT EOF() THIS.addCollectionMember(; THIS.gfxRotateClass,; THIS.gfxRotateClassLib,; THIS.gfxRotateModule, .T., .T.) IF NOT THIS.checkCollectionForSpecifiedMember(; THIS.gfxRotateClass,; THIS.gfxRotateClassLib, .T.) THIS.DoMessage(OUTPUTFX_ROTATION_UNAVAILABLE_LOC,MB_ICONEXCLAMATION) ENDIF ENDIF IF USED("FRX") SELECT FRX ENDIF ENDIF ENDPROC PROCEDURE gfxrotateclass_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "C" AND NOT EMPTY(m.vNewVal) THIS.gfxRotateClass = m.vNewVal ENDIF ENDPROC PROCEDURE gfxrotateclasslib_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "C" AND NOT EMPTY(m.vNewVal) THIS.gfxRotateClassLib = m.vNewVal ENDIF ENDPROC PROCEDURE gfxrotatemodule_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "C" THIS.gfxRotateModule = m.vNewVal ENDIF ENDPROC PROCEDURE removecollectionmember LPARAMETERS m.tcName, m.tlInGFX, m.tlNameIsClass LOCAL m.liIndex, m.loXs, m.loX, m.llFound, m.lcName IF EMPTY(m.tcName) OR VARTYPE(m.tcName) # "C" RETURN .F. ENDIF IF m.tlInGFX m.loXs = THIS.GFXs m.loXs = THIS.FXs ENDIF m.lcName = ALLTRIM(UPPER(m.tcName)) FOR m.liIndex = 1 TO m.loXs.Count m.loX = loXs.Item(liIndex) IF (UPPER(loX.Name) == m.lcName) OR ; (m.tlNameIsClass AND UPPER(loX.Class) == m.lcName) m.loXs.Remove(m.liIndex) m.llFound = .T. EXIT ENDIF RETURN m.llFound ENDPROC PROCEDURE reportstoprundatetime_access LOCAL m.lox, m.ldt m.lox = THIS.checkCollectionForSpecifiedMember(; THIS.fxFeedbackClass, THIS.fxFeedbackClassLib,.F., .T.) IF (NOT ISNULL(m.lox)) AND PEMSTATUS(m.lox,"reportStopRunDatetime",5) m.ldt = lox.reportStopRunDateTime m.ldt = THIS.reportStopRunDateTime ENDIF m.lox = NULL RETURN m.ldt ENDPROC PROCEDURE reportstartrundatetime_access LOCAL m.lox, m.ldt m.lox = THIS.checkCollectionForSpecifiedMember(; THIS.fxFeedbackClass, THIS.fxFeedbackClassLib,.f., .t.) IF (NOT ISNULL(m.lox)) AND PEMSTATUS(m.lox,"reportStartRunDatetime",5) m.ldt = m.lox.reportStartRunDateTime m.ldt = THIS.reportStartRunDateTime ENDIF m.lox = NULL RETURN m.ldt ENDPROC PROCEDURE evaluateuserexpression LPARAMETERS m.tvValueExpr LOCAL m.liSession, m.lvValue m.lvValue = "" m.liSession = SET("DATASESSION") THIS.setCurrentDataSession() IF TYPE(m.tvValueExpr) # "U" m.lvValue = EVALUATE(m.tvValueExpr) THIS.setFRXDataSession() IF TYPE(m.tvValueExpr) # "U" m.lvValue = EVALUATE(m.tvValueExpr) ELSE THIS.resetDataSession() IF TYPE(m.tvValueExpr) # "U" m.lvValue = EVALUATE(m.tvValueExpr) ELSE IF TYPE ("THIS.CommandClauses.StartDatasession") = "N" AND ; THIS.CommandClauses.StartDatasession > 0 AND ; (THIS.CommandClauses.StartDatasession # THIS.ListenerDataSession) SET DATASESSION TO (THIS.CommandClauses.StartDataSession) IF TYPE(m.tvValueExpr) # "U" m.lvValue = EVALUATE(m.tvValueExpr) ENDIF ENDIF ENDIF ENDIF ENDIF SET DATASESSION TO (m.liSession) RETURN m.lvValue ENDPROC PROCEDURE gfxnorenderclass_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "C" THIS.gfxNoRenderClass = m.vNewVal ENDIF ENDPROC PROCEDURE gfxnorenderclasslib_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "C" THIS.gfxNoRenderClassLib = m.vNewVal ENDIF ENDPROC PROCEDURE gfxnorendermodule_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "C" THIS.gfxNoRenderModule = m.vNewVal ENDIF ENDPROC PROCEDURE getnorendergfxobject IF NOT EMPTY(THIS.gfxNoRenderClass) LOCAL m.llNeedThisGFX, m.llOpenedMemberData THIS.setFRXDataSession() IF (NOT USED(THIS.memberDataAlias)) AND ; (NOT THIS.CommandClauses.IsDesignerLoaded) AND ; (NOT THIS.checkCollectionForSpecifiedMember(; THIS.gfxNoRenderClass,; THIS.gfxNoRenderClassLib, .T.)) IF NOT USED("FRX") && during LoadReport IF FILE(THIS.CommandClauses.File) USE (THIS.CommandClauses.File) AGAIN SHARED NOUPDATE ALIAS FRX * this is a special situation, in that * this gfx needs to be available to do a swap * *before* memberdata is commonly available. * At this point, depending on what else has happened, * Memberdata may or may not be here. If it is not, * we could build the memberdata cursor here temporarily -- * the gfx itself will do that, in fact -- but in this * method we're just ascertaining the requirement for * the gfx to *exist*. This doesn't merit the extra time * to do an exact comparison of the appropriate memberdata * element. If we might need it, the class should be * instantiated. Let it do the special build of memberdata * later and do its evaluations at that time. LOCATE FOR FRX_BLDR_ADVPROP_PREPROCESS_NORENDER $ Style ; AND NOT DELETED() m.llNeedThisGFX = (NOT EOF()) USE IN FRX ELSE * built-into another app, just load without the check m.llNeedThisGFX = .T. ENDIF IF m.llNeedThisGFX THIS.loadFrxCursor = .T. ENDIF ENDIF ENDIF IF (NOT m.llNeedThisGFX) AND ; USED(THIS.memberDataAlias) AND ; RECCOUNT(THIS.memberDataAlias) > 0 * now we'll check in the normal way later in the report for * any required instance suppression, which occurs * later in the report cycle and can use the normal build * of memberdata SELECT (THIS.memberDataAlias) LOCATE FOR Type = FRX_BLDR_MEMBERDATATYPE AND ; Name == FRX_BLDR_NAMESPACE_ADVANCEDPROPS AND ; (ExecWhen == FRX_BLDR_ADVPROP_INSTANCE_NORENDER AND ; NOT EMPTY(Execute)) OR ; (ExecWhen == FRX_BLDR_ADVPROP_PREPROCESS_NORENDER) IF NOT EOF() m.llNeedThisGFX = .T. ENDIF ENDIF IF m.llNeedThisGFX THIS.addCollectionMember(; THIS.gfxNoRenderClass,; THIS.gfxNoRenderClassLib,; THIS.gfxNoRenderModule, .T., .T.) IF NOT THIS.checkCollectionForSpecifiedMember(; THIS.gfxNoRenderClass,; THIS.gfxNoRenderClassLib, .T.) THIS.DoMessage(OUTPUTFX_CONDITIONALRENDERING_UNAVAILABLE_LOC,MB_ICONEXCLAMATION) ENDIF ENDIF IF USED("FRX") SELECT FRX ENDIF ENDIF ENDPROC PROCEDURE ensurecollection LPARAMETERS m.tlGFXs IF m.tlGFXs IF VARTYPE(THIS.GFXs) # "O" OR ; (NOT UPPER(THIS.GFXs.BaseClass) == "COLLECTION") THIS.GFXs = CREATEOBJECT("Collection") ENDIF IF VARTYPE(THIS.FXs) # "O" OR ; (NOT UPPER(THIS.FXs.BaseClass) == "COLLECTION") THIS.FXs = CREATEOBJECT("Collection") ENDIF ENDIF ENDPROC PROCEDURE setgdiplusgraphics LPARAMETERS tnHandle IF VARTYPE(THIS.FFCGraphics) = "O" THIS.FFCGraphics.SetHandle(tnHandle) ENDIF This.sharedGdiplusGraphics = tnHandle This.nExternalGdiPlusGfx = tnHandle * THIS.GDIPlusGraphics = tnHandle ENDPROC PROCEDURE CancelReport IF THIS.FXs.Count > 0 THIS.sendFX(PROGRAM()) IF THIS.cancelRequested DODEFAULT() ELSE NODEFAULT ENDIF DODEFAULT() ENDIF ENDPROC PROCEDURE Destroy STORE NULL TO THIS.FXs, THIS.GFXs, THIS.FFCGraphics, ; THIS.FRXCursor DODEFAULT() ENDPROC PROCEDURE Render LPARAMETERS m.nFRXRecno, m.nLeft, m.nTop, m.nWidth, m.nHeight, ; m.nObjectContinuationType, m.cContentsToBeRendered, m.GDIPlusImage LOCAL m.liDefaultBehavior,m.llNeedGFXs, m.lnState LOCAL lhGfx * lhGfx = IIF(This.GDIPlusGraphics > 0, This.GDIPlusGraphics, This.nExternalGdiPlusGfx) lhGfx = This.GDIPlusGraphics m.llNeedGFXs = (NOT THIS.IsSuccessor) AND THIS.GFXs.Count > 0 AND ; THIS.NeedGFXs(PROGRAM(),m.nFRXRecno, m.nLeft, m.nTop, m.nWidth, m.nHeight, ; m.nObjectContinuationType, m.cContentsToBeRendered, m.GDIPlusImage) ; AND (lhGfx > 0) IF m.llNeedGFXs THIS.FFCGraphics.SetHandle(lhGfx) * done in BeforeBand for the page header * for GFX objects, in case they (for any reason) choose to * manipulate the page in other methods than Render. * but we'll do it again here. THIS.FFCGraphics.Save(@m.lnState) ENDIF m.liDefaultBehavior = ; THIS.sendFX(PROGRAM(),m.nFRXRecNo,; @m.nLeft,@m.nTop,@m.nWidth,@m.nHeight,; @m.nObjectContinuationType, ; @m.cContentsToBeRendered, @m.GDIPlusImage) NODEFAULT * note that FX objects get the args passed by reference, * however the GFX objects * should not be seeking to change these args and * receive the args passed by value. Their * job is to draw, not to change what is drawn by others or the base. DO CASE CASE m.llNeedGFXs AND ; m.liDefaultBehavior = OUTPUTFX_BASERENDER_RENDER_BEFORE_RESTORE DODEFAULT( m.nFRXRecno, m.nLeft, m.nTop, m.nWidth, m.nHeight, ; m.nObjectContinuationType, m.cContentsToBeRendered, m.GDIPlusImage) THIS.FFCGraphics.Restore(m.lnState) CASE m.llNeedGFXs AND ; m.liDefaultBehavior >= OUTPUTFX_BASERENDER_NORENDER THIS.FFCGraphics.Restore(m.lnState) IF (NOT ISNULL(THIS.Successor)) THIS.SetSuccessorDynamicProperties() THIS.Successor.Render(m.nFRXRecno, m.nLeft, m.nTop, m.nWidth, m.nHeight, ; m.nObjectContinuationType, m.cContentsToBeRendered, m.GDIPlusImage) ENDIF CASE m.llNeedGFXs && OUTPUTFX_BASERENDER_AFTERRESTORE, ; && OUTPUTFX_DEFAULT_RENDER_BEHAVIOR THIS.FFCGraphics.Restore(m.lnState) DODEFAULT( m.nFRXRecno, m.nLeft, m.nTop, m.nWidth, m.nHeight, ; m.nObjectContinuationType, m.cContentsToBeRendered, m.GDIPlusImage) OTHERWISE && no GFX behavior at all, just base behavior DODEFAULT( m.nFRXRecno, m.nLeft, m.nTop, m.nWidth, m.nHeight, ; m.nObjectContinuationType, m.cContentsToBeRendered, m.GDIPlusImage) ENDCASE RETURN m.liDefaultBehavior ENDPROC PROCEDURE AdjustObjectSize LPARAMETERS m.nFRXRecno, m.oObjProperties THIS.sendFX(PROGRAM(),m.nFRXRecno, m.oObjProperties) NODEFAULT IF (NOT ISNULL(THIS.Successor)) THIS.SetSuccessorDynamicProperties() THIS.Successor.AdjustObjectSize(m.nFRXRecno, m.oObjProperties) ENDIF DODEFAULT(m.nFRXRecno, m.oObjProperties) ENDPROC PROCEDURE EvaluateContents LPARAMETERS m.nFRXRecno, m.oObjProperties THIS.sendFX(PROGRAM(),m.nFRXRecno, m.oObjProperties) NODEFAULT IF (NOT ISNULL(THIS.Successor)) THIS.SetSuccessorDynamicProperties() THIS.Successor.EvaluateContents(m.nFRXRecno, m.oObjProperties) ENDIF DODEFAULT(m.nFRXRecno, m.oObjProperties) ENDPROC PROCEDURE AfterBand LPARAMETERS m.nBandObjCode, m.nFRXRecNo THIS.sendFX(PROGRAM(),m.nBandObjCode, m.nFRXRecNo) NODEFAULT RETURN DODEFAULT(m.nBandObjCode, m.nFRXRecNo) ENDPROC PROCEDURE BeforeBand LPARAMETERS m.nBandObjCode, m.nFRXRecNo IF m.nBandObjCode = FRX_OBJCOD_PAGEHEADER ; AND THIS.GFXs.Count > 0 THIS.FFCGraphics.SetHandle(THIS.GDIPlusGraphics) ENDIF THIS.sendFX(PROGRAM(),m.nBandObjCode, m.nFRXRecNo) NODEFAULT RETURN DODEFAULT(m.nBandObjCode, m.nFRXRecNo) ENDPROC PROCEDURE UnloadReport THIS.sendFX(PROGRAM()) THIS.CommandClauses.File = THIS.commandClausesFile THIS.commandClausesFile = NULL RETURN DODEFAULT() ENDPROC PROCEDURE AfterReport THIS.sendFX(PROGRAM()) NODEFAULT RETURN DODEFAULT() ENDPROC PROCEDURE BeforeReport THIS.setFRXDataSession() IF (NOT THIS.IsSuccessor) THIS.createMemberDataCursor() IF NOT ISNULL(THIS.successor) THIS.successor.AddProperty("memberDataAlias",THIS.memberDataAlias) ENDIF ENDIF * second opportunity to create FX and GFX objects, * in case some are needed that were not needed before: THIS.checkCollectionMembers(.T.) * second opportunity to create non-optional helper members, * in case some are needed that were not needed before, * Any items that would have been required for * FX/GFX-specific use should already have been created during * LoadReport, so this set of calls is "backwards" * from LoadReport pairing: THIS.createHelperObjects(.T.) * note: at this point, * the FX and GFX objects have * an opportunity to * adjust items such as CallAdjustObjectSize, CallEvaluateContents, TwoPassProcess THIS.sendFX(PROGRAM()) NODEFAULT RETURN DODEFAULT() ENDPROC PROCEDURE LoadReport * always start with full reset for this run: THIS.CallAdjustObjectSize = LISTENER_CALLDYNAMICMETHOD_NEVER THIS.CallEvaluateContents = LISTENER_CALLDYNAMICMETHOD_NEVER THIS.commandClausesFile = THIS.CommandClauses.File * see notes in BeforeReport THIS.setFRXDataSessionEnvironment() THIS.createHelperObjects() THIS.checkCollectionMembers() THIS.sendFX(PROGRAM()) *!* Fix by Cathy Pountney *!* http://cathypountney.blogspot.com/2009/04/set-talk-appears-to-be-on-when-running.html * Modify the fxListener class of the _ReportListener class library and change the code in * the LoadReport method. * Simply move This.setFRXDataSessionEnvironment() so it comes before This.createHelperObjects() * and the problem is solved. * Original code: *!* THIS.createHelperObjects() *!* THIS.checkCollectionMembers() *!* THIS.setFRXDataSessionEnvironment() *!* THIS.sendFX(PROGRAM()) NODEFAULT RETURN DODEFAULT() && these changes can be passed on to successors ENDPROC PROCEDURE Init IF DODEFAULT() THIS.AppName = OUTPUTFX_APPNAME_LOC THIS.Name = "FX" + SYS(2015) THIS.createHelperObjects() *&* THIS.getFeedbackFXObject(.T.) RETURN .F. ENDIF RETURN NOT THIS.hadError ENDPROC PROCEDURE DoStatus LPARAMETERS m.cMessage THIS.sendFX(PROGRAM(),m.cMessage) NODEFAULT ENDPROC PROCEDURE UpdateStatus THIS.sendFX(PROGRAM()) NODEFAULT ENDPROC PROCEDURE resetcalladjustobjectsize * abstract, note that fx and gfx objects already * have an opportunity via sendFX call. ENDPROC PROCEDURE resetcallevaluatecontents * abstract, note that fx and gfx objects already * have an opportunity via sendFX call. ENDPROC PROCEDURE ClearStatus THIS.sendFX(PROGRAM()) ENDPROC PROCEDURE quietmode_assign LPARAMETERS m.vNewVal DODEFAULT(m.vNewVal) IF THIS.loadFRXCursor AND (NOT ISNULL(THIS.FRXCursor)) THIS.FRXCursor.QuietMode = THIS.QuietMode ENDIF IF NOT ISNULL(THIS.FFCGraphics) THIS.FFCGraphics.QuietOnError = THIS.QuietMode ENDIF ENDPROC PROCEDURE getdefaultuserxsltasstring LOCAL m.lcResult SET TEXTMERGE TO MEMVAR m.lcResult NOSHOW SET TEXTMERGE ON *!* ------------------------------------------------------------------- *!* ------------------------------------------------------------------- *!* ------------------------------------------------------------------- *!* 2011-08-12 - Jacques Parent *!* ------------------------------------------------------------------- *!* The following text have been modified to let boxes that print from *!* header to footer can print correctly. *!* ------------------------------------------------------------------- *!* Changes (This is pretty complicated...) *!* - Classe "getCSSName" have been modified to add an "itemType" *!* to the class name: T = TOP; M = Middle; B = Bottom; *!* Default: do not add anything. *!* - New clases "shapestylesT", "shapestylesM" and "shapestylesB" *!* have been created: *!* shapestylesT: Print only top, left and right lines *!* shapestylesM: Print left and right lines *!* shapestylesB: Print only bottom, left and right lines *!* - "Render" class have been modified to add a "T", "M" or "B" *!* to the boxes' class depending of the "@c" variable, *!* containing the "continuation" information (0 = complete; *!* (1 = Top; 2 = Middle; 3 = Bottom) *!* ------------------------------------------------------------------- *!* I am hoping that this change do not cause problems elseware... It *!* is a pain do search in that text when you have never heard of xsl *!* or Microsoft DOM... but I've managed for this time. So let's hope! :) *!* ------------------------------------------------------------------- *!* ------------------------------------------------------------------- *!* ------------------------------------------------------------------- name id
rtl the above repeated-explicit declaration is necessary because some versions of MSXML xslt processing don't include the charset as required by the XSLT standard when method="html". Explicitly including the META creates a doubled meta content-type tag, but we do need the encoding to be specified properly and the doubled tag is okay. , <xsl:choose> <xsl:when test="/Reports/VFP-Report[1]/Run/property[@id='title']"> <xsl:value-of select="/Reports/VFP-Report[1]/Run/property[@id='title']/."/> </xsl:when> <xsl:otherwise> <!-- default/VFP 9.0 RTM handling --> <xsl:value-of select="$PageTitlePrefix_LOC"/> <xsl:if test="string-length(/Reports/VFP-Report[1]/VFP-RDL/VFPDataSet/VFPFRXPrintJob/@name) = 0"> <xsl:value-of select="/Reports/VFP-Report[1]/VFP-RDL/@id"/> </xsl:if> <xsl:value-of select="/Reports/VFP-Report[1]/VFP-RDL/VFPDataSet/VFPFRXPrintJob/@name"/> </xsl:otherwise> </xsl:choose>
position=relative;height=in;
width:100%;top:in; position:absolute;
width:100%;top:in;position:absolute;
. { position: absolute;overflow: hidden;width: in;height: in; { position: absolute ;font-size:1pt; border: px ;background-color:;width: in;left: in; } { position: absolute ;font-size:1pt; border-left: px ;border-right: px ;border-top: px ;background-color:;width: in;left: in; } { position: absolute ;font-size:1pt; border-left: px ;border-right: px ;background-color:;width: in;left: in; } { position: absolute ;font-size:1pt; border-left: px ;border-right: px ;border-bottom: px ;background-color:;width: in;left: in; } { vertical-align: top; font-family: ""; font-size: pt; border: 0px none; padding: 0px; margin: 0px;color:; background-color:transparent; background-color: ; overflow:hidden;margin-top:4px; overflow: auto;margin-top:4px; overflow:hidden; position: absolute; } { position:absolute;font-size:1pt;border: px ;left: in; width: in; height: px; margin: 0px; height: in; width: px; none dotted dashed solid # # font-weight: bold; font-weight: normal; text-decoration: line-through underline; font-style: italic; 255 FF 00 00 A B C D E F text-align: left; right; center; left; right; center; direction: rtl; ltr; External stylesheet(s) for Global document styles, if any Styles for report # in this run, clip: rect(0in,in,in,0in); width:100%; height:100%; height: in; width: in; &nbsp; z-Index:;left:in; top: in; width:0in; width:in; width:in;height:in;height:in; font-family:'';font-size:pt; text-decoration:line-throughunderline; font-weight:boldnormal; font-style:italicnormal; background-color: ;color:; transparent
ENDTEXT SET TEXTMERGE OFF SET TEXTMERGE TO RETURN m.lcResult *!* LOCAL m.lcResult *!* SET TEXTMERGE TO MEMVAR m.lcResult NOSHOW *!* SET TEXTMERGE ON *!* *!* ------------------------------------------------------------------- *!* *!* ------------------------------------------------------------------- *!* *!* ------------------------------------------------------------------- *!* *!* 2011-08-12 - Jacques Parent *!* *!* ------------------------------------------------------------------- *!* *!* The following text have been modified to let boxes that print from *!* *!* header to footer can print correctly. *!* *!* ------------------------------------------------------------------- *!* *!* Changes (This is pretty complicated...) *!* *!* - Classe "getCSSName" have been modified to add an "itemType" *!* *!* to the class name: T = TOP; M = Middle; B = Bottom; *!* *!* Default: do not add anything. *!* *!* - New clases "shapestylesT", "shapestylesM" and "shapestylesB" *!* *!* have been created: *!* *!* shapestylesT: Print only top, left and right lines *!* *!* shapestylesM: Print left and right lines *!* *!* shapestylesB: Print only bottom, left and right lines *!* *!* - "Render" class have been modified to add a "T", "M" or "B" *!* *!* to the boxes' class depending of the "@c" variable, *!* *!* containing the "continuation" information (0 = complete; *!* *!* (1 = Top; 2 = Middle; 3 = Bottom) *!* *!* ------------------------------------------------------------------- *!* *!* I am hoping that this change do not cause problems elseware... It *!* *!* is a pain do search in that text when you have never heard of xsl *!* *!* or Microsoft DOM... but I've managed for this time. So let's hope! :) *!* *!* ------------------------------------------------------------------- *!* *!* ------------------------------------------------------------------- *!* *!* ------------------------------------------------------------------- *!* TEXT *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* name *!* id *!* *!* *!* *!* *!* *!* *!*
*!* *!* *!* *!*
*!* *!* *!* *!* *!* *!* *!* *!* *!* *!* rtl *!* *!* *!* *!* *!* the above repeated-explicit declaration is necessary because *!* some versions of MSXML xslt processing don't include the *!* charset as required by the XSLT standard when method="html". *!* Explicitly including the META creates a doubled meta content-type tag, *!* but we do need the encoding to be specified properly and the doubled tag is okay. *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* , *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* <xsl:choose> *!* <xsl:when test="/Reports/VFP-Report[1]/Run/property[@id='title']"> *!* <xsl:value-of select="/Reports/VFP-Report[1]/Run/property[@id='title']/."/> *!* </xsl:when> *!* <xsl:otherwise> *!* <!-- default/VFP 9.0 RTM handling --> *!* <xsl:value-of select="$PageTitlePrefix_LOC"/> *!* <xsl:if test="string-length(/Reports/VFP-Report[1]/VFP-RDL/VFPDataSet/VFPFRXPrintJob/@name) = 0"> *!* <xsl:value-of select="/Reports/VFP-Report[1]/VFP-RDL/@id"/> *!* </xsl:if> *!* <xsl:value-of select="/Reports/VFP-Report[1]/VFP-RDL/VFPDataSet/VFPFRXPrintJob/@name"/> *!* </xsl:otherwise> *!* </xsl:choose> *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!*
*!* *!* *!* position=relative;height=in; *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!*
*!* *!* *!* *!* *!* *!* *!* *!*
*!* width:100%;top:in; position:absolute; *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!*
*!* *!* *!* *!* *!* *!* *!*
*!* width:100%;top:in;position:absolute; *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!*
*!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!*
*!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!*
*!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!*
*!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* . *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* { *!* position: absolute;overflow: hidden;width: in;height: in; *!* } *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* { *!* position: absolute ;font-size:1pt; border: px ;background-color:;width: in;left: in; *!* } *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* { *!* position: absolute ;font-size:1pt; border-left: px ;border-right: px ;border-top: px ;background-color:;width: in;left: in; *!* } *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* { *!* position: absolute ;font-size:1pt; border-left: px ;border-right: px ;background-color:;width: in;left: in; *!* } *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* { *!* position: absolute ;font-size:1pt; border-left: px ;border-right: px ;border-bottom: px ;background-color:;width: in;left: in; *!* } *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* { *!* vertical-align: top; font-family: ""; font-size: pt; border: 0px none; padding: 0px; margin: 0px;color:; *!* background-color:transparent; *!* background-color: ; *!* *!* overflow:hidden;margin-top:4px; *!* overflow: auto;margin-top:4px; *!* overflow:hidden; *!* position: absolute; *!* } *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* { *!* position:absolute;font-size:1pt;border: px ;left: in; *!* *!* width: in; *!* height: px; margin: 0px; *!* height: in; *!* width: px; *!* *!* } *!* *!* *!* *!* none *!* dotted *!* dashed *!* solid *!* *!* *!* # *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* # *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* font-weight: bold; *!* font-weight: normal; *!* *!* text-decoration: line-through *!* underline; *!* font-style: italic; *!* *!* *!* *!* *!* *!* *!* *!* *!* 255 *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* FF *!* 00 *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* 00 *!* *!* *!* *!* A *!* B *!* C *!* D *!* E *!* F *!* *!* *!* text-align: *!* *!* *!* left; *!* right; *!* center; *!* *!* *!* *!* *!* left; *!* right; *!* center; *!* *!* *!* *!* *!* direction: *!* rtl; *!* ltr; *!* *!* *!* *!* *!* *!* *!* *!* *!* External stylesheet(s) for *!* *!* *!* *!* *!* *!* *!* *!* Global document styles, if any *!* *!* *!* *!* *!* *!* *!* *!* Styles for report # in this run, *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* clip: rect(0in,in,in,0in); *!* *!* width:100%; *!* *!* height:100%; *!* *!* height: in; *!* width: in; *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* &nbsp; *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* z-Index:;left:in; *!* top: *!* *!* *!* in; *!* width:0in; *!* width:in; *!* width:in;height:in;height:in; *!* *!* *!* *!* *!* *!* *!* *!* *!* font-family:'';font-size:pt; *!* text-decoration:line-throughunderline; *!* font-weight:boldnormal; *!* font-style:italicnormal; *!* background-color: *!* *!* *!* *!* *!* ;color:; *!* *!* *!* *!* *!* *!* *!* *!* *!* transparent *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!*
*!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* *!* ENDTEXT *!* SET TEXTMERGE OFF *!* SET TEXTMERGE TO *!* RETURN m.lcResult ENDPROC PROCEDURE cssclassattr_assign LPARAMETERS m.vNewVal IF (NOT THIS.IsRunning) AND THIS.VerifyNCName(m.vNewVal) ; AND NOT (m.vNewVal == THIS.cssClassAttr) THIS.cssClassAttr = m.vNewVal THIS.SynchXSLTProcessorUser() ENDIF ENDPROC PROCEDURE anchorattr_assign LPARAMETERS m.vNewVal IF (NOT THIS.IsRunning) AND THIS.VerifyNCName(m.vNewVal) ; AND NOT (m.vNewVal == THIS.anchorAttr) THIS.anchorAttr = m.vNewVal THIS.SynchXSLTProcessorUser() ENDIF ENDPROC PROCEDURE titleattr_assign LPARAMETERS m.vNewVal IF (NOT THIS.IsRunning) AND THIS.VerifyNCName(m.vNewVal) ; AND NOT (m.vNewVal == THIS.titleAttr ) THIS.titleAttr = m.vNewVal THIS.SynchXSLTProcessorUser() ENDIF ENDPROC PROCEDURE linkattr_assign LPARAMETERS m.vNewVal IF (NOT THIS.IsRunning) AND THIS.VerifyNCName(m.vNewVal) ; AND NOT (m.vNewVal == THIS.linkAttr) THIS.linkAttr = m.vNewVal THIS.SynchXSLTProcessorUser() ENDIF ENDPROC PROCEDURE cssclassoverrideattr_assign LPARAMETERS m.vNewVal IF (NOT THIS.IsRunning) AND THIS.VerifyNCName(m.vNewVal) ; AND NOT (m.vNewVal == THIS.cssClassOverrideAttr) THIS.cssClassOverrideAttr = m.vNewVal THIS.SynchXSLTProcessorUser() ENDIF ENDPROC PROCEDURE urlstringencode LPARAMETER m.tcValue, m.tlEncodeURLControlChars, m.tlEncodeSpace * Thanks to Rick Strahl and West Wind for help and advice! IF VARTYPE(m.tcValue) # "C" RETURN "" ENDIF LOCAL m.lcResult, m.lcChar, m.ii, m.lcOKChars m.lcResult="" m.lcOKChars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" IF NOT m.tlEncodeURLControlChars * by default, we also exempt chars that might * indicate an anchor or a query string element m.lcOKChars = m.lcOKChars + ".?=&#" ENDIF FOR m.ii=1 TO LEN(m.tcValue) m.lcChar = SUBSTR(m.tcValue,m.ii,1) IF ATC(m.lcChar,m.lcOKChars) > 0 m.lcResult=m.lcResult + m.lcChar LOOP ENDIF IF m.lcChar=" " AND NOT m.tlEncodeSpace m.lcResult = m.lcResult + "+" LOOP ENDIF m.lcResult = m.lcResult + "%" + RIGHT(TRANSFORM(ASC(m.lcChar),"@0"),2) ENDFOR RETURN m.lcResult ENDPROC PROCEDURE pathencode LPARAMETERS m.tcVal, m.tlXMLEncode LOCAL m.lcVal, m.lcTempVal, m.laVals[1], m.liIndex, m.liSeparators m.lcVal = ALLTRIM(CHRTRAN(m.tcVal,"\","/")) * default XSLT would take care of the above anyway, but * no harm in doing it here DO CASE CASE LEN(m.lcVal) = 0 * nothing CASE AT("/",m.lcVal) > 0 m.lcTempVal = "" m.liSeparators = ALINES(m.laVals,m.lcVal,0,"/") FOR m.liIndex = 1 TO m.liSeparators IF ":" $ m.laVals[m.liIndex] m.lcTempVal = m.lcTempVal + m.laVals[m.liIndex] ELSE m.lcTempVal = m.lcTempVal + ; THIS.urlStringEncode(m.laVals[m.liIndex]) ENDIF IF m.liIndex < m.liSeparators m.lcTempVal = m.lcTempVal + "/" ENDIF ENDFOR IF RIGHT(m.lcVal,1) = "/" m.lcTempVal = m.lcTempVal + "/" ENDIF m.lcVal = m.lcTempVal OTHERWISE m.lcVal = THIS.urlStringEncode(m.lcVal) ENDCASE #IF OUTPUTXML = OUTPUTXML_RAW IF m.tlXMLEncode * the result is going to an XML document m.lcVal = THIS.xmlRawConv(m.lcVal) ENDIF #ENDIF RETURN m.lcVal ENDPROC PROCEDURE updateproperties IF NOT This.lObjTypeMode OR (VARTYPE(_Screen.oFoxyPreviewer) <> "O") RETURN ENDIF LOCAL loFP loFP = _Screen.oFoxyPreviewer IF VARTYPE(This.CommandClauses) = "O" *!* IF This.CommandClauses.Preview *!* This.lOpenViewer = .T. *!* ELSE *!* This.lOpenViewer = NVL(loFP.lOpenViewer, .T.) *!* ENDIF This.lOpenViewer = This.CommandClauses.Preview IF NOT EMPTY(This.CommandClauses.ToFile) This.TargetFileName = This.CommandClauses.ToFile ELSE IF VARTYPE(_Screen.oFoxyPreviewer) = "O" AND ; NOT EMPTY(_Screen.oFoxyPreviewer.cDestFile) AND ; EMPTY(This.TargetFileName) LOCAL lcDestFile lcDestFile = _Screen.oFoxyPreviewer.cDestFile IF NOT "\" $ lcDestFile lcDestFile = ALLTRIM(ADDBS(_Screen.oFoxyPreviewer.cOutputPath) + lcDestFile) ENDIF This.TargetFileName = lcDestFile ELSE LOCAL lcFile lcFile = This.TargetFileName IF EMPTY(lcFile) lcFile = PUTFILE("","","htm") ENDIF IF EMPTY(lcFile) _ReportListener::CancelReport() * This.CancelReport() RETURN .F. ENDIF This.TargetFileName = lcFile ENDIF ENDIF ENDIF This.QUIETMODE = NVL(loFP.lQuietMode , .F.) IF VARTYPE(This.CommandClauses) = "O" IF This.CommandClauses.Preview This.lOpenViewer = .T. ENDIF IF NOT EMPTY(This.CommandClauses.ToFile) This.TargetFileName = This.CommandClauses.ToFile ENDIF ENDIF ENDPROC PROCEDURE fillruncollector DODEFAULT() IF NOT ISNULL(THIS.runCollector) * should have been taken care of by superclass THIS.setFRXDataSession() IF USED(THIS.memberDataAlias) LOCAL m.lvValue, m.lcExpr, m.liSelect, m.loXML, m.loXMLTemp, m.loNode IF USED("FRX") GO (THIS.frxHeaderRecno) IN FRX #IF OUTPUTXML = OUTPUTXML_DOM m.loXML = CREATEOBJECT(OUTPUTXML_DOMFREETHREADED_DOCUMENTOBJECT) m.loXMLTemp = CREATEOBJECT(OUTPUTXML_DOMFREETHREADED_DOCUMENTOBJECT) #ELSE m.loXML = CREATEOBJECT("Microsoft.XMLDOM") m.loXMLTemp = CREATEOBJECT("Microsoft.XMLDOM") #ENDIF IF NOT m.loXML.LoadXML(FRX.Style) m.loXML = NULL ENDIF ENDIF IF NOT ISNULL(m.loXML) m.liSelect = SELECT(0) SELECT (THIS.memberDataAlias) LOCATE FOR FRXRecno = THIS.frxHeaderRecno AND ; Type = FRX_BLDR_MEMBERDATATYPE ; AND Name == FRX_BLDR_NAMESPACE_ADVANCEDPROPS ; AND ExecWhen == FRX_BLDR_ADVPROP_HTML_HTTPEQUIV ; AND VAL(DeClass) = ADVPROP_EDITMODE_TEXT ; AND NOT EMPTY(Execute) IF FOUND() m.lvValue = ; m.loXML.SelectSingleNode("/VFPData/reportdata" + ; "[@name='" + Name + "' and @execwhen='" + ; FRX_BLDR_ADVPROP_HTML_HTTPEQUIV + "']/@execute") IF (NOT ISNULL(m.lvValue)) AND ; m.loXMLTemp.LoadXML(m.lvValue.Text) m.loXML = m.loXMLTemp.SelectNodes("//meta") FOR EACH m.loNode IN m.loXML m.lcExpr = m.loNode.getAttribute("name") m.lvValue = m.loNode.getAttribute("content") IF NOT (ISNULL(m.lcExpr) OR ISNULL(m.lvValue) OR ; EMPTY(m.lcExpr) OR EMPTY(m.lvValue)) IF VAL(m.loNode.getAttribute("type")) = ADVPROP_EDITMODE_GETEXPR m.lvValue = THIS.evaluateUserExpression(m.lvValue) ENDIF IF THIS.runCollector.getKey(FRX_BLDR_ADVPROP_HTML_HTTPEQUIV+"." + m.lcExpr) = 0 THIS.runCollector.add(m.lvValue,FRX_BLDR_ADVPROP_HTML_HTTPEQUIV+"." + m.lcExpr) ENDIF ENDIF NEXT ENDIF ENDIF STORE NULL TO m.loXML, m.loXMLTemp, m.loNode SELECT (liSelect) ENDIF ENDIF ENDIF ENDPROC PROCEDURE getrawformattinginfo LPARAMETERS m.tnLeft, m.tnTop, m.tnWidth, m.tnHeight, m.tnObjectContinuationType LOCAL m.lcInfo, m.lcVal, m.liRecno m.lcInfo = DODEFAULT(m.tnLeft, m.tnTop, m.tnWidth, m.tnHeight, m.tnObjectContinuationType) THIS.setFRXDataSession() m.liRecno = RECNO("FRX") IF USED(THIS.MemberDataAlias) AND ; SEEK(m.liRecno,THIS.MemberDataAlias,"FRXRecno") SELECT (THIS.MemberDataAlias) m.lcVal = "" LOCATE FOR FRXRecno = m.liRecno AND ; Type = FRX_BLDR_MEMBERDATATYPE AND ; Name = FRX_BLDR_NAMESPACE_ADVANCEDPROPS AND ; ExecWhen = FRX_BLDR_ADVPROP_HTML_CSS_CLASSOVERRIDE IF FOUND() IF VAL(DeClass) = ADVPROP_EDITMODE_GETEXPR m.lcVal = TRANSFORM(THIS.evaluateUserExpression(Execute)) ELSE m.lcVal = Execute ENDIF ENDIF SELECT (THIS.MemberDataAlias) IF NOT EMPTY(m.lcVal) m.lcInfo = m.lcInfo + " "+THIS.cssClassOverrideAttr+"='"+m.lcVal+"'" ELSE * try again with other css class attribute LOCATE FOR FRXRecno = m.liRecno AND ; Type = FRX_BLDR_MEMBERDATATYPE AND ; Name = FRX_BLDR_NAMESPACE_ADVANCEDPROPS AND ; ExecWhen = FRX_BLDR_ADVPROP_HTML_CSS_CLASSEXTEND IF FOUND() IF VAL(DeClass) = ADVPROP_EDITMODE_GETEXPR m.lcVal = TRANSFORM(THIS.evaluateUserExpression(Execute)) ELSE m.lcVal = Execute ENDIF ENDIF IF NOT EMPTY(m.lcVal) m.lcInfo = m.lcInfo + " "+THIS.cssClassAttr+"='"+m.lcVal+"'" ENDIF ENDIF SELECT (THIS.MemberDataAlias) m.lcVal = "" LOCATE FOR FRXRecno = m.liRecno AND ; Type = FRX_BLDR_MEMBERDATATYPE AND ; Name = FRX_BLDR_NAMESPACE_ADVANCEDPROPS AND ; ExecWhen = FRX_BLDR_ADVPROP_HTML_ITEMHREF IF FOUND() IF VAL(DeClass) = ADVPROP_EDITMODE_GETEXPR m.lcVal = TRANSFORM(THIS.evaluateUserExpression(Execute)) ELSE m.lcVal = Execute ENDIF ENDIF IF NOT EMPTY(m.lcVal) m.lcInfo = m.lcInfo + " "+ ; THIS.linkAttr +"='"+ ; THIS.pathEncode(m.lcVal, .T.)+"'" ENDIF SELECT (THIS.MemberDataAlias) m.lcVal = "" LOCATE FOR FRXRecno = m.liRecno AND ; Type = FRX_BLDR_MEMBERDATATYPE AND ; Name = FRX_BLDR_NAMESPACE_ADVANCEDPROPS AND ; ExecWhen = FRX_BLDR_ADVPROP_HTML_ITEMTITLE IF FOUND() IF VAL(DeClass) = ADVPROP_EDITMODE_GETEXPR m.lcVal = TRANSFORM(THIS.evaluateUserExpression(Execute)) ELSE m.lcVal = Execute ENDIF ENDIF IF NOT EMPTY(m.lcVal) m.lcInfo = m.lcInfo + " "+THIS.titleAttr +"='"+m.lcVal+"'" ENDIF SELECT (THIS.MemberDataAlias) m.lcVal = "" LOCATE FOR FRXRecno = m.liRecno AND ; Type = FRX_BLDR_MEMBERDATATYPE AND ; Name = FRX_BLDR_NAMESPACE_ADVANCEDPROPS AND ; ExecWhen = FRX_BLDR_ADVPROP_HTML_ITEMANCHOR IF FOUND() IF VAL(DeClass) = ADVPROP_EDITMODE_GETEXPR m.lcVal = TRANSFORM(THIS.evaluateUserExpression(Execute)) ELSE m.lcVal = Execute ENDIF ENDIF IF NOT EMPTY(m.lcVal) m.lcInfo = m.lcInfo + " "+ ; THIS.anchorAttr +"='"+ ; THIS.pathEncode(m.lcVal, .T.)+"'" ENDIF SELECT FRX ENDIF RETURN m.lcInfo ENDPROC PROCEDURE getdefaultuserxslt LOCAL m.lcResult m.lcResult = THIS.getDefaultUserXSLTAsString() * document properties, general m.lcResult = STRTRAN(m.lcResult,"@id='description'","@id='"+FRX_BLDR_ADVPROP_DESCRIPTION+"'") m.lcResult = STRTRAN(m.lcResult,"@id='author'","@id='"+FRX_BLDR_ADVPROP_AUTHOR+"'") m.lcResult = STRTRAN(m.lcResult,"@id='keywords'","@id='"+FRX_BLDR_ADVPROP_KEYWORDS+"'") m.lcResult = STRTRAN(m.lcResult,"@id='title'","@id='"+FRX_BLDR_ADVPROP_TITLE+"'") m.lcResult = STRTRAN(m.lcResult,"@id='copyright'","@id='"+FRX_BLDR_ADVPROP_COPYRIGHT+"'") m.lcResult = STRTRAN(m.lcResult,"@id='date'","@id='"+FRX_BLDR_ADVPROP_DATE+"'") * document properties, HTML-specific m.lcResult = STRTRAN(m.lcResult,"@id='css_sheet'","@id='"+FRX_BLDR_ADVPROP_HTML_CSS_FILE +"'") m.lcResult = STRTRAN(m.lcResult,"@id='http-equiv'","@id='"+FRX_BLDR_ADVPROP_HTML_HTTPEQUIV +"'") * base VFP-RDL XML characteristics set m.lcResult = STRTRAN(m.lcResult,"@h","@"+ THIS.HeightAttr) m.lcResult = STRTRAN(m.lcResult,"@w","@"+ THIS.WidthAttr) m.lcResult = STRTRAN(m.lcResult,"@l","@"+ THIS.LeftAttr) m.lcResult = STRTRAN(m.lcResult,"@t","@"+ THIS.TopAttr) m.lcResult = STRTRAN(m.lcResult,"@c","@"+ THIS.ContAttr) m.lcResult = STRTRAN(m.lcResult,"@idref","@"+ THIS.IdRefAttribute) m.lcResult = STRTRAN(m.lcResult,"@id","@"+THIS.IdAttribute) m.lcResult = STRTRAN(m.lcResult,"@img","@"+THIS.imageSrcAttr ) * dynamic data and page-image extension set implemented in XMLListener m.lcResult = STRTRAN(m.lcResult,"@DTEXT","@"+THIS.dataTextAttr ) m.lcResult = STRTRAN(m.lcResult,"@DTYPE","@"+THIS.dataTypeAttr ) m.lcResult = STRTRAN(m.lcResult,"@PLINK","@"+THIS.pageImageAttr ) * dynamic formatting extension set implemented in XMLDisplayListener m.lcResult = STRTRAN(m.lcResult,"@PA","@"+THIS.penAlphaAttr ) m.lcResult = STRTRAN(m.lcResult,"@PR","@"+THIS.penRedAttr ) m.lcResult = STRTRAN(m.lcResult,"@PG","@"+THIS.penGreenAttr ) m.lcResult = STRTRAN(m.lcResult,"@PB","@"+THIS.penBlueAttr ) m.lcResult = STRTRAN(m.lcResult,"@FA","@"+THIS.fillAlphaAttr ) m.lcResult = STRTRAN(m.lcResult,"@FR","@"+THIS.fillRedAttr ) m.lcResult = STRTRAN(m.lcResult,"@FG","@"+THIS.fillGreenAttr ) m.lcResult = STRTRAN(m.lcResult,"@FB","@"+THIS.fillBlueAttr ) m.lcResult = STRTRAN(m.lcResult,"@FNAME","@"+THIS.fontNameAttr ) m.lcResult = STRTRAN(m.lcResult,"@FSIZE","@"+THIS.fontSizeAttr ) m.lcResult = STRTRAN(m.lcResult,"@FSTYLE","@"+THIS.fontStyleAttr ) * dynamic HTML extension set implemented in this class m.lcResult = STRTRAN(m.lcResult,"@title","@"+THIS.titleAttr ) m.lcResult = STRTRAN(m.lcResult,"@alt","@"+THIS.titleAttr ) m.lcResult = STRTRAN(m.lcResult,"@css","@"+THIS.cssClassAttr ) m.lcResult = STRTRAN(m.lcResult,"@CSS","@"+THIS.cssClassOverrideAttr ) m.lcResult = STRTRAN(m.lcResult,"@anchor","@"+THIS.anchorAttr ) m.lcResult = STRTRAN(m.lcResult,"@hlink","@"+THIS.linkAttr ) THIS.XSLTProcessorUser = m.lcResult ENDPROC PROCEDURE Init IF DODEFAULT() THIS.AppName = OUTPUTHTML_APPNAME_LOC RETURN .F. ENDIF RETURN NOT THIS.HadError ENDPROC PROCEDURE setdomformattinginfo LPARAMETERS m.toNode, m.tnLeft, m.tnTop, m.tnWidth, m.tnHeight, m.tnObjectContinuationType LOCAL m.lcVal, m.liRecno DODEFAULT( m.toNode, m.tnLeft, m.tnTop, m.tnWidth,m.tnHeight, m.tnObjectContinuationType) THIS.setFRXDataSession() m.liRecno = RECNO("FRX") IF USED(THIS.MemberDataAlias) AND ; SEEK(m.liRecno,THIS.MemberDataAlias,"FRXRecno") SELECT (THIS.MemberDataAlias) m.lcVal = "" LOCATE FOR FRXRecno = m.liRecno AND ; Type = FRX_BLDR_MEMBERDATATYPE AND ; Name = FRX_BLDR_NAMESPACE_ADVANCEDPROPS AND ; ExecWhen = FRX_BLDR_ADVPROP_HTML_CSS_CLASSOVERRIDE IF FOUND() IF VAL(DeClass) = ADVPROP_EDITMODE_GETEXPR m.lcVal = TRANSFORM(THIS.evaluateUserExpression(Execute)) ELSE m.lcVal = Execute ENDIF ENDIF SELECT (THIS.MemberDataAlias) IF NOT EMPTY(m.lcVal) m.toNode.SetAttribute(THIS.cssClassOverrideAttr,m.lcVal ) ELSE * try again with other css class attribute LOCATE FOR FRXRecno = m.liRecno AND ; Type = FRX_BLDR_MEMBERDATATYPE AND ; Name = FRX_BLDR_NAMESPACE_ADVANCEDPROPS AND ; ExecWhen = FRX_BLDR_ADVPROP_HTML_CSS_CLASSEXTEND IF FOUND() IF VAL(DeClass) = ADVPROP_EDITMODE_GETEXPR m.lcVal = TRANSFORM(THIS.evaluateUserExpression(Execute)) ELSE m.lcVal = Execute ENDIF ENDIF IF NOT EMPTY(m.lcVal) m.toNode.SetAttribute(THIS.cssClassAttr,m.lcVal ) ENDIF ENDIF SELECT (THIS.MemberDataAlias) m.lcVal = "" LOCATE FOR FRXRecno = m.liRecno AND ; Type = FRX_BLDR_MEMBERDATATYPE AND ; Name = FRX_BLDR_NAMESPACE_ADVANCEDPROPS AND ; ExecWhen = FRX_BLDR_ADVPROP_HTML_ITEMHREF IF FOUND() IF VAL(DeClass) = ADVPROP_EDITMODE_GETEXPR m.lcVal = TRANSFORM(THIS.evaluateUserExpression(Execute)) ELSE m.lcVal = Execute ENDIF ENDIF IF NOT EMPTY(m.lcVal) m.toNode.SetAttribute(THIS.linkAttr,THIS.pathEncode(m.lcVal)) ENDIF SELECT (THIS.MemberDataAlias) m.lcVal = "" LOCATE FOR FRXRecno = m.liRecno AND ; Type = FRX_BLDR_MEMBERDATATYPE AND ; Name = FRX_BLDR_NAMESPACE_ADVANCEDPROPS AND ; ExecWhen = FRX_BLDR_ADVPROP_HTML_ITEMTITLE IF FOUND() IF VAL(DeClass) = ADVPROP_EDITMODE_GETEXPR m.lcVal = TRANSFORM(THIS.evaluateUserExpression(Execute)) ELSE m.lcVal = Execute ENDIF ENDIF IF NOT EMPTY(m.lcVal) m.toNode.SetAttribute(THIS.titleAttr,m.lcVal ) ENDIF SELECT (THIS.MemberDataAlias) m.lcVal = "" LOCATE FOR FRXRecno = m.liRecno AND ; Type = FRX_BLDR_MEMBERDATATYPE AND ; Name = FRX_BLDR_NAMESPACE_ADVANCEDPROPS AND ; ExecWhen = FRX_BLDR_ADVPROP_HTML_ITEMANCHOR IF FOUND() IF VAL(DeClass) = ADVPROP_EDITMODE_GETEXPR m.lcVal = TRANSFORM(THIS.evaluateUserExpression(Execute)) ELSE m.lcVal = Execute ENDIF ENDIF IF NOT EMPTY(m.lcVal) m.toNode.SetAttribute(THIS.anchorAttr,THIS.pathEncode(m.lcVal) ) ENDIF SELECT FRX ENDIF ENDPROC PROCEDURE BeforeReport DODEFAULT() THIS.oldPageImageType = -1 IF THIS.XMLMode # OUTPUTXML_RDL_ONLY LOCAL llSetting, liSelect THIS.setFRXDataSession() IF USED(THIS.memberDataAlias) m.liSelect = SELECT(0) SELECT (THIS.memberDataAlias) LOCATE FOR Type == FRX_BLDR_MEMBERDATATYPE AND ; Name == FRX_BLDR_NAMESPACE_ADVANCEDPROPS AND ; ExecWhen == FRX_BLDR_ADVPROP_HTML_PAGEIMAGEHREF AND ; THIS.evaluateStringToBoolean(Execute) IF FOUND() AND THIS.pageImageType = 0 THIS.oldPageImageType = 0 THIS.pageImageType = OUTPUTHTML_DEFAULT_PAGEIMAGE_TYPE IF THIS.ListenerType = LISTENER_TYPE_DEF THIS.ListenerType = LISTENER_TYPE_PAGED ENDIF IF THIS.supportsPageImages() THIS.makeExternalFileLocationReachable() ELSE IF NOT THIS.IsSuccessor THIS.pageImageType = 0 ENDIF ENDIF ENDIF IF NOT THIS.CommandClauses.NoPageEject * we can only make this adjustment once per chain, * since it can only be applied once per chain. * Last one wins. LOCATE FOR Type == FRX_BLDR_MEMBERDATATYPE AND ; Name == FRX_BLDR_NAMESPACE_ADVANCEDPROPS AND ; ExecWhen == FRX_BLDR_ADVPROP_HTML_TEXTAREAS_OFF IF FOUND() llSetting = THIS.evaluateStringToBoolean(Execute) IF VARTYPE(THIS.xsltParameters) = "O" AND ; THIS.xsltParameters.GetKey("useTextAreaForStretchingText") > 0 THIS.oldTextAreaSetting = THIS.xsltParameters["useTextAreaForStretchingText"] ELSE THIS.oldTextAreaSetting = 1 ENDIF THIS.adjustXSLTParameter( ; IIF(llSetting,0,1),"useTextAreaForStretchingText") ENDIF ENDIF ENDIF ENDIF THIS.resetDataSession() ENDPROC PROCEDURE AfterReport LPARAMETERS tlCalledEarly DODEFAULT(tlCalledEarly) IF THIS.oldPageImageType <> -1 THIS.pageImageType = THIS.oldPageImageType ENDIF THIS.resetDataSession() * by CChalom IF This.lObjTypeMode LOCAL llSaved llSaved = FILE(This.targetFileName) IF llSaved _Screen.oFoxyPreviewer.lSaved = llSaved IF This.lOpenViewer This.ShellExec(This.TargetFileName) ENDIF ENDIF ENDIF ENDPROC PROCEDURE applyusertransformtooutput DODEFAULT() IF THIS.oldTextAreaSetting <> -1 THIS.adjustXSLTParameter( THIS.oldTextAreaSetting,"useTextAreaForStretchingText") THIS.oldTextAreaSetting = -1 ENDIF ENDPROC PROCEDURE LoadReport This.UpdateProperties() DODEFAULT() ENDPROC VNEWVAL THIS ISRUNNING READCONFIGURATION2 OutputConfig OutputConfig OutputConfig ObjCode OutputConfig PROPERTY THIS. |METHOD| |EVENT| THIS. TLCALLEDFROMINIT THIS ISRUNNING LISELECT LCPEM LLOPENED LCORDER LITYPE LLQUIET QUIETMODE GETCONFIGTABLE CONFIGURATIONTABLE OBJCODE HADERROR VERIFYCONFIGTABLE OUTPUTCONFIG CONFIGURATIONOBJTYPE OBJTYPE OBJNAME OBJVALUE FoxyOutputConfig FoxyOutputConfig _ReportOutputConfig FoxyOutputConfig Configuration table was created. TLFORCEEXTERNAL LCDBF LCPATH LLISDBF THIS ISRUNNING GETPATHFOREXTERNALS CREATECONFIGTABLE DOMESSAGE CONFIGURATIONTABLEP DoMessage "Welcome to the demo run!",64 Sample initialization/config method call TargetFileName "xxx" Sample initialization/config property TCDBF TLOVERWRITE LISELECT LCFILE OBJTYPE OBJCODE OBJNAME OBJVALUE OBJINFO ONDELETED File cannot be created. File cannot be created. VERIFYTARGETFILE TARGETHANDLE TARGETFILENAME HADERROR DOMESSAGE LASTERRORMESSAGEA ?*"<>| ?*"<>| LCFILE TARGETFILENAME TARGETFILEEXTD VNEWVAL THIS ISRUNNING TARGETFILEEXTD VNEWVAL THIS ISRUNNING TARGETFILENAMED VNEWVAL THIS ISRUNNING TARGETHANDLE created your report as However, an error occurred during processing. Report execution was cancelled. Your results are not complete. created your report as However, an error occurred during processing. Report execution was cancelled. Your results are not complete. was not able to create your report. was not able to create your report. LADUMMY TARGETHANDLE TARGETFILENAME HADERROR DOMESSAGE APPNAME LASTERRORMESSAGEB .OBJTYPE .OBJCODE .OBJNAME .OBJVALUE .OBJINFO Configuration table is not in correct format. EXACTv OBJTYPE OBJCODE OBJNAME OBJVALUE DELETED() SAFETYv Configuration table is missing C one or more required indexes. TCALIAS TCFAILUREMSGTABLE TCFAILUREMSGINDEXES LCTABLE LCMESSAGE LCALIAS LISELECT LLRETURN LITAGCOUNT LAREQUIRED LAKEYS LIFOUND LLEXACTOFF LLSAFETYON OBJTYPE OBJCODE OBJNAME OBJVALUE ONDELETED THIS DOMESSAGE LASTERRORMESSAGE VNEWVAL THIS ISRUNNING EXTERNALFILELOCATION{ VNEWVAL PAGEIMAGETYPE PAGEIMAGEEXTENSION GETPAGEIMAGEEXTENSION LCEXT PAGEIMAGETYPE TIPAGE TLFULLPATH LCFILENAME TARGETFILENAME PAGEIMAGEEXTENSION EXTERNALFILELOCATION OUTPUTPAGE AFTERREPORT UNLOADREPORT TCMETHODTOKEN ISSUCCESSOR PAGEIMAGETYPE LISTENERTYPEd TIPAGE LCFILE LLERROR PAGEIMAGETYPE GENERATEPAGEIMAGEFILENAME OUTPUTPAGEQ TVNEWVAL CURRENTPAGEIMAGEFILENAME EXTERNALFILELOCATION TARGETFILENAME LLRUNNING ISRUNNING You have asked for page image files to be generated, C but this report run is not in a mode that currently supports this feature. Your main output file will be generated without them. NBANDOBJCODE NFRXRECNO SUPPORTSPAGEIMAGES LCFILE LIPAGENO PAGEIMAGETYPE COMMANDCLAUSES RANGEFROM ISSUCCESSOR SHAREDPAGENO PAGENO GENERATEPAGEIMAGEFILENAME CURRENTPAGEIMAGEFILENAME SUCCESSOR TWOPASSPROCESS CURRENTPASS DOMESSAGE currentPageImageFilename CURRENTPAGEIMAGEFILENAME PAGEIMAGETYPE SUPPORTSPAGEIMAGES ISSUCCESSOR LISTENERTYPE! MAKEEXTERNALFILELOCATIONREACHABLE SUCCESSOR ADDPROPERTY READCONFIGURATION SETCONFIGURATION RESETDATASESSION CLOSETARGETFILE} FileOutput Listener APPNAME READCONFIGURATION SETCONFIGURATION HADERROR AFTERREPORT COMMANDCLAUSES NOPAGEEJECT SUPPORTSPAGEIMAGES LCFILELOCATION LIPAGE LCFILE EXTERNALFILELOCATION! MAKEEXTERNALFILELOCATIONREACHABLE OUTPUTPAGECOUNT OUTPUTPAGEIMAGE OUTPUTPAGE NPAGENO EDEVICE NDEVICETYPE NLEFT NWIDTH NHEIGHT NCLIPLEFT NCLIPTOP NCLIPWIDTH NCLIPHEIGHT SUPPORTSPAGEIMAGES OUTPUTPAGEIMAGE readconfiguration_assign, setconfiguration getconfigtable createconfigtable opentargetfile verifytargetfile targetfileext_assignx targetfilename_assign targethandle_assign[ closetargetfile verifyconfigtable configurationobjtype_access externalfilelocation_assign% pageimagetype_assign getpageimageextension generatepageimagefilename supportspageimages outputpageimage currentpageimagefilename_assign makeexternalfilelocationreachable BeforeBand*! BeforeReport'% setfrxdatasessionenvironment Destroy!' InitU' AfterReport OutputPage DOSTATUS UPDATESTATUS CLEARSTATUS AFTERBAND AFTERREPORT m.toListener.CommandClauses.RecordTotalb BEFOREBAND DATASESSIONv BEFOREREPORT CANCELREPORT DATASESSIONv LOADREPORT reportStartRunDatetime m.toListener.CommandClauses.NoDialogb UNLOADREPORT reportStopRunDatetime TOLISTENER TCMETHODTOKEN TP12 LISESSION DOSTATUS UPDATESTATUS CLEARSTATUS SYNCHSTATUS ISRUNNING CURRENTRECORD COMMANDCLAUSES RECORDTOTAL DESIGNATEDDRIVER DRIVINGALIAS SUCCESSORSYS2024 VISIBLE REPORTSTOPRUNDATETIME POPUSERFEEDBACKGLOBALSETS CURRENTPASS CURRENTDATASESSION SETUPREPORT QUIETMODE PAGELIMIT PAGENO ALLOWMODALMESSAGES DOMESSAGE CANCELQUERYTEXT ATTENTIONTEXT CANCELREQUESTED ISSUCCESSOR REPORTINCOMPLETETEXT RESETUSERFEEDBACK ADDPROPERTY REPORTSTARTRUNDATETIME NODIALOG INITSTATUSTEXT PUSHUSERFEEDBACKGLOBALSETS PERSISTBETWEENRUNS LISTENERDATASESSION RELEASE9 VNEWVAL INCLUDESECONDS9 VNEWVAL INITSTATUSTEXT9 VNEWVAL PREPASSSTATUSTEXT VNEWVAL RUNSTATUSTEXT VNEWVAL SECONDSTEXT VNEWVAL LCTYPE CMESSAGE THERMCAPTIONF VNEWVAL THERMFORMCAPTION SETTHERMFORMCAPTION VNEWVAL THERMFORMHEIGHT THERMMARGIN SYNCHUSERINTERFACE VNEWVAL THERMFORMWIDTH THERMMARGIN SYNCHUSERINTERFACE~ VNEWVAL THERMFORMHEIGHT THERMFORMWIDTH THERMMARGIN SYNCHUSERINTERFACE _SCREEN.ActiveFormb THIS.CommandClauses.InWindowb THIS.CommandClauses.Windowb _SCREEN.ActiveFormb _SCREEN.ActiveFormb LOFORM LOTOPFORM LCINWINDOW ACTIVEFORM SHOWWINDOW COMMANDCLAUSES INWINDOW WINDOW FORMS NAME FORMCOUNT6 WINDOWS SKIPv TOLISTENER LISELECT LCALIAS LISKIPS LASKIPS FRXDATASESSION DESIGNATEDDRIVER DRIVINGALIAS OBJTYPE OBJCODE CURRENTDATASESSION PLATFORM TLRESETTIMES CURRENTRECORD PERCENTDONE REPORTSTARTRUNDATETIME REPORTSTOPRUNDATETIME THERMFORMCAPTION SYNCHUSERINTERFACE TCCOMMANDCLAUSESFILE TCPRINTJOBNAME THERMFORMCAPTION CNAME CANCELINSTRTEXT CAPTION@ TOLISTENER NBANDOBJCODE NFRXRECNO THIS ISRUNNING FRXBANDRECNO CURRENTDATASESSION DRIVINGALIASCURRENTRECNO DRIVINGALIAS CURRENTRECORD COMMANDCLAUSES RECORDTOTAL CURRENTPASS TWOPASSPROCESS RESETUSERFEEDBACK UPDATESTATUS LISTENERDATASESSION MACDESKTOP SCREEN MACDESKTOP SCREEN TOLISTENER CMESSAGE LOPARENTFORM LCCAPTION LCPARENTFORMNAME QUIETMODE THIS ISRUNNING COMMANDCLAUSES NODIALOG THERMCAPTION CLOSABLE MOVABLE THERMSHAPE WIDTH PERCENTDONE THERMBACK VISIBLE GETPARENTWINDOWREF DESKTOP MACDESKTOP SHOWWINDOW ALWAYSONTOP AUTOCENTER THERMLABEL CAPTION LEFT. TOLISTENER VISIBLE> TOLISTENER THIS ISRUNNING LIRECTOTAL LNNEWPERCENT LLSHOW COMMANDCLAUSES RECORDTOTAL CURRENTRECORD THERMPRECISION PERCENTDONE DOSTATUS CURRENTPASS TWOPASSPROCESS PREPASSSTATUSTEXT RUNSTATUSTEXTM Notify ESCAPE PUBLIC &lcRef. ON ESCAPE &lcRef..CancelReport() ESCAPEv TOLISTENER STARTMODE LCREF SETNOTIFYCURSOR ONESCAPECOMMAND ESCAPEREFERENCE SETESCAPE RELEASE &lcRef. ON ESCAPE &lcRef STARTMODE LCREF ESCAPEREFERENCE ONESCAPECOMMAND SETNOTIFYCURSOR SETESCAPE GetSysColor Win32API GETSYSCOLOR WIN32API LITHERMTOP LITHERMLEFT LITHERMWIDTH LITHERMHEIGHT HEIGHT THERMFORMHEIGHT WIDTH THERMFORMWIDTH CONTROLBOX CLOSABLE MOVABLE THERMMARGIN SETTHERMFORMCAPTION THERMBACK THERMLABEL PARENT FORECOLOR THERMSHAPE BACKCOLOR FILLCOLOR m.toListener.CommandClauses.Summaryb Summary- m.toListener.CommandClauses.RecordTotalb RecordTotal m.toListener.CommandClauses.NoDialogb NoDialog- WINDOWS WINDOWS WINDOWS WINDOWS WINDOWS TOLISTENER LLFRXAVAILABLE LCALIAS THIS ISRUNNING CURRENTDATASESSION DRIVINGALIAS FRXDATASESSION GETREPORTSCOPEDRIVER SETTHERMFORMCAPTION COMMANDCLAUSES PRINTJOBNAME FRXBANDRECNO SUMMARY OBJTYPE OBJCODE PLATFORM DRIVINGALIASCURRENTRECNO LISTENERDATASESSION= VNEWVAL THERMPRECISION7 VNEWVAL PERSISTBETWEENRUNS CancelInstrText CancelQueryText ReportIncompleteText AttentionText INITSTATUS PREPSTATUS RUNSTATUS SECONDS CANCELINST CANCELQUER REPINCOMPL ATTENTION Initializing... Running calculation prepass... Creating output... sec(s) Press Esc to cancel... Stop report execution?C (If you press 'No', report execution will continue.) Report execution was cancelled.C Your results are not complete. Attention m.cMessage+ " "+ TRANSFORM(THIS.PercentDone,"999"+ IIF(THIS.ThermPrecision=0,"","."+REPL("9",THIS.ThermPrecision))) + "%" + IIF(NOT THIS.IncludeSeconds, "" , " "+ TRANSFORM(IIF(THIS.IsRunning,DATETIME(), THIS.ReportStopRunDateTime)- THIS.ReportStartRunDateTime)+" " + THIS.SecondsText) ADDPROPERTY NAME _GOHELPER INITSTATUSTEXT GETLOC PREPASSSTATUSTEXT RUNSTATUSTEXT SECONDSTEXT CANCELINSTRTEXT CANCELQUERYTEXT REPORTINCOMPLETETEXT ATTENTIONTEXT THERMCAPTION RESETUSERFEEDBACK applyfx, includeseconds_assign initstatustext_assign prepassstatustext_assignd runstatustext_assign secondstext_assign thermcaption_assign= thermformcaption_assign thermformheight_assign thermformwidth_assignv thermmargin_assignb getparentwindowref5 getreportscopedriver resetuserfeedbackw setthermformcaption synchstatus dostatus clearstatusE updatestatus pushuserfeedbackglobalsets popuserfeedbackglobalsetsX# synchuserinterface setupreport thermprecision_assign persistbetweenruns_assign Initd. PROCEDURE xmlrawtag LPARAMETERS m.tcNode, m.tlOpen, m.tcID, m.tcIDRef, m.tvFormatting LOCAL m.lcNode IF ISNULL(m.tlOpen) OR m.tlOpen m.lcNode = "<" + m.tcNode IF NOT EMPTY(m.tcID) m.lcNode = m.lcNode + " "+THIS.idAttribute+"='"+m.tcID+"'" ENDIF IF NOT EMPTY(m.tcIDRef) m.lcNode = m.lcNode + " "+THIS.idRefAttribute+"='"+m.tcIDRef+"'" ENDIF IF NOT EMPTY(m.tvFormatting) m.lcNode = m.lcNode + " " + m.tvFormatting ENDIF IF ISNULL(m.tlOpen) m.lcNode = m.lcNode + "/" ENDIF m.lcNode = m.lcNode + ">" m.lcNode = "" ENDIF RETURN m.lcNode ENDPROC PROCEDURE xmlrawnode LPARAMETERS m.tcNode,m.tcValue, m.tvID, m.tvIDRef, m.tvFormatting LOCAL m.lcValue, m.lcNode IF PARAMETERS() < 2 m.lcValue = "" m.lcValue = THIS.XMLRawConv(m.tcValue) ENDIF IF EMPTY(m.lcValue) m.lcNode = THIS.XMLRawTag(m.tcNode,NULL, m.tvID, m.tvIDRef, m.tvFormatting) m.lcNode = THIS.XMLRawTag(m.tcNode, .T., m.tvID, m.tvIDRef, m.tvFormatting)+m.lcValue+THIS.XMLRawTag(m.tcNode) ENDIF RETURN m.lcNode ENDPROC PROCEDURE xmlrawconv LPARAMETERS m.tcValue LOCAL m.lcValue, m.liChar * must have ampersand as the first STRTRAN() m.lcValue = STRTRAN(m.tcValue, '&', '&' ) m.lcValue = STRTRAN(m.lcValue, '<', '<' ) m.lcValue = STRTRAN(m.lcValue, '>', '>' ) m.lcValue = STRTRAN(m.lcValue, '"', '"' ) m.lcValue = STRTRAN(m.lcValue, ['], ''' ) m.lcValue = CHRTRAN(m.lcValue, CHR(0)+CHR(4), " ") RETURN m.lcValue * TBD: make any adjustments * and, if needed, for different element types if needed ENDPROC PROCEDURE writeraw LPARAMETERS m.tcContents FWRITE(THIS.TargetHandle, m.tcContents) ENDPROC PROCEDURE includebreaksindata_assign LPARAMETERS m.vNewVal * Readonly during report run IF VARTYPE(m.vNewVal) = "N" AND ; INLIST(m.vNewVal, ; OUTPUTXML_BREAKS_INDATA,; OUTPUTXML_BREAKS_NONE, ; OUTPUTXML_BREAKS_COLLECTION) AND ; NOT THIS.IsRunning THIS.IncludeBreaksInData = m.vNewVal ENDIF ENDPROC PROCEDURE xmlmode_assign LPARAMETERS m.vNewVal * Readonly during report run IF NOT THIS.IsRunning IF VARTYPE(m.vNewVal) = "N" AND ; INLIST(m.vNewVal,; OUTPUTXML_DATA_ONLY,; OUTPUTXML_RDL_ONLY, ; OUTPUTXML_DATA_RDL) THIS.xmlmode = m.vNewVal ENDIF ENDIF ENDPROC PROCEDURE resetreport THIS.IncludePage = .T. THIS.IsRunning = .F. THIS.DataNodes = NULL THIS.PageNodes = NULL THIS.ColumnNodes = NULL THIS.CurrentBand = NULL THIS.CurrentPage = NULL THIS.CurrentColumn = NULL THIS.evaluateContentsValues = NULL THIS.successorGFXNoRender = NULL THIS.ClearStatus() ENDPROC PROCEDURE applyxslt LPARAMETERS m.tvSource, m.tvProcessor, m.tvParamCollection, m.tvFRXAlias LOCAL m.loSource, m.loProcessor, m.lcReturn, m.llSuccess, m.liParam, m.liSession, m.llCharsetsInUse m.lcReturn = "" STORE NULL TO m.loSource, m.loProcessor IF VARTYPE(m.tvSource) = "C" * first param can be filename, string, or object * if filename or string, test existance * and try to load as a dom object * m.liSession = SET("DATASESSION") * THIS.resetDataSession() m.llCharsetsInUse = THIS.frxCharsetsInUse(m.tvFRXAlias) m.loSource = CREATEOBJECT(OUTPUTXML_DOMDOCUMENTOBJECT) THIS.fixMSXMLObjectForDTDs(m.loSource) DO CASE CASE FILE(m.tvSource) AND NOT m.llCharsetsInUse m.loSource.Load(m.tvSource) CASE FILE(m.tvSource) *&* m.loSource.Load(m.tvSource) *&* would introduce problems with the (multi) charset-handling *&* in FRX by engine *&* see notes below m.loSource.LoadXML(FILETOSTR(m.tvSource)) OTHERWISE m.loSource.LoadXML(m.tvSource) ENDCASE * SET DATASESSION TO (m.liSession) IF NOT ISNULL(m.loSource) AND ; LEN(m.loSource.XML) > 0 AND ; EMPTY(m.loSource.parseError.reason) m.llSuccess = .T. ELSE m.loSource = NULL * IF NOT ISNULL(m.loSource) * THIS.LastErrorMessage = loSource.parseError.reason * ENDIF ENDIF * if object, test nodetypestring availability * and then for document/tree shape. IF VARTYPE(m.tvSource) = "O" TRY IF INLIST("|"+UPPER(m.tvSource.nodeTypeString)+"|", ; "|DOCUMENT|","|ELEMENT|") && quick and dirty test for tree shape m.loSource = m.tvSource m.llSuccess = .T. ENDIF ENDTRY ENDIF ENDIF IF m.llSuccess * for failed transformations, return source XML m.lcReturn = m.loSource.XML * as above * second param can be filename or object * if filename, as above * if object, test for appropriate interface * figure out if it's a processor factory * or an instance (either dom or stylesheet) * and error out if we can't figure it out m.llSuccess = .F. IF VARTYPE(m.tvProcessor) = "C" m.loProcessor = THIS.LoadProcessorObject(m.tvProcessor) IF NOT ISNULL(m.loProcessor) m.loProcessor = m.loProcessor.createProcessor() ENDIF ELSE IF VARTYPE(m.tvProcessor) = "O" TRY IF VARTYPE(m.tvProcessor.styleSheet) = "O" m.loProcessor = m.tvProcessor * if the object was a processor object * get a stylesheet instance m.loProcessor = m.loProcessor.createProcessor() ENDIF CATCH * just want to swallow the errors here because * of the primitive tests being used ENDTRY ENDIF ENDIF IF NOT ISNULL(m.loProcessor) m.llSuccess = .T. ENDIF ENDIF IF m.llSuccess WITH m.loProcessor IF VARTYPE(m.tvParamCollection) = "O" AND ; UPPER(m.tvParamCollection.BaseClass) == "COLLECTION" AND ; m.tvParamCollection.Count > 0 FOR m.liParam = 1 TO m.tvParamCollection.Count .AddParameter(m.tvParamCollection.GetKey(m.liParam), ; m.tvParamCollection.Item(m.liParam)) ENDFOR ENDIF * always override for current external file location info, if we have one: IF NOT EMPTY(THIS.externalFileLocation) .AddParameter("externalFileLocation", THIS.externalFileLocation) ENDIF .input = m.loSource .transform() m.lcReturn = .output ENDWITH ENDIF STORE NULL TO m.loSource, m.loProcessor *&* Sedna change to *&* ensure UTF-8 File contents per documented *&* behavior of this class. xsl:output encoding is ignored *&* by the msxml processor transform anyway when outputting *&* to a string (see http://msdn2.microsoft.com/en-us/library/ms753765.aspx) *&* and as a result we are outputting a file with no encoding *&* specified after the transform. So we should ensure that it *&* is in the default XML encoding when none is specified, *&* which is UTF-8. But Fox has changed the UTF-16 return value *&* from the MSXML processor objects to DBCS. We need to fix *&* that at the time we send to disk for other applications to *&* read, can't do it before this point. We can't do it *&* in cases where the user has marked explicit fontcharsets in *&* the FRX, since this information is passed along in VFP-RDL XML *&* and could be treated differently by different output mechanisms/XSLT. *&* We will preserve original behavior in that case. IF m.llCharsetsInUse RETURN m.lcReturn RETURN (STRCONV(m.lcReturn,STRCONV_DBCS_UTF8)) ENDIF ENDPROC PROCEDURE currentdocument_assign LPARAMETERS m.vNewVal * TBD: evaluate for readonly status during the life of the report run THIS.currentdocument = m.vNewVal ENDPROC PROCEDURE idattribute_assign LPARAMETERS m.vNewVal IF (NOT THIS.IsRunning) AND THIS.VerifyNCName(m.vNewVal) THIS.idattribute = m.vNewVal ENDIF ENDPROC PROCEDURE idrefattribute_assign LPARAMETERS m.vNewVal IF (NOT THIS.IsRunning) AND THIS.VerifyNCName(m.vNewVal) THIS.idrefattribute = m.vNewVal ENDIF ENDPROC PROCEDURE xsltprocessorrdl_assign LPARAMETERS m.vNewVal DO CASE CASE VARTYPE(m.vNewVal) = "X" THIS.XSLTProcessorRDL = NULL CASE VARTYPE(m.vNewVal) = "O" TRY IF VARTYPE(m.vNewVal.stylesheet) = "O" THIS.XSLTProcessorRDL = m.vNewVal ENDIF CATCH ENDTRY CASE VARTYPE(m.vNewVal) = "C" LOCAL m.loProcessor m.loProcessor = THIS.LoadProcessorObject(m.vNewVal) IF NOT ISNULL(m.loProcessor) THIS.XSLTProcessorRDL = m.loProcessor ENDIF ENDCASE ENDPROC PROCEDURE xsltprocessoruser_assign LPARAMETERS m.vNewVal DO CASE CASE VARTYPE(m.vNewVal) = "X" THIS.XSLTProcessorUser = NULL CASE VARTYPE(m.vNewVal) = "O" TRY IF VARTYPE(m.vNewVal.stylesheet) = "O" THIS.XSLTProcessorUser = m.vNewVal ENDIF CATCH ENDTRY CASE VARTYPE(m.vNewVal) = "C" LOCAL m.loProcessor m.loProcessor = THIS.LoadProcessorObject(m.vNewVal) IF NOT ISNULL(m.loProcessor) THIS.XSLTProcessorUser = m.loProcessor ENDIF ENDCASE ENDPROC PROCEDURE resetdocument * Do *not* reset * page number/total THIS.ResetReport() THIS.CloseTargetFile() THIS.NoPageEject = .F. IF THIS.HadError THIS.ResetToDefault("QuietMode") ENDIF THIS.CurrentDocument = NULL ENDPROC PROCEDURE verifyncname LPARAMETERS m.tcName LOCAL m.llValid, m.liChar, m.lcChar DO CASE CASE VARTYPE(m.tcName) # "C" OR EMPTY(m.tcName) * invalid CASE LEFT(m.tcName,1) # "_" AND NOT ISALPHA(LEFT(m.tcName,1)) * invalid CASE LEFT(UPPER(m.tcName),3) = "XML" * invalid OTHERWISE m.llValid = .T. FOR m.liChar = 2 TO LEN(tcName) m.lcChar = SUBSTR(m.tcName,m.liChar,1) IF NOT (ISALPHA(m.lcChar) OR ; ISDIGIT(m.lcChar) OR ; INLIST(m.lcChar,".","-","_")) m.llValid = .F. EXIT ENDIF ENDFOR ENDCASE RETURN m.llValid ENDPROC PROCEDURE includeformattinginlayoutobjects_assign LPARAMETERS m.vNewVal *TBD: evaluate whether * it's okay to do this during a run? IF VARTYPE(m.vNewVal) = "L" THIS.IncludeFormattingInLayoutObjects = m.vNewVal ENDIF ENDPROC PROCEDURE includebandswithnoobjects_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "L" AND NOT THIS.IsRunning THIS.IncludeBandsWithNoObjects = m.vNewVal ENDIF ENDPROC PROCEDURE verifynodenames IF NOT USED("Nodes") RETURN .F. ENDIF IF ISREADONLY("Nodes") RETURN .T. ENDIF LOCAL m.liSelect, m.llSuccess m.liSelect = SELECT(0) m.llSuccess = .T. SELECT Nodes SCAN FOR BETWEEN(ObjType,OUTPUTXML_OBJTYPE_NODES,OUTPUTXML_OBJTYPE_NODES+99) ; AND NOT DELETED() IF NOT THIS.VerifyNCName(ObjValue) DELETE m.llSuccess = .F. ENDIF ENDSCAN SELECT (m.liSelect) RETURN m.llSuccess ENDPROC PROCEDURE verifyattributenames * abstract ENDPROC PROCEDURE nopageeject_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "L" AND NOT THIS.IsRunning THIS.NoPageEject = m.vNewVal ENDIF ENDPROC PROCEDURE loadprocessorobject LPARAMETERS m.tcVal LOCAL m.loReturn m.loReturn = NULL IF VARTYPE(m.tcVal) = "C" AND NOT EMPTY(m.tcVal) LOCAL m.loProcessor, m.loStylesheet, m.liSession m.liSession = SET("DATASESSION") THIS.resetDataSession() m.loProcessor = CREATEOBJECT(OUTPUTXML_XSLT_PROCESSOROBJECT) m.loStyleSheet = CREATEOBJECT(OUTPUTXML_DOMFREETHREADED_DOCUMENTOBJECT) THIS.fixMSXMLObjectForDTDs(m.loStyleSheet) SET DATASESSION TO (m.liSession) IF FILE(m.tcVal) m.loStyleSheet.Load(m.tcVal) ELSE * try to load it as a string m.loStyleSheet.LoadXML(m.tcVal) ENDIF IF LEN(m.loStyleSheet.XML) > 0 AND ; EMPTY(m.loStyleSheet.parseError.reason) m.loProcessor.styleSheet = loStyleSheet m.loReturn = m.loProcessor * ELSE * THIS.LastErrorMessage = loSStyleSheet.parseError.reason ENDIF ENDIF RETURN loReturn ENDPROC PROCEDURE getrawformattinginfo LPARAMETERS m.tnLeft, m.tnTop, m.tnWidth, m.tnHeight, m.tnObjectContinuationType LOCAL m.lcInfo m.lcInfo = "" m.lcInfo = m.lcInfo + " "+THIS.contAttr+"='"+TRANSFORM(m.tnObjectContinuationType)+"'" IF THIS.IncludeFormattingInLayoutObjects m.lcInfo = m.lcInfo + " "+THIS.leftAttr+"='"+ TRANSFORM(m.tnLeft)+"'" m.lcInfo = m.lcInfo + " "+THIS.topAttr+"='"+TRANSFORM(m.tnTop)+"'" m.lcInfo = m.lcInfo + " "+THIS.widthAttr+"='"+TRANSFORM(m.tnWidth)+"'" m.lcInfo = m.lcInfo + " "+THIS.heightAttr+"='"+TRANSFORM(m.tnHeight)+"'" ENDIF THIS.setFRXDataSession() m.llPageImages = (NOT EMPTY(THIS.currentPageImageFilename)) ; AND USED(THIS.memberDataAlias) IF THIS.includeDataTypeAttributes OR m.llPageImages IF USED(THIS.FormattingChanges) AND ; SEEK(RECNO("FRX"),THIS.FormattingChanges,"FRXRecno") SELECT (THIS.FormattingChanges) IF THIS.includeDataTypeAttributes IF EMPTY(DText) m.lcInfo = m.lcInfo + " "+THIS.dataTypeAttr+"='"+DType+"'" ELSE m.lcInfo = m.lcInfo + " "+THIS.dataTypeAttr+"='"+DType+"'" m.lcInfo = m.lcInfo + " "+THIS.dataTextAttr+"='"+THIS.xmlRawConv(DText)+"'" ENDIF ENDIF ENDIF IF m.llPageImages AND SEEK(RECNO("FRX"),THIS.memberDataAlias,"FRXRecno") SELECT (THIS.memberDataAlias) LOCATE FOR FRXRecno = RECNO("FRX") AND ; Type == FRX_BLDR_MEMBERDATATYPE AND ; Name == FRX_BLDR_NAMESPACE_ADVANCEDPROPS AND ; ExecWhen == FRX_BLDR_ADVPROP_HTML_PAGEIMAGEHREF AND ; THIS.evaluateStringToBoolean(Execute) IF FOUND() m.lcInfo = m.lcInfo + " " + THIS.pageImageAttr+"='"+ ; THIS.currentPageImageFilename +"'" ENDIF ENDIF SELECT FRX ENDIF RETURN m.lcInfo ENDPROC PROCEDURE topattr_assign LPARAMETERS m.vNewVal IF (NOT THIS.IsRunning) AND THIS.VerifyNCName(m.vNewVal) THIS.topAttr = m.vNewVal ENDIF ENDPROC PROCEDURE leftattr_assign LPARAMETERS m.vNewVal IF (NOT THIS.IsRunning) AND THIS.VerifyNCName(m.vNewVal) THIS.leftAttr = m.vNewVal ENDIF ENDPROC PROCEDURE heightattr_assign LPARAMETERS m.vNewVal IF (NOT THIS.IsRunning) AND THIS.VerifyNCName(m.vNewVal) THIS.heightAttr = m.vNewVal ENDIF ENDPROC PROCEDURE widthattr_assign LPARAMETERS m.vNewVal IF (NOT THIS.IsRunning) AND THIS.VerifyNCName(m.vNewVal) THIS.widthAttr = m.vNewVal ENDIF ENDPROC PROCEDURE contattr_assign LPARAMETERS m.vNewVal IF (NOT THIS.IsRunning) AND THIS.VerifyNCName(m.vNewVal) THIS.contAttr = m.vNewVal ENDIF ENDPROC PROCEDURE getvfprdlcontents LPARAMETERS m.tcNodeName, m.tlAsString * NB: no push/pop session here, don't bother * because we're switching back and forth * rapidly and not changing anything important LOCAL m.liSelectCurrent, m.liSelectFRX, m.liSession, ; m.liFlds, m.liDBFS, m.liIndex1, m.liIndex2, laFlds[1], ; laDBFS[1], laRels[1], m.lcAlias, m.lcKey, m.llDesc, ; m.lcFilter, m.lcRel, m.liRels, m.lcSkip, m.lcResult, m.llWholePage LOCAL m.oXA, m.oXT1, m.oXT2, m.oXT3, m.oXT4, m.oXT5,m.oXT6, ; m.oXML, m.oNode, m.oCommand m.liSession = SET("DATASESSION") THIS.setFRXDataSession() m.liSelectFRX = SELECT(0) IF THIS.IncludeDataSourcesInVFPRDL CREATE CURSOR VFPDataSource (the_alias c(200), rpt_driver l, the_dbf m, the_order m, order_desc l, the_filter m, the_skip m ) CREATE CURSOR flds (the_alias c(200), the_field m, the_type c(1)) CREATE CURSOR rels (the_parent c(200), the_target c(200), the_expr m) SELECT flds INDEX ON the_alias TAG the_alias SELECT rels INDEX ON the_parent TAG the_alias SELECT VFPDataSource SET RELATION TO the_alias INTO flds, the_alias INTO rels THIS.setCurrentDataSession() m.liSelectCurrent = SELECT(0) m.liDBFS = AUSED(laDBFS) FOR m.liIndex = 1 TO m.liDBFS THIS.setCurrentDataSession() m.lcAlias = laDBFs[m.liIndex,1] SELECT (m.lcAlias) m.lcDBF = DBF() m.liFlds = AFIELDS(laFlds) m.lcKey = SET("ORDER") m.llDesc = (" DESC" $ UPPER(m.lcKey)) m.lcFilter = SET("FILTER") m.lcSkip = SET("SKIP") IF NOT EMPTY(m.lcKey) m.lcKey = STRTRAN(UPPER(m.lcKey),"TAG","") m.liIndex2 = ATC(" OF",m.lcKey) IF m.liIndex2 > 0 m.lcKey = LEFT(m.lcKey,m.liIndex2) ENDIF m.lcKey = ALLTR(m.lcKey) m.liTag = TAGNO(m.lcKey) IF m.liTag > 0 m.lcKey = KEY(m.liTag) ELSE m.lcKey = "" ENDIF ENDIF m.liRels = 0 STORE "" TO laRels DO WHILE .T. m.lcRel = RELATION(m.liRels + 1) IF EMPTY(m.lcRel) EXIT ELSE m.liRels = m.liRels + 1 DIME laRels[m.liRels,3] laRels[m.liRels,1] = TARGET(m.liRels) laRels[m.liRels,2] = m.lcRel ENDIF ENDDO THIS.setFRXDataSession() INSERT INTO VFPDataSource VALUES (m.lcAlias, (UPPER(m.lcAlias)==UPPER(THIS.Drivingalias)), m.lcDBF, m.lcKey, m.llDesc, m.lcFilter, m.lcSkip) FOR m.liIndex2 = 1 TO m.liFlds INSERT INTO flds VALUES (m.lcAlias, laFlds[m.liIndex2,1], laFlds[m.liIndex2,2]) ENDFOR FOR m.liIndex2 = 1 TO m.liRels INSERT INTO rels VALUES (m.lcAlias, laRels[m.liIndex2,1], laRels[m.liIndex2,2]) ENDFOR ENDFOR THIS.setCurrentDataSession() SELECT (m.liSelectCurrent) ENDIF THIS.setFRXDataSession() m.lcAlias = THIS.prepareFrxCopy() m.lcResult = THIS.getFRXLayoutObjectFieldList(m.lcAlias) SELECT &lcResult ; FROM (m.lcAlias) ; LEFT JOIN Bands ON &lcAlias..UniqueID = Bands.UniqueID ; LEFT JOIN Objects ON &lcAlias..UniqueID = Objects.UniqueID ; WHERE Platform = FRX_PLATFORM_WINDOWS AND NOT DELETED() ; INTO CURSOR VFPFRXLayoutObject READWRITE THIS.removeFRXCopy(m.lcAlias) SELECT VFPFRXLayoutObject * get rid of compiled data: IF TYPE("VFPFRXLayoutObject.Tag") # "U" REPLACE Tag WITH "" ALL FOR NOT INLIST(ObjType,FRX_OBJTYP_VARIABLE,FRX_OBJTYP_BAND,FRX_OBJTYP_DATAENV ,FRX_OBJTYP_DATAOBJ) ENDIF IF TYPE("VFPFRXLayoutObject.Tag2") # "U" REPLACE Tag2 WITH "" ALL FOR INLIST(ObjType,FRX_OBJTYP_REPORTHEADER,FRX_OBJTYP_DATAENV,FRX_OBJTYP_DATAOBJ) ENDIF IF TYPE("VFPFRXLayoutObject.Fontface") # "U" REPLACE Fontface WITH "" ALL FOR INLIST(ObjType,FRX_OBJTYP_DATAENV,FRX_OBJTYP_DATAOBJ) ENDIF GO TOP IN VFPFRXLayoutObject m.llWholePage = VFPFRXLayoutObject.Top SELECT Nodes.ObjValue AS Name, ; Nodes.ObjType-OUTPUTXML_OBJTYPE_NODES AS Type, ; Nodes.ObjCode AS Code, ; Nodes.ObjInfo AS Info ; FROM Nodes ; WHERE BETWEEN(ObjType,OUTPUTXML_OBJTYPE_NODES, OUTPUTXML_OBJTYPE_NODES+100) ; AND NOT DELETED() ; INTO CURSOR VFPFRXLayoutNode READWRITE m.liFlds = AMEMBERS(laFlds, THIS,0) FOR m.liIndex1 = 1 TO m.liFlds IF ATC("attr",laFlds[m.liIndex1]) > 1 INSERT INTO VFPFRXLayoutNode VALUES ; (TRANSFORM(EVALUATE("THIS."+laFlds[m.liIndex1])),; 0, ; OUTPUTXML_OBJCODE_ATTRIBMEMBER,; laFlds[m.liIndex1]+ " attribute nodename") ENDIF ENDFOR m.oXA=CREATEOBJECT("XMLAdapter") m.oXA.RespectCursorCP = .T. m.oXT4 = m.oXA.AddTableSchema("VFPFRXLayoutObject") m.oXT5 = m.oXA.AddTableSchema("VFPFRXLayoutNode") IF USED(THIS.memberDataAlias) AND ; RECCOUNT(THIS.memberDataAlias) > 0 m.oXT6 = m.oXA.AddTableSchema(THIS.memberDataAlias,.F.,; STRCONV("VFPFRXMemberData",STRCONV_DBCS_UNICODE)) ENDIF m.oXA.RespectNesting=.T. IF THIS.IncludeDataSourcesInVFPRDL m.oXT1=oXA.AddTableSchema("VFPDataSource") m.oXT2=oXA.AddTableSchema("flds") m.oXT3=oXA.AddTableSchema("rels") m.oXT1.Nest(m.oXT2) m.oXT1.Nest(m.oXT3) ENDIF m.oXA.XMLSchemaLocation = "" m.oXA.ToXML("lcResult") THIS.resetDataSession() #IF OUTPUTXML = OUTPUTXML_DOM m.oXML = CREATEOBJECT(OUTPUTXML_DOMFREETHREADED_DOCUMENTOBJECT) #ELSE m.oXML = CREATEOBJECT("Microsoft.XMLDOM") #ENDIF THIS.setFRXDataSession() m.oXML.LoadXML(m.lcResult) m.oNode = m.oXML.SelectSingleNode("/./*") IF NOT ISNULL(THIS.CommandClauses) m.oCommand = m.oXML.createElement("VFPFRXCommand") m.liFlds = AMEMBERS(laFlds, THIS.CommandClauses) FOR m.liIndex1 = 1 TO m.liFlds m.lcKey = EVAL("THIS.CommandClauses."+laFlds[m.liIndex1]) IF VARTYPE(m.lcKey) = "L" IF m.lcKey m.lcKey = "true" ELSE m.lcKey = "false" ENDIF ENDIF m.oCommand.SetAttribute(laFlds[m.liIndex1], TRANSFORM(m.lcKey)) ENDFOR m.oCommand.SetAttribute("OutputType",TRANSFORM(THIS.OutputType)) m.oCommand.SetAttribute("appName",THIS.appName) m.oCommand.SetAttribute("targetFileName",THIS.targetFileName) m.oNode.appendChild(m.oCommand) ENDIF m.oCommand = oXML.createElement("VFPFRXPrintJob") m.oCommand.SetAttribute("pagewidth", THIS.SharedPageWidth) m.oCommand.SetAttribute("pageheight", THIS.SharedPageHeight) m.oCommand.SetAttribute("name",THIS.PrintJobName) m.oCommand.SetAttribute("pagedesign",IIF(llWholePage,"whole","printable")) * if PROMPT was used this will probably work m.oCommand.SetAttribute("printresolution",TRANSFORM(PRTINFO(PRT_YRESOLUTION ,SET("PRINTER",3)))) #IF .F. * OUTPUTXML_RESOLUTIONFIX * try to reset based on current printer FRX information GO (THIS.frxHeaderRecno) IN FRX SELECT FRX m.liIndex = IIF(ALINES(laFlds,Picture,.T.) > 0, ASCAN(laFlds,"YRESOLUTION"),0) IF m.liIndex = 0 m.liIndex = IIF(ALINES(laFlds,Expr,.T.) > 0, ASCAN(laFlds,"YRESOLUTION"),0) ENDIF IF m.liIndex > 0 m.liIndex = VAL(ALLTRIM(SUBSTR(laFlds[liIndex],AT("=",laFlds[m.liIndex])+1))) IF m.liIndex > 0 m.oCommand.SetAttribute("printresolution",TRANSFORM(m.liIndex)) ELSE m.oCommand.SetAttribute("printresolution","-1") ENDIF ENDIF IF USED("SetPrinter") USE IN SetPrinter ENDIF #ENDIF CATCH WHEN .T. * this can happen when there is no printer m.oCommand.SetAttribute("printresolution","-1") ENDTRY m.oNode.appendChild(m.oCommand) IF THIS.IncludeDataSourcesInVFPRDL USE IN VFPDataSource USE IN flds USE IN rels ENDIF USE IN VFPFRXLayoutObject USE IN VFPFRXLayoutNode STORE NULL TO ; m.oXA, m.oXT1, m.oXT2, m.oXT3, m.oXT4, m.oXT5, m.oXT6, m.oXML, m.oCommand SELECT (m.liSelectFRX) SET DATASESSION TO (m.liSession) IF tlAsString RETURN m.oNode.XML RETURN m.oNode ENDIF ENDPROC PROCEDURE includedatasourcesinvfprdl_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "L" THIS.IncludeDataSourcesinVFPRDL = m.vNewVal ENDIF ENDPROC PROCEDURE getpathedimageinfo LPARAMETERS m.tObjType, m.tName, m.tPicture, m.tOffset, m.tPathed LOCAL m.lcReturn, m.lcFile m.lcReturn = "" IF m.tObjType = FRX_OBJTYP_PICTURE DO CASE CASE m.tOffset = 0 && literal filename m.lcReturn = STRTRAN(m.tPicture,["],[]) IF m.tPathed m.lcReturn = FULLPATH(m.tPicture,THIS.CommandClauses.File) ELSE m.lcReturn = JUSTFNAME(m.tPicture) ENDIF CASE m.tOffset = 1 && general field m.lcReturn = "["+m.tName+"]" CASE m.tOffset = 2 AND TYPE(m.tName)= "O" && imagecontrol m.lcReturn = "["+m.tName+"]" CASE m.tOffset = 2 AND TYPE(m.tName) = "C" && expression m.lcFile = EVALUATE(m.tName) IF NOT FILE(m.lcFile) m.lcFile = EVALUATE(STRTRAN(m.tName,"()","")) && indirect ENDIF IF FILE(m.lcFile) IF m.tPathed m.lcReturn = FULLPATH(EVALUATE(m.tName)) ELSE m.lcReturn = JUSTFNAME(EVALUATE(m.tName)) ENDIF ELSE m.lcReturn = "["+m.tName+"]" ENDIF OTHERWISE m.lcReturn = "["+m.tName+"]" ENDCASE ENDIF m.lcReturn = PADR(CHRTRAN(m.lcReturn,"\","/"), OUTPUTXML_CHARFIELD_LIMIT) RETURN m.lcReturn ENDPROC PROCEDURE applyusertransformtooutput DO CASE CASE (THIS.applyUserTransform AND NOT ; (ISNULL(THIS.XSLTProcessorUser))) OR ; THIS.applyRDLTransform LOCAL m.lvProcessor * THIS.SaveTargetFileName is real * THIS.TargetFileName is TMP IF THIS.xmlMode = OUTPUTXML_RDL_ONLY m.lvProcessor = THIS.XSLTProcessorRDL ELSE m.lvProcessor = THIS.XSLTProcessorUser ENDIF IF NOT EMPTY(SYS(2000,THIS.SaveTargetFileName)) ERASE (THIS.SaveTargetFileName) NORECYCLE ENDIF *&* Sedna change to ensure better encoding behavior *&* See notes in .ApplyXSLT method STRTOFILE(THIS.ApplyXSLT(THIS.TargetFileName,m.lvProcessor, THIS.XSLTParameters), ; THIS.SaveTargetFileName) ERASE (THIS.TargetFileName) NORECYCLE THIS.TargetFileName = THIS.SaveTargetFileName RETURN .T. CASE THIS.applyUserTransform && no processor but public property is still set IF NOT EMPTY(SYS(2000,THIS.SaveTargetFileName)) ERASE (THIS.SaveTargetFileName) NORECYCLE ENDIF COPY FILE (THIS.TargetFileName) TO (THIS.SaveTargetFileName) ERASE (THIS.TargetFileName) NORECYCLE THIS.TargetFileName = THIS.SaveTargetFileName RETURN .F. OTHERWISE RETURN .F. ENDCASE ENDPROC PROCEDURE applyusertransform_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "L" AND NOT THIS.IsRunning THIS.applyUserTransform = m.vNewVal IF THIS.applyUserTransform AND ; (ISNULL(THIS.XSLTProcessorUser)) THIS.GetDefaultUserXSLT() ENDIF ENDIF ENDPROC PROCEDURE getdefaultuserxslt ** this is an abstract method for use by subclasses ENDPROC PROCEDURE setdomformattinginfo LPARAMETERS m.toNode, m.tnLeft, m.tnTop, m.tnWidth,m.tnHeight, m.tnObjectContinuationType m.toNode.SetAttribute(THIS.ContAttr,TRANSFORM(m.tnObjectContinuationType)) IF THIS.IncludeFormattingInLayoutObjects m.toNode.SetAttribute(THIS.LeftAttr,TRANSFORM(m.tnLeft)) m.toNode.SetAttribute(THIS.TopAttr,TRANSFORM(m.tnTop)) m.toNode.SetAttribute(THIS.WidthAttr,TRANSFORM(m.tnWidth)) m.toNode.SetAttribute(THIS.HeightAttr,TRANSFORM(m.tnHeight)) ENDIF LOCAL m.llPageImages THIS.setFRXDataSession() m.llPageImages = (NOT EMPTY(THIS.currentPageImageFilename)) ; AND USED(THIS.memberDataAlias) IF THIS.includeDataTypeAttributes OR m.llPageImages IF USED(THIS.FormattingChanges) AND ; SEEK(RECNO("FRX"),THIS.FormattingChanges,"FRXRecno") SELECT (THIS.FormattingChanges) IF THIS.includeDataTypeAttributes IF EMPTY(DText) m.toNode.SetAttribute(THIS.dataTypeAttr,DType) ELSE m.toNode.SetAttribute(THIS.dataTypeAttr,DType) m.toNode.SetAttribute(THIS.dataTextAttr,DText) ENDIF ENDIF ENDIF IF m.llPageImages AND SEEK(RECNO("FRX"),THIS.memberDataAlias,"FRXRecno") SELECT (THIS.memberDataAlias) LOCATE FOR FRXRecno = RECNO("FRX") AND ; Type == FRX_BLDR_MEMBERDATATYPE AND ; Name == FRX_BLDR_NAMESPACE_ADVANCEDPROPS AND ; ExecWhen == FRX_BLDR_ADVPROP_HTML_PAGEIMAGEHREF AND ; INLIST(UPPER(Execute),"YES",".T.","TRUE","1") IF FOUND() m.toNode.SetAttribute(THIS.pageImageAttr,; THIS.currentPageImageFileName) ENDIF ENDIF SELECT FRX ENDIF ENDPROC PROCEDURE synchxsltprocessoruser IF THIS.applyUserTransform AND NOT ISNULL(THIS.XSLTProcessorUser) THIS.XSLTProcessorUser = NULL THIS.applyUserTransform = .T. && kickstart ENDIF ENDPROC PROCEDURE insertxmlconfigrecords * protected, * assumes it is being called with config * table already SELECTed. DELETE FOR ; BETWEEN(OBJTYPE,OUTPUTXML_OBJTYPE_NODES, OUTPUTXML_OBJTYPE_NODES + 100) INSERT INTO (ALIAS()) VALUES ; (OUTPUTXML_OBJTYPE_NODES+ FRX_OBJTYP_BAND, ; FRX_OBJCOD_TITLE,'','Title','Title Band nodename') INSERT INTO (ALIAS()) VALUES ; (OUTPUTXML_OBJTYPE_NODES+ FRX_OBJTYP_BAND,; FRX_OBJCOD_PAGEHEADER,'','PH','Page Header Band nodename') INSERT INTO (ALIAS()) VALUES ; (OUTPUTXML_OBJTYPE_NODES+ FRX_OBJTYP_BAND,; FRX_OBJCOD_COLHEADER,'','CH','Column Header Band nodename') INSERT INTO (ALIAS()) VALUES ; (OUTPUTXML_OBJTYPE_NODES+ FRX_OBJTYP_BAND,; FRX_OBJCOD_GROUPHEADER,'','GH','Group Header Band nodename') INSERT INTO (ALIAS()) VALUES ; (OUTPUTXML_OBJTYPE_NODES+ FRX_OBJTYP_BAND, ; FRX_OBJCOD_DETAIL,'','D','Detail Band nodename') INSERT INTO (ALIAS()) VALUES ; (OUTPUTXML_OBJTYPE_NODES+FRX_OBJTYP_BAND, ; FRX_OBJCOD_GROUPFOOTER,'','GF','Group Footer Band nodename') INSERT INTO (ALIAS()) VALUES ; (OUTPUTXML_OBJTYPE_NODES+ FRX_OBJTYP_BAND, ; FRX_OBJCOD_COLFOOTER,'','CF','Column Footer Band nodename') INSERT INTO (ALIAS()) VALUES ; (OUTPUTXML_OBJTYPE_NODES+ FRX_OBJTYP_BAND, ; FRX_OBJCOD_PAGEFOOTER,'','PF','Page Footer Band nodename') INSERT INTO (ALIAS()) VALUES ; (OUTPUTXML_OBJTYPE_NODES+ FRX_OBJTYP_BAND, ; FRX_OBJCOD_SUMMARY,'','Summary','Summary Band nodename') INSERT INTO (ALIAS()) VALUES ; (OUTPUTXML_OBJTYPE_NODES+ FRX_OBJTYP_BAND, ; FRX_OBJCOD_DETAILHEADER,'','DH','Detail Header Band nodename') INSERT INTO (ALIAS()) VALUES ; (OUTPUTXML_OBJTYPE_NODES+ FRX_OBJTYP_BAND, ; FRX_OBJCOD_DETAILFOOTER,'','DF','Detail Footer Band nodename') INSERT INTO (ALIAS()) VALUES ; (OUTPUTXML_OBJTYPE_NODES+ FRX_OBJTYP_REPORTHEADER,; FRX_OBJCOD_REPORTHEADER ,'','VFP-Report','Report root nodename') INSERT INTO (ALIAS()) VALUES ; (OUTPUTXML_OBJTYPE_NODES+ FRX_OBJTYP_LABEL, ; FRX_OBJCOD_OTHER,'','T','Text object nodename') INSERT INTO (ALIAS()) VALUES ; (OUTPUTXML_OBJTYPE_NODES+ FRX_OBJTYP_FIELD, ; FRX_OBJCOD_OTHER,'','E','Expression object nodename') INSERT INTO (ALIAS()) VALUES ; (OUTPUTXML_OBJTYPE_NODES+ FRX_OBJTYP_PICTURE,; FRX_OBJCOD_OTHER,'','P','Picture object nodename') INSERT INTO (ALIAS()) VALUES ; (OUTPUTXML_OBJTYPE_NODES+ FRX_OBJTYP_RECTANGLE,; FRX_OBJCOD_RECTANGLE,'','S','Shape object nodename') INSERT INTO (ALIAS()) VALUES ; (OUTPUTXML_OBJTYPE_NODES+ FRX_OBJTYP_LINE, ; FRX_OBJCOD_OTHER,'','L','Line object nodename') INSERT INTO (ALIAS()) VALUES ; (OUTPUTXML_OBJTYPE_NODES+ FRX_OBJTYP_VARIABLE,; FRX_OBJCOD_OTHER,'','V','Variable nodename') INSERT INTO (ALIAS()) VALUES ; (OUTPUTXML_OBJTYPE_NODES+ FRX_OBJTYP_FONTRES,; FRX_OBJCOD_OTHER,'','FontRes','FontResource nodename') INSERT INTO (ALIAS()) VALUES ; (OUTPUTXML_OBJTYPE_NODES+ FRX_OBJTYP_DATAENV,; FRX_OBJCOD_OTHER,'','DataEnv','DataEnvironment nodename') INSERT INTO (ALIAS()) VALUES ; (OUTPUTXML_OBJTYPE_NODES+ FRX_OBJTYP_DATAOBJ,; FRX_OBJCOD_OTHER,'','DE-Cursor','DE-Cursor nodename') INSERT INTO (ALIAS()) VALUES ; (OUTPUTXML_OBJTYPE_NODES+ FRX_OBJTYP_DATAOBJ, ; FRX_OBJCOD_OTHER+1,'','DE-Relation','DE-Relation nodename') * offset the DE Relation because * this information isn't in ObjType or ObjCode * as distinct from DE-Cursor other than in the Name field INSERT INTO (ALIAS()) VALUES ; (OUTPUTXML_OBJTYPE_NODES+ FRX_OBJTYP_GROUP, ; FRX_OBJCOD_OTHER,'','Group','Group selector nodename') INSERT INTO (ALIAS()) VALUES ; (OUTPUTXML_OBJTYPE_NODES, ; OUTPUTXML_OBJCODE_DOC,'','Reports','XML Document root nodename') INSERT INTO (ALIAS()) VALUES ; (OUTPUTXML_OBJTYPE_NODES,; OUTPUTXML_OBJCODE_DATA,'','Data','Report scope data root nodename') INSERT INTO (ALIAS()) VALUES ; (OUTPUTXML_OBJTYPE_NODES, ; OUTPUTXML_OBJCODE_RDL,'','VFP-RDL','RDL layout description root nodename') INSERT INTO (ALIAS()) VALUES ; (OUTPUTXML_OBJTYPE_NODES, ; OUTPUTXML_OBJCODE_PAGES,'','Pages','Pages collection root nodename') INSERT INTO (ALIAS()) VALUES ; (OUTPUTXML_OBJTYPE_NODES, ; OUTPUTXML_OBJCODE_COLS,'','Columns','Column collection root nodename') *&* Sedna INSERT INTO (ALIAS()) VALUES ; (OUTPUTXML_OBJTYPE_NODES, ; OUTPUTXML_OBJCODE_RUN,'','Run','Run property set root nodename') ENDPROC PROCEDURE xsltparameters_assign LPARAMETERS m.vNewVal DO CASE CASE VARTYPE(m.vNewVal) = "X" THIS.XSLTParameters= NULL CASE VARTYPE(m.vNewVal) = "O" TRY IF UPPER(m.vNewVal.BaseClass) == "COLLECTION" THIS.XSLTParameters = m.vNewVal ENDIF CATCH ENDTRY OTHERWISE THIS.XSLTParameters= NULL ENDCASE ENDPROC PROCEDURE getfrxlayoutobjectfieldlist LPARAMETERS m.tcAlias * frx * PLATFORM,UNIQUEID,TIMESTAMP,OBJTYPE,OBJCODE,NAME,EXPR,VPOS,HPOS,HEIGHT,WIDTH,STYLE, * PICTURE,ORDER,UNIQUE,COMMENT,ENVIRON,BOXCHAR,FILLCHAR,TAG,TAG2,PENRED,PENGREEN,PENBLUE, * FILLRED,FILLGREEN,FILLBLUE,PENSIZE,PENPAT,FILLPAT,FONTFACE,FONTSTYLE,FONTSIZE,MODE,RULER, * RULERLINES,GRID,GRIDV,GRIDH,FLOAT,STRETCH,STRETCHTOP,TOP,BOTTOM,SUPTYPE,SUPREST,NOREPEAT,RESETRPT,PAGEBREAK,COLBREAK,RESETPAGE,GENERAL,SPACING,DOUBLE,SWAPHEADER,SWAPFOOTER,EJECTBEFOR,EJECTAFTER,PLAIN,SUMMARY,ADDALIAS,OFFSET,TOPMARGIN,BOTMARGIN,TOTALTYPE,RESETTOTAL,RESOID,CURPOS,SUPALWAYS,SUPOVFLOW,SUPRPCOL,SUPGROUP,SUPVALCHNG,SUPEXPR,USER * objects * UNIQUEID,OBJTYPE,OBJCODE,EXPR,VPOS,HPOS,HEIGHT,WIDTH,OBJNAME,LOCALE_ID,START_BAND_ID,BAND_OFFSET,END_BAND_ID,BANDLABEL,SELECTED,OBJ_PICT,BAND_SEQ * bands * UNIQUEID,OBJTYPE,OBJCODE,EXPR,BANDLABEL,START,STOP,HEIGHT,P_START,P_STOP,P_HEIGHT,RESETTOTAL,BAND_SEQ,REL_BAND_ID RETURN ; "RECNO() AS FrxRecno, "+m.tcAlias+".PLATFORM, "+m.tcAlias+".NAME,"+m.tcAlias+".EXPR,"+m.tcAlias+".OFFSET,"+m.tcAlias+".VPOS,"+m.tcAlias+".HPOS,"+m.tcAlias+".HEIGHT,"+; ""+m.tcAlias+".OBJTYPE, "+m.tcAlias+".TAG, "+m.tcAlias+".TAG2,"+m.tcAlias+".PENSIZE,"+m.tcAlias+".PENPAT,"+m.tcAlias+".FILLPAT,"+; ""+m.tcAlias+".WIDTH,"+m.tcAlias+".STYLE,"+m.tcAlias+".PICTURE,"+m.tcAlias+".ORDER,"+m.tcAlias+".COMMENT,"+m.tcAlias+".FILLCHAR,"+; ""+m.tcAlias+".PENRED,"+m.tcAlias+".PENGREEN,"+m.tcAlias+".PENBLUE,"+m.tcAlias+".FILLRED,"+m.tcAlias+".FILLGREEN,"+m.tcAlias+".FILLBLUE,"+; ""+m.tcAlias+".FONTFACE, "+m.tcAlias+".FONTSTYLE,"+m.tcAlias+".FONTSIZE,"+m.tcAlias+".MODE,"+m.tcAlias+".FLOAT,"+m.tcAlias+".STRETCH,"+m.tcAlias+".STRETCHTOP,"+; "BITTEST( "+m.tcAlias+".FONTSTYLE, 0 ) AS FontBold,"+ ; "BITTEST( "+m.tcAlias+".FONTSTYLE, 1 ) AS FontItalic,"+ ; "BITTEST( "+m.tcAlias+".FONTSTYLE, 3 ) AS FontUnderline,"+ ; "BITTEST( "+m.tcAlias+".FONTSTYLE, 7 ) AS FontStrikeThrough,"+ ; "THIS.GetPathedImageInfo("+m.tcAlias+".ObjType, "+m.tcAlias+".Name, "+m.tcAlias+".Picture, "+m.tcAlias+".Offset) AS UnpathedImg,"+ ; "THIS.GetPathedImageInfo("+m.tcAlias+".ObjType, "+m.tcAlias+".Name, "+m.tcAlias+".Picture, "+m.tcAlias+".Offset, .T.) AS PathedImg,"+ ; ""+m.tcAlias+".TOP,"+m.tcAlias+".BOTTOM,"+m.tcAlias+".NOREPEAT,"+m.tcAlias+".PAGEBREAK,"+m.tcAlias+".COLBREAK,"+m.tcAlias+".RESETPAGE,"+m.tcAlias+".GENERAL,"+m.tcAlias+".SPACING,"+ ; ""+m.tcAlias+".SWAPHEADER,"+m.tcAlias+".SWAPFOOTER,"+m.tcAlias+".EJECTBEFOR,"+m.tcAlias+".EJECTAFTER,"+m.tcAlias+".TOTALTYPE,"+m.tcAlias+".RESETTOTAL,"+ ; "IIF("+m.tcAlias+".DOUBLE,"+m.tcAlias+".RESOID,1) AS FONTCHARSET,"+m.tcAlias+".SUPALWAYS,"+m.tcAlias+".SUPOVFLOW,"+m.tcAlias+".SUPRPCOL,"+m.tcAlias+".SUPGROUP,"+m.tcAlias+".SUPVALCHNG,"+m.tcAlias+".SUPEXPR,"+m.tcAlias+".USER,"+ ; "OBJECTS.UniqueID AS ObjID, OBJECTS.ObjName, Objects.Locale_ID,"+ ; "OBJECTS.START_BAND_ID,OBJECTS.BAND_OFFSET,OBJECTS.END_BAND_ID,"+ ; "BANDS.UNIQUEID AS BandID,BANDS.OBJCODE AS BandType,Bands.BANDLABEL,Bands.START,"+; "Bands.STOP,Bands.BAND_SEQ,Bands.REL_BAND_ID, ("+m.tcAlias+".ObjType=9 AND (NOT "+m.tcAlias+".Plain)) AS BandStretch" ENDPROC PROCEDURE preparefrxcopy LOCAL m.lcAlias, m.lcFile m.lcAlias = "FRX" IF EMPTY(SYS(2000,THIS.CommandClauses.File)) AND ; USED("FRX") *&* streamlined in Sedna leveraging new superclass capabilities. m.lcFile = THIS.prepareFRXSwapCopy(JUSTPATH(THIS.targetFileName),.T.) m.lcAlias = JUSTSTEM(m.lcFile) * prepareFRXSwapCopy defines the file name suitably for the * above JUSTSTEM() evaluation -> alias to work all the time. SELECT FRX ENDIF RETURN m.lcAlias ENDPROC PROCEDURE removefrxcopy LPARAMETERS m.tcAlias LOCAL m.lcFile IF m.tcAlias # "FRX" m.lcFile = DBF(m.tcAlias) USE IN (m.tcAlias) * streamlined in Sedna using * new superclass feature THIS.removeFRXSwapCopy(m.lcFile) ENDIF ENDPROC PROCEDURE adjustxsltparameter LPARAMETERS m.tvValue, m.tsKey, m.tlRemoveOnly LOCAL m.liIndex, m.liSession IF ISNULL(THIS.XSLTParameters) AND NOT m.tlRemoveOnly m.liSession = SET("DATASESSION") THIS.resetDataSession() THIS.XSLTParameters = CREATEOBJECT("Collection") SET DATASESSION TO (m.liSession) ENDIF IF NOT ISNULL(THIS.XSLTParameters) WITH THIS.XSLTParameters FOR m.liIndex = 1 TO .COUNT IF .GETKEY(m.liIndex) == m.tsKey .REMOVE(m.liIndex) EXIT ENDIF NEXT IF NOT (m.tlRemoveOnly) .ADD(m.tvValue,m.tsKey) ENDIF ENDWITH ENDIF ENDPROC PROCEDURE getrunnodecontents LPARAMETERS m.tlAsString LOCAL m.lcItem, m.oXML, m.lvValue, m.liSession THIS.setFRXDataSession() m.lcItem = IIF(SEEK( OUTPUTXML_OBJTYPE_NODES+ OUTPUTXML_OBJCODE_RUN , ; "Nodes","FrxNodes"), ; Nodes.ObjValue, ; OUTPUTXML_GOOFTAG) * Handles Cursor, Empty object, Collection * Raw or dom method. m.lcItem = "<" + m.lcItem + "/>" m.liSession = SET("DATASESSION") THIS.resetDataSession() #IF OUTPUTXML = OUTPUTXML_DOM m.oXML = CREATEOBJECT(OUTPUTXML_DOMFREETHREADED_DOCUMENTOBJECT) #ELSE m.oXML = CREATEOBJECT("Microsoft.XMLDOM") #ENDIF SET DATASESSION TO (m.liSession) IF m.oXML.LoadXML(m.lcItem) THIS.setCurrentDataSession() DO CASE CASE ISNULL(THIS.runCollector) m.oXML = NULL CASE VARTYPE(THIS.runCollector) = "C" IF NOT (USED(THIS.runCollector) AND ; RECCOUNT(THIS.runCollector) > 0) * try FRX datasession THIS.setFRXDataSession() ENDIF IF (USED(THIS.runCollector) AND ; RECCOUNT(THIS.runCollector) > 0) * two fields significant, first evaluates to property value, * second is property name LOCAL m.lcField1, m.lcField2, m.liIndex, m.liSelect m.liSelect = SELECT(0) SELECT (THIS.runCollector) FOR m.liIndex = 1 TO FCOUNT() IF INLIST(TYPE(FIELD(m.liIndex)),"M","C") IF EMPTY(m.lcField1) m.lcField1 = FIELD(m.liIndex) ELSE m.lcField2 = FIELD(m.liIndex) EXIT ENDIF ENDIF ENDFOR IF (EMPTY(m.lcField1)) m.oXML = NULL ELSE SCAN ALL FOR NOT DELETED() THIS.addRunNode(m.oXML,EVAL(m.lcField1),; IIF(EMPTY(m.lcField2) OR EMPTY(EVAL(m.lcField2)), ; "P" + TRANSFORM(RECNO()), EVAL(m.lcField2))) ENDSCAN ENDIF ENDIF SELECT (m.liSelect) CASE VARTYPE(THIS.runCollector) = "O" AND ; TYPE("THIS.runCollector.Baseclass") = "U" * empty object LOCAL m.liIndex, m.laMembers[1] IF AMEMBERS(m.laMembers,THIS.runCollector) = 0 m.oXML = NULL ELSE FOR m.liIndex = 1 TO ALEN(m.laMembers) THIS.addRunNode(m.oXML,; "THIS.runCollector." + m.laMembers[m.liIndex], ; m.laMembers[m.liIndex]) ENDFOR ENDIF CASE VARTYPE(THIS.runCollector) = "O" AND ; UPPER(THIS.runCollector.BaseClass) == "COLLECTION" LOCAL m.liIndex IF THIS.runCollector.Count = 0 m.oXML = NULL ELSE FOR m.liIndex = 1 TO THIS.runCollector.Count THIS.addRunNode(m.oXML,"THIS.runCollector[" + TRANSFORM(m.liIndex) + "]",; IIF(EMPTY(THIS.runCollector.getKey[m.liIndex]), ; "P" + TRANSFORM(m.liIndex), ; THIS.runCollector.getKey[m.liIndex] )) ENDFOR ENDIF OTHERWISE m.oXML = NULL ENDCASE THIS.setFRXDataSession() DO CASE CASE ISNULL(m.oXML) RETURN NULL CASE m.tlAsString RETURN m.oXML.DocumentElement.XML OTHERWISE RETURN m.oXML.DocumentElement ENDCASE RETURN NULL ENDIF ENDPROC PROCEDURE addrunnode LPARAMETERS m.oXML, m.tvValueExpr, m.tcPropertyName LOCAL m.oNode, m.vValue m.oNode = m.oXML.createElement("property") m.oNode.setAttribute("id",m.tcPropertyName) m.vValue = THIS.evaluateUserExpression(m.tvValueExpr) IF TYPE("m.vValue.XML") = "C" && xmlnode m.oNode.appendChild(m.vValue) m.oNode.Text = TRANSFORM(m.vValue) ENDIF m.vValue = NULL m.oXML.DocumentElement.appendChild(m.oNode) m.oNode = NULL ENDPROC PROCEDURE includedatatypeattributes_assign LPARAMETERS m.tvNewVal IF VARTYPE(m.tvNewVal) = "L" THIS.includeDataTypeAttributes = m.tvNewVal ENDIF ENDPROC PROCEDURE datatypeattr_assign LPARAMETERS m.vNewVal IF (NOT THIS.IsRunning) AND THIS.VerifyNCName(m.vNewVal) THIS.dataTypeAttr = m.vNewVal ENDIF ENDPROC PROCEDURE datatextattr_assign LPARAMETERS m.vNewVal IF (NOT THIS.IsRunning) AND THIS.VerifyNCName(m.vNewVal) THIS.dataTextAttr = m.vNewVal ENDIF ENDPROC PROCEDURE initializeformattingchangescursor THIS.formattingChanges= "F"+SYS(2015) IF THIS.includeDataTypeAttributes CREATE CURSOR (THIS.formattingChanges) ; (FRXRecno i, ; DText M, ; DType C(1)) ENDIF ENDPROC PROCEDURE formatdatavalue LPARAMETERS m.tVal IF INLIST(VARTYPE(m.tVal),"D","T") RETURN TTOC(m.tVal,3) * a subclass could do more here RETURN TRANSFORM(m.tVal) ENDIF ENDPROC PROCEDURE pageimageattr_assign LPARAMETERS vNewVal IF (NOT THIS.IsRunning) AND THIS.VerifyNCName(m.vNewVal) THIS.pageImageAttr = m.vNewVal ENDIF ENDPROC PROCEDURE evaluatestringtoboolean LPARAMETERS tcVal RETURN INLIST(UPPER(m.tcVal),"YES",".T.","TRUE","1") ENDPROC PROCEDURE applyrdltransform_access RETURN (THIS.XMLMode = OUTPUTXML_RDL_ONLY AND ; (NOT ISNULL(THIS.xsltProcessorRdl ))) ENDPROC PROCEDURE fixmsxmlobjectfordtds LPARAMETERS m.toXML IF VARTYPE(m.toXML) = "O" TRY WITH m.toXML .validateOnParse = .F. .resolveExternals = .F. .setProperty("ProhibitDTD",.F.) ENDWITH CATCH WHEN .T. && Swallow any errors. *&* This fix primarily benefits *&* external usees of the ApplyXSLT public method; *&* it does not affect standard/automatic *&* usage of ApplyXSLT to VFP-RDL XML files. *&* It allows people to use the ApplyXSLT method *&* more flexibly when transforming XML data *&* between two schemas (standard B2B requirement). *&* However, the "ProhibitDTD" property *&* is not supported by the original 2003 msxml4.dll *&* distribution file. *&* The property will exist, and *&* the behavior will be supported, if the user has *&* applied fixes and updates to MSXML as is usually *&* the case. *&* If the msxml4.dll file has been deployed using *&* an MSM supplied with VFP as part of a distribution *&* setup to a Vista machine, rather than as part of *&* normal OS files in pre-Vista environments, this *&* may *not* be the case. *&* For information about updates and patches *&* to msxml4.dll, *&* see http://www.microsoft.com/downloads/details.aspx?FamilyID=24b7d141-6cdf-4fc4-a91b-6f18fe6921d4&DisplayLang=en#Instructions *&* Vulnerabilities in Microsoft XML Core Services 4.0 Could Allow Remote Code Execution (927978) *&* Note that msxml4.dll is a side-by-side installation file and *&* the update will fail to occur properly if the DLL is currently locked *&* because an application is, or has been, using it. This would including *&* loading VFP. *&* For instructions regarding "locked" file that may cause installation to fail *&* and how to get around it, see http://support.microsoft.com/?kbid=927978 *&* To ensure that the updates have been applied, check the current date *&* of the msxml4.dll file in %windir%/system32 directory. *&* At this writing (Sedna development timeframe), the date of msxml4.dll is 11/2006. ENDTRY ENDIF ENDPROC PROCEDURE frxcharsetsinuse LPARAMETERS tcAlias LOCAL m.liSession, m.liSelect, m.liTally, m.liRec, m.lcAlias, m.llSwitchSessions IF VARTYPE(tcAlias) # "C" OR EMPTY(tcAlias) OR UPPER(ALLTRIM(tcAlias)) == "FRX" m.lcAlias = "FRX" m.llSwitchSessions = .T. m.lcAlias = ALLTRIM(tcAlias) ENDIF m.liTally = 0 IF THIS.FRXDataSession > -1 AND m.llSwitchSessions m.liSession = SET("DATASESSION") THIS.setFRXDataSession() m.liSession = -1 ENDIF IF USED(m.lcAlias) m.liSelect = SELECT(0) m.liRec = RECNO(m.lcAlias) SELECT (m.lcAlias) COUNT ALL FOR INLIST(ObjType,; FRX_OBJTYP_LABEL,; FRX_OBJTYP_FIELD) AND ; Double AND Resoid # 1 ; TO m.liTally *&* RESOID=1 indicates use of default locale, treat this like no charset indication *&* do not pay attention to header value, just text labels and expressions, *&* because the header value doesn't propagate to existing controls (even at designtime) *&* -- it just indicates the default for new objects. *&* If you adjusted the FRX contents at runtime with new *&* text controls, you might want to pay attention to the contents *&* of the header RESOID and DOUBLE values, though -- just as the design-time *&* components do. IF m.liRec > RECCOUNT() GO BOTTOM SKIP ELSE GO m.liRec ENDIF SELECT (m.liSelect) ENDIF IF m.liSession > -1 SET DATASESSION TO (m.liSession) ENDIF RETURN (m.liTally > 0) ENDPROC PROCEDURE resetcallevaluatecontents IF (THIS.CallEvaluateContents # LISTENER_CALLDYNAMICMETHOD_ALWAYS) AND ; THIS.includeDataTypeAttributes AND ; (THIS.xmlMode # OUTPUTXML_RDL_ONLY) THIS.CallEvaluateContents = LISTENER_CALLDYNAMICMETHOD_ALWAYS ENDIF ENDPROC PROCEDURE closetargetfile LOCAL m.llResetQuietMode m.llResetQuietMode = ; ((NOT THIS.HadError) AND (NOT THIS.QuietMode) AND ; (THIS.applyUserTransform OR THIS.applyRDLTransform )) IF m.llResetQuietMode THIS.QuietMode = .T. ENDIF DODEFAULT() IF m.llResetQuietMode THIS.QuietMode = .F. ENDIF ENDPROC PROCEDURE setfrxdatasessionenvironment DODEFAULT() SET EXACT ON SET SYSFORMATS ON SET CENTURY ON SET SAFETY OFF ENDPROC PROCEDURE opentargetfile #IF OUTPUTXML = OUTPUTXML_DOM THIS.VerifyTargetFile() THIS.TargetHandle = 0 RETURN (NOT THIS.HadError) #ELSE RETURN DODEFAULT() #ENDIF ENDPROC PROCEDURE AfterBand LPARAMETERS m.nBandObjCode, m.nFRXRecNo DODEFAULT(m.nBandObjCode, m.nFRXRecNo) IF THIS.InvokeOnCurrentPass() AND ; THIS.Targethandle > -1 LOCAL m.lcBand, m.loNode, m.lcID, m.lcIDRef, ; m.llFormatBreakBand, m.loObjects, m.llOmitBand THIS.SetFRXDataSession() m.lcBand = IIF(SEEK(OUTPUTXML_OBJTYPE_NODES+FRX_OBJTYP_BAND+ ; OUTPUTXML_OBJTYPE_BANDOFFSET+nBandObjCode,; "Nodes","FrxNodes"),; Nodes.ObjValue, ; OUTPUTXML_GOOFTAG) GO m.nFRXRecNo IN FRX IF NOT THIS.IncludeBandsWithNoObjects m.loObjects = THIS.FRXCursor.GetObjectsInBand(FRX.UniqueID,.F.,THIS.FRXDataSession) IF loObjects.Count = 0 m.llOmitBand = .T. ENDIF m.loObjects = NULL ENDIF THIS.SetCurrentDataSession() m.llFormatBreakBand = INLIST(m.nBandObjCode,; FRX_OBJCOD_PAGEHEADER, ; FRX_OBJCOD_PAGEFOOTER, ; FRX_OBJCOD_COLHEADER, ; FRX_OBJCOD_COLFOOTER) * first evaluate THIS.IncludeBreaksInData DO CASE CASE m.llOmitBand = .T. * nothing CASE THIS.IncludeBreaksInData = OUTPUTXML_BREAKS_INDATA OR ; NOT m.llFormatBreakBand #IF OUTPUTXML = OUTPUTXML_RAW IF EMPTY(NVL(THIS.CurrentBand,"")) * see continuation discussion in Render. * our fix there may have left us with * no band here * do nothing ELSE THIS.CurrentBand = NVL(THIS.CurrentBand,"") + ; THIS.XMLRawTag( m.lcBand, .F., m.lcID, m.lcIDRef ) IF NOT (ISNULL(THIS.CurrentBand) OR EMPTY(THIS.CurrentBand)) THIS.WriteRaw(THIS.CurrentBand) THIS.CurrentBand = "" ENDIF ENDIF #ELIF OUTPUTXML = OUTPUTXML_DOTNET #ELSE * nothing to do here when using the DOM THIS.CurrentBand = NULL #ENDIF CASE THIS.IncludeBreaksInData = OUTPUTXML_BREAKS_COLLECTION * build the collection which will be inserted into the * data before finishing. * but the band output at this point is .F. #IF OUTPUTXML = OUTPUTXML_RAW IF INLIST( m.nBandObjCode, ; FRX_OBJCOD_PAGEHEADER, ; FRX_OBJCOD_PAGEFOOTER) THIS.CurrentPage = NVL(THIS.CurrentPage,"") THIS.CurrentPage = THIS.CurrentPage + ; THIS.XMLRawTag( m.lcBand, .F., m.lcID, m.lcIDRef ) THIS.PageNodes = THIS.PageNodes + THIS.CurrentPage THIS.CurrentPage = NULL ELSE THIS.CurrentColumn = NVL(THIS.CurrentColumn,"") THIS.CurrentColumn = THIS.CurrentColumn + ; THIS.XMLRawTag( m.lcBand, .F., m.lcID, m.lcIDRef ) THIS.ColumnNodes = THIS.ColumnNodes + THIS.CurrentColumn THIS.CurrentColumn = NULL ENDIF #ELIF OUTPUTXML = OUTPUTXML_DOTNET #ELSE * we leave THIS.CurrentBand alone in this case, * to use after the band has finished. IF INLIST( nBandObjCode, ; FRX_OBJCOD_PAGEHEADER, ; FRX_OBJCOD_PAGEFOOTER) THIS.CurrentPage = NULL ELSE THIS.CurrentColumn = NULL ENDIF #ENDIF CASE INLIST( m.nBandObjCode, ; FRX_OBJCOD_COLHEADER, ; FRX_OBJCOD_COLFOOTER) && XMLBREAKS_NONE and column band THIS.CurrentColumn = NULL OTHERWISE && XMLBREAKS_NONE and page band THIS.CurrentPage = NULL ENDCASE THIS.resetDataSession() ENDIF IF INLIST(m.nBandObjCode,FRX_OBJCOD_PAGEFOOTER, FRX_OBJCOD_TITLE) THIS.includePage = .F. ENDIF ENDPROC PROCEDURE Destroy DODEFAULT() THIS.ResetDocument() STORE NULL TO ; THIS.ColumnNodes, ; THIS.CurrentBand, ; THIS.CurrentColumn, ; THIS.CurrentDocument, ; THIS.CurrentPage, ; THIS.DataNodes, ; THIS.pageNodes, ; THIS.XSLTProcessorRDL, ; THIS.XSLTProcessorUser, ; THIS.xsltParameters ENDPROC PROCEDURE createconfigtable LPARAMETERS m.tcDBF, m.tlOverWrite * table is being created from scratch, * may be in a VCX in an unknown environment * (definitely not in REPORTOUTPUT.APP!) DODEFAULT(m.tcDBF, m.tlOverWrite) IF NOT THIS.HadError LOCAL m.liSelect, m.llSafetyOn m.llSafetyOn = (SET("SAFETY") = "ON") SET SAFETY OFF m.liSelect = SELECT(0) SELECT 0 USE (m.tcDBF) EXCLU INDEX ON ObjType+ObjCode+ ; IIF(ObjType=FRX_OBJTYP_BAND+OUTPUTXML_OBJTYPE_NODES, ; OUTPUTXML_OBJTYPE_BANDOFFSET,0) ; TAG FRXNodes IF m.llSafetyOn SET SAFETY ON ENDIF THIS.InsertXMLConfigRecords() USE SELECT (m.liSelect) ENDIF ENDPROC PROCEDURE Init THIS.ReadConfiguration = OUTPUTCLASS_READCONFIG_INIT IF DODEFAULT() THIS.AppName = OUTPUTXML_APPNAME_LOC THIS.ResetDocument() RETURN .F. ENDIF IF THIS.applyUserTransform THIS.GetDefaultUserXSLT() ENDIF RETURN NOT THIS.HadError ENDPROC PROCEDURE AfterReport LPARAMETERS tlCalledEarly THIS.SetFRXDataSession() IF THIS.TargetHandle > -1 AND NOT (THIS.HadError ) THIS.fillRunCollector() #IF OUTPUTXML = OUTPUTXML_RAW LOCAL m.lcNode IF NOT THIS.XMLMode = OUTPUTXML_RDL_ONLY IF NOT EMPTY(NVL(THIS.CurrentBand,"")) m.lcNode = SUBSTR(THIS.CurrentBand,2,AT(" ", THIS.CurrentBand)-2) THIS.CurrentBand = THIS.CurrentBand + THIS.XMLRawTag(m.lcNode) * write a closing tag THIS.WriteRaw(THIS.CurrentBand) ENDIF IF THIS.IncludeBreaksInData = OUTPUTXML_BREAKS_COLLECTION IF NOT ISNULL(THIS.PageNodes) lcNode = IIF(SEEK( OUTPUTXML_OBJTYPE_NODES+OUTPUTXML_OBJCODE_PAGES,; "Nodes","FrxNodes"), ; Nodes.ObjValue, ; OUTPUTXML_GOOFTAG) THIS.WriteRaw(THIS.PageNodes) THIS.WriteRaw(THIS.XMLRawTag(m.lcNode)) ENDIF IF NOT ISNULL(THIS.ColumnNodes) m.lcNode = IIF(SEEK( OUTPUTXML_OBJTYPE_NODES+OUTPUTXML_OBJCODE_COLS,; "Nodes","FrxNodes"), ; Nodes.ObjValue, ; OUTPUTXML_GOOFTAG) THIS.WriteRaw(THIS.ColumnNodes) THIS.WriteRaw(THIS.XMLRawTag(m.lcNode)) ENDIF ENDIF m.lcNode = IIF(SEEK( OUTPUTXML_OBJTYPE_NODES+OUTPUTXML_OBJCODE_DATA,; "Nodes","FrxNodes"), ; Nodes.ObjValue, ; OUTPUTXML_GOOFTAG) THIS.WriteRaw( THIS.XMLRawTag(m.lcNode)) ENDIF m.lcNode = THIS.getRunNodeContents(.T.) IF NOT (ISNULL(lcNode) OR EMPTY(lcNode)) THIS.WriteRaw(lcNode) ENDIF m.lcNode = IIF(SEEK( OUTPUTXML_OBJTYPE_NODES+ FRX_OBJTYP_REPORTHEADER, ; "Nodes","ObjType"), ; Nodes.ObjValue, ; OUTPUTXML_GOOFTAG) THIS.WriteRaw( THIS.XMLRawTag(m.lcNode)) * check to see if continuation... IF NOT OUTPUTXML_CONTINUATION THIS.WriteRaw( THIS.XMLRawTag(THIS.CurrentDocument)) ENDIF #ELIF OUTPUTXML = OUTPUTXML_DOTNET * XMLTextWriter work #ELSE LOCAL m.loNode * domwork here IF THIS.IncludeBreaksInData = OUTPUTXML_BREAKS_COLLECTION * currently all this is done on entry, but * if not: * append the pages collection * into the report data node -- * that's where we should be right now * THIS.DataNodes.AppendChild(THIS.PageNodes) ** IF NOT ISNULL(THIS.ColumnNodes) * THIS.DataNodes.AppendChild(THIS.ColumnNodes) ** ENDIF ENDIF m.loNode = THIS.getRunNodeContents() IF NOT ISNULL(m.loNode) THIS.DataNodes.ParentNode.AppendChild(m.loNode) ENDIF IF NOT OUTPUTXML_CONTINUATION THIS.CurrentDocument.Save(THIS.TargetFileName) ENDIF m.loNode = NULL #ENDIF ENDIF IF OUTPUTXML_CONTINUATION IF THIS.runCollectorResetLevel = OUTPUTFX_RUNCOLLECTOR_RESET_ONREPORT THIS.resetRunCollector() ENDIF THIS.ResetReport() IF THIS.runCollectorResetLevel > OUTPUTFX_RUNCOLLECTOR_RESET_NEVER THIS.resetRunCollector() ENDIF THIS.ResetDocument() IF (NOT tlCalledEarly) AND ; (THIS.applyUserTransform OR ; THIS.applyRDLTransform) THIS.ApplyUserTransformToOutput() IF (NOT THIS.HadError) * we suppressed this message earlier when closing the target file, * which is just an intermediary format in this case: * IF THIS.DoMessage( OUTPUTCLASS_SUCCESS_LOC + ; IIF(SYS(2024)="Y",CHR(13)+OUTPUTCLASS_REPORT_INCOMPLETE_LOC,""),; MB_ICONINFORMATION + MB_YESNO ) = IDYES * _CLIPTEXT = THIS.TargetFileName * ENDIF ENDIF ENDIF ENDIF THIS.resetDataSession() IF (NOT tlCalledEarly) DODEFAULT() ENDIF ENDPROC PROCEDURE Error LPARAMETERS m.nError, m.cMethod, m.nLine DODEFAULT(m.nError,m.cMethod,m.nLine) * we could evaluate errors first, but generally, THIS.CloseTargetFile() IF THIS.isRunning THIS.QuietMode = .T. ENDIF THIS.CancelReport() ENDPROC PROCEDURE Render LPARAMETERS m.nFRXRecNo, m.nLeft,m.nTop,m.nWidth,m.nHeight, ; m.nObjectContinuationType, m.cContentsToBeRendered, m.GDIPlusImage IF NOT ISNULL(THIS.successorGFXNoRender) * XML Output and descendents respect norendering properties * as successors, evaluating them individually since the conditions * might apply only to some output types IF THIS.successorGFXNoRender.applyFX(THIS,"RENDER",m.nFRXRecNo, m.nLeft) = ; OUTPUTFX_BASERENDER_NORENDER RETURN OUTPUTFX_BASERENDER_NORENDER ENDIF ENDIF IF (DODEFAULT(m.nFRXRecNo, @m.nLeft,@m.nTop,@m.nWidth,@m.nHeight, ; @m.nObjectContinuationType, @m.cContentsToBeRendered, @m.GDIPlusImage) # ; OUTPUTFX_BASERENDER_NORENDER) AND ; THIS.InvokeOnCurrentPass() AND ; THIS.Targethandle > -1 * also evaluate THIS.IncludeBreaksInData and * the band for the object in question. * If the stars align, create the node for the object here. For now: LOCAL m.lcNode, m.loNode, m.lcFormattingInfo, m.lcContents, ; m.llTextType, m.loBandRef, m.liBandRecno, m.lcID THIS.SetFRXDataSession() GO m.nFRXRecNo IN FRX m.lcContents = m.cContentsToBeRendered m.llTextType = INLIST(FRX.ObjType, FRX_OBJTYP_LABEL, FRX_OBJTYP_FIELD) m.lcID = TRANSFORM(m.nFRXRecNo) IF INLIST(m.nObjectContinuationType, ; LISTENER_CONTINUATION_MIDDLE, ; LISTENER_CONTINUATION_END) m.lcID = m.lcID + "+" ENDIF IF THIS.IncludeBreaksInData = OUTPUTXML_BREAKS_COLLECTION ; OR (ISNULL(THIS.CurrentPage) AND ISNULL(THIS.CurrentColumn)) m.lcNode = IIF(SEEK(OUTPUTXML_OBJTYPE_NODES+FRX.ObjType,"Nodes","ObjType"), ; Nodes.ObjValue,; OUTPUTXML_GOOFTAG) #IF OUTPUTXML = OUTPUTXML_RAW m.lcFormattingInfo = THIS.GetRawFormattingInfo( m.nLeft, m.nTop, m.nWidth,m.nHeight, m.nObjectContinuationType) THIS.setFRXDataSession() IF m.llTextType * build 1515: render gets unicode m.lcContents = STRCONV(TRANSFORM(m.lcContents),STRCONV_UNICODE_UTF8) ELSE m.lcContents = TRANSFORM(m.lcContents) ENDIF DO CASE CASE NOT ISNULL(THIS.CurrentPage) THIS.CurrentPage = THIS.CurrentPage + ; THIS.XMLRawNode( ; m.lcNode, ; m.lcContents, ; m.lcID,.F.,m.lcFormattingInfo) && FRX.UniqueID CASE NOT ISNULL(THIS.CurrentColumn) THIS.CurrentColumn = THIS.CurrentColumn + ; THIS.XMLRawNode( ; m.lcNode, ; m.lcContents, ; m.lcID,.F.,m.lcFormattingInfo) OTHERWISE * write directly to the stream * First, take care of continuation. IF EMPTY(NVL(THIS.CurrentBand,"")) * first object in a continued band IF ISNULL(THIS.FRXCursor) m.liBandRecno = 0 ELSE m.loBandRef = THIS.FRXCursor.GetBandFor(FRX.UniqueID, .T.,THIS.FRXDataSession) SELECT FRX LOCATE FOR UniqueID == loBandRef.UniqueID IF EOF() m.liBandRecno = 0 ELSE m.liBandRecno = RECNO() ENDIF ENDIF IF m.liBandRecno = 0 THIS.CurrentBand = THIS.XMLRawTag(OUTPUTXML_GOOFTAG, .T.,; "0",TRANSFORM(IIF(THIS.sharedPageNo = 0, THIS.PageNo, THIS.sharedPageNo)) ) ELSE THIS.SetCurrentDataSession() THIS.BeforeBand(FRX_OBJCOD_DETAIL,m.liBandRecno, .T.) THIS.SetFRXDataSession() ENDIF THIS.CurrentBand = THIS.CurrentBand + ; THIS.XMLRawNode( ; m.lcNode, ; m.lcContents, ; m.lcID,.F.,m.lcFormattingInfo) IF EOF() THIS.WriteRaw(THIS.CurrentBand + ; THIS.XMLRawTag(OUTPUTXML_GOOFTAG)) THIS.CurrentBand = "" ENDIF GO m.nFRXRecNo IN FRX ELSE THIS.CurrentBand = THIS.CurrentBand + ; THIS.XMLRawNode( ; m.lcNode, ; m.lcContents, ; m.lcID,.F., m.lcFormattingInfo) ENDIF ENDCASE #ELIF OUTPUTXML = OUTPUTXML_DOTNET * XMLTextWriter work #ELSE * if continuation type is of type 2 or 3 * and we're in a text type object * we have to create a new * continued band node as if a BeforeBand event has occurred. THIS.setFRXDataSession() IF ISNULL(THIS.CurrentBand) * first object in a continued band IF ISNULL(THIS.FRXcursor) m.liBandRecno = 0 ELSE m.loBandRef = THIS.FRXCursor.GetBandFor(FRX.UniqueID, .T., THIS.FRXDataSession) SELECT FRX LOCATE FOR UniqueID == m.loBandRef.UniqueID m.liBandRecno = RECNO() ENDIF THIS.SetCurrentDataSession() IF EOF() THIS.BeforeBand(FRX_OBJCOD_DETAIL,1, .T.) ELSE THIS.BeforeBand(FRX_OBJCOD_DETAIL,m.liBandRecno, .T.) ENDIF THIS.SetFRXDataSession() GO m.nFRXRecNo IN FRX ENDIF m.loNode = THIS.CurrentDocument.CreateElement(m.lcNode) m.lcContents = TRANSFORM(m.lcContents) * build 1515: render gets unicode, and is already regionally transformed * EXCEPT if it's a filename for an image, in which case it's DBCS IF m.llTextType m.loNode.Text = CREATEBINARY(m.lcContents) ELSE m.loNode.Text = m.lcContents ENDIF m.loNode.SetAttribute(THIS.IdAttribute,m.lcID) THIS.SetDOMFormattingInfo( m.loNode, m.nLeft, m.nTop, m.nWidth,m.nHeight, m.nObjectContinuationType) DO CASE CASE NOT ISNULL(THIS.CurrentPage) THIS.CurrentPage.AppendChild(m.loNode) CASE NOT ISNULL(THIS.CurrentColumn) THIS.CurrentColumn.AppendChild(m.loNode) OTHERWISE THIS.CurrentBand.AppendChild(m.loNode) ENDCASE m.loNode = NULL #ENDIF ELSE * otherwise object belongs to a formatting header or footer * and we're not processing them (XMLBREAKS_NONE) ENDIF THIS.resetDataSession() ENDIF RETURN ENDPROC PROCEDURE BeforeBand LPARAMETERS m.nBandObjCode, m.nFRXRecNo, m.tlContinuedBand DODEFAULT(m.nBandObjCode, m.nFRXRecNo) IF INLIST(m.nBandObjCode,FRX_OBJCOD_PAGEHEADER, FRX_OBJCOD_TITLE,FRX_OBJCOD_SUMMARY) THIS.includePage = THIS.IncludePageInOutput(_PAGENO) *(THIS.PageNo >= THIS.CommandClauses.RangeFrom) AND ; * ((THIS.CommandClauses.RangeTo = -1) OR (THIS.PageNo <= THIS.CommandClauses.RangeTo)) * possibly to be adapted later: * regardless of whether IncludePageInOutput() is used * or the manual evaluation above (commented) is used, * _PAGENO will work for continued reports only if NORESET is not used. * THIS.PageNo/THIS.SharedPageNo will not work whether NORESET is used or not, * for continued reports, * unless you maintain a private offset. RANGE is * sensitive to the current REPORT FORM command, not the full * NOPAGEEJECT (chained) run ENDIF IF THIS.InvokeOnCurrentPass() AND ; THIS.Targethandle > -1 LOCAL m.lcBand, m.loNode, m.lcID, m.lcIDRef, ; m.llFormatBreakBand, m.lcInterruptedBand,; m.llOmitBand, m.loObjects THIS.SetFRXDataSession() GO m.nFRXRecNo IN FRX IF NOT THIS.IncludeBandsWithNoObjects m.loObjects = THIS.FRXCursor.GetObjectsInBand(FRX.UniqueID,.F.,THIS.FRXDataSession) IF m.loObjects.Count = 0 m.llOmitBand = .T. ENDIF m.loObjects = NULL ENDIF m.lcBand = IIF(SEEK(OUTPUTXML_OBJTYPE_NODES+ FRX_OBJTYP_BAND+ ; OUTPUTXML_OBJTYPE_BANDOFFSET+nBandObjCode,; "Nodes","FrxNodes"),; Nodes.ObjValue, ; OUTPUTXML_GOOFTAG) THIS.SetCurrentDataSession() m.llFormatBreakBand = INLIST(nBandObjCode,; FRX_OBJCOD_PAGEHEADER, ; FRX_OBJCOD_PAGEFOOTER, ; FRX_OBJCOD_COLHEADER, ; FRX_OBJCOD_COLFOOTER) IF m.llFormatBreakBand m.lcIDRef = TRANSFORM(m.nFRXRecNo) && TRANSFORM(IIF(EMPTY(FRX.UniqueID),"",FRX.UniqueID)) m.lcID = TRANSFORM(IIF(THIS.sharedPageNo = 0, THIS.PageNo, THIS.sharedPageNo)) ELSE m.lcID = TRANSFORM(m.nFRXRecNo) && TRANSFORM(IIF(EMPTY(FRX.UniqueID),"",FRX.UniqueID) ) IF m.tlContinuedBand m.lcID = m.lcID + "+" ENDIF m.lcIDRef = TRANSFORM(IIF(THIS.sharedPageNo = 0, THIS.PageNo, THIS.sharedPageNo)) ENDIF * first evaluate THIS.IncludeBreaksInData DO CASE CASE m.llOmitBand * do nothing -- TBD checked later. CASE THIS.IncludeBreaksInData = OUTPUTXML_BREAKS_INDATA OR ; NOT m.llFormatBreakBand #IF OUTPUTXML = OUTPUTXML_RAW IF NOT (ISNULL(THIS.CurrentBand) OR EMPTY(THIS.CurrentBand)) * a data band has spanned * formatting breaks (pages or columns) * and we haven't otherwise caught it. * This should not happen. m.lcInterruptedBand = SUBSTR(ALLTR(THIS.CurrentBand),2,AT(" ", THIS.CurrentBand)-2) * write a closing tag THIS.WriteRaw(THIS.CurrentBand + THIS.XMLRawTag(m.lcInterruptedBand)) ENDIF THIS.CurrentBand = THIS.XMLRawTag( m.lcBand,.T., m.lcID, m.lcIDRef ) #ELIF OUTPUTXML = OUTPUTXML_DOTNET #ELSE m.loNode = THIS.CurrentDocument.CreateElement(m.lcBand) m.loNode.SetAttribute(THIS.idAttribute,m.lcID) m.loNode.SetAttribute(THIS.idrefAttribute,m.lcIDRef) THIS.DataNodes.AppendChild(m.loNode) THIS.CurrentBand = m.loNode m.loNull = NULL #ENDIF CASE THIS.IncludeBreaksInData = OUTPUTXML_BREAKS_COLLECTION * build the collection which will be inserted into the * data before finishing. * but the band output at this point is .F. #IF OUTPUTXML = OUTPUTXML_RAW IF INLIST( m.nBandObjCode, ; FRX_OBJCOD_PAGEHEADER, ; FRX_OBJCOD_PAGEFOOTER) THIS.CurrentPage = NVL(THIS.CurrentPage,"") THIS.CurrentPage = THIS.CurrentPage + ; THIS.XMLRawTag( m.lcBand, .T.,m.lcID, m.lcIDRef ) ELSE THIS.CurrentColumn = NVL(THIS.CurrentColumn,"") THIS.CurrentColumn = THIS.CurrentColumn + ; THIS.XMLRawTag( m.lcBand, .T., m.lcID, m.lcIDRef ) ENDIF #ELIF OUTPUTXML = OUTPUTXML_DOTNET #ELSE * we leave THIS.CurrentBand alone in this case, * to use after the band has finished. IF INLIST( m.nBandObjCode, ; FRX_OBJCOD_PAGEHEADER, ; FRX_OBJCOD_PAGEFOOTER) THIS.CurrentPage = THIS.CurrentDocument.CreateElement(m.lcBand) THIS.CurrentPage.SetAttribute(THIS.idAttribute,m.lcID) THIS.CurrentPage.SetAttribute(THIS.idrefAttribute,m.lcIDRef) THIS.PageNodes.AppendChild(THIS.CurrentPage) ELSE THIS.CurrentColumn = THIS.CurrentDocument.CreateElement(m.lcBand) THIS.CurrentColumn.SetAttribute(THIS.idAttribute,m.lcID) THIS.CurrentColumn.SetAttribute(THIS.idrefAttribute,m.lcIDRef) THIS.ColumnNodes.AppendChild(THIS.CurrentColumn) ENDIF #ENDIF CASE INLIST( m.nBandObjCode, ; FRX_OBJCOD_COLHEADER, ; FRX_OBJCOD_COLFOOTER) && XMLBREAKS_NONE and column band THIS.CurrentColumn = "X" OTHERWISE && XMLBREAKS_NONE and page band THIS.CurrentPage = "X" ENDCASE THIS.resetDataSession() ENDIF ENDPROC PROCEDURE BeforeReport DODEFAULT() IF (NOT THIS.HadError) THIS.SetFRXDataSession() IF THIS.isSuccessor * need a private norender object * to handle potential rendering tests * specific to this output type THIS.successorGFXNoRender = ; THIS.checkCollectionForSpecifiedMember(; THIS.gfxNoRenderClass,; THIS.gfxNoRenderClassLib,.T.,.T.) ENDIF IF USED("FRX") LOCAL m.liSelect, m.lcDocument, m.lcReport, ; m.lcRDL, m.lcPage, m.lcCol, m.lcData, m.loNode, m.loParent m.liSelect = SELECT(0) SELECT FRX IF THIS.TargetHandle = -1 AND ; (THIS.applyUserTransform OR ; THIS.applyRDLTransform) THIS.verifyTargetFile() IF EMPTY(JUSTEXT(THIS.TargetFileName)) THIS.TargetFileName = FORCEEXT(THIS.TargetFileName,THIS.TargetFileExt) ENDIF THIS.AddProperty("SaveTargetFileName",THIS.TargetFileName) THIS.TargetFileName = FORCEEXT(THIS.TargetFileName,"TMP") ENDIF IF (THIS.TargetHandle > -1 OR THIS.OpenTargetFile()) IF NOT USED("Nodes") IF UPPER(FULLPATH(THIS.ConfigurationTable)) == ; UPPER(FULLPATH(FORCEEXT(OUTPUTCLASS_INTERNALDBF,"DBF"))) USE (THIS.ConfigurationTable) AGAIN IN 0 ; NOUPDATE ALIAS Nodes SHARED ELSE USE (THIS.ConfigurationTable) AGAIN IN 0 ; ALIAS Nodes SHARED THIS.VerifyNodeNames() THIs.VerifyAttributeNames() ENDIF ENDIF * create helper object * create band and object cursors * we may want to evaluate raw mode * as well as THIS.XMLMode to see if these are needed: IF (NOT (THIS.IncludeBandsWithNoObjects AND ; THIS.XMLMode = OUTPUTXML_DATA_ONLY) ) && OR OUTPUTXML_PERFORMLOCALECONVERSION THIS.LoadFRXCursor = .T. IF ISNULL(THIS.FRXCursor) OR ; (NOT THIS.FRXCursor.CreateObjectCursor("FRX", "OBJECTS", .F., .T. ,THIS.FRXDataSession)) && force the load and make sure && we have access to runtime && version of the cursor THIS.IncludeBandsWithNoObjects = .T. ELSE SELECT Bands IF TAGNO("UniqueID") = 0 INDEX ON UniqueID TAG UniqueID ENDIF SET ORDER TO 0 SELECT Objects IF TAGNO("UniqueID") = 0 INDEX ON UniqueID TAG UniqueID ENDIF SET ORDER TO 0 ENDIF ENDIF THIS.IsRunning = .T. SET ORDER TO 0 IN FRX m.lcDocument = IIF(SEEK(OUTPUTXML_OBJTYPE_NODES+ ; OUTPUTXML_OBJCODE_DOC,; "Nodes","FrxNodes"), ; Nodes.ObjValue, ; OUTPUTXML_GOOFTAG) m.lcReport = IIF(SEEK( OUTPUTXML_OBJTYPE_NODES+ FRX_OBJTYP_REPORTHEADER, ; "Nodes","ObjType"), ; Nodes.ObjValue, ; OUTPUTXML_GOOFTAG) IF NOT THIS.XMLMode = OUTPUTXML_RDL_ONLY m.lcData = IIF(SEEK( OUTPUTXML_OBJTYPE_NODES+ ; OUTPUTXML_OBJCODE_DATA, ; "Nodes","FrxNodes"), ; Nodes.ObjValue, ; OUTPUTXML_GOOFTAG) ENDIF IF NOT THIS.XMLMode = OUTPUTXML_DATA_ONLY m.lcRDL = IIF(SEEK( OUTPUTXML_OBJTYPE_NODES+ ; OUTPUTXML_OBJCODE_RDL, ; "Nodes","FrxNodes"), ; Nodes.ObjValue, ; OUTPUTXML_GOOFTAG) ENDIF IF THIS.IncludeBreaksInData = OUTPUTXML_BREAKS_COLLECTION m.lcPage = IIF(SEEK( OUTPUTXML_OBJTYPE_NODES+ ; OUTPUTXML_OBJCODE_PAGES, ; "Nodes","FrxNodes"), ; Nodes.ObjValue, ; OUTPUTXML_GOOFTAG) * GO (THIS.frxHeaderRecno) IN FRX * IF FRX.VPos > 1 m.lcCol = IIF(SEEK( OUTPUTXML_OBJTYPE_NODES+; OUTPUTXML_OBJCODE_COLS,; "Nodes","FrxNodes"), ; Nodes.ObjValue, ; OUTPUTXML_GOOFTAG) * ENDIF ENDIF #IF OUTPUTXML = OUTPUTXML_RAW IF EMPTY(THIS.CurrentDocument) OR ISNULL(THIS.CurrentDocument) THIS.CurrentDocument = m.lcDocument THIS.WriteRaw( ; THIS.XMLRawTag( THIS.CurrentDocument,.T.) ) ENDIF THIS.WriteRaw( ; THIS.XMLRawTag( m.lcReport,.T.) ) * could add FRXname as ID here IF NOT THIS.XMLMode = OUTPUTXML_DATA_ONLY * write RDL here THIS.WriteRaw( ; THIS.XMLRawTag( m.lcRDL,.T.,THIS.xmlRawConv( THIS.CommandClauses.FILE)) ) THIS.WriteRaw( STRCONV(THIS.GetVFPRDLContents(m.lcRDL, .T.),STRCONV_DBCS_UTF8) ) THIS.WriteRaw( ; THIS.XMLRawTag( m.lcRDL) ) ENDIF IF NOT THIS.XMLMode = OUTPUTXML_RDL_ONLY THIS.WriteRaw( ; THIS.XMLRawTag( m.lcData,.T.) ) IF THIS.IncludeBreaksInData = OUTPUTXML_BREAKS_COLLECTION THIS.PageNodes = THIS.XMLRawTag( m.lcPage,.T.) * IF NOT EMPTY(lcCol) THIS.ColumnNodes = THIS.XMLRawTag(m.lcCol,.T.) * ENDIF ENDIF ENDIF #ELIF OUTPUTXML = OUTPUTXML_DOTNET * XMLTextWriter work #ELSE IF VARTYPE(THIS.CurrentDocument) # "O" LOCAL m.liSession m.liSession = SET("DATASESSION") THIS.resetDataSession() THIS.CurrentDocument = CREATEOBJECT(OUTPUTXML_DOMFREETHREADED_DOCUMENTOBJECT) SET DATASESSION TO (m.liSession) * COMPROP(THIS.CurrentDocument,"UTF8",1) THIS.CurrentDocument.DocumentElement = THIS.CurrentDocument.CreateElement(m.lcDocument) ENDIF loNode = THIS.CurrentDocument.CreateElement(m.lcReport) * setattribute id using FRXName here * idref? THIS.CurrentDocument.DocumentElement.AppendChild(m.loNode) m.loParent = loNode IF NOT THIS.XMLMode = OUTPUTXML_DATA_ONLY m.loNode = THIS.CurrentDocument.CreateElement(m.lcRDL) m.loNode.SetAttribute(THIS.idAttribute,THIS.CommandClauses.FILE) m.loNode.AppendChild(THIS.GetVFPRDLContents(m.lcRDL)) m.loParent.AppendChild(m.loNode) ENDIF IF NOT THIS.XMLMode = OUTPUTXML_RDL_ONLY m.loNode = THIS.CurrentDocument.CreateElement(m.lcData) * possibly add DE stuff here m.loParent.AppendChild(m.loNode) THIS.DataNodes = m.loNode IF THIS.IncludeBreaksInData = OUTPUTXML_BREAKS_COLLECTION THIS.PageNodes = THIS.CurrentDocument.CreateElement(m.lcPage) THIS.DataNodes.AppendChild(THIS.PageNodes) THIS.ColumnNodes = THIS.CurrentDocument.CreateElement(m.lcCol) THIS.DataNodes.AppendChild(THIS.ColumnNodes) ENDIF ENDIF #ENDIF IF THIS.XMLMode = OUTPUTXML_RDL_ONLY THIS.AfterReport(.T.) ENDIF ENDIF *&* Sedna IF THIS.XMLMode # OUTPUTXML_RDL_ONLY THIS.initializeFormattingChangesCursor() SELECT FRX IF USED(THIS.formattingChanges) SELECT FRX SCAN FOR Platform = FRX_PLATFORM_WINDOWS AND ; ObjType = FRX_OBJTYP_FIELD AND NOT DELETED() && fields only INSERT INTO (THIS.FormattingChanges) ; (FRXRecno) VALUES (RECNO("FRX")) ENDSCAN SELECT (THIS.FormattingChanges) INDEX ON FRXRecno TAG FRXRecno SELECT FRX ENDIF ENDIF STORE NULL TO m.loNode, m.loParent SELECT (m.liSelect) ELSE THIS.DoMessage(OUTPUTXML_FRXMISSING_LOC,MB_ICONSTOP ) THIS.lastErrorMessage = OUTPUTXML_FRXMISSING_LOC ENDIF THIS.resetDataSession() ENDIF RETURN ENDPROC PROCEDURE invokeoncurrentpass RETURN (THIS.includePage) AND ; (NOT THIS.XMLMode = OUTPUTXML_RDL_ONLY ) AND ; ((NOT THIS.TwoPassProcess) OR THIS.CurrentPass = LISTENER_FULLPASS) ENDPROC PROCEDURE verifyconfigtable LPARAMETERS m.tcAlias LOCAL m.llReturn, laRequired[1], m.liIndex, m.liSelect, ; m.liTag, m.lcTag, m.lcIndex, m.llSafetyOn, m.llFixedOn m.llReturn = DODEFAULT(m.tcAlias) IF m.llReturn * check for required tagnames (used in SEEKs) m.liSelect = SELECT(0) SELECT (m.tcAlias) DIME laRequired[2,2] laRequired[1,1] = "OBJTYPE" laRequired[1,2] = "OBJTYPE" laRequired[2,1] = "FRXNODES" laRequired[2,2] = NORMALIZE("OBJTYPE+OBJCODE+IIF(OBJTYPE="+ ; TRANSFORM(FRX_OBJTYP_BAND+OUTPUTXML_OBJTYPE_NODES,"9999999")+"," + ; TRANSFORM(OUTPUTXML_OBJTYPE_BANDOFFSET,"9999999")+",0)") FOR m.liIndex = 1 TO ALEN(laRequired,1) m.liTag = TAGNO(laRequired[m.liIndex,1]) IF m.liTag = 0 OR NOT NORMALIZE(KEY(m.liTag)) == ; laRequired[m.liIndex,2] m.llReturn = .F. ENDIF ENDFOR IF NOT m.llReturn m.llSafetyOn = (SET("SAFETY") = "ON") SET SAFETY OFF m.llFixedOn = (SET("FIXED") = "ON") SET FIXED OFF TRY USE (DBF(m.tcAlias)) EXCLU ALIAS (m.tcAlias) FOR m.liIndex = 1 TO ALEN(laRequired,1) m.lcTag = laRequired[m.liIndex,1] m.lcIndex = laRequired[m.liIndex,2] INDEX ON &lcIndex TAG &lcTag ENDFOR m.llReturn = .T. CATCH ENDTRY IF m.llReturn FOR m.liIndex = 1 TO ALEN(laRequired,1) m.liTag = TAGNO(laRequired[m.liIndex,1]) IF m.liTag = 0 OR NOT NORMALIZE(KEY(m.liTag)) == ; laRequired[m.liIndex,2] m.llReturn = .F. ENDIF ENDFOR ENDIF USE (DBF(m.tcAlias)) SHARED ALIAS (m.tcAlias) IF m.llSafetyOn SET SAFETY ON ENDIF IF m.llFixedOn SET FIXED ON ENDIF ENDIF IF NOT m.llReturn m.lcMessage = OUTPUTXML_CONFIGTAGMISSING_LOC + CHR(13) FOR m.liIndex = 1 TO ALEN(laRequired,1) m.lcMessage = m.lcMessage + ; CHR(13) + laRequired[m.liIndex,1] + ; "=" + laRequired[m.liIndex,2] ENDFOR THIS.DoMessage(m.lcMessage,MB_ICONSTOP ) THIS.lastErrorMessage = OUTPUTXML_CONFIGTAGMISSING_LOC ENDIF IF m.llReturn * just do one check, this is in case * a different listener created the config file. * the XML will run just fine without these records, * it will just use its gooftag instead of regular * nodenames if all or any are missing IF NOT SEEK( OUTPUTXML_OBJTYPE_NODES+ FRX_OBJTYP_REPORTHEADER, ; ALIAS(),"ObjType") TRY IF IsReadOnly() USE (DBF(m.tcAlias)) SHARED ALIAS (m.tcAlias) ENDIF THIS.InsertXMLConfigRecords() CATCH ENDTRY ENDIF ENDIF SELECT (m.liSelect) ENDIF RETURN m.llReturn ENDPROC PROCEDURE targetfileext_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "C" AND ; NOT UPPER(ALLTRIM(STRTRAN(m.vNewVal,".",""))) == "TMP" DODEFAULT(m.vNewVal) * this class reserves the extension * TMP for swapping in and out when * using temporary files and XLSTs transforms ENDIF ENDPROC PROCEDURE setfrxrunstartupconditions DODEFAULT() IF TYPE("THIS.CommandClauses.File") # "C" ADDPROPERTY(THIS.CommandClauses,"File","") ENDIF IF TYPE("THIS.CommandClauses.NoPageEject") # "L" ADDPROPERTY(THIS.CommandClauses,"NoPageEject",.F.) ENDIF ENDPROC PROCEDURE EvaluateContents LPARAMETERS m.nFRXRecno, m.oObjProperties DODEFAULT(m.nFRXRecno,m.oObjProperties) * do some work even though we may not be * adding DTYPE and DTEXT, so that * subclasses can rely on the right record * being made available in the formattingChanges alias * and the "empty values" object always being there IF THIS.InvokeOnCurrentPass() AND ; THIS.targetHandle <> -1 THIS.setFRXDataSession() IF USED(THIS.formattingChanges) IF ISNULL(THIS.evaluateContentsValues) * first time SELECT (THIS.formattingChanges) SCATTER MEMO BLANK NAME THIS.evaluateContentsValues ; FIELDS EXCEPT FRXRecno ENDIF =SEEK(m.nFRXRecno,THIS.FormattingChanges, "FRXRecno") IF NOT EOF(THIS.formattingChanges) SELECT (THIS.formattingChanges) GATHER NAME THIS.evaluateContentsValues && always start off empty IF THIS.includeDataTypeAttributes WITH m.oObjProperties IF EMPTY(.Value) REPLACE DType WITH "C" ELSE REPLACE DType WITH VARTYPE(.Value), ; DText WITH THIS.formatDataValue(.Value) ENDIF ENDWITH ENDIF SELECT FRX ENDIF ENDIF THIS.resetDataSession() RETURN .F. ENDIF ENDPROC PROCEDURE resetruncollector THIS.runCollector = NULL ENDPROC PROCEDURE fillruncollector * getRunNodeContents will allow a Collection, * a table/alias, or an empty-type object. * Table/Alias is easiest, and allows you to use * reset levels of OUTPUTFX_RUNCOLLECTOR_RESET_NEVER or * OUTPUTFX_RUNCOLLECTOR_RESET_ONCHAIN, because the entry * keys do not have to be unique. * However, a Collection or EMPTY object * allows you to add serialized XML documents as the values * of a single property if you like. (This is done * in addRunNode method.) You also don't have to * place a cursor in the user's data session. * (The getRunNodeContents method will find the cursor in the FRX data session * as well, but that wouldn't work very well for * chained reports; in fact, even CurrentDataSession is * dicey with chained reports unless you're sure none * of them has a private data session.) * For these reasons, although its known document * properties are all simple values, xmlListener * chooses to implement * fillRunCollector using a Collection object, and * a CASE exists below to load the XML contents properly * for any consumers that wish to read it as true XML. * runCollectorResetLevel is readonly at OUTPUTFX_RUNCOLLECTOR_RESET_ONREPORT * to ensure uniqueness of the keys for each report run. * If you override this method to use an alias, you can * gather data cumulatively for chained runs however you * choose, and getRunNodeContents should cope. * If you augment this method to add to the collection, * you can add serialized objects * in the form of XML nodes that have nothing to do with the * original memberdata contents, and may be completely different * in schema. HTMLListener does this for HTTP-EQUIV handling. IF ISNULL(THIS.runCollector) OR VARTYPE(THIS.runCollector) # "O" * because we are using OUTPUTFX_RUNCOLLECTOR_RESET_ONREPORT, * this should always be true, and the session issue is * probably not relevant. But we will adjust the session * in case somebody changes this #DEFINEd life-period of * the runCollector object LOCAL m.liSession m.liSession = SET("DATASESSION") THIS.resetDataSession() THIS.runCollector = CREATEOBJECT("Collection") SET DATASESSION TO (m.liSession) ENDIF THIS.setFRXDataSession() IF USED(THIS.memberDataAlias) LOCAL m.lvValue, m.lcExpr, m.liSelect, m.loXML, m.loXMLTemp IF USED("FRX") GO (THIS.frxHeaderRecno) IN FRX #IF OUTPUTXML = OUTPUTXML_DOM m.loXML = CREATEOBJECT(OUTPUTXML_DOMFREETHREADED_DOCUMENTOBJECT) m.loXMLTemp = CREATEOBJECT(OUTPUTXML_DOMFREETHREADED_DOCUMENTOBJECT) #ELSE m.loXML = CREATEOBJECT("Microsoft.XMLDOM") m.loXMLTemp = CREATEOBJECT("Microsoft.XMLDOM") #ENDIF IF NOT m.loXML.LoadXML(FRX.Style) m.loXML = NULL ENDIF ENDIF m.liSelect = SELECT(0) SELECT (THIS.memberDataAlias) SCAN ALL FOR FRXRecno = THIS.frxHeaderRecno AND ; Type = FRX_BLDR_MEMBERDATATYPE ; AND (NOT (EMPTY(Execute) OR EMPTY(Name) OR EMPTY(ExecWhen) OR DELETED())) * do not check * for Name == FRX_BLDR_NAMESPACE_ADVANCEDPROPS * because you can add your own in. * But it must have *some* namespace. * IOW, the original metadata record with * blank namespace is not included in this treatment, * because its Execute and ExecWhen fields * are specified to have different scripting behavior. m.lvValue = "" m.lcExpr = Execute DO CASE CASE VAL(DeClass) = ADVPROP_EDITMODE_GETEXPR m.lvValue = THIS.evaluateUserExpression(m.lcExpr) CASE VAL(DeClass) = ADVPROP_EDITMODE_TEXT AND ; NOT ISNULL(m.loXML) m.lvValue = ; m.loXML.SelectSingleNode("/VFPData/reportdata" + ; "[@name='" + Name + "' and @execwhen='" + ExecWhen + "']/@execute") IF (NOT ISNULL(m.lvValue)) AND ; m.loXMLTemp.LoadXML(m.lvValue.Text) m.lvValue = m.loXMLTemp.DocumentElement ELSE m.lvValue = m.lcExpr * may not really be XML, we still want the information ENDIF OTHERWISE m.lvValue = m.lcExpr ENDCASE * The following help ensures uniqueness of key values * in case people use the same property names in ExecWhen. IF Name == FRX_BLDR_NAMESPACE_ADVANCEDPROPS m.lcExpr = ExecWhen ELSE m.lcExpr = Name+"."+ExecWhen ENDIF IF THIS.runCollector.getKey(m.lcExpr) = 0 THIS.runCollector.add(m.lvValue,m.lcExpr) ENDIF ENDSCAN SELECT (liSelect) STORE NULL TO m.loXML, m.loXMLTemp ENDIF ENDPROC PROCEDURE runcollectorresetlevel_assign LPARAMETERS tvNewVal THIS.runCollectorResetLevel = OUTPUTFX_RUNCOLLECTOR_RESET_ONREPORT ENDPROC o^PROCEDURE outputfromdata LPARAMETERS toListener, tcOutputDBF, tnWidth, tnHeight IF VARTYPE(toListener) <> "O" MESSAGEBOX("Invalid parameter. Report listener not available", 16, "Error") RETURN ENDIF IF EMPTY(toListener.cFRXAlias) MESSAGEBOX("The helper FRX table is not available. Output can't be created", 16, "Error") RETURN ENDIF * =DoFoxyTherm(90, "Texto label", "Titulo") * =DoFoxyTherm(-1, "Teste2", "Titulo") && Continuo * =DoFoxyTherm() && Desliga IF NOT This.QuietMode LOCAL lnSecs lnSecs = SECONDS() *!* ._InitStatusText = .GetLoc("INITSTATUS") + SPACE(1) *!* ._RunStatusText = .GetLoc("RUNSTATUS") + SPACE(1) *!* ._SecondsText = .GetLoc("SECONDS") + SPACE(1) =DoFoxyTherm(1, "0%", _Screen.oFoxyPreviewer._InitStatusText) ENDIF LOCAL lnSelect, lnOrigDataSession lnSelect = SELECT() lnOrigDataSession = SET("Datasession") * Ensure we are at the correct DataSession SET DATASESSION TO (toListener.ListenerDataSession) * SET DATASESSION TO (toListener.CurrentDataSession) SELECT (tcOutputDBF) * Generate RTF using the stored information This.lDefaultMode = .F. * This.BeforeReport() THIS.nPageHeight = CEILING(THIS.nScreenDPI * tnHeight / 960) THIS.nPageWidth = CEILING(THIS.nScreenDPI * tnWidth / 960) THIS.nOutFile = FCREATE(THIS.cTargetFileName) && .cOutFile) LOCAL cHtml cHtml = [] + ; [] + This.cTargetFileName + [] FPUTS(THIS.nOutFile, cHtml) LOCAL lnPgFrom, lnPgTo lnPgFrom = toListener.COMMANDCLAUSES.RangeFrom && _goHelper._ClausenRangeFrom lnPgTo = IIF(toListener.COMMANDCLAUSES.RangeTo = -1, 999999, _goHelper._ClausenRangeTo) && = loListener.COMMANDCLAUSES.RangeTo && -1 = All pages && _goHelper._ClausenRangeTo * Initialize class SELECT (tcOutputDBF) IF This.QuietMode SCAN IF BETWEEN(Page, lnPgFrom, lnPgTo) This.RenderHTML(FRXRECNO, Left, Top, Width, Height, ContType, UNContents, 0) ENDIF ENDSCAN ELSE LOCAL lnPercent, lnLastPercent, lnDelay, lnTotRecs, lnRec lnLastPercent = 0 lnDelay = 1 lnTotRecs = RECCOUNT() lnRec = 0 SCAN IF BETWEEN(Page, lnPgFrom, lnPgTo) lnRec = lnRec + 1 lnPercent = CEILING(100*lnRec/lnTotRecs) IF (lnLastPercent > 0 AND ; lnPercent - lnLastPercent < lnDelay AND ; lnPercent <> 100) ELSE =DoFoxyTherm(lnPercent, ; ALLTRIM(TRANSFORM(lnPercent)) + "% - " + TRANSFORM(FLOOR(SECONDS() - lnSecs)) + " " + _Screen.oFoxyPreviewer._SecondsText, ; _Screen.oFoxyPreviewer._RunStatusText) ENDIF This.RenderHTML(FRXRECNO, Left, Top, Width, Height, ContType, UNContents, 0) ENDIF ENDSCAN =DoFoxyTherm(100, ; "100% - " + TRANSFORM(CEILING(SECONDS() - lnSecs)) + " " + _Screen.oFoxyPreviewer._SecondsText, ; _Screen.oFoxyPreviewer._RunStatusText) ENDIF * Finalize * This.AfterReport() FPUTS(THIS.nOutFile, []) LOCAL llSaved llSaved = FCLOSE(THIS.nOutFile) * Delete the pages image files LOCAL n, lcFile FOR m.n = 1 TO ALEN(This.aPagesImgs,1) lcFile = This.aPagesImgs(m.n) IF NOT EMPTY(lcFile) TRY DELETE FILE (lcFile) CATCH ENDTRY ENDIF ENDFOR USE IN SELECT(tcOutputDBF) * Restore DataSession, ALias SET DATASESSION TO (lnOrigDataSession) SELECT (lnSelect) IF NOT This.QuietMode =DoFoxyTherm() ENDIF IF llSaved IF This.lObjTypeMode _Screen.oFoxyPreviewer.lSaved = llSaved ENDIF IF This.lOpenViewer This.ShellExec(This.cTargetFileName) ENDIF ENDIF RETURN ENDPROC PROCEDURE getbandname LPARAMETERS nBandObjCode DO CASE CASE nBandObjCode = FRX_OBJCOD_TITLE RETURN 'FRX_OBJCOD_TITLE' CASE nBandObjCode = FRX_OBJCOD_PAGEHEADER RETURN 'FRX_OBJCOD_PAGEHEADER' CASE nBandObjCode = FRX_OBJCOD_COLHEADER RETURN 'FRX_OBJCOD_COLHEADER' CASE nBandObjCode = FRX_OBJCOD_GROUPHEADER RETURN 'FRX_OBJCOD_GROUPHEADER' CASE nBandObjCode = FRX_OBJCOD_DETAIL RETURN 'FRX_OBJCOD_DETAIL' CASE nBandObjCode = FRX_OBJCOD_GROUPFOOTER RETURN 'FRX_OBJCOD_GROUPFOOTER' CASE nBandObjCode = FRX_OBJCOD_COLFOOTER RETURN 'FRX_OBJCOD_COLFOOTER' CASE nBandObjCode = FRX_OBJCOD_PAGEFOOTER RETURN 'FRX_OBJCOD_PAGEFOOTER' CASE nBandObjCode = FRX_OBJCOD_SUMMARY RETURN 'FRX_OBJCOD_SUMMARY' CASE nBandObjCode = FRX_OBJCOD_DETAILHEADER RETURN 'FRX_OBJCOD_DETAILHEADER' CASE nBandObjCode = FRX_OBJCOD_DETAILFOOTER RETURN 'FRX_OBJCOD_DETAILFOOTER' OTHERWISE RETURN '' ENDCASE ENDPROC PROCEDURE getfontstyle LPARAMETERS nFontStyle LOCAL cStyle cStyle = '' * extended styles IF nFontStyle = FRX_FONTSTYLE_UNDERLINED cStyle = 'U' nFontStyle = nFontStyle - FRX_FONTSTYLE_UNDERLINED ENDIF IF nFontStyle = FRX_FONTSTYLE_STRIKETHROUGH cStyle = cStyle + 'S' nFontStyle = nFontStyle - FRX_FONTSTYLE_STRIKETHROUGH ENDIF * standart styles DO CASE CASE nFontStyle = FRX_FONTSTYLE_NORMAL cStyle = cStyle + 'N' CASE nFontStyle = FRX_FONTSTYLE_BOLD cStyle = cStyle + 'B' CASE nFontStyle = FRX_FONTSTYLE_ITALIC cStyle = cStyle + 'I' CASE nFontStyle = FRX_FONTSTYLE_BOLD + FRX_FONTSTYLE_ITALIC cStyle = cStyle + 'BI' ENDCASE RETURN cStyle ENDPROC PROCEDURE rgbtohex LPARAMETERS nReg, nGreen, nBlue RETURN [#] + RIGHT(TRANSFORM(MAX(nReg, 0), [@0]), 2) + ; RIGHT(TRANSFORM(MAX(nGreen, 0), [@0]), 2) + RIGHT(TRANSFORM(MAX(nBlue, 0), [@0]), 2) ENDPROC PROCEDURE getcontinuationtype LPARAMETERS nObjectContinuationType DO CASE CASE nObjectContinuationType = LISTENER_CONTINUATION_NONE RETURN 'LISTENER_CONTINUATION_NONE' CASE nObjectContinuationType = LISTENER_CONTINUATION_START RETURN 'LISTENER_CONTINUATION_START' CASE nObjectContinuationType = LISTENER_CONTINUATION_MIDDLE RETURN 'LISTENER_CONTINUATION_MIDDLE' CASE nObjectContinuationType = LISTENER_CONTINUATION_END RETURN 'LISTENER_CONTINUATION_END' OTHERWISE RETURN '' ENDCASE ENDPROC PROCEDURE getpageimg #DEFINE OutputJPEG 102 #DEFINE OutputPNG 104 LOCAL loListener as ReportListener * loListener = IIF(VARTYPE(This.oActiveListener)="O", This.oActiveListener, This) loListener = This && This.oActiveListener LOCAL lnPage lnPage = PAGE - loListener.CommandClauses.RangeFrom + 1 DIMENSION This.aPagesImgs(lnPage) IF EMPTY(This.aPagesImgs(lnPage)) LOCAL lnDeviceType, lcFile, lnDeviceType, lnHandle lnDeviceType = OutputJpeg && OutputPNG lcFile = ADDBS(GETENV("TEMP")) + SYS(2015) + ".JPG" && ".PNG" loListener.OutputPage(lnPage, lcFile, lnDeviceType) This.aPagesImgs(lnPage) = lcFile ENDIF RETURN This.aPagesImgs(lnPage) ENDPROC PROCEDURE getpicturefromlistener * 2011/02/25 CChalom * When we can't access the image from the EXE or from a General field, we still can get * an image of the object, and draw it to the PDF document LPARAMETERS tnX, tnY, tnWidth, tnHeight, tcFile LOCAL lcFile lcFile = This.GetPageImg() IF EMPTY(lcFile) RETURN .F. && Could not load image ENDIF * Horizontal and Vertical factors to divide to convert to the correct coordinate LOCAL lnHor, lnVert lnHor = 9.972 lnVert = 9.996 lcNewFile = This.CropImage(lcFile, tnX / lnHor, tnY / lnVert, tnWidth / lnHor, tnHeight / lnVert, tcFile) RETURN lcNewFile ENDPROC PROCEDURE processimages LPARAMETERS tnLeft, tnTop, tnWidth, tnHeight, cContentsToBeRendered * TODO: * Manage new possibilities for storing images, using the new properties: * cExternalFileLocation = ".\images" * lCopyImageFilesToExternalFileLocation = .T. * Create Images directory LOCAL lcFile, lcPath, lcShortPath, lcImageCopy, lcPathLocation lcFile = This.cTargetFileName IF EMPTY(This.cExternalFileLocation) lcPathLocation = JUSTSTEM(lcFile) + "_IMAGES" ELSE lcPathLocation = This.cExternalFileLocation ENDIF lcPath = ADDBS(JUSTPATH(lcFile)) + lcPathLocation lcShortPath = lcPathLocation + "\" + JUSTFNAME(cContentsToBeRendered) IF NOT DIRECTORY(lcPath) MKDIR (lcPath) ENDIF DO CASE CASE EMPTY(cContentsToBeRendered) && General field This.nImgCounter = This.nImgCounter + 1 lcImageCopy = ADDBS(lcPath) + "_" + TRANSFORM(This.nImgCounter) + ".jpg" This.GetPictureFromListener(This.nX0, This.nY0, This.nW0, This.nH0, lcImageCopy) lcShortPath = JUSTSTEM(lcFile) + "_IMAGES" + "\" + "_" + TRANSFORM(This.nImgCounter) + ".jpg" CASE NOT EMPTY(SYS(2000, cContentsToBeRendered)) && File is accessible in the disk lcImageCopy = ADDBS(lcPath) + JUSTFNAME(cContentsToBeRendered) IF PR_PathFileExists(lcImageCopy + CHR(0)) = 0 && PR_PathFileExists function in FoxyPreviewer.app * IF NOT FILE(lcImageCopy) COPY FILE (cContentsToBeRendered) TO (lcImageCopy) ENDIF CASE EMPTY(SYS(2000, cContentsToBeRendered)) && Image embedded in EXE lcImageCopy = ADDBS(lcPath) + JUSTFNAME(cContentsToBeRendered) This.GetPictureFromListener(This.nX0, This.nY0, This.nW0, This.nH0, lcImageCopy) IF PR_PathFileExists(lcImageCopy + CHR(0)) = 0 && PR_PathFileExists function in FoxyPreviewer.app * IF NOT FILE(lcImageCopy) COPY FILE (cContentsToBeRendered) TO (lcImageCopy) ENDIF OTHERWISE RETURN "" ENDCASE * If we could not generate the image copy, leave IF PR_PathFileExists(lcImageCopy + CHR(0)) = 0 && PR_PathFileExists function in FoxyPreviewer.app RETURN "" ENDIF LOCAL lcHTML, lcImgHTML DO CASE CASE General = 0 && Clip * Get the picture size LOCAL lnWidth, lnHeight, lnPictWidth, lnPictHeight, lcHTML LOCAL loVFPImg as Image loVFPImg = CREATEOBJECT("Image") loVFPImg.Picture = lcImageCopy lnWidth = loVFPImg.Width lnHeight = loVFPImg.Height loVFPImg = NULL CLEAR RESOURCES (lcImageCopy) lcImgHTML = [] lcHTML = ; [] + ; lcImgHTML + ; [] *!* img { position: absolute; *!* clip: rect(0 100px 200px 0); *!* /* clip: shape(top right bottom left); NB 'rect' is the only available option */} * CASE General = 1 && Isometric * Calculating the image size for isometric images * Get the picture size LOCAL lnWidth, lnHeight, lnPictWidth, lnPictHeight, lcHTML LOCAL loVFPImg as Image loVFPImg = CREATEOBJECT("Image") loVFPImg.Picture = lcImageCopy lnPictWidth = loVFPImg.Width lnPictHeight = loVFPImg.Height loVFPImg = NULL CLEAR RESOURCES (lcImageCopy) * Isometric Adjustment LOCAL lnHorFactor, lnVertFactor, lnResizeFactor, lnIsoWidth, lnIsoHeight m.lnHorFactor = m.tnWidth / m.lnPictWidth m.lnVertFactor = m.tnHeight / m.lnPictHeight m.lnResizeFactor = MIN(m.lnHorFactor, m.lnVertFactor) m.lnIsoWidth = m.lnPictWidth * m.lnResizeFactor m.lnIsoHeight = m.lnPictHeight * m.lnResizeFactor lcImgHTML = [] lcHTML = ; [] + ; lcImgHTML + ; [] OTHERWISE *!* CASE .General = 2 && Stretch lcImgHTML = [] lcHTML = ; [] + ; lcImgHTML + ; [] ENDCASE RETURN lcHTML ENDPROC PROCEDURE processtext LPARAMETERS tnLeft, tnTop, tnWidth, tnHeight, cContentsToBeRendered LOCAL lcHTML, lcText, lcOrigText lcOrigText = ALLTRIM(STRCONV(cContentsToBeRendered, 6)) && STRCONV_UNICODE_UTF8) for Russian IF EMPTY(lcOrigText) RETURN "" ENDIF * Html special chars lcText = STRTRAN(lcOrigText, [&], [&]) && first! *lcText = STRTRAN(lcText, [ ], [ ]) lcText = STRTRAN(lcText, [<], [<]) lcText = STRTRAN(lcText, [>], [>]) * Alignment settings * Offset = 0 && Left Aligned * Offset = 1 && Right Aligned * Offset = 2 && Center Aligned LOCAL lcAlign DO CASE CASE Offset = 0 lcAlign = "text-align: left;" CASE Offset = 1 lcAlign = "text-align: right;" CASE Offset = 2 lcAlign = "text-align: center;" OTHERWISE lcAlign = "" ENDCASE * css style for span to output LOCAL lcFillHex, lcPreSpan, lcPostSpan, lcForeHex, lcPreFont, lcForeHex, lcPostFont * Mode: 0 = Opaque background; 1 = Transparent DO CASE *CASE (fillred = 255 AND fillgreen = 255 AND fillblue = 255) OR Mode = 1 && Transparent * lcFillHex = "" && white CASE Mode = 1 && Transparent lcFillHex = "" && white CASE fillred = -1 AND fillgreen = -1 AND fillblue = -1 lcFillHex = THIS.RgbToHex(255,255,255) && White * lcFillHex = "" && white OTHERWISE lcFillHex = THIS.RgbToHex(fillred, fillgreen, fillblue) ENDCASE IF PenRed = -1 lcForeHex = THIS.RgbToHex(0, 0, 0) ELSE lcForeHex = THIS.RgbToHex(penred, pengreen, penblue) ENDIF IF Stretch lcWWrap = [white-space:normal;] ELSE * Get the quantity of lines needed LOCAL lnLines lnLines = 0 lnLines = This.GetLinesCnt(lcOrigText, FontFace, FontSize, FontStyle, tnLeft, tnTop, tnWidth, tnHeight) IF lnLines <= 1 lcWWrap = [overflow:hidden ;] + [white-space:nowrap;] ELSE lcWWrap = [white-space:normal;] ENDIF ENDIF lcPreSpan = [] lcPostSpan = [] * [word-wrap:break-word;] + ; * [overflow:hidden ;] + ; * [white-space:normal;] + ; * [overflow: visible;] + ; * Font attrib lcForeHex = THIS.RgbToHex(penred, pengreen, penblue) *lcPreFont = [] *lcPostFont = [] lcPreFont = "" lcPostFont = "" * Set Html font style LOCAL lcFontStyle, lcPreStyle, lcPostStyle lcFontStyle = THIS.GetFontStyle(FontStyle) STORE '' TO lcPreStyle, lcPostStyle IF AT('B', lcFontStyle) > 0 lcPreStyle = [] lcPostStyle = [] ENDIF IF AT('I', lcFontStyle) > 0 lcPreStyle = lcPreStyle + [] lcPostStyle = [] + lcPostStyle ENDIF IF AT('U', lcFontStyle) > 0 lcPreStyle = lcPreStyle + [] lcPostStyle = [] + lcPostStyle ENDIF IF AT('S', lcFontStyle) > 0 lcPreStyle = lcPreStyle + [] lcPostStyle = [] + lcPostStyle ENDIF * write to file lcHtml = lcPreSpan + lcPreFont + lcPreStyle + lcText + lcPostStyle + lcPostFont + lcPostSpan RETURN lcHTML ENDPROC PROCEDURE processlines LPARAMETERS tnLeft, tnTop, tnWIdth, tnHeight LOCAL lcHTML *!* lcHTML = ; *!* [] + ; *!* [] lcHTML = ; [] + ; [] RETURN lcHTML ENDPROC PROCEDURE processshapes LPARAMETERS tnLeft, tnTop, tnWidth, tnHeight, tnObjectContinuationType *!* 2011-08-17 - Jacques Parent *!* Added tnObjectContinuationType parameter * Process Background information LOCAL lcFillHex * Mode : 0 = Opaque background; 1 = Transparent * FillPat : 0 = Transparent; others fill patterns (opaque) DO CASE CASE ((Mode = 1) OR (FillPat = 0)) AND (FillRed = -1) && Transparent lcFillHex = "" && white CASE fillred = -1 AND fillgreen = -1 AND fillblue = -1 * lcFillHex = "" && White lcFillHex = THIS.RgbToHex(255,255,255) && White OTHERWISE lcFillHex = THIS.RgbToHex(fillred, fillgreen, fillblue) ENDCASE lcFillHex = IIF(EMPTY(lcFillHex), "", [background-color:] + lcFillHex + [;]) * Process Border color LOCAL lcBorderHex lcBorderHex = "" * PenPat: 0 = Transparent (no border) DO CASE CASE PenPat = 0 && Transparent CASE PenRed = -1 lcBorderHex = THIS.RgbToHex(0,0,0) && Black OTHERWISE lcBorderHex = THIS.RgbToHex(PenRed, PenGreen, PenBlue) ENDCASE IF NOT EMPTY(lcBorderHex) *!* -------------------------------------------------------------------------------------------------------- *!* -------------------------------------------------------------------------------------------------------- *!* -------------------------------------------------------------------------------------------------------- *!* 2011-08-17 - Jacques Parent *!* In case tnObjectContinuationType is <> 0, we must deactivate some borders... DO CASE CASE tnObjectContinuationType == 1 && Top of box only lcBorderHex = [border-left:] + TRANSFORM(PenSize) + [px ] + lcBorderHex + [ solid;] +; [border-right:] + TRANSFORM(PenSize) + [px ] + lcBorderHex + [ solid;] +; [border-top:] + TRANSFORM(PenSize) + [px ] + lcBorderHex + [ solid;] CASE tnObjectContinuationType == 2 && Middle of box only lcBorderHex = [border-left:] + TRANSFORM(PenSize) + [px ] + lcBorderHex + [ solid;] +; [border-right:] + TRANSFORM(PenSize) + [px ] + lcBorderHex + [ solid;] CASE tnObjectContinuationType == 3 && Bottom of box only lcBorderHex = [border-left:] + TRANSFORM(PenSize) + [px ] + lcBorderHex + [ solid;] +; [border-right:] + TRANSFORM(PenSize) + [px ] + lcBorderHex + [ solid;] +; [border-bottom:] + TRANSFORM(PenSize) + [px ] + lcBorderHex + [ solid;] OTHERWISE && Complete box lcBorderHex = [border:] + TRANSFORM(PenSize) + [px ] + ; lcBorderHex + [ solid;] * border:1px solid ENDCASE *!* -------------------------------------------------------------------------------------------------------- *!* -------------------------------------------------------------------------------------------------------- *!* -------------------------------------------------------------------------------------------------------- ENDIF LOCAL lcHTML lcHTML = ; [] + [ ] + ; [] RETURN lcHTML ENDPROC PROCEDURE getlinescnt LPARAMETERS tcText, tcFontName, tnSize, tcStyle, tnLeft, tnTop, tnWidth, tnHeight LOCAL loFont, lnChars, lnLines, lnHeight, lnWidth, lnFactor LOCAL loRect as GpRectangle OF HOME() + "\ffc\_Gdiplus.vcx" loRect = NEWOBJECT("GPRectangle", "_Gdiplus.vcx", "", 0, 0, tnWidth, tnHeight) * Create a font object using the text object's settings. loFont = NEWOBJECT("GPFont", "_Gdiplus.vcx") loFont.Create(tcFontName, tnSize, tcStyle, 3) LOCAL loGfx as GpGraphics OF HOME() + "\ffc\_Gdiplus.vcx" loGfx = NEWOBJECT("GpGraphics", "_Gdiplus.vcx") lnFactor = 1 && 10 loGfx.CreateFromHWND(_Screen.HWnd) loGfx.PageUnit = 1 loGfx.PageScale = 0.3 loRect.w = tnWidth / lnFactor loRect.h = tnHeight / lnFactor LOCAL loSize as GpSize OF HOME() + "\ffc\_Gdiplus.vcx" loSize = loGfx.MeasureStringA(tcText, loFont, loRect.GdipRectF, .F., @lnChars, @lnLines) lnWidth = loSize.w lnHeight = loSize.h RETURN lnLines * loGfx.SetHandle(0) *RETURN (lnHeight / 960) * 72 * lnFactor ENDPROC PROCEDURE cropimage Lparameters lcFile As String, tnX, tnY, lnWidth As Integer, lnHeight As Integer, tcNewFile IF EMPTY(tcNewFile) tcNewFile = FORCEEXT(This._cTempFolder + Sys(2015), lcEXT) ENDIF Local loBmp As gpBitmap OF HOME() + "ffc\_gdiplus.vcx" loBmp = NEWOBJECT("GpBitmap", "_GdiPlus.vcx") loBmp.CreateFromFile(lcFile) lnHeight = MIN(lnHeight, loBmp.ImageHeight) lnWidth = MIN(lnWidth , loBmp.ImageWidth) LOCAL lhBitmap, lnStatus lhBitmap = 0 * Function used in the CropImage method DECLARE Long GdipCloneBitmapAreaI IN GDIPLUS.DLL AS pdfxGdipCloneBitmapAreaI Long x, Long y, Long nWidth, Long Height, Long PixelFormat, Long srcBitmap, Long @dstBitmap lnStatus = pdfxGdipCloneBitmapAreaI(tnX, tnY, lnWidth, lnHeight, loBmp.PixelFormat, loBmp.GetHandle(), @lhBitmap) IF (lnStatus <> 0) OR (lhBitmap = 0) loBmp = NULL * lnHandle = 0 RETURN "" ENDIF LOCAL loCropped As gpBitmap OF HOME() + "ffc\_gdiplus.vcx" loCropped = NEWOBJECT("GpBitmap", "_GdiPlus.vcx") loCropped.SetHandle(lhBitmap, .T.) && Owns handle, please destroy the Bmp object when releasing loCropped.SetResolution(loBmp.HorizontalResolution, loBmp.VerticalResolution) LOCAL lcEXT, lcEncoder lcEXT = UPPER(JUSTEXT(lcFile)) lcEncoder = IIF(lcEXT = "PNG", "image/png", "image/jpeg") LOCAL lcCroppedFile lcCroppedFile = tcNewFile && FORCEEXT(This._cTempFolder + Sys(2015), lcEXT) loCropped.SaveToFile(lcCroppedFile, lcEncoder) loCropped = NULL loBMP = NULL This.oImages.Add(lcCroppedFile) RETURN lcCroppedFile ENDPROC PROCEDURE renderhtml * 2011-07-14 CChalom: * Introduced text alignment, Width and Height * Adjusted positions * Fixed transparent background texts * Reduced FontSize in 2 points to make text fit in space * Added lines * Created separate methods to deal with different tasks * TODO: * Manage images and shapes LPARAMETERS nFRXRecno, nLeft, nTop, nWidth, nHeight, nObjectContinuationType, cContentsToBeRendered, GDIPlusImage This.nX0 = nLeft This.nY0 = nTop This.nW0 = nWidth This.nH0 = nHeight LOCAL lcDebugInfo, lcHTML IF THIS.lDebug lcDebugInfo = [] FPUTS(THIS.nOutFile, lcDebugInfo) ENDIF #Define OBJ_COMMENT 0 #Define OBJ_LABEL 5 #Define OBJ_LINE 6 #Define OBJ_RECTANGLE 7 #Define OBJ_FIELD 8 #Define OBJ_PICTURE 17 #Define OBJ_VARIABLE 18 LOCAL lnAdjust lnAdjust = 1.10 * dpi2pix nLeft = CEILING(CEILING(THIS.nScreenDPI * nLeft / 960) * lnAdjust) nTop = ROUND(THIS.nScreenDPI * nTop / 960, 0) nWidth = CEILING(CEILING(THIS.nScreenDPI * nWidth / 960) * lnAdjust) nHeight = CEILING(THIS.nScreenDPI * nHeight / 960) IF PAGE > 1 * nTop = THIS.nPageHeight * (PAGE - This.oActiveListener.CommandClauses.RangeFrom) + nTop && Original -1 nTop = THIS.nPageHeight * (PAGE - This.CommandClauses.RangeFrom) + nTop && Original -1 ENDIF DO CASE CASE ObjType = OBJ_LINE lcHTML = This.ProcessLines(nLeft, nTop, nWidth, nHeight) CASE ObjType = OBJ_RECTANGLE lcHTML = This.ProcessShapes(nLeft, nTop, nWidth, nHeight, nObjectContinuationType) *!* 2011-08-17 - Jacques Parent *!* Added nObjectContinuationType parameter CASE INLIST(ObjType, OBJ_LABEL, OBJ_FIELD) lcHTML = This.ProcessText(nLeft, nTop, nWidth, nHeight, cContentsToBeRendered) CASE ObjType = OBJ_PICTURE lcHTML = This.ProcessImages(nLeft, nTop, nWidth, nHeight, cContentsToBeRendered) OTHERWISE RETURN ENDCASE IF VARTYPE(lcHTML) <> "C" RETURN ENDIF IF NOT EMPTY(lcHTML) =FPUTS(THIS.nOutFile, lcHtml) ENDIF ENDPROC PROCEDURE prepareoutput LOCAL lcOutputDBF, lnWidth, lnHeight m.lcOutputDBF = This.GetFullFRXData() IF NOT EMPTY(m.lcOutputDBF) m.lnWidth = This.GETPAGEWIDTH() m.lnHeight = This.GETPAGEHEIGHT() This.OutputFromData(This, m.lcOutputDBF, m.lnWidth, m.lnHeight) ENDIF ENDPROC PROCEDURE BeforeReport This.lDefaultMode = .T. DODEFAULT() ENDPROC PROCEDURE AfterReport This.PrepareOutput() DODEFAULT() ENDPROC PROCEDURE AfterBand LPARAMETERS nBandObjCode, nFRXRecno DODEFAULT(nBandObjCode, nFRXRecno) LOCAL cBand SET DATASESSION TO THIS.FRXDATASESSION GO nFRXRecno IN frx cBand = THIS.GetBandName(nBandObjCode) IF THIS.lDebug FPUTS(THIS.nOutFile, '') ENDIF IF ATC('pagefooter', cBand) > 0 * fputs(This.nOutFile, '
') ENDIF SET DATASESSION TO THIS.CURRENTDATASESSION ENDPROC PROCEDURE BeforeBand LPARAMETERS nBandObjCode, nFRXRecno DODEFAULT(nBandObjCode, nFRXRecno) SET DATASESSION TO THIS.FRXDATASESSION GO nFRXRecno IN frx IF THIS.lDebug FPUTS(THIS.nOutFile, '') ENDIF SET DATASESSION TO THIS.CURRENTDATASESSION ENDPROC PROCEDURE Destroy FCLOSE(This.nOutFile) DODEFAULT() ENDPROC PROCEDURE Init * Author: aMaximum * Class adapted from the class posted at www.foxclub.ru * Original info: ************************************************** *-- Class: html_listener (c:\projects\vfp9_preview\html_listener.vcx) *-- ParentClass: reportlistener *-- BaseClass: reportlistener *-- Time Stamp: 06/18/04 03:09:01 PM * http://forum.foxclub.ru/read.php?29,144472 * http://translate.google.com/translate?js=n&prev=_t&hl=pt-BR&ie=UTF-8&layout=2&eotf=1&sl=ru&tl=en&u=http%3A%2F%2Fforum.foxclub.ru%2Fread.php%3F29%2C144472&act=url * http://forum.foxclub.ru/read.php?29,144639,144728 * http://translate.google.com/translate?js=n&prev=_t&hl=pt-BR&ie=UTF-8&layout=2&eotf=1&sl=ru&tl=en&u=http%3A%2F%2Fforum.foxclub.ru%2Fread.php%3F29%2C144639%2C144728&act=url * The report emerged, but the problem with the encoding of Russian letters. What is the trick? * Change in the method of render on strconv * cText = strconv (cContentsToBeRendered, 6) * Or changing * cHtml = [] + ; * to * cHtml = [] + ; * and then there is a UNICODE conversion to UTF-8 DODEFAULT() #define LOGPIXELSX 88 DECLARE INTEGER GetDeviceCaps IN WIN32API INTEGER HDC, INTEGER ITEM DECLARE INTEGER GetDC IN WIN32API INTEGER HWND LOCAL HDC, lnScreenDPI HDC = GetDC(0) lnScreenDPI = GetDeviceCaps( m.HDC, LOGPIXELSX ) THIS.nScreenDPI = lnScreenDPI THIS.lDebug = .F. && VERSION(2) = 2 This._cTempFolder = ADDBS(SYS(2023)) && ADDBS(GETENV("TEMP")) This.oImages = CREATEOBJECT("Collection") ENDPROC PROCEDURE updateproperties DODEFAULT() IF NOT This.lObjTypeMode OR (VARTYPE(_Screen.oFoxyPreviewer) <> "O") RETURN ENDIF LOCAL loFP loFP = _Screen.oFoxyPreviewer IF VARTYPE(This.CommandClauses) = "O" *!* IF This.CommandClauses.Preview *!* This.lOpenViewer = .T. *!* ELSE *!* This.lOpenViewer = NVL(loFP.lOpenViewer, .T.) *!* ENDIF This.lOpenViewer = This.CommandClauses.Preview IF NOT EMPTY(This.CommandClauses.ToFile) This.cTargetFileName = This.CommandClauses.ToFile ELSE IF VARTYPE(_Screen.oFoxyPreviewer) = "O" AND ; NOT EMPTY(_Screen.oFoxyPreviewer.cDestFile) AND ; EMPTY(This.cTargetFileName) LOCAL lcDestFile lcDestFile = _Screen.oFoxyPreviewer.cDestFile IF NOT "\" $ lcDestFile lcDestFile = ALLTRIM(ADDBS(_Screen.oFoxyPreviewer.cOutputPath) + lcDestFile) ENDIF This.cTargetFileName = lcDestFile ELSE LOCAL lcFile lcFile = This.cTargetFileName IF EMPTY(lcFile) lcFile = PUTFILE("","","HTM") ENDIF IF EMPTY(lcFile) _ReportListener::CancelReport() * This.CancelReport() RETURN .F. ENDIF This.cTargetFileName = lcFile ENDIF ENDIF ENDIF This.QUIETMODE = NVL(loFP.lQuietMode , .F.) ENDPROC _GDIPLUS.VCX DATASESSIONv GpGraphics _GDIPlus.VCX TLCALLEDFROMBEFOREREPORT _GDIPLUS LISESSION RESETDATASESSION ENSURECOLLECTION FFCGRAPHICS COUNT GETOBJECTINSTANCE QUIETONERROR QUIETMODE[ TCPROGRAM TCPROGRAM LIRENDERBEHAVIOR LITEMP LCMETHODTOKEN ISSUCCESSOR UPPERMETHODNAME COUNT SETCURRENTDATASESSION APPLYFX NEEDGFXS COLLECTION ApplyFX ApplyFX TLCALLEDFROMBEFOREREPORT LIINDEX GETFEEDBACKFXOBJECT GETMEMBERDATASCRIPTFXOBJECT GETROTATEGFXOBJECT GETNORENDERGFXOBJECT COUNT REMOVE GFXSF TCPROGRAM LCPROGRAM9 VNEWVAL CANCELREQUESTEDE VNEWVAL FXFEEDBACKCLASSC VNEWVAL FXFEEDBACKCLASSLIB7 VNEWVAL FXFEEDBACKMODULE THIS.CommandClauses.NoDialogb TLQUIET THIS QUIETMODE ISSUCCESSOR COMMANDCLAUSES NODIALOG ADDCOLLECTIONMEMBER FXFEEDBACKCLASS FXFEEDBACKCLASSLIB FXFEEDBACKMODULE! CHECKCOLLECTIONFORSPECIFIEDMEMBER STARTMODE classPath VNEWVAL THIS CLASSPATH RESETTODEFAULT A required helper object is not defined.C This report run may be missing some features, or it may not conclude successfully. DATASESSIONv ALIAS CLASSLIBv ALIAS CLASSLIBv PROCEDUREv PROCEDUREv A required helper object is not available.C Class: Library: This report run may be missing some features, or it may not conclude successfully. TCCLASS TCCLASSLIB TCMODULE TLASSIGNUNIQUENAMETOOBJECT TCNAMEPREFIX TLMANDATORYOBJECT THIS DOMESSAGE LCFORCEVCX LCFORCEFXP LCUSETHISLIB LCEXTERNALSPATH LISESSION RESETDATASESSION GETPATHFOREXTERNALS CLASSPATH TCCLASS TCCLASSLIB TLINGFX TLRETURNREF LIINDEX LCFORCEVCX LCCLASSLIB LCCLASS LCTHISLIB LLFOUND LOREF ENSURECOLLECTION LCFORCEFXP COUNT CLASSLIBRARY CLASS ApplyFX TCCLASS TCCLASSLIB TCMODULE TLSINGLETON TLINGFX TLREQUIRED LEXISTS LIRETURN THIS! CHECKCOLLECTIONFORSPECIFIEDMEMBER ENSURECOLLECTION GETOBJECTINSTANCE LILEVEL LCSYS16 LCPATH THIS CLASSPATH CLASSLIBRARY GpGraphics TVNEWVAL THIS ISRUNNING FFCGRAPHICS LADUMMYo Class to handle scripting during C report generation process is not available. Report run may not provide expected dynamic behavior. SETFRXDATASESSION MEMBERDATAALIAS EXECUTE ADDCOLLECTIONMEMBER FXMEMBERDATASCRIPTCLASS FXMEMBERDATASCRIPTCLASSLIB FXMEMBERDATASCRIPTMODULE! CHECKCOLLECTIONFORSPECIFIEDMEMBER DOMESSAGE VNEWVAL FXMEMBERDATASCRIPTCLASSC VNEWVAL FXMEMBERDATASCRIPTCLASSLIB7 VNEWVAL FXMEMBERDATASCRIPTMODULE FRXCursor _FRXCURSOR.VCX THIS ISRUNNING FRXCURSOR LOADFRXCURSOR GETOBJECTINSTANCE QUIETMODE? VNEWVAL THIS ISRUNNING FRXCURSORD VNEWVAL THIS ISRUNNING LOADFRXCURSORE VNEWVAL MEMBERDATAALIAS WINDOWS UnpackFRXMemberdata Class to handle scripting during C report generation process is not available. Report run may not provide expected dynamic behavior. PLATFORM STYLE LOADFRXCURSOR FRXCURSOR UNPACKFRXMEMBERDATA MEMBERDATAALIAS FRXDATASESSION DOMESSAGEK TVNEWVAL RUNCOLLECTORRESETLEVEL BEFOREREPORT AFTERREPORT LOADREPORT UNLOADREPORT DATASESSIONv WINDOWS BEFOREBAND AFTERBAND TCMETHODTOKEN LIFRXRECNO LISESSION FRXHEADERRECNO SETFRXDATASESSION OBJTYPE PLATFORM Microsoft.VFP.Reporting.Builder.Rotate Class to handle rotation during C report generation process is not available. Report layout controls will not rotate. SETFRXDATASESSION MEMBERDATAALIAS EXECUTE ADDCOLLECTIONMEMBER GFXROTATECLASS GFXROTATECLASSLIB GFXROTATEMODULE! CHECKCOLLECTIONFORSPECIFIEDMEMBER DOMESSAGE VNEWVAL GFXROTATECLASSE VNEWVAL GFXROTATECLASSLIB9 VNEWVAL GFXROTATEMODULE] TCNAME TLINGFX TLNAMEISCLASS LIINDEX LLFOUND LCNAME COUNT CLASS REMOVE reportStopRunDatetime THIS! CHECKCOLLECTIONFORSPECIFIEDMEMBER FXFEEDBACKCLASS FXFEEDBACKCLASSLIB REPORTSTOPRUNDATETIME reportStartRunDatetime THIS! CHECKCOLLECTIONFORSPECIFIEDMEMBER FXFEEDBACKCLASS FXFEEDBACKCLASSLIB REPORTSTARTRUNDATETIME DATASESSIONv THIS.CommandClauses.StartDatasessionb TVVALUEEXPR LISESSION LVVALUE SETCURRENTDATASESSION SETFRXDATASESSION RESETDATASESSION COMMANDCLAUSES STARTDATASESSION LISTENERDATASESSION9 VNEWVAL GFXNORENDERCLASS9 VNEWVAL GFXNORENDERCLASSLIB9 VNEWVAL GFXNORENDERMODULE ListenerRef.Preprocess.NoRenderWhen Microsoft.VFP.Reporting.Builder.AdvancedProperty ListenerRef.NoRenderWhen ListenerRef.Preprocess.NoRenderWhen Class or behavior to handle conditional rendering during C report generation process is not available during this run. Some report layout controls may appear unexpectedly in the output. GFXNORENDERCLASS LLNEEDTHISGFX LLOPENEDMEMBERDATA SETFRXDATASESSION MEMBERDATAALIAS COMMANDCLAUSES ISDESIGNERLOADED! CHECKCOLLECTIONFORSPECIFIEDMEMBER GFXNORENDERCLASSLIB STYLE LOADFRXCURSOR EXECWHEN EXECUTE ADDCOLLECTIONMEMBER GFXNORENDERMODULE DOMESSAGE COLLECTION Collection COLLECTION Collection TLGFXS GFXS BASECLASS TNHANDLE FFCGRAPHICS SETHANDLE SHAREDGDIPLUSGRAPHICS NEXTERNALGDIPLUSGFXg COUNT SENDFX CANCELREQUESTED/ FFCGRAPHICS FRXCURSOR NFRXRECNO NLEFT NWIDTH NHEIGHT NOBJECTCONTINUATIONTYPE CCONTENTSTOBERENDERED GDIPLUSIMAGE LIDEFAULTBEHAVIOR LLNEEDGFXS LNSTATE LHGFX GDIPLUSGRAPHICS ISSUCCESSOR COUNT NEEDGFXS FFCGRAPHICS SETHANDLE SENDFX RESTORE SUCCESSOR SETSUCCESSORDYNAMICPROPERTIES RENDER NFRXRECNO OOBJPROPERTIES SENDFX SUCCESSOR SETSUCCESSORDYNAMICPROPERTIES ADJUSTOBJECTSIZE NFRXRECNO OOBJPROPERTIES SENDFX SUCCESSOR SETSUCCESSORDYNAMICPROPERTIES EVALUATECONTENTSF NBANDOBJCODE NFRXRECNO SENDFX NBANDOBJCODE NFRXRECNO COUNT FFCGRAPHICS SETHANDLE GDIPLUSGRAPHICS SENDFX? SENDFX COMMANDCLAUSES COMMANDCLAUSESFILE SENDFX memberDataAlias SETFRXDATASESSION ISSUCCESSOR CREATEMEMBERDATACURSOR SUCCESSOR ADDPROPERTY MEMBERDATAALIAS CHECKCOLLECTIONMEMBERS CREATEHELPEROBJECTS SENDFX| CALLADJUSTOBJECTSIZE CALLEVALUATECONTENTS COMMANDCLAUSESFILE COMMANDCLAUSES SETFRXDATASESSIONENVIRONMENT CREATEHELPEROBJECTS CHECKCOLLECTIONMEMBERS SENDFXx FX-Update Listener APPNAME CREATEHELPEROBJECTS HADERROR% CMESSAGE SENDFX SENDFX SENDFX VNEWVAL LOADFRXCURSOR FRXCURSOR QUIETMODE FFCGRAPHICS QUIETONERROR createhelperobjects, needgfxs sendfx checkcollectionmembers" uppermethodnamex cancelrequested_assign fxfeedbackclass_assign5 fxfeedbackclasslib_assign fxfeedbackmodule_assign getfeedbackfxobjectd classpath_assign getobjectinstance checkcollectionforspecifiedmember addcollectionmember} getpathforexternals ffcgraphics_assign getmemberdatascriptfxobject% fxmemberdatascriptclass_assignb fxmemberdatascriptclasslib_assign fxmemberdatascriptmodule_assignE frxcursor_access frxcursor_assign loadfrxcursor_assign memberdataalias_assign creatememberdatacursor runcollectorresetlevel_assign getfrxrecno getrotategfxobject gfxrotateclass_assignG) gfxrotateclasslib_assign gfxrotatemodule_assign removecollectionmemberw* reportstoprundatetime_accessP, reportstartrundatetime_accessx- evaluateuserexpression gfxnorenderclass_assign gfxnorenderclasslib_assignf1 gfxnorendermodule_assign getnorendergfxobject&2 ensurecollection setgdiplusgraphics CancelReport Destroy;9 Render AdjustObjectSize EvaluateContents AfterBand BeforeBand1@ UnloadReport AfterReport BeforeReport LoadReport Init;D DoStatus UpdateStatus,E resetcalladjustobjectsizeTE resetcallevaluatecontents[E ClearStatusbE quietmode_assign VNEWVAL ALLOWMODALMESSAGES9 VNEWVAL LIGNOREERRORS, Error: Method: Line: NERROR CMETHOD NLINE CNAME CMESSAGE CCODELINE LCERRORMESSAGE LCCODELINEMSG HADERROR LASTERRORMESSAGE LASTERRORMESSAGEM DATASESSIONv Collection Collection Collection toListener.BaseClassb REPORTLISTENER TCFRXNAME TCCLAUSES TOLISTENER REPORTFILENAMES REPORTCLAUSES LISTENERS LISESSION RESETDATASESSION REPORTPAGES COUNT BASECLASSi ISRUNNINGREPORTS REPORTFILENAMES REPORTCLAUSES LISTENERS REPORTPAGESP OBJE C OBJEC REPORT FORM (THIS.ReportFileNames[m.liIndex]) &lcClauses OBJECT OBJE OBJEC OBJE OBJE TYPE TYPE _oReportOutput[' REPORT FORM (THIS.ReportFileNames[m.liIndex]) &lcClauses OBJECT THIS REPORT FORM (THIS.ReportFileNames[m.liIndex]) &lcClauses OBJECT m.loListener TLREMOVEREPORTSAFTERRUN TLOMITLISTENERREFERENCES ISRUNNINGREPORTS REPORTFILENAMES COUNT OERROR LIINDEX LCCLAUSES LOLISTENER LCPARSE REPORTCLAUSES LISTENERS ADJUSTREPORTPAGESINFO LCERRMSG PREPAREERRORMESSAGE ERRORNO PROCEDURE LINENO APPNAME MESSAGE LINECONTENTS DOMESSAGE LASTERRORMESSAGE REMOVEREPORTS SETFRXDATASESSION lDefaultMode listenerDataSession LDEFAULTMODE LISTENERDATASESSION RESETTODEFAULT lDefaultMode DATASESSIONv FRXDataSession LDEFAULTMODE FRXDATASESSION RESETTODEFAULT RESETDATASESSION lDefaultMode DATASESSIONv CurrentDataSession LDEFAULTMODE CURRENTDATASESSION RESETTODEFAULT RESETDATASESSION9 VNEWVAL THIS QUIETMODE9 VNEWVAL ISSUCCESSORr REPORTLISTENER VNEWVAL THIS ISRUNNING BASECLASS SUCCESSOR WINDOWS WINDOWS SETFRXDATASESSION OBJTYPE PLATFORM REPORTUSESPRIVATEDATASESSION ENVIRON FRXHEADERRECNO SETCURRENTDATASESSION DRIVINGALIAS ISSUCCESSOR SHAREDOUTPUTPAGECOUNT OUTPUTPAGECOUNT SHAREDPAGETOTAL PAGETOTAL SHAREDPAGENO PAGENO SHAREDGDIPLUSGRAPHICS GDIPLUSGRAPHICS SUCCESSOR CURRENTPASS TWOPASSPROCESS CALLEVALUATECONTENTS CALLADJUSTOBJECTSIZE9 VNEWVAL APPNAME9 VNEWVAL SHAREDGDIPLUSGRAPHICS9 VNEWVAL SHAREDPAGEHEIGHT9 VNEWVAL SHAREDPAGEWIDTHD VNEWVAL SUPPORTSLISTENERTYPE ISRUNNING LISTENERTYPEt VNEWVAL THIS ISRUNNING OUTPUTTYPE SUPPORTSLISTENERTYPE LISTENERTYPE9 VNEWVAL SHAREDOUTPUTPAGECOUNT9 VNEWVAL SHAREDPAGENO9 VNEWVAL SHAREDPAGETOTAL Empty THIS.CommandClauses.NoDialogb NoDialog- COMMANDCLAUSESc THIS PAGELIMITc PAGETOPLIMITc PAGETAILLIMIT9 PAGELIMITQUIETMODE9 PAGELIMITINSIDERANGE CallAdjustObjectSize CallEvaluateContents CALLADJUSTOBJECTSIZE RESETCALLADJUSTOBJECTSIZE CALLEVALUATECONTENTS RESETCALLEVALUATECONTENTS SUCCESSOR VNEWVAL SHAREDLISTENERTYPEZ TVNEWVAL COMMANDCLAUSESFILE DATASESSIONv SAFETYv TCPATH TLKEEPCOPYOPEN" TLADJUSTCOMMANDCLAUSESINLOADREPORT LCPATH LCFILE LISESSION LCALIAS LISELECT LLSAFETY SETFRXDATASESSION COMMANDCLAUSES ONEFIELD RECYCLE ERASE (FORCEEXT(m.tcFile,"FRX")) &lcRecycle ERASE (FORCEEXT(m.tcFile,"FRT")) &lcRecycle TCFILE TLRECYCLE LCRECYLE LLRESETTINGSHAREDCOPY ISFRXSWAPCOPYPRESENT COMMANDCLAUSES FILE LCRECYCLE COMMANDCLAUSESFILEb THIS.commandClauses.Fileb COMMANDCLAUSESFILE COMMANDCLAUSES FILEk TIREPORTINDEX TCCLAUSES TOLISTENER REPORTPAGES REPORTFILENAMES COUNT PAGENO% STRING STRING STRING ShellExecute SHELL32.Dll FindWindow WIN32API LCLINK LCACTION LCPARMS SHELLEXECUTE SHELL32 FINDWINDOW WIN32API CAPTIONk Your report exceeded a specified page limit (C Report execution was cancelled. Your results are not complete. Your report exceeded a specified page limit (C Report execution was cancelled. Your results are not complete. NPAGENO LLINCLUDE ISSUCCESSOR PAGELIMIT PAGENO PAGELIMITQUIETMODE DOMESSAGE LASTERRORMESSAGE CANCELREPORT PAGETOPLIMIT PAGETAILLIMIT PAGELIMITINSIDERANGE Running calculation prepass... CMESSAGE THIS QUIETMODE ISRUNNING COMMANDCLAUSES NODIALOG TWOPASSPROCESS CURRENTPASS isSuccessora commandClausesFile CLEARERRORS SETFRXDATASESSIONENVIRONMENT RESETDATASESSION FRXHEADERRECNO SUCCESSOR ADDPROPERTY COMMANDCLAUSESFILE PRINTJOBNAME COMMANDCLAUSES LOADREPORT@ THIS SUCCESSOR SETSUCCESSORDYNAMICPROPERTIES CLEARSTATUS@ THIS SUCCESSOR SETSUCCESSORDYNAMICPROPERTIES UPDATESTATUS ISSUCCESSOR SHAREDPAGEWIDTH GETPAGEWIDTH SHAREDPAGEHEIGHT GETPAGEHEIGHT RESETDATASESSION SUCCESSOR FRXDATASESSION CURRENTDATASESSION TWOPASSPROCESS COMMANDCLAUSES SETSUCCESSORDYNAMICPROPERTIES UNLOADREPORTY ISSUCCESSOR SUCCESSOR SETSUCCESSORDYNAMICPROPERTIES CANCELREPORTG FRXDataSession CurrentDataSession ISSUCCESSOR SHAREDPAGEWIDTH GETPAGEWIDTH SHAREDPAGEHEIGHT GETPAGEHEIGHT SUCCESSOR FRXDATASESSION CURRENTDATASESSION TWOPASSPROCESS COMMANDCLAUSES SETSUCCESSORDYNAMICPROPERTIES AFTERREPORT RESETTODEFAULT. DATASESSIONv VFP Report Output Class CallEvaluateContents CallEvaluateContents CallAdjustObjectSize CallAdjustObjectSize LISTENERDATASESSION APPNAME CLASS ADDPROPERTY HADERROR_ NBANDOBJCODE NFRXRECNO THIS SUCCESSOR SETSUCCESSORDYNAMICPROPERTIES BEFOREBAND RESETDATASESSION CMESSAGE IPARAMS CTITLE THIS QUIETMODE ISRUNNING COMMANDCLAUSES NODIALOG ALLOWMODALMESSAGES APPNAME DOSTATUSD ERROR ERROR() nError PROGRAM() cMethod LINENO() nLine &lcOnError NERROR CMETHOD NLINE LCONERROR LCERRORMSG LCCODELINEMSG HADERROR LIGNOREERRORS STARTMODE PREPAREERRORMESSAGE LASTERRORMESSAGE DOMESSAGE% sharedPageNo sharedPageTotal sharedOutputPageCount sharedGDIPlusGraphics sharedGDIPlusGraphics sharedPageHeight sharedPageWidth sharedOutputPageCount sharedPageNo sharedPageTotal sharedListenerType SETFRXRUNSTARTUPCONDITIONS GETFRXSTARTUPINFO RESETDATASESSION ISSUCCESSOR SHAREDPAGEHEIGHT GETPAGEHEIGHT SHAREDPAGEWIDTH GETPAGEWIDTH SHAREDLISTENERTYPE LISTENERTYPE RESETTODEFAULT SUCCESSOR ADDPROPERTY SHAREDGDIPLUSGRAPHICS SHAREDOUTPUTPAGECOUNT SHAREDPAGENO SHAREDPAGETOTAL SETSUCCESSORDYNAMICPROPERTIES FRXDATASESSION CURRENTDATASESSION TWOPASSPROCESS COMMANDCLAUSES COMMANDCLAUSESFILE BEFOREREPORT RESETDYNAMICMETHODCALLS CALLEVALUATECONTENTS CALLADJUSTOBJECTSIZE; RUNCOLLECTOR SUCCESSOR LISTENERS REPORTCLAUSES REPORTFILENAMES PREVIEWCONTAINER COMMANDCLAUSESR NBANDOBJCODE NFRXRECNO THIS SUCCESSOR SETSUCCESSORDYNAMICPROPERTIES AFTERBAND NFRXRECNO NLEFT NWIDTH NHEIGHT NOBJECTCONTINUATIONTYPE CCONTENTSTOBERENDERED GDIPLUSIMAGE THIS SUCCESSOR SETSUCCESSORDYNAMICPROPERTIES RENDER allowmodalmessages_assign, lignoreerrors_assign prepareerrormessage pushglobalsetsv popglobalsets} clearerrors getlasterrormessage addreport removereports runreports setfrxdatasessionenvironmentC invokeoncurrentpassv resetdatasession setfrxdatasessionn setcurrentdatasessionz quietmode_assign~ issuccessor_assign successor_assign. getfrxstartupinfo setsuccessordynamicpropertiesg appname_assignT sharedgdiplusgraphics_assign sharedpageheight_assign sharedpagewidth_assignj listenertype_assign outputtype_assignM sharedoutputpagecount_assign sharedpageno_assignr sharedpagetotal_assign setfrxrunstartupconditions) pagelimit_assign pagetoplimit_assignA pagetaillimit_assign pagelimitquietmode_assignD pagelimitinsiderange_assign resetdynamicmethodcalls resetcalladjustobjectsize resetcallevaluatecontents sharedlistenertype_assign commandclausesfile_assign preparefrxswapcopy removefrxswapcopyi$ isfrxswapcopypresent}& adjustreportpagesinfo shellexec IncludePageInOutputZ* DoStatusu. LoadReport ClearStatus UpdateStatus UnloadReport CancelReport AfterReport BeforeBandA8 DoMessage Errorx: BeforeReportZ< DestroyxA AfterBand#B Render lvParam.C ,Obj.C lvParam.C Listener.PageNo=C _PAGENO= recno= , TargetAlias= , targetRecno= PCOUNT TARGETHANDLE LIINDEX LOOBJ LVPARAM LIOBJINDEX LIMEMBERS LAMEMBERS VERBOSE SETCURRENTDATASESSION SHAREDPAGENO PAGENO DRIVINGALIAS TARGETALIAS RESETDATASESSION MEMBERS: THIS.C THIS.C ... NO MEMBERS tvCommand.C TVCOMMAND TCHEADER TARGETHANDLE LIINDEX LAMEMBERS LIMEMBERS9 VNEWVAL VERBOSE DODEBUG DODEBUG DODEBUG DODEBUGe current CommandClauses INCLUDELOADANDUNLOAD LCPROGRAM DODEBUG DODEBUGCOMMANDCLAUSES COMMANDCLAUSES TARGETHANDLE NOPAGEEJECT CLOSETARGETFILE QUIETMODE TARGETFILENAME received CommandClauses INCLUDELOADANDUNLOAD TARGETHANDLE OPENTARGETFILE DODEBUG DODEBUGCOMMANDCLAUSES COMMANDCLAUSES DODEBUG DODEBUG DODEBUG DODEBUG DODEBUG DODEBUG DODEBUG DODEBUG DODEBUG DODEBUG DODEBUG DODEBUGO DODEBUG VERBOSE TARGETALIAS SETFRXDATASESSION RESETDATASESSION DODEBUG DODEBUG DODEBUGS current CommandClauses LCPROGRAM DODEBUG DODEBUGCOMMANDCLAUSES COMMANDCLAUSES INCLUDELOADANDUNLOAD NOPAGEEJECT CLOSETARGETFILE QUIETMODE TARGETFILENAMEd received CommandClauses LCPROGRAM VERBOSE SETCURRENTDATASESSION TARGETHANDLE OPENTARGETFILE DODEBUG DODEBUGCOMMANDCLAUSES COMMANDCLAUSES RESETDATASESSION8 TARGETFILENAMEW VFP Report Output Class APPNAME HADERROR dodebug, dodebugcommandclausesZ verbose_assign OutputPage IncludePageInOutput EvaluateContents CancelReport UnloadReport LoadReport8 WriteMethod WriteExpression UpdateStatus SupportsListenerType SaveAsClass ResetToDefault ReadMethod ReadExpression OnPreviewClosen ClearStatus\ RenderS DoStatus BeforeBand AfterBand^ AdjustObjectSizea AddPropertyd AfterReportR BeforeReportl! opentargetfile PROCEDURE storefrxdata LPARAMETERS m.tnFRXRecno, m.tnLeft, m.tnTop, m.tnWidth, m.tnHeight, m.tnObjectContinuationType, m.tcContentsToBeRendered, m.tiGDIPlusImage IF This.TwoPassProcess AND This.CurrentPass = 0 && Code to detect if report will run twice because of use of _PAGETOTAL * DODEFAULT(m.tnFRXRecno, m.tnLeft, m.tnTop, m.tnWidth, m.tnHeight, m.tnObjectContinuationType, m.tcContentsToBeRendered, m.tiGDIPlusImage) RETURN ENDIF * As each object is rendered, add a record to the cursor. LOCAL lcContents, lnRec, lnSelect, lnSession, llDynamics m.lnSelect = SELECT() m.lnSession = SET("Datasession") m.llDynamics = .F. DO WHILE .T. WITH This m.lcContents = STRCONV(m.tcContentsToBeRendered, 6) * Ensure we are in the correct datasession .ResetDataSession() IF VARTYPE(_goHelper) = "O" AND (_goHelper.nSearchPages > 0) AND (.PageNo > _goHelper.nSearchPages) This.lStoreData = .F. * MESSAGEBOX("The offline output generation was turned off because you are using the 'nSearchPages'" + CHR(13) + ; "feature. If you want to allow all options, set the Search Pages value to -1" + CHR(13) + CHR(13) + ; "Current value = " + TRANSFORM(_goHelper.nSearchPages), 48, "Attention") EXIT ENDIF IF NOT EMPTY(This.cMainAlias) m.lnRec = RECNO(This.cMainAlias) ELSE m.lnRec = 1 ENDIF LOCAL lcTestContents, lcNewContents, lcNewUNContents, lnRotate, lnDynamics STORE "" TO m.lcTestContents, m.lcNewContents, m.lcNewUNContents m.lnRotate = 0 m.lnDynamics = This.GetDynamicsFromFRX(m.tnFRXRecno, @m.lcTestContents, @m.lnRotate) IF NOT EMPTY(m.lcTestContents) m.lcNewContents = m.lcTestContents m.lcNewUNContents = STRCONV(m.lcTestContents, 5) ELSE m.lcNewContents = m.lcContents m.lcNewUNContents = m.tcContentsToBeRendered ENDIF *!* IF (VARTYPE(_TempDynamics.Script) = "C") AND (NOT EMPTY(_TempDynamics.Script)) *!* REPLACE Contents WITH _TempDynamics.Script, ; *!* UNContents WITH STRCONV(_TempDynamics.Script, 5) IN (THIS.cFullOutputAlias) *!* ENDIF TRY * INSERT INTO (.cOutputAlias) ; VALUES (tnFRXRecNo, lnRec, tnLeft, tnTop, tnWidth, tnHeight, ; tnObjectContinuationType, lcContents, tcContentsToBeRendered, ; .PageNo, This.nFrxIndex, lnDynamics) && MAX(_goHelper._nIndex, 1)) INSERT INTO (.cOutputAlias) ; VALUES (m.tnFRXRecno, m.lnRec, m.tnLeft, m.tnTop, m.tnWidth, m.tnHeight, ; m.tnObjectContinuationType, m.lcNewContents, m.lcNewUNContents, ; .PageNo, This.nFrxIndex, m.lnDynamics, m.lnRotate) CATCH TO m.loexc SET STEP ON ENDTRY ENDWITH EXIT ENDDO SET DATASESSION TO (m.lnSession) IF NOT EMPTY(This.cMainAlias) IF NOT USED(This.cMainAlias) This.cMainAlias = "" ENDIF SELECT (This.cMainAlias) CATCH SELECT (m.lnSelect) ENDTRY SELECT (m.lnSelect) ENDIF ENDPROC PROCEDURE getfullfrxdata *!* Creates a single CURSOR with the Render + FRX information, to be used *!* by the report listeners to generate the outputs without running the *!* REPORT FORM again. *!* ----------------------------------------------------------------------------- * Ensure we are in the correct DataSession This.ResetDataSession() IF EMPTY(This.cOutputAlias) MESSAGEBOX("The helper 'Rendering' cursor is not available.", 16, "Error") RETURN "" IF NOT USED(This.cOutputAlias) USE (This.cOutputAlias) IN 0 SHARED AGAIN ENDIF ENDIF IF EMPTY(This.cFRXAlias) MESSAGEBOX("The helper 'FRX' cursor is not available.", 16, "Error") RETURN "" IF NOT USED(This.cFRXAlias) USE (This.cFRXAlias) IN 0 SHARED AGAIN ENDIF ENDIF IF NOT EMPTY(This.cFullOutputAlias) USE IN SELECT(This.cFullOutputAlias) ENDIF LOCAL lnSelect, lcFullOutput m.lnSelect = SELECT() LOCAL loExc as Exception LOCAL lnAliases && , lcCurrFRX m.lnAliases = ALEN(This.aFRXTables, 1) DIMENSION m.laTempData(m.lnAliases) FOR m.n = 1 TO m.lnAliases m.laTempData(m.n) = STRTRAN(SYS(2015), " ", "_") SELECT CAST(RECNO() AS N(4,0)) as nRecno, * FROM (This.aFRXTables(m.n)) INTO CURSOR TempFRX READWRITE SELECT TempFRX * Change some field values to be used to index the object drawing in the output files REPLACE ALL RESETRPT WITH 0 REPLACE ALL RESETRPT WITH 1 FOR OBJTYPE = 7 REPLACE ALL RESETRPT WITH 2 FOR OBJTYPE = 6 REPLACE ALL RESETRPT WITH 3 FOR OBJTYPE = 5 REPLACE ALL RESETRPT WITH 4 FOR OBJTYPE = 8 REPLACE ALL RESETRPT WITH 5 FOR OBJTYPE = 17 *!* OBJTYPE *!* resetrpt *!* 7 - Shape *!* 6 - Line *!* 5 - Label *!* 8 - Field *!* 17 - Picture * Rename the fields that can be duplicated during JOIN ALTER TABLE TempFRX rename COLUMN Width to FRXWidth ALTER TABLE TempFRX rename COLUMN Height to FRXHeight ALTER TABLE TempFRX rename COLUMN Top to FRXTop INDEX ON nRecno TAG nRecno * SELECT OA.*, ; && OA = Output Alias TempFrx.* ; FROM (This.cOutputAlias) OA ; JOIN TempFrx ON OA.FrxRecno = TempFrx.nRecno ; WHERE FRXINDEX = m.n ; ORDER BY Page, resetRpt, Top, Left ; INTO CURSOR (m.laTempData(m.n)) READWRITE SELECT OA.*, ; && OA = Output Alias TempFrx.* ; FROM (This.cOutputAlias) OA ; JOIN TempFrx ON OA.FrxRecno = TempFrx.nRecno ; WHERE FRXINDEX = m.n ; INTO CURSOR (m.laTempData(m.n)) READWRITE IF _TALLY = 0 MESSAGEBOX("Error creating report data. The output will not be rendered correctly.", 16, "Error") SET STEP ON ENDIF USE IN SELECT("TempFRX") ENDFOR IF m.lnAliases > 1 SELECT m.laTempData(1) FOR m.n = 2 TO m.lnAliases APPEND FROM DBF(m.laTempData(m.n)) USE IN SELECT(m.laTempData(m.n)) ENDFOR ENDIF * Check if the "cAuxFullOutputAlias" exists, and appends with its data TRY IF NOT EMPTY(This.cAuxFullOutputAlias) IF NOT USED(This.cAuxFullOutputAlias) USE (This.cAuxFullOutputAlias) IN 0 SHARED AGAIN ENDIF SELECT m.laTempData(1) APPEND FROM DBF(This.cAuxFullOutputAlias) ENDIF CATCH TO m.loExc SET STEP ON ENDTRY This.cFullOutputAlias = m.laTempData(1) SELECT (This.cFullOutputAlias) SCAN IF Dynamics > 0 This.ProcessDynamics() ENDIF ENDSCAN CATCH TO m.loExc MESSAGEBOX("Error getting report information" + CHR(13) + ; TRANSFORM(m.loExc.ERRORNO) + " - " + m.loExc.MESSAGE + CHR(13) + ; "Line: " + TRANSFORM(m.loExc.LINENO) + " - " + m.loExc.LINECONTENTS + ; CHR(13) + CHR(13) + "Please inform the details to vfpimaging@hotmail.com", 16, "FoxyPreviewer Error") This.cFullOutputAlias = "" ENDTRY SELECT (m.lnSelect) RETURN (This.cFullOutputAlias) ENDPROC PROCEDURE erasetempfiles This.resetDataSession() * We need to clean all properties properly because the class remains opened * waiting for new sessions LOCAL n FOR m.n = 1 TO ALEN(This.aFRXTables, 1) USE IN SELECT(This.aFRXTables(m.n)) ENDFOR DIMENSION This.aFRXTables(1) This.aFRXTables(1) = "" USE IN SELECT(This.cOutputAlias) USE IN SELECT(This.cFullOutputAlias) USE IN SELECT(This.cFRXAlias) USE IN SELECT(This.cAuxFullOutputAlias) This.cOutputAlias = "" This.cFullOutputAlias = "" This.cFRXAlias = "" This.cAuxFullOutputAlias = "" ENDPROC PROCEDURE updateproperties Local lcThermClass, loExc IF (VARTYPE(_goHelper) = "O") AND ; _goHelper.lExtended = .F. AND ; VARTYPE(_Screen.oFoxypreviewer) = "O" OR ; (VARTYPE(_goHelper) <> "O" AND VARTYPE(_Screen.oFoxypreviewer) = "O") This.QuietMode = _Screen.oFoxypreviewer.lQuietMode This.Successor = _Screen.oFoxypreviewer.cSuccessor This.lExpandFields = _Screen.oFoxypreviewer.lExpandFields LOCAL lnType m.lnType = _Screen.oFoxypreviewer.nThermType IF m.lnType = 1 m.lcThermClass = "FXTHERM" ELSE m.lcThermClass = "FOXYTHERM" ENDIF This.fxFeedbackClass = m.lcThermClass _Screen.oFoxypreviewer._oDestScreen = This.CommandClauses.Window ENDIF CATCH TO m.loExc SET STEP ON ENDTRY ENDPROC PROCEDURE getdynamicsfromfrx LPARAMETERS tnRecno, tcNewContents, tnRotate #DEFINE OBJ_COMMENT 0 #DEFINE OBJ_LABEL 5 #DEFINE OBJ_LINE 6 #DEFINE OBJ_RECTANGLE 7 #DEFINE OBJ_FIELD 8 #DEFINE OBJ_PICTURE 17 #DEFINE OBJ_VARIABLE 18 LOCAL lnSession, lnSelect, lcDynamics, lnObjType, lcStyle m.lnSelect = SELECT() m.lnSession = SET("Datasession") m.lcDynamics = "" * Get info from FRX THIS.setFRXDataSession() SELECT FRX GO m.tnRecno m.lnObjType = FRX.ObjType m.lcStyle = FRX.STYLE * Restore the datasession SET DATASESSION TO(m.lnSession) SELECT (m.lnSelect) IF EMPTY(m.lcStyle) OR (NOT USED(THIS.cMainAlias)) OR (NOT INLIST(m.lnObjType, OBJ_LABEL, OBJ_FIELD, OBJ_PICTURE)) RETURN 0 ENDIF *!* Code to handle the Dynamic Options added in SP2 LOCAL lcExecWhen, lcDynType, N, llTrue, lcScript, lcNewContents m.N = 1 m.llTrue = .F. m.lcScript = "" m.lcNewContents = "" DO WHILE .T. m.lcDynType = UPPER(STREXTRACT(m.lcStyle, [name="Microsoft.VFP.Reporting.Builder.], ["], m.N)) && Possible results: ROTATE, EVALUATECONTENTS DO CASE CASE m.lcDynType == "ROTATE" m.tnRotate = VAL(STREXTRACT(m.lcStyle, [ execute="], ["], m.N)) m.N = m.N + 1 LOOP CASE EMPTY(m.lcDynType) m.N = 0 EXIT OTHERWISE ENDCASE m.lcExecWhen = STREXTRACT(m.lcStyle, [execwhen="], ["], m.N) m.lcExecWhen = THIS.GetStringFromXML(m.lcExecWhen) m.llTrue = EVALUATE(m.lcExecWhen) CATCH m.llTrue = .F. ENDTRY * If the dynamics does not return a logical value, then treat it as false m.llTrue = IIF(VARTYPE(m.llTrue)="L", m.llTrue, .F.) DO CASE CASE m.lcDynType = "ROTATE" CASE m.lcDynType = "EVALUATECONTENTS" AND ; (NOT EMPTY(m.lcExecWhen)) AND ; (m.llTrue) m.lcNewContents = STREXTRACT(m.lcStyle, [ script="], ["], m.N) IF NOT EMPTY(m.lcNewContents) TRY m.lcNewContents = THIS.GetStringFromXML(m.lcNewContents) m.lcNewContents = EVALUATE(m.lcNewContents) CATCH TO m.loExc SET STEP ON ENDTRY ENDIF EXIT OTHERWISE ENDCASE m.N = m.N + 1 ENDDO m.tcNewContents = m.lcNewContents RETURN m.N *!* * Dynamic formatting sample *!* *!* *!* *!* * Rotation *!* *!* *!* ENDPROC PROCEDURE getprinterinfo * See PRTINFO() in Help *!* nPrtOrientation *!* ---------------------------------------------------- *!* Numeric data type. The following tables list values returned when specifying particular values for nPrinterSetting. *!* If nPrinterSetting is 1, PRTINFO( ) returns the paper orientation as the following: *!* Values Paper orientation *!* 1 Information not available *!* 0 Portrait *!* 1 Landscape *!* nPrtPaperSize *!* ---------------------------------------------------- *!* See complete list in Help *!* Values Paper size *!* 1 Information not available. Use nPrinterSetting = 3 and nPrinterSetting = 4 to return the paper size. *!* *!* 1 Letter, 8 1/2 x 11 in *!* 2 Letter Small, 8 1/2 x 11 in *!* 3 Tabloid, 11 x 17 in *!* 4 Ledger, 17 x 11 in *!* 5 Legal, 8 1/2 x 14 in *!* 6 Statement, 5 1/2 x 8 1/2 in *!* 7 Executive, 7 1/4 x 10 1/2 in *!* 8 A3, 297 x 420 mm *!* 9 A4, 210 x 297 mm *!* 10 A4, Small 210 x 297 mm LOCAL lnSettings, lnOrientation, lcPrinterName, lnOrientationLine, lnPaperSize, lnPaperSizeLine, lcPrinterNameLine SELECT FRX LOCATE FOR ObjType = 1 and ObjCode = 53 * make an array out of the settings in the expr field m.lnSettings = ALines( laSettings, EXPR ) * Find the ORIENTATION element and get the value m.lnOrientationLine = Ascan( laSettings, "ORIENTATION",1,0,0,4) IF m.lnOrientationLine > 0 m.lnOrientation = VAL(SUBSTR(laSettings(m.lnOrientationLine), 13)) This.nPrtOrientation = m.lnOrientation ENDIF * Find the PAPERSIZE element and get the value m.lnPaperSizeLine = Ascan( laSettings, "PAPERSIZE",1,0,0,4) IF m.lnPaperSizeLine > 0 m.lnPaperSize = VAL(SUBSTR(laSettings(m.lnPaperSizeLine), 11)) This.nPrtPaperSize = m.lnPaperSize ENDIF * Find the DEVICE element and get the value m.lnPrinterNameLine = Ascan( laSettings, "DEVICE",1,0,0,4) IF m.lnPrinterNameLine > 0 m.lcPrinterName = SUBSTR(m.laSettings(m.lnPrinterNameLine), 8) This.cPrtPrinterName = m.lcPrinterName ENDIF ENDPROC PROCEDURE getstringfromxml LPARAMETERS tcText * Adjust Html special chars m.tcText = STRTRAN(m.tcText, [&] , [&]) && first! m.tcText = STRTRAN(m.tcText, [ ], [ ]) m.tcText = STRTRAN(m.tcText, [<] , [<]) m.tcText = STRTRAN(m.tcText, [>] , [>]) m.tcText = STRTRAN(m.tcText, ["], ["]) RETURN m.tcText ENDPROC PROCEDURE processdynamics #Define OBJ_COMMENT 0 #Define OBJ_LABEL 5 #Define OBJ_LINE 6 #Define OBJ_RECTANGLE 7 #Define OBJ_FIELD 8 #Define OBJ_PICTURE 17 #Define OBJ_VARIABLE 18 *!* Code to handle the Dynamic Options added in SP2 LOCAL lcStyle LOCAL lcDynamicString, loExc m.lcStyle = Style IF EMPTY(m.lcStyle) RETURN ENDIF *!* LOCAL lcDynType *!* lcDynType = UPPER(STREXTRACT(lcStyle, [name="Microsoft.VFP.Reporting.Builder.], ["], 1)) *!* && Possible results: ROTATE, EVALUATECONTENTS *!* DO CASE *!* CASE lcDynType = "ROTATE" *!* CASE lcDynType = "EVALUATECONTENTS" *!* OTHERWISE *!* ENDCASE m.lcDynamicString = STREXTRACT(Style, [ 0 THEN SELECT _TempDynamics TRY GO m.lnRecDyn CATCH TO m.loExc SET STEP ON ENDTRY TRY SELECT (THIS.cFullOutputAlias) DO CASE CASE ObjType = OBJ_FIELD *!* IF (VARTYPE(_TempDynamics.Script) = "C") AND (NOT EMPTY(_TempDynamics.Script)) *!* REPLACE Contents WITH _TempDynamics.Script, ; *!* UNContents WITH STRCONV(_TempDynamics.Script, 5) IN (THIS.cFullOutputAlias) *!* ENDIF * AddProperty(loDynamics, "cValue", _TempDynamics.Script) && the Replace Expression With * AddProperty(loDynamics, "cExecWhen", _TempDynamics.ExecWhen) && the expresion to be evaluate it IF VARTYPE(_TempDynamics.FName) = "C" REPLACE FontFace WITH _TempDynamics.FName IN (THIS.cFullOutputAlias) ENDIF IF VARTYPE(_TempDynamics.FSIZE) = "N" REPLACE FONTSIZE WITH _TempDynamics.FSIZE IN (THIS.cFullOutputAlias) ENDIF IF VARTYPE(_TempDynamics.FStyle) = "N" REPLACE FontStyle WITH _TempDynamics.FStyle IN (THIS.cFullOutputAlias) ENDIF *!* *!* *!* LOCAL lnPenRGB, lnPenR, lnPenG, lnPenB m.lnPenRGB = _TempDynamics.PenRgb IF VARTYPE(m.lnPenRgb) <> "N" m.lnPenRGB = VAL(ALLTRIM(m.lnPenRGB)) ENDIF IF m.lnPenRgb = -1 STORE 0 TO m.lnPenR, m.lnPenG, m.lnPenB ELSE m.lnPenR = BITRSHIFT(BITAND(m.lnPenRGB, 0x0000FF),0) m.lnPenG = BITRSHIFT(BITAND(m.lnPenRGB, 0x00FF00),8) m.lnPenB = BITRSHIFT(BITAND(m.lnPenRGB, 0xFF0000),16) ENDIF REPLACE PenRed WITH m.lnPenR, ; PenGreen WITH m.lnPenG, ; PenBlue WITH m.lnPenB IN (THIS.cFullOutputAlias) LOCAL lnFillRGB, lnFillR, lnFillG, lnFillB m.lnFillRGB = _TempDynamics.FillRgb IF VARTYPE(m.lnFillRGB) <> "N" m.lnFillRGB = VAL(ALLTRIM(m.lnFillRGB)) ENDIF IF m.lnFillRgb = -1 STORE 255 TO m.lnFillR, m.lnFillG, m.lnFillB ELSE m.lnFillR = BITRSHIFT(BITAND(m.lnFillRGB, 0x0000FF),0) m.lnFillG = BITRSHIFT(BITAND(m.lnFillRGB, 0x00FF00),8) m.lnFillB = BITRSHIFT(BITAND(m.lnFillRGB, 0xFF0000),16) ENDIF REPLACE FillRed WITH m.lnFillR, ; FillGreen WITH m.lnFillG, ; FillBlue WITH m.lnFillB IN (THIS.cFullOutputAlias) * New option, allowing opaque backgrounds * Mode: 0 = Opaque background; 1 = Transparent IF (VARTYPE(_TempDynamics.FillA) = "N") AND (_TempDynamics.FillA > 0) REPLACE Mode WITH 0 IN (THIS.cFullOutputAlias)&& Opaque ELSE REPLACE Mode WITH 1 IN (THIS.cFullOutputAlias)&& Transparent ENDIF m.lbReturn = .T. CASE INLIST(ObjType, OBJ_RECTANGLE, OBJ_IMAGE) *!* AddProperty(loDynamics, "cExecWhen", _TempDynamics.ExecWhen) &&Corresponds to the expresion to be evaluate it *!* AddProperty(loDynamics, "nWidth", Iif(Vartype(_TempDynamics.Width)="C", Int(Val(_TempDynamics.Width)), _TempDynamics.Width)) &&Corresponds to the width assigned *!* AddProperty(loDynamics, "nHeight", Iif(Vartype(_TempDynamics.Height)="C", Int(Val(_TempDynamics.Height)), _TempDynamics.Height)) &&Corresponds to the width assigned m.lbReturn = .T. ENDCASE CATCH TO m.loExc SET STEP ON m.lbReturn = .F. ENDTRY SELECT _TempDynamics *!* *!* No check for Rotation Values *!* SCAN FOR _TempDynamics.NAME="Microsoft.VFP.Reporting.Builder.Rotate" *!* ADDPROPERTY(loDynamics, "nRotationDegree", IIF(VARTYPE(_TempDynamics.Execute)="C", INT(VAL(_TempDynamics.Execute)), _TempDynamics.Execute)) *!* lbReturn = .T. *!* ENDSCAN SELECT (m.lnSelect) RETURN m.lbReturn m.lbReturn = .F. ENDIF SELECT (m.lnSelect) RETURN m.lbReturn *!* * Dynamic formatting sample *!* *!* *!* *!* * Rotation *!* *!* *!* *!* *!* *!* ENDPROC PROCEDURE onpreviewclose_bind LPARAMETERS lPrint This.EraseTempFiles() This.nFrxIndex = 0 ENDPROC PROCEDURE addtolog LPARAMETERS tcInfo, tcMethod LOCAL lnSelect, lcAlias, lnDataSession, lcText, CRLF m.lnSelect = SELECT() m.lcAlias = ALIAS() m.lnDataSession = SET("Datasession") m.CRLF = CHR(13) + CHR(10) m.lcText = m.tcInfo + m.CRLF + ; m.tcMethod + m.CRLF + ; "Select: " + TRANSFORM(m.lnSelect) + " - " + ; "Alias: " + m.lcAlias + " - " + ; "Session: " + TRANSFORM(m.lnDataSession) + m.CRLF + m.CRLF STRTOFILE(m.lcText, "c:\FoxyPreviewer_Log.txt", .T.) ENDPROC PROCEDURE LoadReport This.UpdateProperties() * If ListenerType hasn't already been set, set it based on whether the report * is being printed or previewed. WITH This DO CASE CASE .ListenerType <> -1 CASE .CommandClauses.Preview .ListenerType = 3 && 1 CASE .CommandClauses.OutputTo = 1 .ListenerType = 0 ENDCASE IF .ListenerType = 0 .lStoreData = .F. && There's no need to store the report info when direct printing ENDIF ENDWITH DODEFAULT() ENDPROC PROCEDURE Init *!* IF FILE("c:\FoxyPreviewer_Log.txt") *!* DELETE FILE ("c:\FoxyPreviewer_Log.txt") *!* ENDIF This.AddProperty("cOutputAlias" , '') && The alias for the cursor to output to This.AddProperty("cAuxFullOutputAlias" , '') && The AUXILIAR alias for the cursor to output to - used by the feature This.AddProperty("lDeleteOnDestroy" , .T.) && .T. to delete the table when this object is destroyed This.AddProperty("cMainAlias" , '') This.AddProperty("nStartingSession" , 1) This.AddProperty("nStartingRecNo" , 1) This.AddProperty("cStartingAlias" , "") This.AddProperty("lStoreData" , .T.) && .T. to store the info from the report in a table This.AddProperty("cFullOutputAlias" , '') && The name of the cursor that will contain the FULL && report info to regenerate the report in a different format This.AddProperty("cFRXDBF" , '') && The name of the FRX table to output to This.AddProperty("cFRXAlias" , '') && The name of the FRX table to output to This.AddProperty("aFRXTables[1]" , '') && Array of FRX tables This.AddProperty("nFRXIndex" , 0) && The FRX index This.AddProperty("nPrtOrientation" , 0) This.AddProperty("nPrtPaperSize" , 0) This.AddProperty("cPrtPrinterName" , "") IF VARTYPE(_goHelper) = "O" This.QuietMode = _goHelper.lQuietMode This.lStoreData = .T. && (_goHelper.lExtended = .F.) OR (_goHelper.lShowSearch) ENDIF DODEFAULT() BINDEVENT(This, "OnPreviewClose", This, "OnPreviewClose_Bind", 1) ENDPROC PROCEDURE BeforeReport IF NOT This.lStoreData DODEFAULT() RETURN ENDIF LOCAL lcTable, lcAlias, llHelper, lnSelect, lnSession, lnIndex m.lnSession = SET("Datasession") m.lnSelect = SELECT() m.llHelper = VARTYPE(_goHelper) = "O" This.nFrxIndex = This.nFrxIndex + 1 IF m.llHelper _goHelper._cOutputAlias = This.cOutputAlias m.lcAlias = _goHelper._oAliases(_goHelper._nIndex) CATCH ENDTRY ENDIF m.lnIndex = This.nFrxIndex m.lcAlias = EVL(UPPER(ALIAS()), "") IF EMPTY(m.lcAlias) m.lcAlias = UPPER(ALIAS()) ENDIF This.cMainAlias = m.lcAlias * Get the original Alias information This.setCurrentDataSession() LOCAL lcStartingAlias m.lcStartingAlias = UPPER(ALIAS()) This.cStartingAlias = m.lcStartingAlias This.nStartingSession = SET("Datasession") This.nStartingRecNo = RECNO() WITH This * Store the table info .SetFRXDataSession() .GetPrinterInfo() LOCAL lcFRXDBF0, lcFRXAlias, lcFRXAlias0 m.lcFRXDBF0 = ADDBS(GETENV("TEMP")) + FORCEEXT(SYS(2015), "DBF") m.lcFRXAlias0 = STRTRAN(JUSTSTEM(m.lcFRXDBF0), ' ', '_') m.lcFRXAlias = STRTRAN(SYS(2015), ' ', '_') * Create a copy of the FRX to be available to export SELECT FRX COPY TO (m.lcFRXDBF0) .ResetDataSession() IF NOT FILE(m.lcFRXDBF0) MESSAGEBOX("Error creating temporary FRX table") ELSE * Load the FRX table as a cursor USE (m.lcFRXDBF0) AGAIN IN 0 ALIAS (m.lcFRXAlias0) * Convert the table to a cursor and delete the local table SELECT * FROM (m.lcFRXAlias0) INTO CURSOR (m.lcFRXAlias) READWRITE USE IN SELECT(m.lcFRXAlias0) ERASE (m.lcFRXDBF0) ERASE FORCEEXT(m.lcFRXDBF0, "FPT") .cFRXAlias = m.lcFRXAlias DIMENSION This.aFRXTables(m.lnIndex) This.aFRXTables(m.lnIndex) = m.lcFRXAlias IF m.lnIndex < 2 && Merged reports, no need to close the cursor * Prepare the Render data cursor .cOutputAlias = STRTRAN(SYS(2015), " ", "_") CREATE CURSOR (.cOutputAlias) (FRXRECNO I, DBFRECNO I, LEFT I, TOP I, ; WIDTH I, HEIGHT I, CONTTYPE I, CONTENTS M NOCPTRANS, ; UNCONTENTS M NOCPTRANS, PAGE I, FRXINDEX I, DYNAMICS I, ROTATE I) INDEX ON PAGE TAG PAGE INDEX ON FRXINDEX TAG FRXINDEX ENDIF ENDIF ENDWITH * Make sure to select the right DataSession SET DATASESSION TO (m.lnSession) * Do the usual behavior. DODEFAULT() * Make sure to select the right DataSession SET DATASESSION TO (m.lnSession) * In some cases, FoxyPreviewer wants to force the report to select a certain ALIAS, so * here we give it a chance to try to make it IF NOT EMPTY(m.lcAlias) SELECT (m.lcAlias) SELECT (m.lnSelect) ENDIF RETURN ENDPROC PROCEDURE Render LPARAMETERS m.tnFRXRecno, m.tnLeft, m.tnTop, m.tnWidth, m.tnHeight, m.tnObjectContinuationType, m.tcContentsToBeRendered, m.tiGDIPlusImage IF This.lStoreData This.StoreFRXData(m.tnFRXRecno, m.tnLeft, m.tnTop, m.tnWidth, m.tnHeight, m.tnObjectContinuationType, ; m.tcContentsToBeRendered, m.tiGDIPlusImage) ENDIF DODEFAULT(m.tnFRXRecNo, m.tnLeft, m.tnTop, m.tnWidth, m.tnHeight, ; m.tnObjectContinuationType, m.tcContentsToBeRendered, m.tiGDIPlusImage) ENDPROC PROCEDURE applyfx LPARAMETERS m.toListener, m.tcMethodToken,; m.tP1, m.tP2, m.tP3, m.tP4, m.tP5, m.tP6, ; m.tP7, m.tP8, m.tP9, m.tP10, m.tP11, m.tP12 This.Movable = .T. LOCAL m.liSession IF VARTYPE(m.toListener) = "O" && AND ; (NOT m.toListener.IsSuccessor) DO CASE CASE m.tcMethodToken == "DOSTATUS" THIS.DoStatus(m.toListener, m.tP1) CASE m.tcMethodToken == "UPDATESTATUS" THIS.UpdateStatus(m.toListener) CASE m.tcMethodToken == "CLEARSTATUS" THIS.ClearStatus(m.toListener) CASE m.tcMethodToken == "AFTERBAND" THIS.synchStatus(m.toListener,m.tP1,m.tP2) CASE m.tcMethodToken == "AFTERREPORT" IF SYS(2024) # "Y" IF THIS.isRunning AND TYPE("m.toListener.CommandClauses.RecordTotal") = "N" THIS.CurrentRecord = m.toListener.CommandClauses.RecordTotal ENDIF THIS.UpdateStatus(m.toListener) ENDIF THIS.designatedDriver = "" THIS.drivingAlias = "" THIS.successorSys2024 = "N" THIS.Visible = .F. THIS.ReportStopRunDateTime = DATETIME() THIS.popUserFeedbackGlobalSets() THIS.ClearStatus(m.toListener) CASE m.tcMethodToken == "BEFOREBAND" IF THIS.successorSys2024 = "Y" AND ; m.toListener.CurrentPass = LISTENER_FULLPASS * user cancelled during the prepass, * we need to re-cancel. m.liSession = SET("DATASESSION") SET DATASESSION TO (m.toListener.CurrentDataSession) IF USED(THIS.designatedDriver) GO BOTTOM IN (THIS.designatedDriver) ENDIF SET DATASESSION TO (m.liSession) ENDIF THIS.synchStatus(m.toListener,m.tP1,m.tP2) CASE m.tcMethodToken == "BEFOREREPORT" THIS.setupReport(m.toListener) CASE m.tcMethodToken == "CANCELREPORT" IF THIS.isRunning AND ; (m.toListener.QuietMode OR ; (m.toListener.pageLimit > 0 AND m.toListener.PageNo > m.toListener.pageLimit) OR ; (NOT m.toListener.AllowModalMessages) OR ; m.toListener.DoMessage(This.CancelQueryText,; && OUTPUTCLASS_REPORT_CANCELQUERY_LOC MB_ICONQUESTION+MB_YESNO, This.AttentionText) = IDYES ) m.toListener.cancelRequested = .T. IF m.toListener.isSuccessor AND NOT EMPTY(THIS.designatedDriver) * NB: FX should ordinarily not be used in a successor, * but this won't hurt and will take care of the exception THIS.successorSys2024 = "Y" m.liSession = SET("DATASESSION") SET DATASESSION TO (m.toListener.CurrentDataSession) IF USED(THIS.designatedDriver) GO BOTTOM IN (THIS.designatedDriver) ENDIF SET DATASESSION TO (m.liSession) ENDIF IF SYS(2024) = "Y" OR m.toListener.IsSuccessor THIS.Visible = .F. IF (m.toListener.pageLimit = -1 OR m.toListener.PageNo <= m.toListener.pageLimit) m.toListener.DoMessage(; This.ReportIncompleteText, ; && OUTPUTCLASS_REPORT_INCOMPLETE_LOC MB_ICONEXCLAMATION, This.AttentionText) ENDIF ENDIF RETURN .F. ELSE RETURN .T. && did not handle, use default behavior ENDIF CASE m.tcMethodToken == "LOADREPORT" THIS.ResetUserFeedback(.T.) m.toListener.AddProperty("reportStartRunDatetime",THIS.reportStartRunDatetime) IF NOT (m.toListener.QuietMode OR ; (TYPE("m.toListener.CommandClauses.NoDialog") = "L" AND ; m.toListener.CommandClauses.NoDialog) ) THIS.DoStatus(m.toListener,THIS.initStatusText) * NB: a user can call LoadReport manually, * hence the need for a TYPE() check here. ENDIF THIS.pushUserFeedbackGlobalSets(m.toListener) CASE m.tcMethodToken == "UNLOADREPORT" THIS.ReportStopRunDateTime = DATETIME() m.toListener.AddProperty("reportStopRunDatetime",THIS.reportStopRunDatetime) THIS.IsRunning = .F. THIS.ClearStatus() IF NOT THIS.persistBetweenRuns SET DATASESSION TO (m.toListener.ListenerDataSession) THIS.Release() ENDIF ENDCASE SET DATASESSION TO (m.toListener.ListenerDataSession) ENDIF ENDPROC PROCEDURE includeseconds_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "L" THIS.includeSeconds = m.vNewVal ENDIF ENDPROC PROCEDURE initstatustext_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "C" THIS.initStatusText = m.vNewVal ENDIF ENDPROC PROCEDURE prepassstatustext_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "C" THIS.prepassStatusText = m.vNewVal ENDIF ENDPROC PROCEDURE runstatustext_assign LPARAMETERS vNewVal *To do: Modify this routine for the Assign method THIS.runStatusText = m.vNewVal ENDPROC PROCEDURE secondstext_assign LPARAMETERS vNewVal *To do: Modify this routine for the Assign method THIS.secondsText = m.vNewVal ENDPROC PROCEDURE thermcaption_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "C" LOCAL m.lcType, m.cMessage m.cMessage = "" TRY m.lcType = VARTYPE(EVALUATE(m.vNewVal)) IF m.lcType = "C" THIS.thermCaption = m.vNewVal ENDIF CATCH ENDTRY ENDIF ENDPROC PROCEDURE thermformcaption_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "C" THIS.thermFormCaption = m.vNewVal THIS.setThermFormCaption() ENDIF ENDPROC PROCEDURE thermformheight_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "N" AND ; BETWEEN(m.vNewVal,30,SYSMETRIC(SYSMETRIC_SCREENHEIGHT )-30) AND ; INT(m.vNewVal) # THIS.thermFormHeight THIS.thermFormHeight = INT(m.vNewVal) IF THIS.thermMargin > THIS.thermFormHeight/4 THIS.thermMargin = THIS.thermFormHeight/4 ENDIF THIS.synchUserInterface() ENDIF ENDPROC PROCEDURE thermformwidth_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "N" AND ; BETWEEN(m.vNewVal,100,SYSMETRIC( SYSMETRIC_SCREENWIDTH )-100) AND ; INT(m.vNewVal) # THIS.ThermFormWidth THIS.thermFormWidth = INT(m.vNewVal) IF THIS.thermMargin > THIS.thermFormWidth/4 THIS.thermMargin = THIS.thermFormWidth/4 ENDIF THIS.synchUserInterface() ENDIF ENDPROC PROCEDURE thermmargin_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "N" AND ; BETWEEN(m.vNewVal,1,MIN(THIS.ThermFormHeight/4,THIS.ThermFormWidth/4)) AND ; INT(m.vNewVal) # THIS.thermMargin THIS.thermMargin = INT(m.vNewVal) THIS.synchUserInterface() ENDIF ENDPROC PROCEDURE getparentwindowref LOCAL m.loForm, m.loTopForm, m.lcInWindow * first top form in the list * will be the current top form. ASSERT TYPE("_SCREEN.ActiveForm") # "O" OR ; INLIST(_SCREEN.ActiveForm.ShowWindow, 0,1,2) m.loTopForm = NULL IF TYPE("THIS.CommandClauses.InWindow") = "C" m.lcInWindow = UPPER(ALLTRIM(THIS.CommandClauses.InWindow)) ENDIF IF EMPTY(lcInWindow) AND TYPE("THIS.CommandClauses.Window") = "C" m.lcInWindow = UPPER(ALLTRIM(THIS.CommandClauses.Window)) ENDIF IF NOT EMPTY(m.lcInWindow) FOR EACH m.loForm IN _SCREEN.Forms FOXOBJECT IF m.loForm.ShowWindow = 2 AND ; UPPER(m.loForm.Name) == m.lcInWindow m.loTopForm = m.loForm EXIT ENDIF ENDFOR ENDIF DO CASE CASE VARTYPE(m.loTopForm) = "O" * already found CASE _SCREEN.FormCount = 0 OR ; (TYPE("_SCREEN.ActiveForm") = "O" AND ; _SCREEN.ActiveForm.ShowWindow = 0 ) && ShowWindow In Screen m.loTopForm = _SCREEN CASE (TYPE("_SCREEN.ActiveForm") = "O" AND ; _SCREEN.ActiveForm.ShowWindow = 2 ) && ShowWindow As Top Form m.loTopForm = _SCREEN.ActiveForm OTHERWISE FOR EACH m.loForm IN _SCREEN.Forms FOXOBJECT IF m.loForm.ShowWindow = 2 m.loTopForm = m.loForm EXIT ENDIF ENDFOR IF VARTYPE(m.loTopForm) # "O" m.loTopForm = _SCREEN ENDIF ENDCASE IF VARTYPE(m.loTopForm) # "O" OR ; EMPTY(m.loTopForm.Name) m.loTopForm = NULL ENDIF RETURN m.loTopForm ENDPROC PROCEDURE getreportscopedriver LPARAMETERS m.toListener LOCAL m.liSelect, m.lcAlias, ; m.liSkips, laSkips[1] IF m.toListener.FRXDataSession > 0 SET DATASESSION TO (m.toListener.FRXDataSession) RETURN .F. ENDIF THIS.designatedDriver = THIS.drivingAlias * used later if we have to cancel report as * a Successor IF USED("frx") m.liSelect = SELECT(0) m.lcAlias = "" SELECT FRX * first look for any target alias that * is the same as the driver SCAN ALL FOR ObjType = FRX_OBJTYP_BAND AND ; Objcode = FRX_OBJCOD_DETAIL AND ; TYPE(Expr) = "C" AND ; NOT (EMPTY(Expr) OR DELETED()) m.lcAlias = ALLTRIM(Expr) SET DATASESSION TO (m.toListener.CurrentDataSession) m.lcAlias = UPPER(EVALUATE(m.lcAlias)) SET DATASESSION TO (m.toListener.FRXDataSession) IF m.lcAlias == UPPER(THIS.drivingAlias) EXIT ENDIF ENDSCAN IF m.lcAlias == UPPER(THIS.drivingAlias) SELECT (m.liSelect) * if the driver is also a target alias, * don't touch. * otherwise: ELSE LOCATE FOR ObjType = FRX_OBJTYP_BAND AND ; Objcode = FRX_OBJCOD_DETAIL AND ; Platform = FRX_PLATFORM_WINDOWS AND ; NOT (EMPTY(Expr) OR DELETED()) IF FOUND() * use the first detail band, on the theory * that people are going to put pre-processing * calculations before other bands, * so an early band has the best chance to be * the right driver. m.lcAlias = ALLTRIM(Expr) SET DATASESSION TO (m.toListener.CurrentDataSession) THIS.drivingAlias = UPPER(EVALUATE(m.lcAlias)) SET DATASESSION TO (m.toListener.FrxDataSession) SELECT (m.liSelect) ELSE * adjust the driver based on any * one to many relationships we can find. SELECT (m.liSelect) SET DATASESSION TO (m.toListener.CurrentDataSession) m.lcAlias = THIS.drivingAlias m.liSelect = SELECT(0) DO WHILE NOT EMPTY(m.lcAlias) SELECT (m.lcAlias) m.liSkips = ALINES(laSkips,SET("SKIP"),",") IF m.liSkips = 0 OR EMPTY(laSkips[1]) THIS.drivingAlias = m.lcAlias m.lcAlias = "" ELSE m.lcAlias = laSkips[1] * it doesn't really matter how many lines there * are in the array; this is not going to be perfect * but we can't predict which child * has the most records. ENDIF ENDDO SELECT (m.liSelect) ENDIF ENDIF RETURN .F. ENDIF ENDPROC PROCEDURE resetuserfeedback LPARAMETERS m.tlResetTimes THIS.CurrentRecord = 0 THIS.PercentDone = 0 IF m.tlResetTimes THIS.ReportStartRunDateTime= DATETIME() THIS.ReportStopRunDateTime= DTOT({}) THIS.thermFormCaption = "" THIS.synchUserInterface() ENDIF ENDPROC PROCEDURE setthermformcaption LPARAMETERS tcCommandClausesFile, tcPrintJobName IF EMPTY(THIS.ThermFormCaption) IF VARTYPE(tcCommandClausesFile) = "C" LOCAL m.cName, loFP loFP = _Screen.oFoxyPreviewer DO CASE CASE VARTYPE(loFp) = "O" AND NOT EMPTY(NVL(_Screen.oFoxyPreviewer.cTitle, "")) m.cName = _Screen.oFoxyPreviewer.cTitle CASE EMPTY(tcPrintJobName) OR VARTYPE(tcPrintJobName) # "C" m.cName = PROPER(JUSTFNAME(tcCommandClausesFile)) OTHERWISE m.cName = tcPrintJobName ENDCASE THIS.thermFormCaption = ; m.cName + ": " + This.CancelInstrText && OUTPUTCLASS_CANCEL_INSTRUCTIONS_LOC ELSE THIS.thermFormCaption = "" ENDIF ENDIF This.Caption = THIS.thermFormCaption ENDPROC PROCEDURE synchstatus LPARAMETERS m.toListener, m.nBandObjCode, m.nFRXRecNo IF THIS.isRunning AND ; THIS.frxBandRecno = m.nFRXRecNo WITH m.toListener TRY SET DATASESSION TO (.CurrentDataSession) IF THIS.drivingAliasCurrentRecno # RECNO(THIS.drivingAlias) THIS.currentRecord = THIS.CurrentRecord + 1 THIS.drivingAliasCurrentRecno = RECNO(THIS.drivingAlias) ENDIF IF THIS.currentRecord >= .CommandClauses.RecordTotal IF .CurrentPass = 0 AND .TwoPassProcess THIS.resetUserFeedback() ELSE THIS.currentRecord = .CommandClauses.RecordTotal ENDIF ENDIF THIS.updateStatus(m.toListener) CATCH TO err #IF OUTPUTCLASS_DEBUGGING SUSPEND #ENDIF ENDTRY SET DATASESSION TO (.ListenerDataSession) ENDWITH ENDIF ENDPROC PROCEDURE dostatus LPARAMETERS m.toListener, m.cMessage LOCAL m.loParentForm, m.lcCaption, m.lcParentFormName IF (VARTYPE(m.toListener) # "O") OR (NOT (m.toListener.QuietMode OR ; (THIS.isRunning AND m.toListener.CommandClauses.NoDialog))) IF (This.nLastPercent > 0 AND ; This.percentDone - This.nLastPercent < This.nDelay AND ; This.percentDone <> 100) RETURN ELSE this.nlastpercent = CEILING(This.percentDone) ENDIF IF EMPTY(m.cMessage) OR ISNULL(m.cMessage) m.cMessage = "" ENDIF m.lcCaption = EVALUATE(THIS.ThermCaption) WITH This IF THIS.isRunning THIS.Closable = .F. * THIS.Movable = .F. ENDIF .Therm.Value = CEILING(This.percentDone) .ThermLabel.Caption = lcCaption * .Paint() .Draw() && To ensure the label text will be updated IF NOT .Visible m.loParentForm = THIS.GetParentWindowRef() DO CASE CASE VARTYPE(m.loParentForm) # "O" AND (NOT _SCREEN.Visible) m.lcParentFormName = "MACDESKTOP" CASE VARTYPE(m.loParentForm) # "O" m.lcParentFormName = "SCREEN" CASE (NOT m.loParentForm.Visible) AND ; (m.loParentForm.DeskTop OR NOT EMPTY(m.loParentForm.MacDesktop) OR ; m.loParentForm.ShowWindow = 2 OR (NOT _SCREEN.Visible)) * in many cases, * they've probably made a programming error, * the parent should be visible according to * the requirements of REPORT FORM ... IN WINDOW * if it's a WINDOW clause they * have no need to show it, might not be an error * Either way, they should see the therm * to know that the report is progressing m.lcParentFormName = "MACDESKTOP" CASE (NOT m.loParentForm.Visible) * same comment as above m.lcParentFormName = "SCREEN" OTHERWISE m.lcParentFormName = m.loParentForm.Name ENDCASE SHOW WINDOW (.Name) IN WINDOW (m.lcParentFormName) .AlwaysOnTop = .T. .AutoCenter = .T. * .Visible = .T. ENDIF ENDWITH m.loParentForm = NULL ENDIF ENDPROC PROCEDURE clearstatus LPARAMETERS m.toListener IF THIS.Visible THIS.Visible = .F. ENDIF ENDPROC PROCEDURE updatestatus LPARAMETERS m.toListener IF VARTYPE(m.toListener) = "O" AND THIS.isRunning LOCAL m.liRecTotal, m.lnNewPercent, m.llShow m.liRecTotal = m.toListener.CommandClauses.RecordTotal IF m.liRecTotal > 0 m.lnNewPercent = ROUND(THIS.CurrentRecord/m.liRecTotal,(THIS.ThermPrecision + 2) ) * 100 IF (THIS.PercentDone # m.lnNewPercent) THIS.PercentDone = m.lnNewPercent m.llShow = .T. #IF OUTPUTCLASS_DEBUGGING ? THIS.PercentDone, THIS.CurrentRecord, m.liRecTotal, m.toListener.PageTotal ? REPL(OUTPUTCLASS_STATUSCHAR_PCT_DONE,INT(THIS.PercentDone/100* OUTPUTCLASS_ONE_HUNDRED_PCT_MARK))+ ; REPL(OUTPUTCLASS_STATUSCHAR_PCT_NOT_DONE,MAX(FLOOR(OUTPUTCLASS_ONE_HUNDRED_PCT_MARK - ; (OUTPUTCLASS_ONE_HUNDRED_PCT_MARK *THIS.PercentDone/100)),0) ) #ENDIF ENDIF ELSE m.llShow = .T. ENDIF IF m.llShow THIS.DoStatus(m.toListener, ; IIF(m.toListener.CurrentPass = LISTENER_PREPASS AND m.toListener.TwoPassProcess,; THIS.PrepassStatusText, ; THIS.RunStatusText) ) ENDIF ENDIF ENDPROC PROCEDURE pushuserfeedbackglobalsets LPARAMETERS m.toListener IF (NOT INLIST(_VFP.StartMode,2,3,5)) PUSH KEY CLEAR LOCAL m.lcRef SET MESSAGE TO "" THIS.SetNotifyCursor = (SET("Notify",2) = "ON") IF THIS.SetNotifyCursor SET NOTIFY CURSOR OFF ENDIF THIS.OnEscapeCommand = ON("ESCAPE") m.lcRef = SYS(2015) PUBLIC &lcRef. STORE m.toListener TO (m.lcRef) ON ESCAPE &lcRef..CancelReport() THIS.EscapeReference = m.lcRef THIS.SetEscape = (SET("ESCAPE")="OFF") IF THIS.SetEscape SET ESCAPE ON ENDIF ENDIF ENDPROC PROCEDURE popuserfeedbackglobalsets IF (NOT INLIST(_VFP.StartMode,2,3,5)) LOCAL m.lcRef m.lcRef = THIS.EscapeReference IF (NOT EMPTY(m.lcRef)) AND ; TYPE(m.lcRef) = "O" * push occurred earlier STORE NULL TO (m.lcRef) RELEASE &lcRef. THIS.escapeReference = "" m.lcRef = THIS.OnEscapeCommand ON ESCAPE &lcRef POP KEY IF THIS.SetNotifyCursor SET NOTIFY CURSOR ON ENDIF IF THIS.SetEscape SET ESCAPE OFF ENDIF ENDIF ENDIF ENDPROC PROCEDURE setupreport LPARAMETERS m.toListener LOCAL m.llFRXAvailable, m.lcAlias THIS.isRunning = .T. WITH m.toListener SET DATASESSION TO (.CurrentDataSession) THIS.DrivingAlias = UPPER(ALIAS()) IF .FRXDataSession > 0 SET DATASESSION TO (.FRXDataSession) ENDIF m.llFRXAvailable = THIS.getReportScopeDriver(m.toListener) IF m.llFRXAvailable THIS.setThermformCaption(m.toListener.CommandClauses.File, m.toListener.PrintJobName) IF TYPE("m.toListener.CommandClauses.Summary") # "L" ADDPROPERTY(.CommandClauses,"Summary",.F.) ENDIF IF TYPE("m.toListener.CommandClauses.RecordTotal") # "N" ADDPROPERTY(.CommandClauses,"RecordTotal",0) ENDIF IF TYPE("m.toListener.CommandClauses.NoDialog") # "L" ADDPROPERTY(.CommandClauses,"NoDialog",.F.) ENDIF SET DATASESSION TO (.FRXDataSession) THIS.FRXBandRecno = 0 SELECT FRX IF .CommandClauses.Summary * don't use groups unless * we're forced to by Summary. * Group usage will not work if * there's a group on .T. or some * other nonsensical expression that * doesn't change. LOCATE FOR ObjType = FRX_OBJTYP_BAND AND ; Objcode = FRX_OBJCOD_GROUPHEADER AND ; Platform = FRX_PLATFORM_WINDOWS AND ; NOT DELETED() DO WHILE NOT EOF() * find the innermost group THIS.FRXBandRecno = RECNO() CONTINUE ENDDO IF THIS.frxBandRecno = 0 * no groups in a Summary report * doesn't make a lot of sense, but * can happen. LOCATE FOR ObjType = FRX_OBJTYP_BAND AND ; Platform = FRX_PLATFORM_WINDOWS AND ; Objcode = FRX_OBJCOD_PAGEHEADER AND ; NOT DELETED() IF NOT EOF() THIS.FRXBandRecno = RECNO() ENDIF ENDIF ENDIF IF THIS.FRXBandRecno = 0 * not a Summary report. * look for the appropriate detail * using the report driver LOCATE FOR ObjType = FRX_OBJTYP_BAND AND ; Objcode = FRX_OBJCOD_DETAIL AND ; Platform = FRX_PLATFORM_WINDOWS AND ; TYPE(Expr) = "C" AND ; NOT (EMPTY(Expr) OR DELETED()) DO WHILE NOT EOF() m.lcAlias = ALLTRIM(Expr) SET DATASESSION TO (.CurrentDataSession) m.lcAlias = UPPER(EVALUATE(m.lcAlias)) SET DATASESSION TO (.FRXDataSession) IF m.lcAlias == UPPER(THIS.DrivingAlias) THIS.FRXBandRecno = RECNO() ENDIF CONTINUE && try not to use the first detail band ENDDO ENDIF IF THIS.frxBandRecno = 0 * couldn't match up a band with * the known driver LOCATE FOR ObjType = FRX_OBJTYP_BAND AND ; Objcode = FRX_OBJCOD_DETAIL AND ; Platform = FRX_PLATFORM_WINDOWS AND ; EMPTY(Expr) AND NOT DELETED() IF NOT EOF() THIS.FRXBandRecno = RECNO() ELSE IF THIS.FRXBandRecno = 0 LOCATE FOR ObjType = FRX_OBJTYP_BAND AND ; Platform = FRX_PLATFORM_WINDOWS AND ; Objcode = FRX_OBJCOD_DETAIL AND ; NOT DELETED() IF NOT EOF() THIS.FRXBandRecno = RECNO() ENDIF ENDIF ENDIF ENDIF ENDIF THIS.DrivingAliasCurrentRecno = 0 SET DATASESSION TO (.ListenerDataSession) ENDWITH ENDPROC PROCEDURE thermprecision_assign LPARAMETERS m.vNewVal IF VARTYPE(m.vNewVal) = "N" THIS.thermPrecision = ABS(INT(m.vNewVal)) ENDIF ENDPROC PROCEDURE persistbetweenruns_assign LPARAMETERS vNewVal IF VARTYPE(m.vNewVal) = "L" THIS.persistBetweenRuns = m.vNewVal ENDIF ENDPROC PROCEDURE createtherm LPARAMETERS toListener *modified to use Carlos Alloatti progress bar #DEFINE SCALEMODE_PIXELS 3 && 3 - Pixel #DEFINE BORDER_DOUBLE 2 * #DEFINE OUTPUTCLASS_RUNSTATUS_LOC "Creating output... " DECLARE INTEGER GetSysColor IN Win32API INTEGER LOCAL liThermTop, liThermLeft, liThermWidth, liThermHeight, liSession IF TYPE("toListener.CommandClauses.StartDataSession") = "N" liSession = SET("DATASESSION") TRY SET DATASESSION TO (toListener.CommandClauses.StartDataSession) CATCH WHEN .T. toListener.resetDataSession() ENDTRY ENDIF liThermTop = THIS.ThermMargin + 20 liThermLeft = THIS.ThermMargin WITH This .ScaleMode = SCALEMODE_PIXELS .Height = THIS.ThermFormHeight .HalfHeightCaption = .T. .Width = THIS.ThermFormWidth .AutoCenter = .T. .BorderStyle = BORDER_DOUBLE && fixed dialog .ControlBox = .F. .Closable = (NOT THIS.IsRunning) .MaxButton = .F. .MinButton = .F. * .Movable = (NOT THIS.IsRunning) .AlwaysOnTop = .T. .AllowOutput = .F. .ThermLabel.Visible = .T. .ThermLabel.FontBold = .T. .ThermLabel.Left = liThermLeft .ThermLabel.Top = 4 .ThermLabel.Width = .Width - (THIS.ThermMargin*2) .ThermLabel.Alignment = 2 liThermHeight = .Height - (THIS.ThermMargin* 2) - .ThermLabel.Height liThermWidth = .Width - (THIS.ThermMargin*2) ENDWITH THIS.SetThermFormCaption() WITH THIS.Therm .Top = liThermTop .Left = liThermLeft .Height = liThermHeight .Width = liThermWidth .Visible = .T. .Caption = This.RunStatusText && OUTPUTCLASS_RUNSTATUS_LOC ENDWITH IF NOT EMPTY(liSession) SET DATASESSION TO (liSession) ENDIF RETURN NOT ISNULL(THIS.Therm) ENDPROC PROCEDURE bringwindowtofront * Craig Boyd * http://fox.wikis.com/wc.dll?Wiki~ForceWindowtoFrontNotJustBlink DECLARE Long BringWindowToTop In Win32API Long DECLARE Long ShowWindow In Win32API Long, Long DECLARE INTEGER GetCurrentThreadId; IN kernel32 DECLARE INTEGER GetWindowThreadProcessId IN user32; INTEGER hWnd,; INTEGER @ lpdwProcId DECLARE INTEGER GetCurrentThreadId; IN kernel32 DECLARE INTEGER AttachThreadInput IN user32 ; INTEGER idAttach, ; INTEGER idAttachTo, ; INTEGER fAttach DECLARE INTEGER GetForegroundWindow IN user32 DECLARE Long FindWindow In Win32API String, String Local lnHWND lnHWND = FindWindow(NULL, _Screen.Caption) && we could have just used _screen.hwnd, but this will work for other non-VFP windows as well If lnHWND >0 LOCAL lnForeThread, lnAppThread lnForeThread = GetWindowThreadProcessId(GetForegroundWindow(), 0) && what process owns foreground window? lnAppThread = GetCurrentThreadId() && what process is our window owned by? IF lnForeThread != lnAppThread && our process doesn't own the foreground window currently AttachThreadInput(lnForeThread, lnAppThread, .T.) && let's become a part of this the process that owns the foreground window so we can bring our window to the front BringWindowToTop(lnHWND) ShowWindow(lnHWND, 3) AttachThreadInput(lnForeThread, lnAppThread, .F.) && ok, we're done bringing our window to the front so let's detach now ELSE && our process owns foreground window so proceed as we always would have BringWindowToTop(lnHWND) ShowWindow(lnHWND, 3) ENDIF ENDIF ENDPROC PROCEDURE Init *!* Declare Long SetParent in User32 Long hWndChild, Long hWndNewParent *!* SetParent(This.HWnd, lnParentWindowHWND) This.AddProperty("nLastPercent", 0) This.AddProperty("CancelInstrText", "") This.AddProperty("CancelQueryText", "") This.AddProperty("ReportIncompleteText", "") This.AddProperty("AttentionText", "") THIS.Name = "X"+SYS(2015) WITH THIS .Visible = .F. *!* #DEFINE OUTPUTCLASS_INITSTATUS_LOC "Initializing... " *!* #DEFINE OUTPUTCLASS_PREPSTATUS_LOC "Running calculation prepass... " *!* #DEFINE OUTPUTCLASS_RUNSTATUS_LOC "Creating output... " *!* #DEFINE OUTPUTCLASS_TIME_SECONDS_LOC "sec(s)" *!* #DEFINE OUTPUTCLASS_CANCEL_INSTRUCTIONS_LOC "Press Esc to cancel... " *!* #DEFINE OUTPUTCLASS_REPORT_CANCELQUERY_LOC "Stop report execution? (If you press 'No', report execution will continue.)" *!* #DEFINE OUTPUTCLASS_REPORT_INCOMPLETE_LOC "Report execution was cancelled." + CHR(13) + ; "Your results are not complete." #DEFINE OUTPUTCLASS_THERMCAPTION_LOC2 [m.cMessage+ " "+ ] + ; [TRANSFORM(THIS.PercentDone,"999"+ ] + ; [IIF(THIS.ThermPrecision=0,"","."+REPL("9",THIS.ThermPrecision))) + "%" ] + ; [+ IIF(NOT THIS.IncludeSeconds, "" , " "+] + ; [TRANSFORM(IIF(THIS.IsRunning,DATETIME(), THIS.ReportStopRunDateTime)-] + ; [THIS.ReportStartRunDateTime)+" " + THIS.SecondsText)] .Createtherm() DO CASE CASE VARTYPE(_goHelper) = "O" .InitStatusText = _goHelper.GetLoc("INITSTATUS") + SPACE(1) .PrepassStatusText = _goHelper.GetLoc("PREPSTATUS") + SPACE(1) .RunStatusText = _goHelper.GetLoc("RUNSTATUS") + SPACE(1) .SecondsText = _goHelper.GetLoc("SECONDS") + SPACE(1) .CancelInstrText = _goHelper.GetLoc("CANCELINST") + SPACE(1) .CancelQueryText = _goHelper.GetLoc("CANCELQUER") .ReportIncompleteText = _goHelper.GetLoc("REPINCOMPL") .AttentionText = _goHelper.GetLoc("ATTENTION") CASE VARTYPE(_Screen.oFoxyPreviewer) = "O" *!* IF NOT EMPTY(_Screen.oFoxyPreviewer._oDestScreen) *!* LOCAL lcTitle, lnDestHwnd *!* lcTitle = WTITLE(_Screen.oFoxyPreviewer._oDestScreen) *!* DECLARE INTEGER FindWindow IN user32 STRING lpClassName, STRING lpWindowName *!* lnDestHwnd = FindWindow(NULL, lcTitle) *!* IF lnDestHwnd <> 0 *!* Declare Long SetParent in User32 Long hWndChild, Long hWndNewParent *!* = SetParent(This.HWnd, lnDestHWND) *!* * SetParent(This.HWnd, lnParentWindowHWND) *!* * ACTIVATE WINDOW (lcTitle) *!* * DECLARE INTEGER ShowWindow IN user32 AS ShowWindowA INTEGER hWindow, INTEGER nCmdShow *!* * = ShowWindowA(lnDestHWND, 1) *!* ENDIF *!* ENDIF *!* LOCAL lcLanguage *!* lcLanguage = NVL(_Screen.oFoxyPreviewer.cLanguage, _Screen.oFoxyPreviewer._cLanguageFromDBF) *!* =PR_SetLanguage(lcLanguage) *!* *!* .InitStatusText = PR_GetLoc("INITSTATUS") + SPACE(1) *!* .PrepassStatusText = PR_GetLoc("PREPSTATUS") + SPACE(1) *!* .RunStatusText = PR_GetLoc("RUNSTATUS") + SPACE(1) *!* .SecondsText = PR_GetLoc("SECONDS") + SPACE(1) *!* .CancelInstrText = PR_GetLoc("CANCELINST") + SPACE(1) *!* .CancelQueryText = PR_GetLoc("CANCELQUER") *!* .ReportIncompleteText = PR_GetLoc("REPINCOMPL") *!* .AttentionText = PR_GetLoc("ATTENTION") .InitStatusText = _Screen.oFoxyPreviewer._InitStatusText .PrepassStatusText = _Screen.oFoxyPreviewer._PrepassStatusText .RunStatusText = _Screen.oFoxyPreviewer._RunStatusText .SecondsText = _Screen.oFoxyPreviewer._SecondsText .CancelInstrText = _Screen.oFoxyPreviewer._CancelInstrText .CancelQueryText = _Screen.oFoxyPreviewer._CancelQueryText .ReportIncompleteText = _Screen.oFoxyPreviewer._ReportIncompleteText .AttentionText = _Screen.oFoxyPreviewer._AttentionText * This.BringWindowToFront() OTHERWISE .InitStatusText = OUTPUTCLASS_INITSTATUS_LOC .PrepassStatusText = OUTPUTCLASS_PREPSTATUS_LOC .RunStatusText = OUTPUTCLASS_RUNSTATUS_LOC .SecondsText = OUTPUTCLASS_TIME_SECONDS_LOC .CancelInstrText = OUTPUTCLASS_CANCEL_INSTRUCTIONS_LOC .CancelQueryText = OUTPUTCLASS_REPORT_CANCELQUERY_LOC .ReportIncompleteText = OUTPUTCLASS_REPORT_INCOMPLETE_LOC .AttentionText = "Attention" ENDCASE IF VARTYPE(_Screen.oFoxyPreviewer) = "O" IF NOT EMPTY(_Screen.oFoxyPreviewer._oDestScreen) This.Visible = .T. LOCAL lcTitle, lnDestHwnd lcTitle = WTITLE(_Screen.oFoxyPreviewer._oDestScreen) DECLARE INTEGER FindWindow IN user32 STRING lpClassName, STRING lpWindowName lnDestHwnd = FindWindow(NULL, lcTitle) IF lnDestHwnd <> 0 DECLARE Long SetParent IN User32 Long hWndChild, Long hWndNewParent = SetParent(This.HWnd, lnDestHWND) * SetParent(This.HWnd, lnParentWindowHWND) * ACTIVATE WINDOW (lcTitle) * DECLARE INTEGER ShowWindow IN user32 AS ShowWindowA INTEGER hWindow, INTEGER nCmdShow * = ShowWindowA(lnDestHWND, 1) ENDIF ENDIF ENDIF .thermCaption = OUTPUTCLASS_THERMCAPTION_LOC2 && Keep original .resetUserFeedback() ENDWITH ENDPROC oPROCEDURE drawstringjustified ************************************************************************************* ** Method: GpGraphics.DrawStringJustified ** Draws the specified text string at the specified location with the specified Brush ** and Font objects in a Full Justified format. ** History: ** 2007/01/15: CChalom - Coded ** 2007/02/02: CChalom - Tweaked to work with ReportListener ** 2007/04/16: CChalom - Minor fixes for small sentences ** 2008/06/22: CChalom - Added some tweaks to allow better drawing on reports ** Added new flag - tlJustLast - that will forcely justify the last line ** 2010/09/22: CChalom - Adapted to include in the ReportListener and use the FFC _GdiPlus.vcx ************************************************************************************* #DEFINE StringFormatFlagsDirectionRightToLeft 1 #DEFINE StringFormatFlagsDirectionVertical 2 #DEFINE StringFormatFlagsNoFitBlackBox 4 #DEFINE StringFormatFlagsDisplayFormatControl 32 #DEFINE StringFormatFlagsNoFontFallback 1024 #DEFINE StringFormatFlagsMeasureTrailingSpaces 2048 #DEFINE StringFormatFlagsNoWrap 4096 #DEFINE StringFormatFlagsLineLimit 8192 #DEFINE StringFormatFlagsNoClip 16384 #DEFINE StringAlignmentNear 0 #DEFINE StringAlignmentCenter 1 #DEFINE StringAlignmentFar 2 #DEFINE EMPTY_FLOAT 0h00000000 #DEFINE EMPTY_LONG 0h00000000 #DEFINE EMPTY_SHORT 0h0000 #DEFINE EMPTY_RECTANGLE EMPTY_LONG+EMPTY_LONG+EMPTY_LONG+EMPTY_LONG #DEFINE EMPTY_RECTANGLEF EMPTY_FLOAT+EMPTY_FLOAT+EMPTY_FLOAT+EMPTY_FLOAT #DEFINE EMPTY_POINT EMPTY_LONG+EMPTY_LONG #DEFINE EMPTY_POINTF EMPTY_FLOAT+EMPTY_FLOAT #DEFINE EMPTY_SIZE EMPTY_LONG+EMPTY_LONG #DEFINE EMPTY_SIZEF EMPTY_FLOAT+EMPTY_FLOAT #DEFINE EMPTY_METAFILEHEADER EMPTY_LONG+EMPTY_LONG+EMPTY_LONG+EMPTY_LONG+; EMPTY_FLOAT+EMPTY_FLOAT+; EMPTY_LONG+EMPTY_LONG+EMPTY_LONG+EMPTY_LONG+; EMPTY_LONG+EMPTY_LONG+EMPTY_LONG+EMPTY_LONG #DEFINE EMPTY_ICONINFO EMPTY_LONG+EMPTY_LONG+EMPTY_LONG+EMPTY_LONG+EMPTY_LONG #DEFINE EMPTY_BITMAP EMPTY_LONG+EMPTY_LONG+EMPTY_LONG+EMPTY_LONG+EMPTY_SHORT+EMPTY_SHORT+EMPTY_LONG LPARAMETERS tcString, ; toFont as GpFont of HOME() + "\ffc\_gdiplus.vcx", ; toBrush as GpSolidBrush of HOME() + "\ffc\_gdiplus.vcx", ; toRectangle as GpRectangle of HOME() + "\ffc\_gdiplus.vcx", ; tlJustLast as Boolean, ; toGfx as GpGraphics of HOME() + "\ffc\_gdiplus.vcx" LOCAL lhFont, lhGraphics, lhBrush, lcRectF LOCAL N, lnSpaceWidth, lnLineHeight, lcText LOCAL wImg, hImg, x0, y0 LOCAL loGfxState AS xfcGraphicsState LOCAL lhTempStrFormat, lhStringFormat LOCAL lhLeftAlignHandle LOCAL lhRightAlignHandle LOCAL lnWords, lnWordWidth, lnChars, lcCurrWord, lcCutWord, lnReduce LOCAL llEndOfSentence, lnWordsWidth, lnWordsinLine, lnCurrWord, lnCurrLine, lnX, lnY LOCAL lnWidthofBetween, lnStringFormatHandle, llLast #DEFINE TextRenderingHintAntiAlias 4 LOCAL loExc AS Exception m.X0 = m.toRectangle.x m.Y0 = m.toRectangle.y m.wImg = m.toRectangle.w m.hImg = m.toRectangle.h * Save the current state of the graphics handle LOCAL lhGfxState m.lhGfxState = 0 m.toGfx.Save(@m.lhGfxState) * Store Gdi+ handles for MeasureString and DrawString m.lhFont = m.toFont.GetHandle() m.lhGraphics = m.toGfx.GetHandle() m.lhBrush = m.toBrush.GetHandle() * Obtain the Font Height to be used as Line Height m.lnLineHeight = FLOOR(m.toFont.GetHeight(m.toGfx)) * Adjust the Text String to ease detection of Carriage Returns m.lcText = STRTRAN(m.tcString,CHR(13)+CHR(10), " ") m.lcText = STRTRAN(m.lcText,CHR(13), " ") m.lcText = STRTRAN(m.lcText,CHR(10), " ") m.lcText = m.lcText + " " * Ensure Measure String will bring the best measures possible * Set to AntiAlias =xfcGdipSetTextRenderingHint(m.lhGraphics, TextRenderingHintAntiAlias) * Create a String Format object with the Generic Typographic TO obtain * the most accurate String measurements * Strange, but the recommended for this case is to use a "cloned" StringFormat STORE 0 TO m.lhTempStrFormat, m.lhStringFormat = xfcGdipStringFormatGetGenericTypographic(@m.lhTempStrFormat) = xfcGdipCloneStringFormat(m.lhTempStrFormat, @m.lhStringFormat) * Delete the Temporary StringFormat object created = xfcGdipDeleteStringFormat(m.lhTempStrFormat) * Allow the correct measuring of Spaces = xfcGdipSetStringFormatFlags(m.lhStringFormat, StringFormatFlagsMeasureTrailingSpaces) * Create a StringFormat for LeftAlignment m.lhLeftAlignHandle = 0 = xfcGdipCreateStringFormat(0, 0, @m.lhLeftAlignHandle) = xfcGdipSetStringFormatAlign(m.lhLeftAlignHandle, StringAlignmentNear) * Create a StringFormat for RightAlignment m.lhRightAlignHandle = 0 = xfcGdipCreateStringFormat(0, 0, @m.lhRightAlignHandle) = xfcGdipSetStringFormatAlign(m.lhRightAlignHandle, StringAlignmentFar) * Measure Space for the given font STORE EMPTY_RECTANGLE TO m.lcRectF, m.pcBoundingBox = xfcGdipMeasureString( m.lhGraphics; , STRCONV(" " + 0h00,5) ; , 1 ; , m.lhFont ; , m.lcRectF ; , m.lhStringFormat ; , @m.pcBoundingBox, 0, 0) m.lnSpaceWidth = CTOBIN(SUBSTR(m.pcBoundingBox, 9, 4), 'N') + 1 m.lnWords = GETWORDCOUNT(m.lcText) DIMENSION m.laWords(m.lnWords,2) * Measure each word m.n = 1 DO WHILE .T. m.laWords(m.N,1) = GETWORDNUM(m.lcText, m.N) m.lcCurrWord = m.laWords(m.N,1) STORE EMPTY_RECTANGLE TO m.lcRectF, m.pcBoundingBox = xfcGdipMeasureString(m.lhGraphics; , STRCONV(m.lcCurrWord + 0h00,5) ; , LENC(m.lcCurrWord) ; , m.lhFont ; , m.lcRectF ; , m.lhStringFormat ; , @m.pcBoundingBox, 0, 0) m.lnWordWidth = CTOBIN(SUBSTR(m.pcBoundingBox, 9, 4), 'N') IF m.lnWordWidth > m.wImg AND (NOT INLIST(m.lcCurrWord, "", "")) m.lnReduce = 1 DO WHILE .T. m.lnChars = ROUND((LENC(m.lcCurrWord) / (m.lnWordWidth / m.wImg)),0) - m.lnReduce m.lcCutWord = SUBSTR(m.lcCurrWord, 1, m.lnChars) STORE EMPTY_RECTANGLE TO m.lcRectF, m.pcBoundingBox = xfcGdipMeasureString(m.lhGraphics; , STRCONV(m.lcCutWord + 0h00,5) ; , LENC(m.lcCutWord) ; , m.lhFont ; , m.lcRectF ; , m.lhStringFormat ; , @m.pcBoundingBox, 0, 0) m.lnWordWidth = CTOBIN(SUBSTR(m.pcBoundingBox, 9, 4), 'N') m.laWords(m.N,1) = m.lcCutWord IF m.lnWordWidth <= m.wImg m.lnWords = m.lnWords + 1 DIMENSION m.laWords(m.lnWords,2) m.laWords(m.lnWords,1) = "" m.laWords(m.lnWords,2) = 0 m.lcText = STRTRAN(m.lcText, m.lcCurrWord, ; m.lcCutWord + SPACE(1) + SUBSTR(m.lcCurrWord, m.lnChars + 1), ; 1, 1) EXIT ENDIF m.lnReduce = m.lnReduce + 1 ENDDO ENDIF m.laWords(m.N,2) = m.lnWordWidth m.N = m.N + 1 IF m.N > m.lnWords EXIT ENDIF ENDDO * Before we start drawing, it's wise to restore our Graphics object to * its original state. * Put back the state of the graphics handle m.toGfx.Restore(m.lhGfxState) * Start Drawing word by word m.lnCurrWord = 1 m.lnCurrLine = 0 LOCAL llLastLine m.llLastLine = .F. FOR m.N = 1 TO m.lnWords m.llEndOfSentence = .F. m.lnWordsWidth = 0 m.lnWordsinLine = 0 FOR m.z = m.N TO m.lnWords m.lcChar = LOWER(m.laWords(m.z,1)) IF m.laWords(m.z,1) = "" m.llEndOfSentence = .T. EXIT ENDIF IF m.laWords(m.z,1) = "" m.llLastLine = .T. m.lnWordsWidth = m.lnWordsWidth - (m.lnSpaceWidth * m.lnWordsinLine) + m.lnSpaceWidth EXIT ENDIF m.lnWordsWidth = m.lnWordsWidth + m.laWords(m.z,2) + m.lnSpaceWidth IF m.lnWordsWidth > m.wImg AND m.z > m.N m.lnWordsWidth = m.lnWordsWidth - m.laWords(m.z,2) - (m.lnSpaceWidth * m.lnWordsinLine) EXIT ENDIF m.lnWordsinLine = m.lnWordsinLine + 1 ENDFOR m.lnWordsWidth = m.lnWordsWidth - m.lnSpaceWidth IF m.z >= m.lnWords m.llEndOfSentence = .T. m.llLastLine = .T. ENDIF IF m.llLastLine IF m.tlJustLast m.lnWidthOfBetween = (m.wImg - m.lnWordsWidth - m.lnSpaceWidth) / (m.lnWordsinLine - 1) ELSE m.lnWidthOfBetween = m.lnSpaceWidth ENDIF ELSE IF m.llEndOfSentence m.lnWidthOfBetween = m.lnSpaceWidth ELSE m.lnWidthOfBetween = (m.wImg - m.lnWordsWidth - m.lnSpaceWidth) / (m.lnWordsinLine - 1) ENDIF ENDIF m.lnY = m.Y0 + (m.lnCurrLine * m.lnLineHeight) IF m.lnY > (m.hImg + m.Y0 - m.lnLineHeight / 2) m.n = m.lnWords EXIT ENDIF m.lnX = m.X0 FOR m.lnCurrWord = 1 TO m.lnWordsinLine m.llLast = .F. IF m.laWords(m.N,1) = "" && Ignore m.N = m.N + 1 LOOP ENDIF IF m.lnCurrWord = m.lnWordsinLine AND NOT m.llEndOfSentence m.llLast = .T. ENDIF IF m.lnCurrWord = m.lnWordsinLine AND m.llLastLine AND m.tlJustLast m.llLast = .T. ENDIF IF m.lnWordsInLine = 1 m.lnX = m.X0 m.llLast = .F. ENDIF IF m.llLast m.lcRectF = BINTOC(m.X0,'F') + BINTOC(m.lnY,'F') + ; BINTOC(m.wImg,'F') + BINTOC(m.lnY + m.lnLineHeight,'F') m.lnStringFormatHandle = m.lhRightAlignHandle ELSE m.lcRectF = BINTOC(m.lnX,'F') + BINTOC(m.lnY,'F') + REPLICATE(CHR(0),8) m.lnStringFormatHandle = m.lhLeftAlignHandle ENDIF = xfcGdipDrawString(m.lhGraphics ; , STRCONV(m.laWords(m.N,1) + 0h00,5) ; , LEN(m.laWords(m.N,1)) ; , m.lhFont ; , m.lcRectF ; , m.lnStringFormatHandle ; , m.lhBrush) m.lnX = m.lnX + m.laWords(m.N,2) + m.lnWidthOfBetween m.N = m.N + 1 && Go to next word ENDFOR m.lnCurrLine = m.lnCurrLine + 1 IF m.N >= m.lnWords EXIT ENDIF IF m.laWords(m.N,1) <> "" m.N = m.N - 1 && Compensate ENDFOR ENDIF ENDFOR * Finished Drawing, so erase the temp objects * Delete the StringFormat object created =xfcGdipDeleteStringFormat(m.lhStringFormat) =xfcGdipDeleteStringFormat(m.lhLeftAlignHandle) =xfcGdipDeleteStringFormat(m.lhRightAlignHandle) CATCH TO m.loExc LOCAL loExc as Exception MESSAGEBOX("Error drawing the justified string !" + CHR(13) + ; TRANSFORM(m.loExc.ERRORNO) + " - " + m.loExc.MESSAGE + CHR(13) + ; "Line: " + TRANSFORM(m.loExc.LINENO) + " - " + m.loExc.LINECONTENTS + CHR(13) + ; lcMsg) MESSAGEBOX(TRANSFORM(m.tcString), 16, "String that generated the error") SET STEP ON ENDTRY RETURN NULL ENDPROC PROCEDURE drawstringintf #UNDEF StringFormatFlagsDirectionRightToLeft #UNDEF StringFormatFlagsDirectionVertical #UNDEF StringFormatFlagsNoFitBlackBox #UNDEF StringFormatFlagsDisplayFormatControl #UNDEF StringFormatFlagsNoFontFallback #UNDEF StringFormatFlagsMeasureTrailingSpaces #UNDEF StringFormatFlagsNoWrap #UNDEF StringFormatFlagsLineLimit #UNDEF StringFormatFlagsNoClip #UNDEF StringAlignmentNear #UNDEF StringAlignmentCenter #UNDEF StringAlignmentFar #DEFINE StringFormatFlagsDirectionRightToLeft 1 #DEFINE StringFormatFlagsDirectionVertical 2 #DEFINE StringFormatFlagsNoFitBlackBox 4 #DEFINE StringFormatFlagsDisplayFormatControl 32 #DEFINE StringFormatFlagsNoFontFallback 1024 #DEFINE StringFormatFlagsMeasureTrailingSpaces 2048 #DEFINE StringFormatFlagsNoWrap 4096 #DEFINE StringFormatFlagsLineLimit 8192 #DEFINE StringFormatFlagsNoClip 16384 #DEFINE StringAlignmentNear 0 #DEFINE StringAlignmentCenter 1 #DEFINE StringAlignmentFar 2 #DEFINE TextRenderingHintAntiAlias 4 #DEFINE EMPTY_FLOAT 0h00000000 #DEFINE EMPTY_LONG 0h00000000 #DEFINE EMPTY_SHORT 0h0000 #DEFINE EMPTY_RECTANGLE EMPTY_LONG+EMPTY_LONG+EMPTY_LONG+EMPTY_LONG #DEFINE EMPTY_RECTANGLEF EMPTY_FLOAT+EMPTY_FLOAT+EMPTY_FLOAT+EMPTY_FLOAT #DEFINE EMPTY_POINT EMPTY_LONG+EMPTY_LONG #DEFINE EMPTY_POINTF EMPTY_FLOAT+EMPTY_FLOAT #DEFINE EMPTY_SIZE EMPTY_LONG+EMPTY_LONG #DEFINE EMPTY_SIZEF EMPTY_FLOAT+EMPTY_FLOAT #DEFINE EMPTY_METAFILEHEADER EMPTY_LONG+EMPTY_LONG+EMPTY_LONG+EMPTY_LONG+; EMPTY_FLOAT+EMPTY_FLOAT+; EMPTY_LONG+EMPTY_LONG+EMPTY_LONG+EMPTY_LONG+; EMPTY_LONG+EMPTY_LONG+EMPTY_LONG+EMPTY_LONG #DEFINE EMPTY_ICONINFO EMPTY_LONG+EMPTY_LONG+EMPTY_LONG+EMPTY_LONG+EMPTY_LONG #DEFINE EMPTY_BITMAP EMPTY_LONG+EMPTY_LONG+EMPTY_LONG+EMPTY_LONG+EMPTY_SHORT+EMPTY_SHORT+EMPTY_LONG LPARAMETERS tnFRXRecNo, tnLeft, tnTop, tnWidth, tnHeight, tnObjectContinuationType, tcContentsToBeRendered, tiGDIPlusImage, ; tcFullText, ; tcFontName0, tnFontSize0 , tnFontStyle0, ; tnFillRed0 , tnFillGreen0, tnFillBlue0 , ; tnPenRed0 , tnPenGreen0 , tnPenBlue0 * Change the value of this variable to stop the execution when this word is being processed LOCAL lcStep m.lcStep = "ZZZZZZZZFOXYPREVIEWER" LOCAL loFRXRecord, lnSelect m.lnSelect = SELECT() SELECT (This.cFRXAlias) GO m.tnFRXRecNo IF EOF() * SET STEP ON RETURN ENDIF SCATTER NAME m.loFrxRec SELECT (m.lnSelect) LOCAL loExc AS Exception LOCAL lhTempStrFormat, lhStringFormat LOCAL lhLeftAlignHandle LOCAL lhRightAlignHandle LOCAL lcRectF, pcBoundingBox LOCAL loGfx as GpGraphics OF HOME() + "\FFC\_GdiPlus.vcx" m.loGfx = This.oGdiGraphics LOCAL lhGfx, lhFont m.lhGfx = m.loGfx.GetHandle() * Save the current state of the graphics handle LOCAL lhGfxState m.lhGfxState = 0 m.loGfx.Save(@m.lhGfxState) * Ensure Measure String will bring the best measures possible * Set to AntiAlias =xfcGdipSetTextRenderingHint(m.lhGfx, TextRenderingHintAntiAlias) * Create a String Format object with the Generic Typographic TO obtain * the most accurate String measurements * Strange, but the recommended for this case is to use a "cloned" StringFormat STORE 0 TO m.lhTempStrFormat, m.lhStringFormat = xfcGdipStringFormatGetGenericTypographic(@m.lhTempStrFormat) = xfcGdipCloneStringFormat(m.lhTempStrFormat, @m.lhStringFormat) * Delete the Temporary StringFormat object created = xfcGdipDeleteStringFormat(m.lhTempStrFormat) * Allow the correct measuring of Spaces = xfcGdipSetStringFormatFlags(m.lhStringFormat, StringFormatFlagsMeasureTrailingSpaces) * Create a StringFormat for LeftAlignment m.lhLeftAlignHandle = 0 = xfcGdipCreateStringFormat(0, 0, @m.lhLeftAlignHandle) = xfcGdipSetStringFormatAlign(m.lhLeftAlignHandle, StringAlignmentNear) = xfcGdipSetStringFormatLineAlign(m.lhLeftAlignHandle, StringAlignmentFar) && Force vertical alignment to bottom = xfcGdipSetStringFormatFlags(m.lhLeftAlignHandle, StringFormatFlagsMeasureTrailingSpaces) * Create a StringFormat for RightAlignment m.lhRightAlignHandle = 0 = xfcGdipCreateStringFormat(0, 0, @m.lhRightAlignHandle) = xfcGdipSetStringFormatAlign(m.lhRightAlignHandle, StringAlignmentFar) * Generate the array of words This.TFProcess(m.tcFullText) LOCAL lnWords, lnMaxHeight m.lnWords = ALEN(This.aTFWords, 1) m.lnMaxHeight = 0 * Step 1: * Get the measures of all words according to the formatting LOCAL lcWord, lcFont, lnFontSize, lcFontStyle, lnRed, lnGreen, lnBlue, lnBackRed, lnBackGreen, lnBackBlue, n, lnStyle, lnLineHeight LOCAL lnWordWidth, lnWordHeight, lnFontHeight FOR m.n = 1 TO m.lnWords m.lcWord = This.aTFWords(m.n, 1) IF EMPTY(m.lcWord) This.aTFWords(m.n, 1) = "" This.aTFWords(m.n, 11) = 0 This.aTFWords(m.n, 12) = 0 LOOP ENDIF This.aTFWords(m.n, 1) = ALLTRIM(m.lcWord) m.lcFont = This.aTFWords(m.n, 2) m.lnFontSize = This.aTFWords(m.n, 3) m.lcFontStyle = EVL(This.aTFWords(m.n, 4), "") m.lnRed = This.aTFWords(m.n, 5) m.lnGreen = This.aTFWords(m.n, 6) m.lnBlue = This.aTFWords(m.n, 7) IF m.lnRed = -1 This.aTFWords(m.n, 5) = MAX(0, m.tnPenRed0) This.aTFWords(m.n, 6) = MAX(0, m.tnPenGreen0) This.aTFWords(m.n, 7) = MAX(0, m.tnPenBlue0) ENDIF m.lnBackRed = This.aTFWords(m.n, 8) m.lnBackGreen = This.aTFWords(m.n, 9) m.lnBackBlue = This.aTFWords(m.n, 10) IF m.lnBackRed = -1 This.aTFWords(m.n, 8) = m.tnFillRed0 This.aTFWords(m.n, 9) = m.tnFillGreen0 This.aTFWords(m.n,10) = m.tnFillBlue0 ENDIF * If the stored value is empty, then we'll use the default stored in the FRX field IF EMPTY(m.lcFont) m.lcFont = m.tcFontName0 This.aTFWords(m.n, 2) = m.lcFont ENDIF IF (VARTYPE(m.lnFontSize) <> "N") OR (m.lnFontSize <= 0) m.lnFontSize = m.tnFontSize0 This.aTFWords(m.n, 3) = m.lnFontSize ENDIF IF EMPTY(m.lcFontStyle) && If we have no formatting, then use the one determined originally *!* 1 = Bold BITTEST(tnFontStyle0, 0) *!* 2 = Italic BITTEST(tnFontStyle0, 1) *!* 4 = Underlined BITTEST(tnFontStyle0, 2) *!* 128 = Strikethrough BITTEST(tnFontStyle0, 7) m.lnStyle = 0 IF BITTEST(tnFontStyle0, 0) && Bold m.lnStyle = 1 ENDIF IF BITTEST(tnFontStyle0, 1) && Italic m.lnStyle = m.lnStyle + 2 ENDIF IF BITTEST(tnFontStyle0, 2) && Underlined m.lnStyle = m.lnStyle + 4 ENDIF IF BITTEST(tnFontStyle0, 7) && Strikethrough m.lnStyle = m.lnStyle + 8 ENDIF ELSE && NOT EMPTY(m.lcFontStyle) m.lnStyle = 0 IF "B" $ m.lcFontStyle m.lnStyle = 1 ENDIF IF "I" $ m.lcFontStyle m.lnStyle = m.lnStyle + 2 ENDIF IF "U" $ m.lcFontStyle m.lnStyle = m.lnStyle + 4 ENDIF IF "S" $ m.lcFontStyle m.lnStyle = m.lnStyle + 8 ENDIF ENDIF This.aTFWords(m.n, 4) = m.lnStyle * tnFillRed0 , tnFillGreen0, tnFillBlue0 , ; * tnPenRed0 , tnPenGreen0 , tnPenBlue * Create a font object using the text object's settings. m.loFont = CREATEOBJECT("GPFont") m.loFont.Create(m.lcFont, m.lnFontSize, m.lnStyle, 3) m.lhFont = m.loFont.GetHandle() * Obtain the Font Height to be used as Line Height m.lnLineHeight = FLOOR(m.loFont.GetHeight(m.loGfx)) STORE EMPTY_RECTANGLE TO m.lcRectF, m.pcBoundingBox = xfcGdipMeasureString(m.lhGfx; , STRCONV(m.lcWord + " " + 0h00,5) ; , LEN(m.lcWord) + 1 ; , m.lhFont ; , m.lcRectF ; , m.lhStringFormat ; , @m.pcBoundingBox, 0, 0) m.lnWordWidth = CEILING(CTOBIN(SUBSTR(m.pcBoundingBox, 9, 4), 'N')) m.lnWordHeight = CEILING(CTOBIN(SUBSTR(m.pcBoundingBox,13, 4), 'N')) * Get the font height to compare with the height obtained from MeasureString m.lnFontHeight = CEILING(m.loFont.GetHeight(m.loGfx)) IF m.lcWord = "[CR]" This.aTFWords(m.n, 11) = 0 ELSE This.aTFWords(m.n, 11) = m.lnWordWidth ENDIF This.aTFWords(m.n, 12) = MAX(m.lnWordHeight, m.lnFontHeight) m.loFont = NULL ENDFOR CATCH TO m.loExc SET STEP ON ENDTRY LOCAL lcRectF, loColor, loBrush, lnX, lnY, lnXNext, lnCurrLine, lnWordHeight, lnY2 DIMENSION m.laLines(1, 3) && Line, Starting word, Line Height m.lnCurrLine = 1 m.lnX = 0 m.lnY = m.tnTop m.lnWordHeight = 0 m.lnXNext = 0 m.laLines(1,1) = 1 && Line m.laLines(1,2) = 1 && Starting word m.laLines(1,3) = 0 && Line Height m.lnLineHeight = 0 FOR m.n = 1 TO m.lnWords m.lnWordHeight = This.aTFWords(m.n, 12) m.lnWordWidth = This.aTFWords(m.n, 11) This.aTFWords(m.n, 13) = m.lnCurrLine * For debugging purposes IF UPPER(This.aTFWords(m.n,1)) = m.lcStep SET STEP ON ENDIF m.lcWord = ALLTRIM(This.aTFWords(m.n, 1)) m.lnX = m.lnX + m.lnWordWidth IF (m.lnX > m.tnWidth) OR (m.lcWord = "[CR]") m.laLines(m.lnCurrLine,1) = m.lnCurrLine && Line m.laLines(m.lnCurrLine,2) = m.n && Starting word m.laLines(m.lnCurrLine,3) = m.lnLineHeight && Line Height IF (m.lnCurrLine > 1) AND (m.lcWord = "[CR]") * laLines(lnCurrLine,3) = laLines(lnCurrLine - 1, 3) && Line Height m.lnX = 0 ELSE m.lnX = m.lnWordWidth ENDIF * Reset variables, to start a new line m.lnLineHeight = m.lnWordHeight m.lnCurrLine = m.lnCurrLine + 1 This.aTFWords(m.n, 13) = m.lnCurrLine DIMENSION m.laLines(m.lnCurrLine, 3) LOOP ENDIF m.lnLineHeight = MAX(m.lnLineHeight, m.lnWordHeight) ENDFOR m.laLines(m.lnCurrLine,1) = m.lnCurrLine && Line m.laLines(m.lnCurrLine,2) = m.n && Starting word m.laLines(m.lnCurrLine,3) = m.lnLineHeight && Line Height * Rebuild the words array joining words that have the exact same formatting to a same string. * This helps to render a little faster, and improves the drawing of the words, specially for * words that are underlined or have background colors m.lcOldFormat = "" m.lcNextFormat = "" m.lcOldWord = "" m.lcNextWord = "" m.lnCount = 1 m.lcCurrWord = This.aTFWords(1, 1) m.lnCurrWidth = 0 DIMENSION m.laNewWords(1, 14) FOR m.n = 1 TO m.lnWords m.lcNextWord = This.aTFWords(m.n, 1) IF EMPTY(m.lcNextWord) LOOP ENDIF * For debugging purposes IF UPPER(m.lcNextWord) = m.lcStep SET STEP ON ENDIF m.lcNextFormat = "" FOR m.i = 2 TO 10 m.lcNextFormat = m.lcNextFormat + TRANSFORM(This.aTFWords(m.n, m.i)) ENDFOR m.lnPrevLine = IIF(m.n = 1, 1, This.aTFWords(m.n-1, 13)) m.lnCurrLine = This.aTFWords(m.n, 13) IF (m.lcOldFormat = m.lcNextFormat) AND (m.lnPrevLine = m.lnCurrLine) AND (m.lcNextWord <> "[CR]") AND (m.lcCurrWord <> "[CR]") && We have a match, so we can join the words m.lcCurrWord = ALLTRIM(m.lcCurrWord + " " + m.lcNextWord) m.lnCurrWidth = m.lnCurrWidth + This.aTFWords(m.n, 11) m.laNewWords(m.lnCount - 1, 1) = m.lcCurrWord m.laNewWords(m.lnCount - 1, 11) = m.lnCurrWidth m.laNewWords(m.lnCount - 1, 12) = This.aTFWords(m.n, 12) m.laNewWords(m.lnCount - 1, 14) = m.lnCurrWidth ELSE DIMENSION m.laNewWords(m.lnCount, 14) m.lcCurrWord = m.lcNextWord m.lnCurrWidth = This.aTFWords(m.n, 11) m.laNewWords(m.lnCount, 1) = m.lcCurrWord m.laNewWords(m.lnCount, 11) = m.lnCurrWidth m.laNewWords(m.lnCount, 12) = This.aTFWords(m.n, 12) m.laNewWords(m.lnCount, 14) = m.lnCurrWidth FOR m.i = 2 TO 10 m.laNewWords(m.lnCount, m.i) = This.aTFWords(m.n, m.i) ENDFOR IF (m.lcCurrWord = "[CR]") AND (m.n > 1) m.laNewWords(m.lnCount, 12) = This.aTFWords(m.n-1, 12) ENDIF m.lnCount = m.lnCount + 1 m.lcOldFormat = m.lcNextFormat ENDIF ENDFOR m.loGfx.Restore(m.lhGfxState) * Measure the words again, in order to get more precision specially for merged words FOR m.n = 1 TO ALEN(m.laNewWords, 1) m.lcWord = m.laNewWords(m.n, 1) m.lcWord = EVL(m.lcWord, "") && by Pavel Celba IF NOT " " $ ALLTRIM(m.lcWord) && No need to measure again, since it's a single word LOOP ENDIF * For debugging purposes IF m.lcStep $ UPPER(m.lcWord) SET STEP ON ENDIF m.lcFont = m.laNewWords(m.n, 2) m.lnFontSize = m.laNewWords(m.n, 3) m.lcFontStyle = m.laNewWords(m.n, 4) * Create a font object using the text object's settings. m.loFont = CREATEOBJECT("GPFont") m.loFont.Create(m.lcFont, m.lnFontSize, m.lnStyle, 3) m.lhFont = m.loFont.GetHandle() STORE EMPTY_RECTANGLE TO m.lcRectF, m.pcBoundingBox = xfcGdipMeasureString(m.lhGfx; , STRCONV(m.lcWord + " " + 0h00,5) ; , LEN(m.lcWord) + 2 ; , m.lhFont ; , m.lcRectF ; , m.lhStringFormat ; , @m.pcBoundingBox, 0, 0) m.lnWordWidth = CEILING(CTOBIN(SUBSTR(m.pcBoundingBox, 9, 4), 'N')) m.lnWordHeight = CEILING(CTOBIN(SUBSTR(m.pcBoundingBox,13, 4), 'N')) m.laNewWords(m.n, 11) = MAX(m.laNewWords(m.n, 14), m.lnWordWidth) m.laNewWords(m.n, 12) = m.lnWordHeight m.loFont = NULL ENDFOR * Before we start drawing, it's wise to restore our Graphics object to * its original state. * Put back the state of the graphics handle m.loGfx.Restore(m.lhGfxState) LOCAL lnH2 m.lnX = m.tnLeft m.lnY = m.tnTop m.lnCurrLine = 1 m.lnY2 = 0 m.lnH2 = 0 FOR m.n = 1 TO ALEN(m.laNewWords, 1) m.lcWord = m.laNewWords(m.n, 1) IF EMPTY(m.lcWord) LOOP ENDIF * For debugging purposes IF m.lcStep $ UPPER(m.lcWord) SET STEP ON ENDIF * m.lnStringFormatHandle = lhStringFormat && m.lhLeftAlignHandle m.lnStringFormatHandle = m.lhLeftAlignHandle * Create a font object using the text object's settings. m.loFont1 = CREATEOBJECT("GPFont") m.loFont1.Create(m.laNewWords(m.n, 2), ; && Font name m.laNewWords(m.n, 3), ; && Font size m.laNewWords(m.n, 4), 3) && Font style m.lhFont1 = m.loFont1.GetHandle() m.loColor = CREATEOBJECT("gpColor", ; m.laNewWords(m.n, 5), ; && PenRed m.laNewWords(m.n, 6), ; && PenGreen m.laNewWords(m.n, 7), ; && PenBlue 255) && Alpha m.loBrush = CREATEOBJECT("gpSolidBrush", m.loColor) *!* * Add to the array of words *!* This.aTFWords(lnI, 1) = m.lcParamWord *!* This.aTFWords(lnI, 2) = m.lcParamFName *!* This.aTFWords(lnI, 3) = m.lnParamFSize *!* This.aTFWords(lnI, 4) = m.lcParamFStyle *!* This.aTFWords(lnI, 5) = m.lnParamCRed *!* This.aTFWords(lnI, 6) = m.lnParamCGreen *!* This.aTFWords(lnI, 7) = m.lnParamCBlue *!* This.aTFWords(lnI, 8) = m.lnParamHRed *!* This.aTFWords(lnI, 9) = m.lnParamHGreen *!* This.aTFWords(lnI, 10) = m.lnParamHBlue *!* This.aTFWords(lnI, 11) = WIDTH *!* This.aTFWords(lnI, 12) = HEIGHT * Check if we have a
- Line jump IF ALLTRIM(m.lcWord) = "[CR]" m.lnX = m.tnLeft m.lnY = m.lnY + m.lnMaxHeight && laNewWords(n, 12) m.lnCurrLine = m.lnCurrLine + 1 LOOP ENDIF m.lnXNext = m.lnX + m.laNewWords(m.n, 11) IF m.lnXNext > (m.tnLeft + m.tnWidth) * 1.015 m.lnX = m.tnLeft m.lnY = m.lnY + m.lnMaxHeight m.lnCurrLine = m.lnCurrLine + 1 ENDIF *!* laLines(lnCurrLine,1) = lnCurrLine && Line *!* laLines(lnCurrLine,2) = n && Starting word *!* laLines(lnCurrLine,3) = lnLineHeight && Line Height TRY m.lnMaxHeight = EVL(m.laLines(m.lnCurrLine,3), 0) CATCH TO m.loExc m.lnMaxHeight = EVL(m.laLines(m.lnCurrLine-1,3), 0) ENDTRY m.lnH2 = CEILING(m.lnMaxHeight * 1.15) * m.lcRectF = BINTOC(m.lnX,'F') + BINTOC(m.lnY,'F') + BINTOC(4*CEILING(laNewWords(n, 11)),'F') + BINTOC(m.lnMaxHeight,'F') m.lcRectF = BINTOC(m.lnX,'F') + BINTOC(m.lnY,'F') + BINTOC(4*CEILING(m.laNewWords(m.n, 11)),'F') + BINTOC(m.lnH2,'F') * m.lcRectF = BINTOC(m.lnX,'F') + BINTOC(m.lnY2,'F') + BINTOC(4*CEILING(laNewWords(n, 11)),'F') + BINTOC(m.lnMaxHeight,'F') * Draw the background if needed IF m.laNewWords(m.n, 8) > -1 m.loBackColor = CREATEOBJECT("gpColor", ; m.laNewWords(m.n, 8), ; && loObject.FillRed m.laNewWords(m.n, 9), ; && loObject.FillGreen m.laNewWords(m.n, 10), ; && loObject.FillBlue 255 ) && Alpha m.loBackBrush = CREATEOBJECT("gpSolidBrush", m.loBackColor) This.oGDIGraphics.FillRectangle(m.loBackBrush, m.lnX, ; m.lnY, m.laNewWords(m.n,11), m.lnH2) && laNewWords(n,12)) ENDIF = xfcGdipDrawString(m.lhGfx ; , STRCONV(m.lcWord + 0h00,5) ; , LEN(m.lcWord) ; , m.lhFont1 ; , m.lcRectF ; , m.lnStringFormatHandle ; , m.loBrush.GetHandle()) * Adjust the Y position manually, in order to provide an accurate position for the Alternative outputs * This coordinate will not be used for drawing now, because here GDI+ provides a better aproach to align the strings * at the bottom m.lnY2 = m.lnY + m.lnMaxHeight - m.laNewWords(m.n, 12) CATCH TO m.loexc * SET STEP ON ENDTRY This.TFAddToOutput(m.tnFRXRecNo, m.lnX, m.lnY, m.laNewWords(m.n, 11), m.lnMaxHeight, m.tnObjectContinuationType, m.lcWord, m.tiGDIPlusImage, ; m.laNewWords(m.n, 2), ; && Font name m.laNewWords(m.n, 3), ; && Font size m.laNewWords(m.n, 4), ; && Font style m.laNewWords(m.n, 5), ; && Pen red m.laNewWords(m.n, 6), ; && Pen green m.laNewWords(m.n, 7), ; && Pen blue m.laNewWords(m.n, 8), ; && Fill red m.laNewWords(m.n, 9), ; && Fill green m.laNewWords(m.n, 10), ; && Fill blue m.loFrxRec) && FRX record m.lnX = m.lnX + m.laNewWords(m.n, 11) m.loFont1 = NULL m.loColor = NULL m.loBrush = NULL ENDFOR * Delete the StringFormat object created =xfcGdipDeleteStringFormat(m.lhStringFormat) =xfcGdipDeleteStringFormat(m.lhLeftAlignHandle) =xfcGdipDeleteStringFormat(m.lhRightAlignHandle) SELECT (lnSelect) RETURN ENDPROC PROCEDURE tfprocess * by Eduard Shor (Romania) * Preprocesses the tags found *-- :: bold *-- :: italic *-- :: underline *-- :: strikethru *-- // :: forecolor *-- // :: backcolor *-- // :: font name *-- // :: font size *-- // :: font style string // will alter previous state *?-- color could be save as a number with RGB() *?-- could prevent transform if ', adding a special TAG, [CR] m.tcString = STRTRAN(m.tcString, "
", ' [CR] ') m.tcString = STRTRAN(m.tcString, "
", ' [CR] ') m.tcString = STRTRAN(m.tcString, CHR(13) + CHR(10), ' [CR] ') m.tcString = STRTRAN(m.tcString, CHR(10) + CHR(13), ' [CR] ') m.tcString = CHRTRAN(m.tcString, CHR(10), ' [CR] ') m.tcString = CHRTRAN(m.tcString, CHR(13), ' [CR] ') LOCAL lcTempString, lcNextChar m.lcTempString = "" FOR m.n = 1 TO LEN(m.tcString) m.lcNextChar = SUBSTR(m.tcString, m.n, 1) IF m.lcNextChar = "<" m.lcNextChar = " <" ENDIF m.lcTempString = m.lcTempString + m.lcNextChar ENDFOR m.tcString = m.lcTempString *Set Step On *-- replace space in tag contents (font names) with a placeholder m.lcKString = '' m.lnKStart = 1 m.lnI = 1 *Set Step On Do While m.lnI <= Len(m.tcString) *-- If Substr(m.tcString,m.lnI,1)='<' And ; ( ; Inlist(Left( Strtran( Lower(Substr(m.tcString,m.lnI,30)) ,' ',''), 3), '',Substr(m.tcString,m.lnI)) ) *-- lnI will continue with value after the closing tag m.lnI = m.lnI + Len(m.lcKChunk)-1 *-- assign the next starting point for unprocessed text m.lnKStart = m.lnI + 1 *-- remove spaces from tag name m.lcKTagPre = Strtran(Substr(m.lcKChunk,1,Atc('=',m.lcKChunk)),' ','') *-- replace spaces in tag value with somthing else - chr(31) m.lcKTagValue = Substr(m.lcKChunk,Atc('=',m.lcKChunk)+1,Len(m.lcKChunk)-Atc('=',m.lcKChunk)-1) m.lcKTagValue = Strtran( Alltrim(m.lcKTagValue), Chr(32), Chr(31) ) && ' *-- add tag-name + tag-value + closing tag sign to lcKString m.lcKString = m.lcKString + m.lcKTagPre + m.lckTagValue + '>' *-- EndIf *-- m.lnI = m.lnI + 1 *-- EndDo *-- add the last unprocessed text m.lcKString = m.lcKString + Substr(m.tcString, m.lnKStart, Len(m.tcString)-m.lnKStart+1) *-- *? lcKString Store '' To m.lcResultString, m.lcColorStack, m.lcHighlightStack, m.lcFontNameStack, m.lcFontSizeStack, m.lcFontStyleStack *Set Step On m.lnWords = Getwordcount(m.lcKString) IF m.lnWords = 0 && Fix by Pavel Celba RETURN "" ENDIF This.aTFWords = .F. DIMENSION This.aTFWords(m.lnWords, 14) For m.lnI = 1 To m.lnWords *-- if it's not the first word // can be removed if you can't draw spaced with backcolor and/or underlined/strikethru *-- will call DrawInReport(' ', cFontName,nFontSize,'US', -1,-1,-1, nHRed,nHGreen,nHBlue) m.llWhiteStyled = (m.lnI>1) And (m.llUnderline Or m.llStrikeThru Or m.llHighlight) If m.llWhiteStyled Then *-- style+backcolor ptr whitespace m.lcWhiteFName = Iif( Not m.llFontName, '', Getwordnum(m.lcFontNameStack,Getwordcount(m.lcFontNameStack,'|'),'|') ) m.lnWhiteFSize = Iif( Not m.llFontSize, -1, Val(Getwordnum(m.lcFontSizeStack,Getwordcount(m.lcFontSizeStack,'|'),'|')) ) *m.lcWhiteFStyle = Iif( Not m.llFontStyle, '', Iif(m.llUnderline,'U','') + Iif(m.llStrikeThru,'S','') ) m.lcWhiteFStyle = Iif(m.llUnderline,'U','') + Iif(m.llStrikeThru,'S','') *-- m.lcColorValue = Iif( Not m.llColor, '', Getwordnum(m.lcColorStack,Getwordcount(m.lcColorStack,'|'),'|') ) m.lnWhiteCRed = Iif( Not m.llColor, -1, Val(GetWordNum(m.lcColorValue,1,',')) ) m.lnWhiteCGreen = Iif( Not m.llColor, -1, Val(GetWordNum(m.lcColorValue,2,',')) ) m.lnWhiteCBlue = Iif( Not m.llColor, -1, Val(GetWordNum(m.lcColorValue,3,',')) ) *-- m.lcColorValue = Iif( Not m.llHighlight, '', Getwordnum(m.lcHighlightStack,Getwordcount(m.lcHighlightStack,'|'),'|') ) m.lnWhiteHRed = Iif( Not m.llHighlight, -1, Val(GetWordNum(m.lcColorValue,1,',')) ) m.lnWhiteHGreen = Iif( Not m.llHighlight, -1, Val(GetWordNum(m.lcColorValue,2,',')) ) m.lnWhiteHBlue = Iif( Not m.llHighlight, -1, Val(GetWordNum(m.lcColorValue,3,',')) ) *-- EndIf *-- *m.lcWord = Getwordnum(m.tcString,m.lnI) m.lcWord = Getwordnum(m.lcKString,m.lnI) *Set Step On *-- add spaces back m.lcWord = Strtran(m.lcWord,Chr(31),Chr(32)) && ' m.lcWordLow = Lower(m.lcWord) *!* If LEFT(m.lcWordLow,3)='sometext' Do while Inlist( Left(m.lcWordLow,3), '','','','','','','','','','' ) ; Or Left(m.lcWordLow,7) =' m.llBold = (m.llBold Or Left(m.lcWordLow,3)='') And Left(m.lcWordLow,4)!='' m.llItalic = (m.llItalic Or Left(m.lcWordLow,3)='') And Left(m.lcWordLow,4)!='' m.llUnderline = (m.llUnderline Or Left(m.lcWordLow,3)='') And Left(m.lcWordLow,4)!='' m.llStrikeThru = (m.llStrikeThru Or Left(m.lcWordLow,3)='') And Left(m.lcWordLow,4)!='' *-- *-- if colors, save in stack If Left(m.lcWordLow,3)='',m.lcWord)-At('=',m.lcWord)-1 ) m.lcColorValue = Strtran(m.lcColorValue,' ','') && here it could be converted from rgb to number if it's more convenient // the user could use a number instead of an RGB pair also *-- m.lcColorStack = m.lcColorStack + Iif(Not Empty(m.lcColorStack),'|','') + m.lcColorValue *? ' +colorstack: '+m.lcColorStack EndIf *-- If Left(m.lcWordLow,3)='',m.lcWord)-At('=',m.lcWord)-1 ) m.lcColorValue = Strtran(m.lcColorValue,' ','') && here it could be converted from rgb to number if it's more convenient // the user could use a number instead of an RGB pair also *-- m.lcHighlightStack = m.lcHighlightStack + Iif(Not Empty(m.lcHighlightStack),'|','') + m.lcColorValue *? ' +highlightstack: '+m.lcHighlightStack EndIf *-- If Left(m.lcWordLow,7)='',m.lcWord)-At('=',m.lcWord)-1 ) m.lcTagValue = Alltrim(Strtran(m.lcTagValue,["],'')) *-- m.lcFontNameStack = m.lcFontNameStack + Iif(Not Empty(m.lcFontNameStack),'|','') + m.lcTagValue *? ' +fontnamestack: '+m.lcFontNameStack EndIf *-- If Left(m.lcWordLow,7)='',m.lcWord)-At('=',m.lcWord)-1 ) m.lcTagValue = Strtran( Strtran(m.lcTagValue,["],'') ,' ','') *-- m.lcFontSizeStack = m.lcFontSizeStack + Iif(Not Empty(m.lcFontSizeStack),'|','') + m.lcTagValue *? ' +fontsizestack: '+m.lcFontSizeStack EndIf *-- If Left(m.lcWordLow,8)='',m.lcWord)-At('=',m.lcWord)-1 ) m.lcTagValue = Upper( Strtran( Strtran(m.lcTagValue,["],'') ,' ','') ) *-- m.lcFontStyleStack = m.lcFontStyleStack + Iif(Not Empty(m.lcFontStyleStack),'|','') + m.lcTagValue *? ' +fontnamestack: '+m.lcFontNameStack m.llBold = ('B' $ m.lcTagValue) m.llItalic = ('I' $ m.lcTagValue) m.llUnderline = ('U' $ m.lcTagValue) m.llStrikeThru = ('S' $ m.lcTagValue) EndIf *-- if end of color Then remove from stack If Left(m.lcWordLow,4)='' Or Left(m.lcWordLow,8)='' Then *-- m.lcColorStack = ; Iif( Empty(m.lcColorStack) Or Occurs('|',m.lcColorStack)=0, '',; Left( m.lcColorStack, AT('|',m.lcColorStack,Occurs('|',m.lcColorStack))-1 ) ) *? ' -colorstack: '+m.lcColorStack EndIf *-- If Left(m.lcWordLow,4)='' Or Left(m.lcWordLow,12)='' Then *-- m.lcHighlightStack = ; Iif( Empty(m.lcHighlightStack) Or Occurs('|',m.lcHighlightStack)=0, '',; Left( m.lcHighlightStack, AT('|',m.lcHighlightStack,Occurs('|',m.lcHighlightStack))-1 ) ) *? ' -highlightstack: '+m.lcHighlightStack EndIf *-- If Left(m.lcWordLow,8)='' Or Left(m.lcWordLow,11)='' Then *-- m.lcFontNameStack = ; Iif( Empty(m.lcFontNameStack) Or Occurs('|',m.lcFontNameStack)=0, '',; Left( m.lcFontNameStack, AT('|',m.lcFontNameStack,Occurs('|',m.lcFontNameStack))-1 ) ) *? ' +fontnamestack: '+m.lcFontNameStack EndIf *-- If Left(m.lcWordLow,8)='' Or Left(m.lcWordLow,11)='' Then *-- m.lcFontSizeStack = ; Iif( Empty(m.lcFontSizeStack) Or Occurs('|',m.lcFontSizeStack)=0, '',; Left( m.lcFontSizeStack, AT('|',m.lcFontSizeStack,Occurs('|',m.lcFontSizeStack))-1 ) ) *? ' +fontsizestack: '+m.lcFontSizeStack EndIf *-- If Left(m.lcWordLow,9)='' Or Left(m.lcWordLow,12)='' Then *-- m.lcFontStyleStack = ; Iif( Empty(m.lcFontStyleStack) Or Occurs('|',m.lcFontStyleStack)=0, '',; Left( m.lcFontStyleStack, AT('|',m.lcFontStyleStack,Occurs('|',m.lcFontStyleStack))-1 ) ) *? ' +fontstylestack: '+m.lcFontStyleStack *-- retrieve curent style in stack to setup flags m.lcTagValue = Getwordnum(m.lcFontStyleStack,Getwordcount(m.lcFontStyleStack,'|'),'|') *-- m.llBold = ('B' $ m.lcTagValue) m.llItalic = ('I' $ m.lcTagValue) m.llUnderline = ('U' $ m.lcTagValue) m.llStrikeThru = ('S' $ m.lcTagValue) *-- EndIf *-- some flags are .T. if stack is not empty m.llColor = Not Empty(m.lcColorStack) m.llHighlight = Not Empty(m.lcHighlightStack) m.llFontName = Not Empty(m.lcFontNameStack) m.llFontSize = Not Empty(m.lcFontSizeStack) m.llFontStyle = Not Empty(m.lcFontStyleStack) *-- remove procesed tag m.lcWord = Substr(m.lcWord,AT('>',m.lcWord)+1) m.lcWordLow = Lower(m.lcWord) EndDo *-- setup parameters for DrawInReport m.lcParamFName = Iif( Not m.llFontName, '', Getwordnum(m.lcFontNameStack,Getwordcount(m.lcFontNameStack,'|'),'|') ) m.lnParamFSize = Iif( Not m.llFontSize, -1, Val(Getwordnum(m.lcFontSizeStack,Getwordcount(m.lcFontSizeStack,'|'),'|')) ) *m.lcParamFStyle = Iif( Not m.llFontStyle, '', Iif(m.llBold,'B','') + Iif(m.llItalic,'I','') + Iif(m.llUnderline,'U','') + Iif(m.llStrikeThru,'S','') ) m.lcParamFStyle = Iif(m.llBold,'B','') + Iif(m.llItalic,'I','') + Iif(m.llUnderline,'U','') + Iif(m.llStrikeThru,'S','') m.lcColorValue = Iif( Not m.llColor, '', Getwordnum(m.lcColorStack,Getwordcount(m.lcColorStack,'|'),'|') ) m.lnParamCRed = Iif( Not m.llColor, -1, Val(GetWordNum(m.lcColorValue,1,',')) ) m.lnParamCGreen = Iif( Not m.llColor, -1, Val(GetWordNum(m.lcColorValue,2,',')) ) m.lnParamCBlue = Iif( Not m.llColor, -1, Val(GetWordNum(m.lcColorValue,3,',')) ) m.lcColorValue = Iif( Not m.llHighlight, '', Getwordnum(m.lcHighlightStack,Getwordcount(m.lcHighlightStack,'|'),'|') ) m.lnParamHRed = Iif( Not m.llHighlight, -1, Val(GetWordNum(m.lcColorValue,1,',')) ) m.lnParamHGreen = Iif( Not m.llHighlight, -1, Val(GetWordNum(m.lcColorValue,2,',')) ) m.lnParamHBlue = Iif( Not m.llHighlight, -1, Val(GetWordNum(m.lcColorValue,3,',')) ) *-- proces trailing tags // same as before, in loop for consecutive tags: 'sometext' Do while Inlist( right(m.lcWordLow,3), '','','','','','','','','',''); ; Or Left( Substr(m.lcWordLow,Rat('<',m.lcWordLow)) ,3) ='', '', ; '', '', '', '', '', '' ) ; *-- enable/disable style flags m.llBold = (m.llBold Or Right(m.lcWordLow,3)='') And Right(m.lcWordLow,4)!='' m.llItalic = (m.llItalic Or Right(m.lcWordLow,3)='') And Right(m.lcWordLow,4)!='' m.llUnderline = (m.llUnderline Or Right(m.lcWordLow,3)='') And Right(m.lcWordLow,4)!='' m.llStrikeThru = (m.llStrikeThru Or Right(m.lcWordLow,3)='') And Right(m.lcWordLow,4)!='' *-- *-- if colors, save in stack If Left( Substr(m.lcWordLow,Rat('<',m.lcWordLow)) ,3)='',m.lcWord)-RAt('=',m.lcWord)-1 ) m.lcColorValue = Strtran(m.lcColorValue,' ','') && here it could be converted from rgb to number if it's more convenient // the user could use a number instead of an RGB pair also *-- m.lcColorStack = m.lcColorStack + Iif(Not Empty(m.lcColorStack),'|','') + m.lcColorValue *? ' +colorstack: '+m.lcColorStack EndIf *-- If Left( Substr(m.lcWordLow,Rat('<',m.lcWordLow)) , 3)='',m.lcWord)-RAt('=',m.lcWord)-1 ) m.lcColorValue = Strtran(m.lcColorValue,' ','') && here it could be converted from rgb to number if it's more convenient // the user could use a number instead of an RGB pair also *-- m.lcHighlightStack = m.lcHighlightStack + Iif(Not Empty(m.lcHighlightStack),'|','') + m.lcColorValue *? ' +highlightstack: '+m.lcHighlightStack EndIf *-- If Left( Substr(m.lcWordLow,Rat('<',m.lcWordLow)) , 7)='',m.lcWord)-RAt('=',m.lcWord)-1 ) m.lcTagValue = Alltrim(Strtran(m.lcTagValue,["],'')) *-- m.lcFontNameStack = m.lcFontNameStack + Iif(Not Empty(m.lcFontNameStack),'|','') + m.lcTagValue *? ' +fontnamestack: '+m.lcFontNameStack EndIf *-- If Left( Substr(m.lcWordLow,Rat('<',m.lcWordLow)) , 7)='',m.lcWord)-RAt('=',m.lcWord)-1 ) m.lcTagValue = Strtran( Strtran(m.lcTagValue,["],'') ,' ','') *-- m.lcFontSizeStack = m.lcFontSizeStack + Iif(Not Empty(m.lcFontSizeStack),'|','') + m.lcTagValue *? ' +fontsizestack: '+m.lcFontSizeStack EndIf *-- If Left( Substr(m.lcWordLow,Rat('<',m.lcWordLow)) , 8)='',m.lcWord)-RAt('=',m.lcWord)-1 ) m.lcTagValue = Upper( Strtran( Strtran(m.lcTagValue,["],'') ,' ','') ) *-- m.lcFontStyleStack = m.lcFontStyleStack + Iif(Not Empty(m.lcFontStyleStack),'|','') + m.lcTagValue *? ' +fontnamestack: '+m.lcFontNameStack m.llBold = ('B' $ m.lcTagValue) m.llItalic = ('I' $ m.lcTagValue) m.llUnderline = ('U' $ m.lcTagValue) m.llStrikeThru = ('S' $ m.lcTagValue) *-- EndIf *-- if end of color Then remove from stack If Right(m.lcWordLow,4)='' Or Right(m.lcWordLow,8)='' Then *-- m.lcColorStack = ; Iif( Empty(m.lcColorStack) Or Occurs('|',m.lcColorStack)=0, '',; Left( m.lcColorStack, AT('|',m.lcColorStack,Occurs('|',m.lcColorStack))-1 ) ) *? ' -colorstack: '+m.lcColorStack EndIf *-- If Right(m.lcWordLow,4)='' Or Right(m.lcWordLow,12)='' Then *-- m.lcHighlightStack = ; Iif( Empty(m.lcHighlightStack) Or Occurs('|',m.lcHighlightStack)=0, '',; Left( m.lcHighlightStack, AT('|',m.lcHighlightStack,Occurs('|',m.lcHighlightStack))-1 ) ) *? ' -highlightstack: '+m.lcHighlightStack EndIf *-- If Right(m.lcWordLow,8)='' Or Right(m.lcWordLow,11)='' Then *-- m.lcFontNameStack = ; Iif( Empty(m.lcFontNameStack) Or Occurs('|',m.lcFontNameStack)=0, '',; Left( m.lcFontNameStack, AT('|',m.lcFontNameStack,Occurs('|',m.lcFontNameStack))-1 ) ) *? ' +fontnamestack: '+m.lcFontNameStack EndIf *-- If Right(m.lcWordLow,8)='' Or Right(m.lcWordLow,11)='' Then *-- m.lcFontSizeStack = ; Iif( Empty(m.lcFontSizeStack) Or Occurs('|',m.lcFontSizeStack)=0, '',; Left( m.lcFontSizeStack, AT('|',m.lcFontSizeStack,Occurs('|',m.lcFontSizeStack))-1 ) ) *? ' +fontsizestack: '+m.lcFontSizeStack EndIf *-- If Right(m.lcWordLow,9)='' Or Right(m.lcWordLow,12)='' Then *-- m.lcFontStyleStack = ; Iif( Empty(m.lcFontStyleStack) Or Occurs('|',m.lcFontStyleStack)=0, '',; Left( m.lcFontStyleStack, AT('|',m.lcFontStyleStack,Occurs('|',m.lcFontStyleStack))-1 ) ) *? ' +fontstylestack: '+m.lcFontStyleStack *-- retrieve curent style in stack to setup flags m.lcTagValue = Getwordnum(m.lcFontStyleStack,Getwordcount(m.lcFontStyleStack,'|'),'|') *-- m.llBold = ('B' $ m.lcTagValue) m.llItalic = ('I' $ m.lcTagValue) m.llUnderline = ('U' $ m.lcTagValue) m.llStrikeThru = ('S' $ m.lcTagValue) *-- EndIf *-- some flags are .T. if stack is not empty m.llColor = Not Empty(m.lcColorStack) m.llHighlight = Not Empty(m.lcHighlightStack) m.llFontName = Not Empty(m.lcFontNameStack) m.llFontSize = Not Empty(m.lcFontSizeStack) m.llFontStyle = Not Empty(m.lcFontStyleStack) *-- remove procesed tag m.lcWord = Left(m.lcWord,Rat('<',m.lcWord)-1) m.lcWordLow = Lower(m.lcWord) EndDo *-- the word to be sent as parameter m.lcParamWord = Alltrim(m.lcWord) *-- we have a word If Not Empty(m.lcParamWord) Then *-- If Not m.tlReturnVanillaString AND NOT EMPTY(m.lcParamWord) Then *-- not first word, so previous whitespace might be styled *!* If m.llWhiteStyled Then *!* *-- *!* DrawInReport(' ', ; *!* m.lcWhiteFName, m.lnWhiteFSize, m.lcWhiteFStyle, ; *!* m.lnWhiteCRed, m.lnWhiteCGreen, m.lnWhiteCBlue, ; *!* m.lnWhiteHRed, m.lnWhiteHGreen, m.lnWhiteHBlue ) *!* *-- *!* EndIf *-- draw the word * DrawInReport( m.lcParamWord, ; m.lcParamFName,m.lnParamFSize, m.lcParamFStyle, ; m.lnParamCRed, m.lnParamCGreen, m.lnParamCBlue, ; m.lnParamHRed, m.lnParamHGreen, m.lnParamHBlue ) * Add to the array of words This.aTFWords(m.lnI, 1) = m.lcParamWord This.aTFWords(m.lnI, 2) = m.lcParamFName This.aTFWords(m.lnI, 3) = m.lnParamFSize This.aTFWords(m.lnI, 4) = m.lcParamFStyle This.aTFWords(m.lnI, 5) = m.lnParamCRed This.aTFWords(m.lnI, 6) = m.lnParamCGreen This.aTFWords(m.lnI, 7) = m.lnParamCBlue This.aTFWords(m.lnI, 8) = m.lnParamHRed This.aTFWords(m.lnI, 9) = m.lnParamHGreen This.aTFWords(m.lnI, 10) = m.lnParamHBlue *-- *!* Else &&-- this might be usefull to decorate with whitespace, hoever cesar will justify the text making the result unpredictible *!* *-- before the first word, prefixed whitespace could be styled // mid-white-space style change *!* DrawInReport(' ', ; *!* m.lcParamFName,m.lnParamFSize, m.lcParamFStyle, ; *!* -1, -1, -1, ; *!* m.lnParamHRed, m.lnParamHGreen, m.lnParamHBlue ) *!* *-- Else *-- compose normal string, without tags m.lcResultString = Evl(m.lcResultString+' ','') + m.lcParamWord EndIf *-- EndIf EndFor *-- if vanillastring is requested If m.tlReturnVanillaString Then Return m.lcResultString EndIf ENDPROC PROCEDURE tfaddtooutput LPARAMETERS tnRecNo, tnX, tnY, tnW, tnH, tnObjectContinuationType, ; tcWord, tiGDIPlusImage, ; tcFont, ; && Font name m.tnFontSize, ; && Font size m.tnFontStyle, ; && Font style m.tnPenRed, ; && Pen red m.tnPenGreen, ; && Pen green m.tnPenBlue, ; && Pen blue m.tnFillRed, ; && Fill red m.tnFillGreen, ; && Fill green m.tnFillBlue, ; && Fill blue m.toFRX LOCAL lnSelect, lnRecno m.lnSelect = SELECT() m.lnRecno = RECNO() IF EMPTY(This.cAuxFullOutputAlias) This.cAuxFullOutputAlias = STRTRAN(SYS(2015), " ", "_") SELECT 0000 as nRecNo, ; CAST(0 AS N(9, 3)) as FRXWidth, ; CAST(0 AS N(9, 3)) as FRXHeight, ; CAST(0 AS N(9, 3)) as FRXTop, ; CAST(0 AS I) AS Left, ; CAST(0 AS I) AS FRXRECNO, ; CAST(0 AS I) AS DBFRECNO, ; CAST(0 AS I) AS CONTTYPE, ; CAST("" AS M) AS CONTENTS, ; CAST("" AS M) AS UNCONTENTS, ; CAST(0 AS I) AS PAGE, ; CAST(0 AS I) AS FRXINDEX, ; CAST(0 AS I) AS DYNAMICS, ; CAST(0 AS I) AS ROTATE, * FROM (This.cFrxAlias) WHERE .F. INTO CURSOR (This.cAuxFullOutputAlias) READWRITE SELECT (This.cAuxFullOutputAlias) ALTER TABLE (This.cAuxFullOutputAlias) ALTER COLUMN Top Integer ENDIF * Add the information to be used by the Search engine INSERT INTO (This.cOutputAlias) ; VALUES (0, 0, m.tnX, m.tnY, m.tnW, m.tnH, ; m.tnObjectContinuationType, m.tcWord, STRCONV(m.tcWord, 5), ; This.PageNo, 0, 0, 0) * Add the information to be used to generate the outputs * The width was enhanced in 30% to make sure that all words will be inserted in the outputs SELECT (This.cAuxFullOutputAlias) APPEND BLANK GATHER NAME m.toFRX REPLACE FontFace WITH m.tcFont, ; FontSize WITH m.tnFontSize, ; FontStyle with m.tnFontStyle, ; PenRed with m.tnPenRed, ; PenGreen WITH m.tnPenGreen, ; PenBlue WITH m.tnPenBlue, ; FillRed WITH m.tnFillRed, ; FillGreen WITH m.tnFillGreen, ; FillBlue WITH m.tnFillBlue, ; Mode WITH 0, ; Left WITH m.tnX, ; Top WITH m.tnY, ; Width WITH INT(m.tnW * 1.15), ; Height WITH m.tnH, ; FRXRECNO WITH m.tnRecNo, ; CONTTYPE WITH m.tnObjectContinuationType, ; CONTENTS WITH m.tcWord, ; UNCONTENTS WITH STRCONV(m.tcWord, 5), ; Page WITH This.PageNo, ; FRXINDEX WITH m.tnRecNo ; IN (This.cAuxFullOutputAlias) SELECT (m.lnSelect) GO m.lnRecno RETURN ENDPROC PROCEDURE Destroy * Clear the watermark bitmap object IF VARTYPE(This.oWatermarkBmp) = "O" This.oWatermarkBmp.Destroy() This.oWatermarkBmp = NULL ENDIF DODEFAULT() ENDPROC PROCEDURE EvaluateContents LPARAMETERS m.nFRXRecno, m.oObjProperties DO CASE CASE ("*" $ m.oObjProperties.Text AND VARTYPE(m.oObjProperties.Value) = "N") OR ; && Adjust to fit size ("..." $ m.oObjProperties.Text AND VARTYPE(m.oObjProperties.Value) = "N") LOCAL lcFormat, lnValue m.lnValue = m.oObjProperties.Value TRY IF This.aRecords[m.nFRXRecno + This.nAdj, 3] = .T. && Already been here m.lcFormat = This.aRecords[m.nFRXRecno + This.nAdj, 4] ELSE LOCAL lnSession, lnSelect m.lnSession = SET("DataSession") m.lnSelect = SELECT() * Get the number format This.setFRXDataSession() SELECT FRX GO m.nFRXRecno m.lcFormat = FRX.Picture SET DATASESSION TO m.lnSession SELECT (m.lnSelect) This.aRecords[m.nFRXRecno + This.nAdj, 3] = .T. && Already know that we need to stretch This.aRecords[m.nFRXRecno + This.nAdj, 4] = m.lcFormat && Save for future use ENDIF m.oObjProperties.Text = SPACE(1) + ALLTRIM(TRANSFORM(m.lnValue, &lcFormat.)) m.oObjProperties.Reload = .T. This.aRecords[m.nFRXRecno + This.nAdj, 1] = m.oObjProperties CATCH TO m.loExc SET STEP ON ENDTRY CASE This.aRecords[m.nFRXRecno + This.nAdj, 2] && or This.aRecords[m.nFRXRecno + This.nAdj, 1] = m.oObjProperties OTHERWISE DODEFAULT(m.nFRXRecno, m.oObjProperties) ENDCASE ENDPROC PROCEDURE Init WITH This .AddProperty("oGDIGraphics", NULL) && a reference to a GDIPlusX Graphics object .AddProperty("aRecords[1]") && an array of records in the FRX .AddProperty("lHasFJ", .F.) .AddProperty("nAdj", 0) .AddProperty("lNewPage", .F.) .AddProperty("lHasUserFld", .F.) * Watermarks .AddProperty("lUsingWatermark", .F.) .AddProperty("cWatermarkImage" , "") && loFP.cWaterMarkImage .AddProperty("nWatermarkType" , 1) && 1 = colored ; 2 = greyscale (1) .AddProperty("nWatermarkTransparency", 0) && 0 = transparent ; 1 = opaque (.25) .AddProperty("nWatermarkWidthRatio" , 0) && 0 - 1 (.75) .AddProperty("nWatermarkHeightRatio" , 0) && 0 - 1 (.75) .AddProperty("oWatermarkBmp" , NULL) ENDWITH DODEFAULT() ENDPROC PROCEDURE BeforeReport DODEFAULT() WITH This TRY .oGDIGraphics = CREATEOBJECT("GPGraphics") CATCH .oGDIGraphics = NEWOBJECT("GPGraphics", "_GdiPlus.vcx") ENDTRY * Switch to the FRX cursor's datasession and for every record with the "" * directive in the USER memo, flag in This.aRecords that we need to process it. * Then restore the datasession. .SetFRXDataSession() * Detect if we have the USER field. In FP DOS, this field did not exist. * http://foxypreviewer.codeplex.com/workitem/9236 This.lHasUserFld = NOT EMPTY(FIELD("USER")) LOCAL lnAdj, lnOldSize m.lnAdj = 0 m.lnOldSize = 0 m.lnOldSize = ALEN(.aRecords, 1) IF m.lnOldSize > 1 m.lnAdj = m.lnOldSize This.nAdj = m.lnAdj ENDIF DIMENSION .aRecords[reccount() + m.lnAdj, 5] * Column 1 : Recno() * Column 2 : Has * Column 3 : Stretched * Column 4 : Field Format (Picture) IF This.lHasUserFld SCAN FOR ('' $ UPPER(USER)) OR ('' $ UPPER(USER)) .aRecords[RECNO() + m.lnAdj, 2] = .T. .aRecords[RECNO() + m.lnAdj, 5] = UPPER(USER) .lHasFJ = .T. ENDSCAN FOR '' $ UPPER(USER) .ResetDataSession() ENDIF * Watermarks IF VARTYPE(_Screen.oFoxyPreviewer) = "O" LOCAL loFP loFP = _Screen.oFoxyPreviewer .cWatermarkImage = loFP.cWaterMarkImage .nWatermarkType = loFP.nWatermarkType && 1 = colored ; 2 = greyscale (1) .nWatermarkTransparency = loFP.nWatermarkTransparency && 0 = transparent ; 1 = opaque (.25) .nWatermarkWidthRatio = loFP.nWatermarkWidthRatio && 0 - 1 (.75) .nWatermarkHeightRatio = loFP.nWatermarkHeightRatio && 0 - 1 (.75) IF (NOT FILE(.cWatermarkImage)) OR ; (.nWatermarkTransparency = 0) OR ; (.nWatermarkWidthRatio = 0) OR ; (.nWatermarkHeightRatio = 0) .lUsingWatermark = .F. ELSE .lUsingWatermark = .T. LOCAL loBmp AS GpBitmap OF HOME() + "\ffc\_gdiplus.vcx" loBmp = CREATEOBJECT("GpBitmap") loBmp.CreateFromFile(This.cWatermarkImage) IF (This.nWatermarkTransparency < 1) OR ; (This.nWatermarkType = 2) && 1 = colored ; 2 = greyscale * Applying the effects if necessary LOCAL loAtt && AS GPATTRIB OF "PR_GdiplusHelper.Prg" LOCAL lcMatrix AS COLORMATRIX OF "PR_GdiplusHelper.Prg" loAtt = NEWOBJECT("GpAttrib", "PR_GdiplusHelper.Prg") IF This.nWatermarkType = 2 && 1 = colored ; 2 = greyscale lcMatrix = loAtt.ColorMatrix(; .30, .30, .30, 0, 0, ; .59, .59, .59, 0, 0, ; .11, .11, .11, 0, 0, ; 0, 0, 0, This.nWatermarkTransparency, 0, ; 0, 0, 0, 0, 1) ELSE lcMatrix = loAtt.ColorMatrix(; 1, 0, 0, 0, 0, ; 0, 1, 0, 0, 0, ; 0, 0, 1, 0, 0, ; 0, 0, 0, This.nWatermarkTransparency, 0, ; 0, 0, 0, 0, 1) ENDIF loAtt.ApplyColorMatrix(lcMatrix, loBmp, .F., 0xFFFFFF) loAtt = NULL ENDIF * Clear the watermark bitmap object IF VARTYPE(This.oWatermarkBmp) = "O" This.oWatermarkBmp.Destroy() This.oWatermarkBmp = NULL ENDIF .oWatermarkBmp = loBmp ENDIF ENDIF ENDWITH ENDPROC PROCEDURE BeforeBand LPARAMETERS m.nBandObjCode, m.nFRXRecNo IF THIS.lHasFJ = .T. OR THIS.lExpandFields THIS.CallEvaluateContents = 2 ENDIF #DEFINE frx_objcod_pageheader 1 IF nBandObjCode==frx_objcod_pageheader THIS.lNewPage = .T. IF NOT THIS.IsSuccessor THIS.sharedGdiplusGraphics = THIS.GDIPLUSGRAPHICS ENDIF THIS.oGdiGraphics.SetHandle(This.SharedGdiplusGraphics) ENDIF DODEFAULT(m.nBandObjCode, m.nFRXRecNo) ENDPROC PROCEDURE Render LPARAMETERS m.tnFRXRecno, m.tnLeft, m.tnTop, m.tnWidth, m.tnHeight, m.tnObjectContinuationType, ; m.tcContentsToBeRendered, m.tiGDIPlusImage * DODEFAULT(m.tnFRXRecno, m.tnLeft, m.tnTop, m.tnWidth, m.tnHeight, m.tnObjectContinuationType, ; m.tcContentsToBeRendered, m.tiGDIPlusImage) * RETURN * Check if field enlargement is needed IF This.aRecords(m.tnFRXRecno, 3) = .T. && Using Expand fields m.tnWidth = m.tnWidth + 500 m.tnLeft = m.tnLeft - 500 m.tcContentsToBeRendered = STRCONV(This.aRecords(m.tnFRXRecno, 1).Text, 5) && Convert to unicode, to allow it to store in the cursor ENDIF CATCH ENDTRY * Adding the Watermark IF This.lNewPage AND This.lUsingWatermark = .T. This.oGDIGraphics.SetHandle(IIF(This.IsSuccessor, ; This.SharedGDIPlusGraphics, This.GDIPlusGraphics)) LOCAL lnX, lnY, lnWidth, lnHeight lnX = (1 - This.nWatermarkWidthRatio) / 2 lnY = (1 - This.nWatermarkHeightRatio) / 2 lnWidth = This.nWatermarkWidthRatio lnHeight = This.nWatermarkHeightRatio * create a rectangle of the size of 60% of the report page LOCAL loRect as GpRectangle * loRect = .rectangle.new(lnx * this.sharedpagewidth, ; lny * this.sharedpageheight, ; this.sharedpagewidth * lnwidth, ; this.sharedpageheight * lnheight) * Create a rectangle loRect = CREATEOBJECT("GPRectangle", lnx * This.SharedPageWidth, ; lnY * this.sharedPageHeight, ; This.SharedPageWidth * lnWidth, ; This.SharedPageHeight * lnHeight) * Load the image file to gdi+ LOCAL loBmp as GpBitmap OF ADDBS(HOME()) + "FFC\_Gdiplus.vcx" IF VARTYPE(This.oWatermarkBmp) = "O" loBmp = This.oWatermarkBmp ELSE loBmp = CREATEOBJECT("GpBitmap") loBmp.CreateFromFile(This.cWatermarkImage) ENDIF LOCAL loGfx as GpGraphics OF ADDBS(HOME()) + "FFC\_Gdiplus.vcx" loGfx = This.oGdiGraphics loGfx.DrawImageScaled(loBmp, loRect) *!* local loClrMatrix as xfcColorMatrix *!* if this.WatermarkType = 2 && 1 = colored ; 2 = greyscale *!* loclrmatrix = .imaging.colormatrix.new( ; *!* .33, .33, .33, 0 , 0, ; *!* .33, .33, .33, 0 , 0, ; *!* .33, .33, .33, 0 , 0, ; *!* 0, 0, 0, this.watermarktransparency, 0, ; *!* 0, 0, 0, 0, 0) *!* else *!* loclrmatrix = .imaging.colormatrix.new() *!* loclrmatrix.matrix33 = this.watermarktransparency *!* endif *!* local loattr as xfcimageattributes *!* loattr = .imaging.imageattributes.new() *!* loattr.setcolormatrix(loclrmatrix) * This.oGdiGraphics.drawimage(loBmp, loRect, loBmp.GetBounds(), 2, loattr) This.lNewPage = .F. ENDIF * dodefault(nfrxrecno,; nleft,ntop,nwidth,nheight,; nobjectcontinuationtype, ; ccontentstoberendered, gdiplusimage) LOCAL loObject, ; lcText, ; llFJ, ; llTF, ; llFlag, ; loGfx as GpGraphics OF HOME() + "\FFC\_GdiPlus.vcx", ; loRect as GpRectangle OF HOME() + "\FFC\_GdiPlus.vcx", ; loFont as GpFont OF HOME() + "\FFC\_GdiPlus.vcx", ; loBrush as GpSolidBrush OF HOME() + "\FFC\_GdiPlus.vcx", ; loColor as GpColor OF HOME() + "\FFC\_GdiPlus.vcx", ; lnAlpha, ; llStoreData m.llStoreData = This.lStoreData * Checking if the HTML formatting was chosen IF VARTYPE(This.aRecords[m.tnFRXRecNo + This.nAdj, 5]) = "C" m.llTF = ('' $ This.aRecords[m.tnFRXRecNo + This.nAdj, 5]) AND (NOT EMPTY(STRCONV(m.tcContentsToBeRendered,6))) ENDIF && We'll store the data only if not && The TF routine has its own storing data IF This.lStoreData AND (NOT llTF) This.StoreFRXData(m.tnFRXRecno, m.tnLeft, m.tnTop, m.tnWidth, m.tnHeight, m.tnObjectContinuationType, ; m.tcContentsToBeRendered, m.tiGDIPlusImage) ENDIF * See if the current object is supposed to be fully-justified. If we're * continuing to render a object from previous page because of text overflow, * set a flag. IF NOT This.lHasFJ && OR (_goHelper._nIndex > 1) This.lStoreData = .F. DODEFAULT(m.tnFRXRecNo, m.tnLeft, m.tnTop, m.tnWidth, m.tnHeight, ; m.tnObjectContinuationType, m.tcContentsToBeRendered, ; m.tiGDIPlusImage) This.lStoreData = m.llStoreData RETURN ENDIF m.loObject = This.aRecords[m.tnFRXRecNo + This.nAdj, 1] IF VARTYPE(m.loObject) = 'O' m.lcText = m.loObject.Text m.llFJ = (LEFT(m.lcText, 4) = '' or This.aRecords[m.tnFRXRecNo + This.nAdj, 2]) AND ; (NOT EMPTY(STRCONV(m.tcContentsToBeRendered,6))) ENDIF VARTYPE(m.loObject) = 'O' *!* * Checking if the HTML formatting was chosen *!* IF VARTYPE(This.aRecords[tnFRXRecNo + This.nAdj, 5]) = "C" *!* llTF = ('' $ This.aRecords[tnFRXRecNo + This.nAdj, 5]) *!* ENDIF IF m.llTF This.oGDIGraphics.SetHandle(IIF(This.IsSuccessor, ; This.SharedGDIPlusGraphics, This.GDIPlusGraphics)) This.DrawStringInTF( ; m.tnFRXRecNo, m.tnLeft, m.tnTop, m.tnWidth, m.tnHeight, m.tnObjectContinuationType, m.tcContentsToBeRendered, m.tiGDIPlusImage, ; m.lcText, ; m.loObject.FontName, m.loObject.FontSize, m.loObject.FontStyle, ; m.loObject.FillRed, m.loObject.FillGreen, m.loObject.FillBlue, ; m.loObject.PenRed, m.loObject.PenGreen, m.loObject.PenBlue) * Since we already drew the text, we don't want the default behavior to occur. NODEFAULT * Release the GDi+ objects used STORE "" TO m.loObject, m.loGfx, m.loRect, m.loFont, m.loBrush, m.loColor RETURN ENDIF IF m.llFJ IF m.tnObjectContinuationType > 0 m.lcText = strconv(m.tcContentsToBeRendered, 6) IF INLIST(m.tnObjectContinuationType, 1, 2) m.llFlag = .T. ENDIF INLIST(m.tnObjectContinuationType, 1, 2) ENDIF m.tnObjectContinuationType > 0 IF UPPER(LEFT(m.lcText, 4)) = '' m.lcText = SUBSTR(m.lcText, 5) && Remove the tag from string ENDIF UPPER(LEFT(m.lcText, 4)) = '' m.lcText = STRTRAN(m.lcText,CHR(9),REPLICATE(CHR(160),8)) && Replaces the With a CHR(160) to keep paragraphs * Set the GDI+ handle for our graphics object to the same one the report uses * (the property to use depends on whether this is a successor or not). This.oGDIGraphics.SetHandle(IIF(This.IsSuccessor, ; This.SharedGDIPlusGraphics, This.GDIPlusGraphics)) * Create a rectangle m.loRect = CREATEOBJECT("GPRectangle", m.tnLeft, m.tnTop, m.tnWidth, m.tnHeight) * Create a font object using the text object's settings. m.loFont = CREATEOBJECT("GPFont") m.loFont.Create(m.loObject.FontName, m.loObject.FontSize, m.loObject.FontStyle, 3) * If the text uses an opaque background, draw a rectangle in the chosen * background color using a solid brush. m.lnAlpha = m.loObject.FillAlpha IF m.lnAlpha <> 0 m.loColor = CREATEOBJECT("gpColor", ; m.loObject.FillRed, ; m.loObject.FillGreen, ; m.loObject.FillBlue, ; m.lnAlpha ) m.loBrush = CREATEOBJECT("gpSolidBrush", m.loColor) This.oGDIGraphics.FillRectangle(m.loBrush, m.tnLeft, ; m.tnTop, m.tnWidth, m.tnHeight) ENDIF m.lnAlpha <> 0 m.loColor = CREATEOBJECT("gpColor", ; m.loObject.PenRed, ; m.loObject.PenGreen, ; m.loObject.PenBlue, ; m.loObject.PenAlpha) m.loBrush = CREATEOBJECT("gpSolidBrush", m.loColor) This.DrawStringJustified(m.lcText, m.loFont, ; m.loBrush, m.loRect, m.llFlag, This.oGDIGraphics) * If we're not drawing a full justified string, let VFP draw the text as usual. This.lStoreData = .F. DODEFAULT(m.tnFRXRecNo, m.tnLeft, m.tnTop, m.tnWidth, m.tnHeight, ; m.tnObjectContinuationType, m.tcContentsToBeRendered, ; m.tiGDIPlusImage) This.lStoreData = m.llStoreData ENDIF m.llFJ * Since we already drew the text, we don't want the default behavior to occur. NODEFAULT * Release the GDi+ objects used STORE "" TO m.loObject, m.loGfx, m.loRect, m.loFont, m.loBrush, loColor ENDPROC PROCEDURE AfterReport This.oGDIGraphics.SetHandle(0) This.oGdiGraphics = "" DODEFAULT() ENDPROC BorderStyle = 2 Height = 25 Width = 356 ShowWindow = 1 ShowInTaskBar = .F. DoCreate = .T. AutoCenter = .T. Caption = "ThermForm" ControlBox = .F. HalfHeightCaption = .T. MaxButton = .F. MinButton = .F. Visible = .F. AlwaysOnTop = .T. AllowOutput = .F. _memberdata = 3586 _origautoyield = .F. _origsys2333 = .F. Name = "frmSendMail2" PROCEDURE setlanguage LOCAL loExc as Exception IF VARTYPE(_goHelper) = "O" WITH This .lblTo.Caption = _goHelper.GetLoc("TO") .lblSubject.Caption = _goHelper.GetLoc("SUBJECT") .cmdAttachment.ToolTipText = _goHelper.GetLoc("ATTACHMENT") .cmbAttach.ToolTipText = _goHelper.GetLoc("ATTACHMENT") .chkPriority.Caption = _goHelper.GetLoc("PRIORITY") .chkReceipt.Caption = _goHelper.GetLoc("RECEIPT") .chtmleditor1.tgBold.ToolTipText = _goHelper.GetLoc("BOLD") .chtmleditor1.tgBold.Caption = LEFT(_goHelper.GetLoc("BOLD"),1) .chtmleditor1.tgItalic.ToolTipText = _goHelper.GetLoc("ITALIC") .chtmleditor1.tgItalic.Caption = LEFT(_goHelper.GetLoc("ITALIC"),1) .chtmleditor1.tgUnderline.ToolTipText = _goHelper.GetLoc("UNDERLINE") .chtmleditor1.tgUnderline.Caption = LEFT(_goHelper.GetLoc("UNDERLINE"),1) .chtmleditor1.tgLeft.ToolTipText = _goHelper.GetLoc("ALIGNLEFT") .chtmleditor1.tgCenter.ToolTipText = _goHelper.GetLoc("ALIGNCENTE") .chtmleditor1.tgRight.ToolTipText = _goHelper.GetLoc("ALIGNRIGHT") .chtmleditor1.tgJustify.ToolTipText = _goHelper.GetLoc("ALIGNJUSTI") .chtmleditor1.cmdHyperlink .ToolTipText = _goHelper.GetLoc("HYPERLINK") .chtmleditor1.cmdPicture.ToolTipText = _goHelper.GetLoc("ADDPICTURE") .chtmleditor1.tgDecrease.ToolTipText = _goHelper.GetLoc("INDENTREDU") .chtmleditor1.tgIncrease.ToolTipText = _goHelper.GetLoc("INDENTINCR") .chtmleditor1.tgLine.ToolTipText = _goHelper.GetLoc("HORIZBAR") .chtmleditor1.tgClean.ToolTipText = _goHelper.GetLoc("CLEANFORMT") .chtmleditor1.tgBullet.ToolTipText = _goHelper.GetLoc("LISTBULLET") .chtmleditor1.tgNumbers.ToolTipText = _goHelper.GetLoc("LISTNUMBER") .chtmleditor1.cmdCopy.ToolTipText = _goHelper.GetLoc("COPY") .chtmleditor1.cmdCut.ToolTipText = _goHelper.GetLoc("CUT") .chtmleditor1.cmdPaste.ToolTipText = _goHelper.GetLoc("PASTE") .chtmleditor1.cmdOpen.ToolTipText = _goHelper.GetLoc("HTMLMODEL") .chtmleditor1.cmdSave.ToolTipText = _goHelper.GetLoc("SAVEASHTML") .chtmleditor1.cmdNew.ToolTipText = _goHelper.GetLoc("NEW") .chtmleditor1.cmdUndo.ToolTipText = _goHelper.GetLoc("UNDO") .chtmleditor1.cmdRedo.ToolTipText = _goHelper.GetLoc("REDO") .chtmleditor1.cmbFontName.ToolTipText = _goHelper.GetLoc("FONTNAME") .chtmleditor1.cmbFontSize.ToolTipText = _goHelper.GetLoc("FONTSIZE") .chtmleditor1.btnForeColor.ToolTipText = _goHelper.GetLoc("FONTCOLOR") .chtmleditor1.btnBackColor.ToolTipText = _goHelper.GetLoc("BACKCOLOR") ENDWITH ENDIF CATCH TO loExc SET STEP ON ENDTRY RETURN ENDPROC PROCEDURE removeattachment LOCAL lnOption, lcCancel, lcRemove lnOption = 0 IF VARTYPE(_goHelper) = "O" lcCancel = _goHelper.GetLoc("CANCEL") lcRemove = _goHelper.GetLoc("REMOVEFILE") lcCancel = "Cancel" lcRemove = "Remove file" ENDIF LOCAL loList as ComboBox loList = Thisform.CmbAttach DEFINE POPUP MyShortCut SHORTCUT RELATIVE FROM MROW(),MCOL() DEFINE BAR 1 OF MyShortCut PROMPT lcRemove + ": " + ; loList.ListItem(loList.ListIndex) DEFINE BAR 2 OF MyShortCut PROMPT lcCancel ON SELECTION POPUP MyShortCut lnOption = BAR() ACTIVATE POPUP MyShortCut IF lnOption = 1 && Remove file loList.RemoveListItem(loList.ListItemId) loList.ListIndex = 1 ENDIF ENDPROC PROCEDURE Load SET TALK OFF SET CONSOLE OFF *!* * Adjust some properties to make sure the WebBrowser active-X will work as desired *!* * http://www.tek-tips.com/viewthread.cfm?qid=1204873&page=168 *!* This._OrigAutoYield = _VFP.AutoYield *!* This._OrigSYS2333 = VAL(SYS(2333, 2)) *!* _VFP.AutoYield = .F. *!* SYS(2333, 1) ENDPROC PROCEDURE Unload *!* * Restore ActiveX settings *!* _VFP.AutoYield = This._OrigAutoYield *!* SYS(2333, This._OrigSYS2333) IF NOT EMPTY(Thisform.cTempFile) DELETE FILE (Thisform.cTempFile) CATCH ENDTRY ENDIF RETURN Thisform.lCancelled ENDPROC PROCEDURE Activate IF EMPTY(This.Comment) This.Width = This.Width + 1 This.Comment = "Started" ENDIF ENDPROC PROCEDURE Init LPARAMETERS tcFile * Thisform.lblAttachment.Caption = JUSTFNAME(tcFile) IF NOT EMPTY(tcFile) WITH Thisform.CmbAttach as ComboBox .AddItem(JUSTFNAME(tcFile)) .List(.NewIndex, 2) = tcFile .ListIndex = 1 .Refresh() ENDWITH ENDIF LOCAL lcAttach, n, lcFile lcAttach = _goHelper.cAttachments IF NOT EMPTY(lcAttach) lcAttach = CHRTRAN(lcAttach, ";", ",") FOR m.n = 1 TO GETWORDCOUNT(lcAttach, ",") lcFile = GETWORDNUM(lcAttach, m.n, ",") IF NOT FILE(lcFile) LOOP ENDIF WITH Thisform.CmbAttach as ComboBox .AddItem(JUSTFNAME(lcFile)) .List(.NewIndex, 2) = lcFile .ListIndex = 1 .Refresh() ENDWITH ENDFOR ENDIF Thisform.AddProperty("lCancelled", .F.) This.Icon = _goHelper.cFormIcon CATCH ENDTRY WITH _goHelper This.txtDestination.Value = .cEmailTo This.txtSubject.Value = .cEmailSubject * This.edtBody.Value = .cEmailBody This.chkPriority.Value = .lPriority This.chkReceipt.Value = .lReadReceipt This.Caption = .GetLoc("SENDEMAIL") This.CmdCancel.Caption = .GetLoc("CANCEL") This.CmdSend.Caption = .GetLoc("SEND") This.lblSubject.Caption = .GetLoc("SUBJECT") This.lblTo.Caption = .GetLoc("TO") TRY IF NOT EMPTY(_goHelper.cEmailBody) OR NOT EMPTY(_goHelper.cEmailBodyFile) LOCAL lcHTMLFile IF NOT EMPTY(_goHelper.cEmailBody) lcHTMLfile = FORCEEXT(ADDBS(SYS(2023))+SYS(2015),"htm") STRTOFILE(_goHelper.cEmailBody, lcHTMLFile) Thisform.cTempFile = lcHTMLFile INKEY(.1) ELSE lcHTMLfile = _goHelper.cEmailBodyFile ENDIF IF FILE(lcHTMLfile) WITH Thisform.Chtmleditor1.oIE .Navigate(lcHTMLFile) DO WHILE .ReadyState != 4 DOEVENTS ENDDO .Document.Body.contentEditable = .T. ENDWITH IF lcHTMLfile ==_goHelper.cEmailBodyFile && Whithout this the "cEmailBodyFile" will be always deleted!!... by Nick Porfyris [20101213]... ELSE DELETE FILE (lcHTMLFile) ENDIF ENDIF ENDIF CATCH MESSAGEBOX("Could not load the HTML body file", 48, "Error loading HTML") ENDTRY ENDWITH CATCH ENDTRY This.SetLanguage() RETURN *!* XP Style WebBrowser Control *!* I'm sure there is more then me that been looking for a way to get the XP style in the WebBrowser Control. *!* To enable the XP style in your web pages that you load in your WebBrowser Control put the following line in your head tags: *!* Code: *!* *!* * Testing code *!* TEXT TO lcHTML NOSHOW *!* *!* *!* *!* *!* *!* <> *!* To
 *!* <> *!*
*!*
*!* Sincerely *!*

*!*
*!*
*!* FoxyPreviewer team. *!*
*!* 1818 Super Street  -  Your Home
05432-030  -  Your City -  XX
*!* ( *!* Phone: 1 11 - 3322.2233
*!* ( *!* Fax:   2 11 - 3366.6656
 *!* * *!* contact@mycompany.com *!*
*!* *!* ENDTEXT *!* SET TEXTMERGE ON *!* lcHTML = TEXTMERGE(lcHTML,.T.,"<<",">>") *!* *!* lcFile = FORCEEXT(ADDBS(SYS(2023))+SYS(2015),"htm") *!* Thisform.cTempFile = lcFile *!* STRTOFILE(lcHTML, lcFile) *!* WITH Thisform.Chtmleditor1.oIE *!* .Navigate(lcFile) *!* DO WHILE .ReadyState != 4 *!* DOEVENTS *!* ENDDO *!* .Document.Body.contentEditable = .T. *!* ENDWITH * Article with all the EXECWB commands available * http://delphicikk.atw.hu/listaz.php?id=1391&oldal=41 ENDPROC pr_AdressBook( LCADRESS LCORIGADRESS _GOHELPER CADRESSTABLE CADRESSSEARCH PR_ADRESSBOOK THISFORM TXTDESTINATION VALUE SETFOCUS THIS LOSTFOCUS LOEXC Click, THISFORM LCANCELLED RELEASE Click, The email can't be sent because there is no FoxyPreviewer report active! Error contentEditable=true COMBOBOX THISFORM CHTMLEDITOR1 LTOGGLEUPDATE LCHTML LCATTACH _GOHELPER CEMAILTO TXTDESTINATION VALUE CEMAILSUBJECT TXTSUBJECT DOCUMENT BODY OUTERHTML CEMAILBODY CMBATTACH LISTCOUNT _CATTACHMENT LREADRECEIPT CHKRECEIPT LPRIORITY CHKPRIORITY RELEASE Click, THISFORM REMOVEATTACHMENT' ATTACHFILE COMBOBOX LCFILE _GOHELPER GETLOC THISFORM CMBATTACH ADDITEM NEWINDEX REFRESH VALUE LCTTIP LISTCOUNT TOOLTIPTEXT RightClick, Click\ THISFORM REMOVEATTACHMENT RightClick, WIDTH PARENT HEIGHT SAVEASHTML HTMLDEFA Save as HTML Make the saved file the default email body in the next sessions? Htm;Html contentEditable=true FoxyPreviewer_Settings.dbf CEMAILBODYFILE cEmailBodyFile Error updating the settings fileC Line: Error LCHTML LCFILE LCLOCTEXT _GOHELPER GETLOC COUTPUTPATH LCQUESTION THISFORM CHTMLEDITOR1 DOCUMENT BODY OUTERHTML LCALIAS PROPERTY CVALUE LOEXC ERRORNO MESSAGE LINENO LINECONTENTS Resize, cmdSave.Click Arial, 0, 9, 5, 15, 12, 32, 3, 0 Arial, 1, 12, 8, 20, 15, 42, 4, 1 Arial, 2, 12, 7, 20, 16, 30, 3, 1 Arial, 4, 12, 7, 19, 15, 43, 3, 1 Wingdings, 0, 12, 14, 17, 14, 22, 3, 0 Wingdings, 0, 10, 12, 15, 12, 18, 3, 0 Arial, 0, 10, 6, 16, 13, 35, 3, 0 Arial, 0, 8, 5, 14, 11, 29, 3, 0 frmSendMail2 Command1 commandbutton commandbutton IPROCEDURE Click Thisform.lCancelled = .T. Thisform.Release() ENDPROC ctempfile _memberdata XML Metadata for customizable properties _origautoyield _origsys2333 *setlanguage *removeattachment chtmleditor pr_htmledit.vcx container Chtmleditor1 frmSendMail2 Anchor = 15 Top = 84 Left = 1 Width = 655 Height = 365 BorderWidth = 0 TabIndex = 3 Name = "Chtmleditor1" oIE.Top = 48 oIE.Left = 0 oIE.Height = 120 oIE.Width = 132 oIE.TabIndex = 1 oIE.Name = "oIE" tgBold.Alignment = 0 tgBold.TabIndex = 23 tgBold.Name = "tgBold" tgItalic.Alignment = 0 tgItalic.TabIndex = 24 tgItalic.Name = "tgItalic" tgUnderline.Alignment = 0 tgUnderline.TabIndex = 25 tgUnderline.Name = "tgUnderline" tgLeft.Alignment = 0 tgLeft.TabIndex = 10 tgLeft.Name = "tgLeft" tgCenter.Alignment = 0 tgCenter.TabIndex = 11 tgCenter.Name = "tgCenter" tgRight.Alignment = 0 tgRight.TabIndex = 12 tgRight.Name = "tgRight" btnForeColor.TabIndex = 26 btnForeColor.Name = "btnForeColor" btnBackColor.TabIndex = 27 btnBackColor.Name = "btnBackColor" cmbFontName.Height = 23 cmbFontName.Left = 0 cmbFontName.TabIndex = 21 cmbFontName.Top = 24 cmbFontName.Width = 154 cmbFontName.Name = "cmbFontName" cmbFontSize.Alignment = 2 cmbFontSize.Height = 23 cmbFontSize.Left = 159 cmbFontSize.TabIndex = 22 cmbFontSize.Top = 24 cmbFontSize.Width = 47 cmbFontSize.Name = "cmbFontSize" tgIncrease.Alignment = 0 tgIncrease.TabIndex = 16 tgIncrease.Name = "tgIncrease" tgDecrease.Alignment = 0 tgDecrease.TabIndex = 15 tgDecrease.Name = "tgDecrease" tgBullet.Alignment = 0 tgBullet.TabIndex = 14 tgBullet.Name = "tgBullet" tgNumbers.Alignment = 0 tgNumbers.TabIndex = 29 tgNumbers.Name = "tgNumbers" cmdHyperlink.TabIndex = 18 cmdHyperlink.Name = "cmdHyperlink" cmdPicture.TabIndex = 19 cmdPicture.Name = "cmdPicture" Label1.Left = 453 Label1.Top = 28 Label1.Visible = .F. Label1.TabIndex = 28 Label1.Name = "Label1" tgJustify.Alignment = 0 tgJustify.TabIndex = 13 tgJustify.Name = "tgJustify" cmdOpen.Name = "cmdOpen" cmdSave.cpropertyname = cmdSave.Name = "cmdSave" cmdNew.Name = "cmdNew" cmdCut.cpropertyname = Cut cmdCut.Name = "cmdCut" cmdCopy.cpropertyname = Copy cmdCopy.Name = "cmdCopy" cmdPaste.cpropertyname = Paste cmdPaste.Name = "cmdPaste" cmdUndo.cpropertyname = Undo cmdUndo.Name = "cmdUndo" cmdRedo.cpropertyname = Redo cmdRedo.Name = "cmdRedo" tgLine.TabIndex = 17 tgLine.Alignment = 0 tgLine.Name = "tgLine" tgCLean.Top = 0 tgCLean.Left = 503 tgCLean.TabIndex = 20 tgCLean.Alignment = 0 tgCLean.Name = "tgCLean" lPROCEDURE Resize This.width=this.parent.width This.height=this.parent.height - 115 && 72 *!* *this.top=0 *!* *this.left=0 This.oIE.Width = This.Width - 2 This.oIE.Height = This.Height - 60 ENDPROC PROCEDURE cmdSave.Click LOCAL lcHTML, lcFile, lcLocText IF VARTYPE(_goHelper) = "O" lcLocText = _goHelper.GetLoc("SAVEASHTML") lcFile = IIF(EMPTY(_goHelper.cOutputPath), "", ADDBS(_goHelper.cOutputPath)) lcQuestion = _goHelper.GetLoc("HTMLDEFA") lcLocText = "Save as HTML" lcFile = "" lcQuestion = "Make the saved file the default email body in the next sessions?" ENDIF lcFile = PUTFILE(lcLocText + "...", lcFile, "Htm;Html") IF NOT EMPTY(lcFile) lcHTML = "" + Thisform.Chtmleditor1.oIE.Document.Body.OuterHTML + "" lcHTML = STRTRAN(lcHTML, "contentEditable=true", "") STRTOFILE(lcHTML, lcFile) IF MESSAGEBOX(lcQuestion, 32 + 4, lcLocText) = 6 && Yes LOCAL lcAlias lcAlias = SYS(2015) TRY USE ("FoxyPreviewer_Settings.dbf") IN 0 AGAIN SHARED ALIAS (lcAlias) && FP_Settings SELECT(lcAlias) LOCATE FOR ALLTRIM(UPPER(property)) == "CEMAILBODYFILE" IF EOF() APPEND BLANK REPLACE Property WITH "cEmailBodyFile", ; cValue WITH lcFile ; IN (lcAlias) ELSE REPLACE cValue WITH lcFile IN (lcAlias) ENDIF CATCH TO loExc MESSAGEBOX("Error updating the settings file" + CHR(13) + CHR(13) + ; TRANSFORM(loExc.ERRORNO) + " - " + loExc.MESSAGE + CHR(13) + ; "Line: " + TRANSFORM(loExc.LINENO) + " - " + loExc.LINECONTENTS, 16, "Error") SET STEP ON ENDTRY USE IN SELECT(lcAlias) ENDIF ENDIF ENDPROC PROCEDURE Click LOCAL lcAdress, lcOrigAdress lcAdress = "" IF NOT EMPTY(_goHelper.cAdressTable) AND NOT EMPTY(_goHelper.cAdressSearch) DO FORM pr_AdressBook ; WITH _goHelper.cAdressTable, _goHelper.cAdressSearch ; TO lcAdress IF NOT EMPTY(lcAdress) AND VARTYPE(lcAdress) = "C" lcOrigAdress = ALLTRIM(Thisform.TxtDestination.Value) IF EMPTY(lcOrigAdress) Thisform.TxtDestination.Value = lcAdress ELSE Thisform.TxtDestination.Value = lcOrigAdress + ";" + lcAdress ENDIF Thisform.TxtDestination.SetFocus() ELSE This.LostFocus() ENDIF ENDIF CATCH TO loExc SET STEP ON ENDTRY ENDPROC Top = 12 Left = 5 Height = 23 Width = 23 Picture = images\pr_adress.bmp Caption = "" TabIndex = 6 TabStop = .F. SpecialEffect = 2 Name = "Command1" Top = 456 Left = 591 Height = 27 Width = 84 Anchor = 12 Cancel = .T. Caption = "Cancel" TabIndex = 5 Name = "cmdCancel" frmSendMail2 cmdCancel commandbutton commandbutton Top = 456 Left = 495 Height = 27 Width = 84 Anchor = 12 Picture = images\pr_sendmessage.bmp Caption = "Send" TabIndex = 4 PicturePosition = 0 Name = "cmdSend" frmSendMail2 cmdSend commandbutton commandbutton AutoSize = .T. BackStyle = 0 Caption = "Subject:" Height = 17 Left = 8 Top = 50 Width = 46 TabIndex = 12 Name = "lblSubject" frmSendMail2 textbox textbox txtDestination frmSendMail2 Format = "K" Height = 23 Left = 110 MaxLength = 255 TabIndex = 1 Top = 12 Width = 386 AutoComplete = 2 AutoCompTable = "FoxyPreviewer_Emails" Name = "txtDestination" textbox textbox TxtSubject frmSendMail2 aFormat = "K" Height = 23 Left = 110 TabIndex = 2 Top = 48 Width = 386 Name = "TxtSubject" checkbox checkbox chkPriority frmSendMail2 Top = 108 Left = 537 Height = 13 Width = 148 Alignment = 0 Caption = "Priority" Value = .F. TabIndex = 9 Visible = .T. Name = "chkPriority" checkbox checkbox chkReceipt frmSendMail2 Top = 84 Left = 537 Height = 13 Width = 148 Alignment = 0 Caption = "Read receipt" Value = .F. TabIndex = 11 Visible = .T. Name = "chkReceipt" combobox combobox cmbAttach frmSendMail2 FontSize = 8 ColumnCount = 2 ColumnWidths = "160,0" Height = 24 ColumnLines = .F. Left = 537 Style = 2 TabIndex = 8 Top = 48 Width = 141 Name = "cmbAttach" "O" MESSAGEBOX("The email can't be sent because there is no FoxyPreviewer report active!", 16, "Error") RETURN ENDIF WITH _goHelper .cEmailTo = ALLTRIM(Thisform.txtDestination.Value) .cEmailSubject = ALLTRIM(Thisform.txtSubject.Value) lcHTML = "" + Thisform.Chtmleditor1.oIE.Document.Body.OuterHTML + "" lcHTML = STRTRAN(lcHTML, "contentEditable=true", "") .cEmailBody = lcHTML lcAttach = "" WITH Thisform.CmbAttach as ComboBox FOR m.i = 1 TO .ListCount lcAttach = lcAttach + .List(m.i, 2) + "," ENDFOR ENDWITH lcAttach = LEFT(lcAttach, LEN(lcAttach) - 1) ._cAttachment = lcAttach .lReadReceipt = Thisform.chkReceipt.Value .lPriority = Thisform.chkPriority.Value ENDWITH Thisform.Release() RETURN ENDPROC EXCEPTION SUBJECT ATTACHMENT ATTACHMENT PRIORITY RECEIPT ITALIC ITALIC UNDERLINE UNDERLINE ALIGNLEFT ALIGNCENTE ALIGNRIGHT ALIGNJUSTI HYPERLINK ADDPICTURE INDENTREDU INDENTINCR HORIZBAR CLEANFORMT LISTBULLET LISTNUMBER PASTE HTMLMODEL SAVEASHTML FONTNAME FONTSIZE FONTCOLOR BACKCOLOR LOEXC _GOHELPER LBLTO CAPTION GETLOC LBLSUBJECT CMDATTACHMENT TOOLTIPTEXT CMBATTACH CHKPRIORITY CHKRECEIPT CHTMLEDITOR1 TGBOLD TGITALIC TGUNDERLINE TGLEFT TGCENTER TGRIGHT TGJUSTIFY CMDHYPERLINK CMDPICTURE TGDECREASE TGINCREASE TGLINE TGCLEAN TGBULLET TGNUMBERS CMDCOPY CMDCUT CMDPASTE CMDOPEN CMDSAVE CMDNEW CMDUNDO CMDREDO CMBFONTNAME CMBFONTSIZE BTNFORECOLOR BTNBACKCOLORr CANCEL REMOVEFILE Cancel Remove file COMBOBOX lnOption = BAR() LNOPTION LCCANCEL LCREMOVE _GOHELPER GETLOC LOLIST THISFORM CMBATTACH MYSHORTCUT LISTITEM LISTINDEX REMOVELISTITEM LISTITEMID THISFORM CTEMPFILE LCANCELLEDG Started COMMENT WIDTH| COMBOBOX COMBOBOX lCancelled- SENDEMAIL CANCEL SUBJECT Could not load the HTML body file Error loading HTML TCFILE THISFORM CMBATTACH ADDITEM NEWINDEX LISTINDEX REFRESH LCATTACH LCFILE _GOHELPER CATTACHMENTS ADDPROPERTY ICON CFORMICON TXTDESTINATION VALUE CEMAILTO TXTSUBJECT CEMAILSUBJECT CHKPRIORITY LPRIORITY CHKRECEIPT LREADRECEIPT CAPTION GETLOC CMDCANCEL CMDSEND LBLSUBJECT LBLTO CEMAILBODY CEMAILBODYFILE LCHTMLFILE CTEMPFILE CHTMLEDITOR1 NAVIGATE READYSTATE DOCUMENT CONTENTEDITABLE SETLANGUAGE setlanguage, removeattachment Unload& Activate PLATFORM UNIQUEID TIMESTAMP CLASS CLASSLOC BASECLASS OBJNAME PARENT PROPERTIES PROTECTED METHODS OBJCODE RESERVED1 RESERVED2 RESERVED3 RESERVED4 RESERVED5 RESERVED6 RESERVED7 RESERVED8 COMMENT Class WINDOWS _1740W7OC6 813201933 COMMENT RESERVED WINDOWS _1740WXCG0 813202935 COMMENT RESERVED WINDOWS _1740QHB8J 827741504@F COMMENT RESERVED WINDOWS _1740W78J0 922511065q COMMENT RESERVED WINDOWS _1731BXUH2 925330000mF COMMENT RESERVED WINDOWS _1740S4S5B1031176059 COMMENT RESERVED WINDOWS _1740QGBYD1033747498 WINDOWS _1740RH5FM 925330789 WINDOWS _1740S7WUJ1030405923qR WINDOWS _1740SF2VG1030405923 WINDOWS _1740SF2W01030405923 Q WINDOWS _1740SNVJQ1030402864 WINDOWS _1740SNVKA1030402864 WINDOWS _1740W7OC61030402864 WINDOWS _1740W7OC61030402864 WINDOWS _1740W0P9C1033746905 WINDOWS _1740WA4YL1030402864 WINDOWS _1740X64WS1030402864 WINDOWS _1740Y1B1R1030402864 WINDOWS _1740Y1B2B1030402864f> WINDOWS _1740YB8XA1030402864D= WINDOWS _1740YB8XU1030402864!< WINDOWS _1740Z7TQJ1030402864 WINDOWS _1740Z7TRD1030402864 WINDOWS _1750K7E5L1030402132T8 WINDOWS _32M1DWMRJ1030402864 WINDOWS _3300XEAYB1031175409 WINDOWS _3300XEAYC1031176583P1 WINDOWS _3300XEAYD1031175409 WINDOWS _3300XEAYE1031176033R. WINDOWS _3300XEAYR1031176285:- WINDOWS _3300XEAYS1031176285 WINDOWS _3300XEAYT1031176285 WINDOWS _3300XEAYU1031176285 WINDOWS _3300YECRE1031176285 WINDOWS _1740W7OC6 813201933 COMMENT RESERVED VERSION = 3.00 !Arial, 0, 9, 5, 15, 12, 16, 3, 0 Pixels Class combobox cpropertyname _memberdata combobox about:blank PARENT NAVIGATE READYSTATE REFRESH Click, InsertImagea PARENT DOCUMENT EXECCOMMAND Click, Pixels pr_HtmlEdit.vcx pr_HtmlEdit.vcx LCFILE PARENT NAVIGATE READYSTATE DOCUMENT CONTENTEDITABLE REFRESH SETFOCUS Click, Inner Outer Importar texto de arquivo TXT Copiar HTML Copiar Texto MESSAGEBOX(oThis.oIE.Document.Body.InnerHTML) MESSAGEBOX(oThis.oIE.Document.Body.OuterHTML) oThis.oIE.Document.Body.innerHTML = GETFILE("txt") _ClipText = oThis.oIE.Document.Body.innerHTML _ClipText = oThis.oIE.Document.Body.innerTEXT OTHIS PARENT Click, CreateLinka PARENT DOCUMENT EXECCOMMAND Click, FontSize- PARENT DOCUMENT EXECCOMMAND VALUE InteractiveChange, FontName- PARENT DOCUMENT EXECCOMMAND DISPLAYVALUE InteractiveChange, ForeColor- LNCOLOR LCCOLOR PARENT DOCUMENT EXECCOMMAND Click, chtmleditor combobox HHeight = 23 Width = 177 cpropertyname = FontName Name = "cfontname" PROCEDURE Init This.AddProperty("aNames[1]","") =AFONT(This.aNames) This.RowSource = "This.aNames" This.RowSourceType = 5 This.Value = "Arial" ENDPROC cfontname nHeight = 23 Style = 2 TabStop = .F. Width = 100 _memberdata = 526 Name = "_cbo" BackColor- LNCOLOR LCCOLOR PARENT DOCUMENT EXECCOMMAND BGCOLOR Click, COMMAND ENABLE PARENT TOGGLESTATUS PARENT ACTIVATECOMMANDS CommandStateChange, DownloadComplete CTOGGLE OTOGGLE OBJECTS CLASS DOCUMENT QUERYCOMMANDENABLED CPROPERTYNAME CTOGGLE LTOGGLEUPDATE OTOGGLE LOCATIONURL OBJECTS CLASS VALUE DOCUMENT QUERYCOMMANDVALUE CPROPERTYNAME PARENTCLASS JUSTIFYC JustifyNone TCPROPERTYNAME DOCUMENT QUERYCOMMANDVALUE EXECCOMMAND SETFOCUSg WIDTH PARENT HEIGHT RESIZE DOCUMENT BODY OUTERHTML activatecommands, togglestatus toggle- Resize RightClick CPROPERTYNAME PARENT TOGGLE Click, DOCUMENT CONTENTEDITABLEz about:blank LNLOADTIMEOUT OBJECT NAVIGATE LNSTARTSECONDS READYSTATE= LFIRSTREFRESH DOCUMENT CONTENTEDITABLE DownloadComplete, Initn Refresh/ PARENT TOGGLE CPROPERTYNAME Click, DblClickn RightClicky ADDITEM Init, Class container chtmleditor aNames[1] This.aNames Arial ADDPROPERTY ANAMES ROWSOURCE ROWSOURCETYPE VALUE Init, Arial, 1, 12, 8, 20, 15, 42, 4, 1 Arial, 2, 12, 7, 20, 16, 30, 3, 1 Arial, 4, 12, 7, 19, 15, 43, 3, 1 Wingdings, 0, 12, 14, 17, 14, 22, 3, 0 Wingdings, 0, 10, 12, 15, 12, 18, 3, 0 Arial, 0, 9, 5, 15, 12, 32, 3, 0 Arial, 0, 10, 6, 16, 13, 35, 3, 0 Top = 24 Left = 428 Picture = images\pr_clean.bmp Caption = "" ToolTipText = "Remove formatting" SpecialEffect = 2 Alignment = 0 cpropertyname = RemoveFormat Name = "tgClean" chtmleditor tgClean commandbutton pr_htmledit.vcx cbutton Top = 0 Left = 428 FontName = "Arial" Caption = "--" ToolTipText = "Insert horizontal line" SpecialEffect = 2 Alignment = 2 cpropertyname = InsertHorizontalRule Name = "tgLine" chtmleditor tgLine commandbutton pr_htmledit.vcx cbutton Top = 0 Left = 183 Picture = images\pr_redo.bmp Caption = "" ToolTipText = "Redo" SpecialEffect = 2 Alignment = 0 cpropertyname = Redo Name = "cmdRedo" chtmleditor cmdRedo commandbutton pr_htmledit.vcx cbutton Top = 0 Left = 159 FontName = "Wingdings" Picture = images\pr_undo.bmp Caption = "" ToolTipText = "Undo" SpecialEffect = 2 Alignment = 0 cpropertyname = Undo Name = "cmdUndo" chtmleditor cmdUndo commandbutton pr_htmledit.vcx cbutton Top = 0 Left = 131 FontName = "Wingdings" Picture = images\pr_paste.bmp Caption = "" ToolTipText = "Paste" SpecialEffect = 2 Alignment = 0 cpropertyname = Paste Name = "cmdPaste" chtmleditor cmdPaste commandbutton pr_htmledit.vcx cbutton Top = 0 Left = 107 FontName = "Wingdings" Picture = images\pr_copy.bmp Caption = "" ToolTipText = "Copy" SpecialEffect = 2 Alignment = 0 cpropertyname = Copy Name = "cmdCopy" chtmleditor cmdCopy commandbutton pr_htmledit.vcx cbutton Top = 0 Left = 83 FontName = "Wingdings" Picture = images\pr_cut.bmp Caption = "" ToolTipText = "Cut" SpecialEffect = 2 Alignment = 0 cpropertyname = Cut Name = "cmdCut" chtmleditor cmdCut commandbutton pr_htmledit.vcx cbutton PROCEDURE Click WITH this.Parent.OiE .navigate("about:blank") DO WHILE (.busy) OR (.ReadyState != 4) DOEVENTS ENDDO ENDWITH this.Parent.refresh ENDPROC Top = 0 Left = 50 FontName = "Wingdings" Picture = images\pr_new.bmp Caption = "" Enabled = .T. ToolTipText = "New..." SpecialEffect = 2 Alignment = 0 Name = "cmdNew" chtmleditor cmdNew commandbutton pr_htmledit.vcx cbutton Top = 0 Left = 26 FontName = "Wingdings" Picture = images\pr_save.bmp Caption = "" Enabled = .T. ToolTipText = "Save as HTML..." SpecialEffect = 2 Alignment = 0 cpropertyname = SaveAs Name = "cmdSave" chtmleditor cmdSave commandbutton pr_htmledit.vcx cbutton PROCEDURE Click NODEFAULT LOCAL lcFile lcFile=GETFILE("htm*") IF !EMPTY(lcFile) WITH this.Parent.oIE .Navigate(lcFile) DO WHILE .ReadyState != 4 DOEVENTS ENDDO .Document.Body.contentEditable = .T. .Refresh() .SetFocus() ENDWITH ENDIF ENDPROC Top = 0 Left = 2 FontName = "Wingdings" Picture = images\pr_open.bmp Caption = "" Enabled = .T. ToolTipText = "Open HTML file..." SpecialEffect = 2 Alignment = 0 Name = "cmdOpen" chtmleditor cmdOpen commandbutton pr_htmledit.vcx cbutton Top = 0 Left = 288 Picture = images\pr_align_justify.bmp Alignment = 0 Caption = "" SpecialEffect = 2 ToolTipText = "Justify" cpropertyname = JustifyFull Name = "tgJustify" chtmleditor tgJustify checkbox pr_htmledit.vcx ctoggle PROCEDURE Click define popup pop1 shortcut define bar 1 of pop1 prompt "Inner" define bar 2 of pop1 prompt "Outer" define bar 3 of pop1 prompt "Importar texto de arquivo TXT" define bar 4 of pop1 prompt "Copiar HTML" define bar 5 of pop1 prompt "Copiar Texto" private oThis oThis = This.Parent on selection bar 1 of pop1 MESSAGEBOX(oThis.oIE.Document.Body.InnerHTML) on selection bar 2 of pop1 MESSAGEBOX(oThis.oIE.Document.Body.OuterHTML) on selection bar 3 of pop1 oThis.oIE.Document.Body.innerHTML = GETFILE("txt") on selection bar 4 of pop1 _ClipText = oThis.oIE.Document.Body.innerHTML on selection bar 5 of pop1 _ClipText = oThis.oIE.Document.Body.innerTEXT activate popup pop1 AT MROW(),MCOL() ENDPROC AutoSize = .F. Alignment = 2 BorderStyle = 1 Caption = "More..." Height = 19 Left = 374 Top = 27 Width = 44 Name = "Label1" chtmleditor Label1 label label SPROCEDURE Click This.Parent.oIE.Document.execCommand("InsertImage",.T.) ENDPROC Top = 0 Left = 474 Picture = images\pr_getimage.bmp Caption = "" ToolTipText = "Insert picture" SpecialEffect = 2 Name = "cmdPicture" chtmleditor cmdPicture commandbutton pr_htmledit.vcx cbutton SPROCEDURE Click This.Parent.oIE.Document.execCommand("CreateLink", .T.) ENDPROC Top = 0 Left = 451 Picture = images\pr_hyperlink.bmp Caption = "" ToolTipText = "Create a hyperlink" SpecialEffect = 2 Name = "cmdHyperlink" chtmleditor cmdHyperlink commandbutton pr_htmledit.vcx cbutton Top = 0 Left = 341 Picture = images\pr_listnumber.bmp Alignment = 0 Caption = "" SpecialEffect = 2 ToolTipText = "Formatting numbers" cpropertyname = InsertOrderedList Name = "tgNumbers" chtmleditor tgNumbers checkbox pr_htmledit.vcx ctoggle Top = 0 Left = 317 Picture = images\pr_listdot.bmp Alignment = 0 Caption = "" SpecialEffect = 2 ToolTipText = "Formatting bullets" cpropertyname = InsertUnOrderedList Name = "tgBullet" chtmleditor tgBullet checkbox pr_htmledit.vcx ctoggle Top = 0 Left = 372 Picture = images\pr_textmoveleft.bmp Alignment = 0 Caption = "" SpecialEffect = 2 ToolTipText = "Decrease indentation" cpropertyname = Outdent Name = "tgDecrease" chtmleditor tgDecrease checkbox pr_htmledit.vcx ctoggle Top = 0 Left = 398 Picture = images\pr_textmoveright.bmp Alignment = 0 Caption = "" SpecialEffect = 2 ToolTipText = "Increase indentation" cpropertyname = Indent Name = "tgIncrease" chtmleditor tgIncrease checkbox pr_htmledit.vcx ctoggle iPROCEDURE InteractiveChange This.Parent.oIE.Document.execCommand("FontSize",.F.,This.Value) ENDPROC `Height = 23 Left = 129 ToolTipText = "Font size" Top = 24 Width = 54 Name = "cmbFontSize" chtmleditor cmbFontSize combobox pr_htmledit.vcx cfontsize pPROCEDURE InteractiveChange This.Parent.oIE.Document.execCommand("FontName",.F.,This.DisplayValue) ENDPROC _Height = 23 Left = 0 ToolTipText = "Font name" Top = 24 Width = 127 Name = "cmbFontName" chtmleditor cmbFontName combobox pr_htmledit.vcx cfontname Top = 24 Left = 341 Picture = images\pr_fontback.bmp Caption = "" ToolTipText = "Background color" SpecialEffect = 2 ForeColor = 0,0,255 Name = "btnBackColor" chtmleditor btnBackColor commandbutton pr_htmledit.vcx cbutton Top = 24 Left = 317 Picture = images\pr_textcolor.bmp Caption = "" ToolTipText = "Cor do Texto" SpecialEffect = 2 ForeColor = 0,0,255 Name = "btnForeColor" chtmleditor btnForeColor commandbutton pr_htmledit.vcx cbutton Acpropertyname The name of the property this command will toggle 'Wingdings, 0, 12, 14, 17, 14, 22, 3, 0 Class chtmleditor tgRight checkbox pr_htmledit.vcx ctoggle ctoggle chtmleditor tgCenter checkbox Class Pixels cfontsize !Arial, 0, 9, 5, 15, 12, 32, 3, 0 +OLEObject = C:\WINNT\System32\shdocvw.dll Elfirstrefresh _memberdata XML Metadata for customizable properties checkbox checkbox olecontrol olecontrol Class Pixels Class cfontsize ctoggle Pixels Pixels cfontname !Arial, 0, 9, 5, 15, 12, 32, 3, 0 *update combobox TAlignment = 1 Value = 1 Width = 45 cpropertyname = FontSize Name = "cfontsize" PROCEDURE Click This.Parent.Toggle(This.cPropertyName) ENDPROC PROCEDURE DblClick NODEFAULT ENDPROC PROCEDURE RightClick NODEFAULT ENDPROC Height = 23 Width = 23 FontName = "Wingdings" FontSize = 12 Alignment = 0 Caption = "C" Value = .F. Style = 1 TabStop = .F. Name = "ctoggle" PROCEDURE Init This.AddItem("8") This.AddItem("10") This.AddItem("12") This.AddItem("14") This.AddItem("18") This.AddItem("24") This.AddItem("36") ENDPROC xPROCEDURE Click LOCAL lnColor, lcColor lnColor = GETCOLOR() IF lnColor > -1 lcColor = RIGHT(TRANSFORM(lnColor,"@0"),6) lcColor = RIGHT(lcColor, 2)+ SUBSTR(lcColor,3,2)+ LEFT(lcColor,2) This.Parent.oIE.Document.execCommand("BackColor",.F.,lcColor) ENDIF RETURN * Not used any more * This converted the whole document BackColor instead of the current selection LOCAL lnColor, lcColor lnColor = GETCOLOR() IF lnColor > -1 lcColor = RIGHT(TRANSFORM(lnColor,"@0"),6) lcColor = RIGHT(lcColor, 2)+ SUBSTR(lcColor,3,2)+ LEFT(lcColor,2) This.Parent.oIE.Document.bgColor = lcColor ENDIF ENDPROC PROCEDURE Click LOCAL lnColor, lcColor lnColor = GETCOLOR() IF lnColor > -1 lcColor = RIGHT(TRANSFORM(lnColor,"@0"),6) lcColor = RIGHT(lcColor, 2)+ SUBSTR(lcColor,3,2)+ LEFT(lcColor,2) This.Parent.oIE.Document.execCommand("ForeColor",.F.,lcColor) ENDIF ENDPROC Top = 0 Left = 264 Picture = images\pr_align_right.bmp Alignment = 0 Caption = "" SpecialEffect = 2 ToolTipText = "Align right" cpropertyname = JustifyRight Name = "tgRight" Top = 0 Left = 240 Picture = images\pr_align_center.bmp Alignment = 0 Caption = "" SpecialEffect = 2 ToolTipText = "Center" cpropertyname = JustifyCenter Name = "tgCenter" pr_htmledit.vcx ctoggle Top = 0 Left = 216 Picture = images\pr_align_left.bmp Alignment = 0 Caption = "" SpecialEffect = 2 ToolTipText = "Align left" cpropertyname = JustifyLeft Name = "tgLeft" chtmleditor tgLeft checkbox pr_htmledit.vcx ctoggle Top = 24 Left = 264 FontName = "Arial" FontUnderline = .T. Alignment = 0 Caption = "U" SpecialEffect = 2 ToolTipText = "Underline" cpropertyname = Underline Name = "tgUnderline" chtmleditor tgUnderline checkbox pr_htmledit.vcx ctoggle Top = 24 Left = 240 FontItalic = .T. FontName = "Arial" Alignment = 0 Caption = "I" SpecialEffect = 2 ToolTipText = "Italic" cpropertyname = Italic Name = "tgItalic" chtmleditor tgItalic checkbox pr_htmledit.vcx ctoggle chtmleditor tgBold checkbox pr_htmledit.vcx ctoggle chtmleditor cbutton gHeight = 100 Width = 100 lfirstrefresh = .T. _memberdata = 524 Name = "cie" PROCEDURE DownloadComplete *** ActiveX Control Event *** * Set the edit mode on *THIS.Document.designMode = "On" && This gives a different context menu This.Document.Body.contentEditable = .T. && This is a good context menu ENDPROC PROCEDURE Init * Navigate to a blank page *This.Navigate2("About:Blank") * Prevent an OLE error, and wait until the object * gets the blank page open before showing or accessing LOCAL lnLoadTimeout lnLoadTimeout = 3 && seconds WITH This.OBJECT .Navigate("about:blank") * Wait for load completion lnStartSeconds = SECONDS() DO WHILE .ReadyState <> 4 ; AND (SECONDS()-lnStartSeconds <= lnLoadTimeout ) DOEVENTS ENDDO ENDWITH ENDPROC PROCEDURE Refresh *** ActiveX Control Method *** IF This.lFirstRefresh NODEFAULT This.lFirstRefresh = .F. This.Document.Body.contentEditable = .T. ENDIF ENDPROC Top = 24 Left = 216 FontBold = .T. FontName = "Arial" Alignment = 0 Caption = "B" SpecialEffect = 2 ToolTipText = "Bold" cpropertyname = Bold Name = "tgBold" -OLEObject = C:\Windows\system32\ieframe.dll PROCEDURE CommandStateChange *** ActiveX Control Event *** LPARAMETERS command, enable This.Parent.ToggleStatus() DODEFAULT(command, enable) ENDPROC PROCEDURE DownloadComplete *** ActiveX Control Event *** DODEFAULT() This.Parent.Activatecommands() ENDPROC fTop = 48 Left = 0 Height = 100 Width = 100 _memberdata = 524 Name = "oIE" olecontrol pr_htmledit.vcx s_memberdata XML Metadata for customizable properties ltoggleupdate *activatecommands *togglestatus *toggle PROCEDURE activatecommands LOCAL oToggle FOR EACH oToggle IN This.Objects IF UPPER(oToggle.Class) = "CTOGGLE" This.oIE.Document.queryCommandEnabled(oToggle.cPropertyName) * oToggle.Refresh() ENDIF ENDPROC PROCEDURE togglestatus IF This.lToggleUpdate LOCAL oToggle IF NOT EMPTY(This.oIE.LocationURL) FOR EACH oToggle IN This.Objects IF UPPER(oToggle.Class) = "CTOGGLE" oToggle.Value = This.oIE.Document.QueryCommandValue(oToggle.cPropertyName) * oToggle.Refresh() ENDIF IF UPPER(oToggle.ParentClass) = "_CBO" oToggle.Value = This.oIE.Document.queryCommandValue(oToggle.cPropertyName) ENDIF NEXT ENDIF ENDIF ENDPROC PROCEDURE toggle LPARAMETERS tcPropertyName IF "JUSTIFY" $ UPPER(tcPropertyName) IF This.oIE.Document.queryCommandValue(tcPropertyName) tcPropertyName = "JustifyNone" ENDIF ENDIF This.oIE.Document.execCommand(tcPropertyName) This.oIE.SetFocus() ENDPROC PROCEDURE Resize This.width=this.parent.width This.height=this.parent.height - 72 *!* *this.top=0 *!* *this.left=0 This.oIE.Width = This.Width - 2 This.oIE.Height = This.Height - 60 ENDPROC PROCEDURE Init This.Resize() ENDPROC PROCEDURE RightClick MESSAGEBOX(This.oIE.Document.Body.OuterHTML) ENDPROC container commandbutton mPROCEDURE Click IF NOT EMPTY(This.cPropertyName) This.Parent.Toggle(This.cPropertyName) ENDIF ENDPROC Ecpropertyname _memberdata XML Metadata for customizable properties cbutton commandbutton Class Pixels 'Wingdings, 0, 10, 12, 15, 12, 18, 3, 0 Height = 23 Width = 23 FontName = "Wingdings" FontSize = 10 Caption = "C" TabStop = .F. SpecialEffect = 2 cpropertyname = _memberdata = 79 Name = "cbutton" Width = 633 Height = 324 BackStyle = 0 BorderWidth = 0 _memberdata = 546 ltoggleupdate = .T. Name = "chtmleditor" xH@@`````` \KF\KF\KF \KF\KF\KF\KF\KF\KF\KF\KF\KF \KF\KF\KF \KF\KF\KF\KF\KF\KF\KF\KF\KF \KF\KF\KF \KF\KF\KF\KF\KF\KF\KF\KF\KF \KF\KF\KF \KF\KF\KF\KF\KF\KF\KF\KF\KF gOwW? gOwW? `P(`P(h`0@ 0P (X 0` P PLATFORM UNIQUEID TIMESTAMP CLASS CLASSLOC BASECLASS OBJNAME PARENT PROPERTIES PROTECTED METHODS OBJCODE RESERVED1 RESERVED2 RESERVED3 RESERVED4 RESERVED5 RESERVED6 RESERVED7 RESERVED8 COMMENT Screen WINDOWS _34Q0PJ4TY1043685131 WINDOWS _34Q0PJ4TZ1059848267 WINDOWS _34Q0PJ4U01045479108R) WINDOWS _34Q0PJ4U11045105636** WINDOWS _34Q0PJ4U61045105899i0 WINDOWS _35800F2H410451285359/ WINDOWS _35A033NLY1045107191 WINDOWS _35A033NLZ10451058994& WINDOWS _34Q0PJ4TY1045479237-% WINDOWS _35G1FDGMD1045479237R$ COMMENT RESERVED VERSION = 3.00 dataenvironment dataenvironment Dataenvironment YTop = 0 Left = 0 Width = 0 Height = 0 DataSource = .NULL. Name = "Dataenvironment" Form1 CHeight = 422 Width = 635 Desktop = .T. DoCreate = .T. ShowTips = .T. AutoCenter = .T. Caption = "Select recipients" Closable = .F. WindowType = 1 ngridx = 0 ngridy = 0 crecipients = _memberdata = 529 "O" * Creating the cursor with the adress book SELECT CAST(LOWER(GETWORDNUM(Contact, 1, " "))+"@vfp.com" AS C(30)) As email,* From (_samples + '\data\customer') ; Where .T. Into Cursor Test Readwrite ENDIF LOCAL loDummy as Image loDummy = CREATEOBJECT("Image") loDummy.Picture = "images\pr_locate.bmp" CATCH ENDTRY ENDPROC PROCEDURE Init *!* Author : Soykan OZCELIK *!* Description : email adress collector for FoxyPreviewer SendMail Form *!* Usage : Do form GetEmailAdress with "YourCursor","YourSearchField" *!* Important : YourCursor must contain "email" field which is filled contact emails *!* to testing this form first create test cursor with below codes *!* Select "s@s.com" as email,* FROM (_samples + '\data\customer') Where .T. Into Cursor Test readwrite *!* You can create your own cursors to test this form LPARAMETERS tcCursor,tcSearchField IF EMPTY(tcCursor) tcCursor = ALIAS() ENDIF LOCAL llError llError = .F. IF NOT USED(tcCursor) TRY USE (tcCursor) AGAIN IN 0 SHARED ALIAS C_AdressBook * This.lCloseTable = .T. tcCursor = "C_AdressBook" CATCH MESSAGEBOX("Could not load the adress book table!", 48, "Error") llError = .T. ENDTRY ENDIF IF llError RETURN .F. ENDIF IF EMPTY(tcSearchField) tcSearchField = "EMAIL" && "Contact" ENDIF Thisform.UpdateSearchFld(tcSearchField) TEXT TO m.lcSQL TEXTMERGE NOSHOW SELECT .F. AS lSelected, * FROM ; <> WHERE .t. ; INTO CURSOR CrsAdresses READWRITE ENDTEXT EXECSCRIPT(m.lcSQL) GO TOP * Close the table if it was passed as a file IF tcCursor = "C_AdressBook" USE IN SELECT("C_AdressBook") ENDIF Thisform.cSearchField = m.tcSearchField This.Icon= "pr_mail03.ico" * This.Icon= HOME() + "Graphics\Icons\Mail\mail03.ico" CATCH ENDTRY With This.Grid1 as Grid .RecordSource="" .RecordSource="CrsAdresses" .ColumnCount = FCOUNT(.RecordSource) .LockColumns = 1 LOCAL loColumn as Column FOR EACH loColumn IN .Columns WITH loColumn.header1 .FontBold = .T. .FontSize = 9 .Alignment = 3 .ForeColor = RGB(255,0,0) IF EMPTY(loColumn.ControlSource) loColumn.Visible = .F. ENDIF ENDWITH ENDFOR Thisform.Gridsort1.BindControl() With .Column1 LOCAL loHeader as Header loHeader = .header1 WITH loHeader as Header .FontName="wingdings" .Caption = Chr(0xFC) &&"Checkbox" .Alignment = 2 * UNBINDEVENTS(loHeader) &&, "DblClick") BINDEVENT(loHeader, "DblClick", This, "DoSelectAll") BINDEVENT(loHeader, "RightClick", This, "DoUnselectAll") ENDWITH .Alignment = 2 .Width = 20 .AddObject("Check1","CheckBox") .Sparse = .F. .CurrentControl = "Check1" With .Check1 .Alignment = 2 .Caption = "" .Name = "Check1" .Visible = .T. Endwith .RemoveObject("text1") Endwith .AutoFit() This.Grid1.Column1.Alignment = 2 .SetAll("DynamicForeColor", "ICASE(lSelected=.t.,RGB(255,0,0),lSelected=.f.,RGB(0,0,0))" , "Column") .SetAll("DynamicFontBold", "lSelected=.t." , "Column") ENDWITH IF VARTYPE(_goHelper) = "O" This.SetLanguage() ENDIF ENDPROC PROCEDURE Destroy Use In (This.Grid1.RecordSource) If Used("CrsTemp") Use In "CrsTemp" Endif ENDPROC PROCEDURE Unload IF NOT EMPTY(Thisform.cRecipients) RETURN Thisform.cRecipients ENDIF ENDPROC THISFORM RELEASE Click, No Selected e-mails... Safetyv emails EMAIL THISFORM GRID1 RECORDSOURCE LSELECTED EMAILS ACTIVEFORM CAPTION LCRECIPENTLIST CRECIPIENTS RELEASE Click, LNRELCOL LNRELROW LNWHERE GRIDHITTEST THISFORM NGRIDX NGRIDY COLUMNS CHECK1 VALUE REFRESH LNRELCOL LNRELROW LNWHERE GRIDHITTEST THISFORM NGRIDX NGRIDY COLUMNS CHECK1 VALUE6 NBUTTON NSHIFT NXCOORD NYCOORD THISFORM NGRIDX NGRIDY DblClick, Click3 MouseDown: SELECT RECNO() as nrec,* FROM <> ; WHERE LOWER(<>) ; like '%' + '<>' + '%'; INTO CURSOR CrsTemp VALUE LCSEARCHVALUE LCSEARCHFIELD LCALIAS LNSELECT THISFORM GRID1 RECORDSOURCE CSEARCHFIELD LCSEARCHSQL CRSTEMP REFRESH Valid, !Arial, 0, 9, 5, 15, 12, 32, 3, 0 aTop = 0 Left = 7 Width = 24 Height = 21 BackStyle = 0 BorderWidth = 0 Name = "Container1" Form1 Container1 container container Top = -1 Left = 8 Height = 22 Width = 24 Picture = images\pr_locate.bmp Caption = "" TabStop = .F. SpecialEffect = 2 Name = "Command1" Form1 Command1 commandbutton commandbutton .PROCEDURE Click Thisform.Release() ENDPROC Top = 387 Left = 539 Height = 27 Width = 84 Anchor = 12 Cancel = .T. Caption = "Cancel" TabIndex = 5 Name = "cmdCancel" Form1 cmdCancel commandbutton commandbutton (PROCEDURE Click Select email From (Thisform.Grid1.RecordSource); Where Lselected ; And ; Not Empty(email) Into Array emails If _Tally = 0 Messagebox('No Selected e-mails...',16,_Screen.ActiveForm.Caption) Return Endif If Set("Safety")='ON' Set Safety Off Endif Local lcRecipentList lcRecipentList="" For ix=1 To Alen("emails") lcRecipentList = lcRecipentList+Trim(emails[ix])+";" Endfor m.lcRecipentList = Left(m.lcRecipentList,Len(m.lcRecipentList)-1) Thisform.cRecipients = m.lcRecipentList Thisform.Release ENDPROC ngridx ngridy crecipients _memberdata XML Metadata for customizable properties csearchfield clocsearchfld lclosetable *updatesearchfld *doselectall *dounselectall *doselectinvert *setlanguage label label lblSearchFld Form1 AutoSize = .T. BackStyle = 0 Caption = "Search Field : " Height = 17 Left = 37 Top = 3 Width = 80 ForeColor = 255,0,0 Name = "lblSearchFld" textbox textbox TxtSearch Form1 BHeight = 25 Left = 8 Top = 21 Width = 227 Name = "TxtSearch" PROCEDURE Valid IF NOT EMPTY(This.Value) Local lcSearchValue,lcSearchField,lcAlias,lnSelect lcAlias = Thisform.Grid1.RecordSource lcSearchField = Thisform.cSearchField lcSearchValue = Chrtran(Trim(LOWER(This.Value)),"'","%") lnSelect = Select(0) TEXT TO m.lcSearchSQL TEXTMERGE noshow SELECT RECNO() as nrec,* FROM <> ; WHERE LOWER(<>) ; like '%' + '<>' + '%'; INTO CURSOR CrsTemp ENDTEXT *_Cliptext = m.lcSearchSQL Execscript(m.lcSearchSQL) If _Tally # 0 Select (Thisform.Grid1.RecordSource) Go (CrsTemp.nrec) In (Thisform.Grid1.RecordSource) Thisform.Refresh() ENDIF ENDIF ENDPROC kTop = 387 Left = 443 Height = 27 Width = 84 Anchor = 12 Caption = "Ok" TabIndex = 4 Name = "cmdOK" Form1 cmdOK commandbutton commandbutton Top = 396 Left = 12 Height = 17 Width = 36 cgrideval = Thisform.Grid1 csortascendinggraphic = images\pr_sortascending.bmp csortdescendinggraphic = images\pr_sortDescending.bmp Name = "Gridsort1" Form1 Gridsort1 custom pr_rcsgridsort.vcx gridsort Anchor = 15 DeleteMark = .F. Height = 331 Left = 8 RecordMark = .F. Top = 50 Width = 620 GridLineColor = 192,192,192 HighlightBackColor = 159,159,208 HighlightForeColor = 255,255,255 HighlightStyle = 2 AllowCellSelection = .F. Name = "Grid1" Form1 Grid1 lPROCEDURE DblClick Local lnRelCol, lnRelRow, lnWhere Store 0 To lnWhere, lnRelRow, lnRelCol This.GridHitTest(Thisform.ngridx, Thisform.ngridy, @lnWhere, @lnRelRow, @lnRelCol) If lnWhere = 3 && Cell * If lnRelCol = 1 && column 1 This.Columns(1).Check1.Value = Not This.Columns(1).Check1.Value * Endif ENDIF Thisform.Refresh() ENDPROC PROCEDURE Click Local lnRelCol, lnRelRow, lnWhere Store 0 To lnWhere, lnRelRow, lnRelCol This.GridHitTest(Thisform.ngridx, Thisform.ngridy, @lnWhere, @lnRelRow, @lnRelCol) If lnWhere = 3 && Cell If lnRelCol = 1 && column 1 This.Columns(lnRelCol).Check1.Value = Not This.Columns(lnRelCol).Check1.Value Endif Endif ENDPROC PROCEDURE MouseDown Lparameters nButton, nShift, nXCoord, nYCoord * Save mouse position to use in Grid.Click Thisform.ngridx = nXCoord Thisform.ngridy = nYCoord ENDPROC PROCEDURE Init ****************************************************************** * FUNCTION NAME: Init * AUTHOR, DATE: * Paul Mrozowski, 5/7/2007 * PROCEDURE DESCRIPTION: * Get things started. * INPUT PARAMETERS: * None * OUTPUT PARAMETERS: * None ****************************************************************** This.oIndex = CREATEOBJECT("Collection") * This.BindControl() ENDPROC PROCEDURE bindcontrol ****************************************************************** * FUNCTION NAME: Bindcontrol * AUTHOR, DATE: * Paul Mrozowski, 5/7/2007 * PROCEDURE DESCRIPTION: * Bind us to the headers in the grid. * INPUT PARAMETERS: * None * OUTPUT PARAMETERS: * None ****************************************************************** LOCAL loGrid AS Grid, ; loColumn AS Column, ; loControl loGrid = EVALUATE(This.cGridEval) IF TYPE("loGrid") = "O" FOR EACH loColumn IN loGrid.Columns FOR EACH loControl IN loColumn.Controls IF loControl.BaseClass = "Header" BINDEVENT(loControl, "DblClick", This, "Sort") BINDEVENT(loControl, "RightClick", This, "Search") EXIT ENDIF ENDFOR ENDFOR IF PEMSTATUS(loGrid, "SaveSource", 5) IF This.cAutoCleanOn = "S" BINDEVENT(loGrid, "SaveSource", This, "Cleanup") ENDIF IF This.cAutoCleanOn = "R" BINDEVENT(loGrid, "RestoreSource", This, "Cleanup") ENDIF ENDIF ENDIF CATCH MESSAGEBOX("This.cGridEval doesn't evaluate to an object: " + This.cGridEval) ENDTRY ENDPROC PROCEDURE search LOCAL loGrid AS Grid, ; lcRecordSource, ; loEx AS Exception, ; laEvent[1], ; loHeader AS Header, ; loColumn AS Column, ; lcControlSource, ; lcIndexFile, ; luKey, ; lcField lnSelect = SELECT() loGrid = EVALUATE(This.cGridEval) IF TYPE("loGrid") <> "O" EXIT ENDIF IF EMPTY(This.cRecordSource) lcRecordSource = ALLTRIM(loGrid.RecordSource) ELSE lcRecordSource = ALLTRIM(This.cRecordSource) ENDIF IF !EMPTY(lcRecordSource) AEVENTS(laEvent, 0) loHeader = laEvent[1] loColumn = loHeader.Parent lcControlSource = ALLTRIM(loColumn.ControlSource) IF ("." $ lcControlSource) lcField = GETWORDNUM(lcControlSource, 2, ".") ELSE lcField = lcControlSource ENDIF * MESSAGEBOX(lcField) Thisform.UpdateSearchFld(lcField) ENDIF CATCH TO loEx SET STEP ON MESSAGEBOX("Error sorting: " + loEx.Message, 48, "Error") FINALLY SELECT (lnSelect) ENDTRY RETURN IF !EMPTY(lcControlSource) IF ("." $ lcControlSource) lcFieldType = VARTYPE(EVALUATE(lcControlSource)) ELSE lcFieldType = VARTYPE(EVALUATE(lcRecordSource + "." + lcControlSource)) ENDIF lcIndexFile = FORCEEXT(ADDBS(SYS(2023)) + "_" + SYS(3), "IDX") DO CASE CASE lcFieldType = "T" lcIndexExpr = "INDEX ON TTOC(" + lcControlSource + ", 3) TO " + lcIndexFile + " ADDITIVE" CASE lcFieldType = "D" lcIndexExpr = "INDEX ON DTOS(" + lcControlSource + ") TO " + lcIndexFile + " ADDITIVE" CASE INLIST(lcFieldType, "N", "Y") lcIndexExpr = "INDEX ON " + lcControlSource + " TO " + lcIndexFile + " ADDITIVE" CASE lcFieldType = "C" lcIndexExpr = "INDEX ON ALLTRIM(UPPER(" + lcControlSource + ")) TO " + lcIndexFile + " ADDITIVE" CASE lcFieldType = "L" lcIndexExpr = "INDEX ON " + lcControlSource + " TO " + lcIndexFile + " ADDITIVE" OTHERWISE EXIT ENDCASE lcNewIndexExpr = This.IndexExpressionHook(lcIndexExpr, lcControlSource) IF VARTYPE(lcNewIndexExpr) = "C" AND !EMPTY(lcNewIndexExpr) lcIndexExpr = lcNewIndexExpr ENDIF luKey = This.oIndex.GetKey(lcControlSource) * Remove any existing header pictures, then add it to the current column loGrid.SetAll("Picture", "") SELECT (lcRecordSource) IF VARTYPE(luKey) = "N" AND luKey = 0 * Index doesn't exist yet This.oIndex.Add(lcIndexFile, lcControlSource) &lcIndexExpr loHeader.Picture = This.cSortAscendingGraphic ELSE lcIndexFile = JUSTSTEM(This.oIndex[luKey]) IF DESCENDING() SET ORDER TO &lcIndexFile ASCENDING loHeader.Picture = This.cSortAscendingGraphic ELSE SET ORDER TO &lcIndexFile DESCENDING loHeader.Picture = This.cSortDescendingGraphic ENDIF ENDIF LOCATE loGrid.Refresh() ENDIF IF lnBuffering > 3 CURSORSETPROP("Buffering", lnBuffering, lcRecordSource) ENDIF ENDPROC Collection OINDEX COLUMN loGridb Header DblClick RightClick Search SaveSource SaveSource Cleanup RestoreSource Cleanup This.cGridEval doesn't evaluate to an object: LOGRID LOCOLUMN LOCONTROL THIS CGRIDEVAL COLUMNS CONTROLS BASECLASS CAUTOCLEANON EXCEPTION HEADER COLUMN loGridb Error sorting: Error INDEX ON TTOC( , 3) TO ADDITIVE INDEX ON DTOS( ) TO ADDITIVE INDEX ON ADDITIVE INDEX ON ALLTRIM(UPPER( )) TO ADDITIVE INDEX ON ADDITIVE Picture &lcIndexExpr SET ORDER TO &lcIndexFile ASCENDING SET ORDER TO &lcIndexFile DESCENDING Buffering LOGRID LCRECORDSOURCE LAEVENT LOHEADER LOCOLUMN LCCONTROLSOURCE LCINDEXFILE LUKEY LCFIELD LNSELECT THIS CGRIDEVAL CRECORDSOURCE RECORDSOURCE PARENT CONTROLSOURCE THISFORM UPDATESEARCHFLD MESSAGE LCFIELDTYPE LCINDEXEXPR LCNEWINDEXEXPR INDEXEXPRESSIONHOOK OINDEX GETKEY SETALL PICTURE CSORTASCENDINGGRAPHIC CSORTDESCENDINGGRAPHIC REFRESH LNBUFFERING Init, bindcontrol^ search TCFIELD THISFORM CSEARCHFIELD LBLSEARCHFLD CAPTION CLOCSEARCHFLDS LNREC THISFORM GRID1 RECORDSOURCE LSELECTED REFRESHP LNREC THISFORM GRID1 RECORDSOURCE LSELECTED REFRESH EXCEPTION SEARCHFLD GOTOPG_OK CANCEL SELECTRECI LOEXC THIS LCCAPTION _GOHELPER GETLOC LBLSEARCHFLD CAPTION CLOCSEARCHFLD CMDOK CMDCANCEL \data\customer @vfp.com IMAGE Image images\pr_locate.bmp _GOHELPER CONTACT EMAIL LODUMMY PICTURE C_AdressBook Could not load the adress book table! Error EMAIL SELECT .F. AS lSelected, * FROM ; <> WHERE .t. ; INTO CURSOR CrsAdresses READWRITE C_AdressBook C_AdressBookW pr_mail03.ico CrsAdresses COLUMN HEADER HEADER wingdings DblClick DoSelectAll RightClick DoUnselectAll Check1 CheckBox Check1 Check1 text1 DynamicForeColor ICASE(lSelected=.t.,RGB(255,0,0),lSelected=.f.,RGB(0,0,0)) Column DynamicFontBold lSelected=.t. Column TCCURSOR TCSEARCHFIELD LLERROR C_ADRESSBOOK THISFORM UPDATESEARCHFLD LCSQL CSEARCHFIELD GRID1 RECORDSOURCE COLUMNCOUNT LOCKCOLUMNS LOCOLUMN COLUMNS HEADER1 FONTBOLD FONTSIZE ALIGNMENT FORECOLOR CONTROLSOURCE VISIBLE GRIDSORT1 BINDCONTROL COLUMN1 LOHEADER FONTNAME CAPTION WIDTH ADDOBJECT SPARSE CURRENTCONTROL CHECK1 REMOVEOBJECT AUTOFIT SETALL _GOHELPER SETLANGUAGE? CrsTemp CrsTemp GRID1 RECORDSOURCE& THISFORM CRECIPIENTS updatesearchfld, doselectall dounselectallD setlanguage Load Init4 Destroy Unload wwwwwwwwwwww wwwwwwp PLATFORM UNIQUEID TIMESTAMP CLASS CLASSLOC BASECLASS OBJNAME PARENT PROPERTIES PROTECTED METHODS OBJCODE RESERVED1 RESERVED2 RESERVED3 RESERVED4 RESERVED5 RESERVED6 RESERVED7 RESERVED8 COMMENT Class WINDOWS _22W0OBY4H1045105419L COMMENT RESERVED VERSION = 3.00 gridsort Pixels Class custom gridsort cgrideval Eval'd to retrieve reference to the grid. _memberdata XML Metadata for customizable properties crecordsource Leave empty to read the record source from the grid, fill in to override. oindex cautocleanon Used when grid has SaveSource/RestoreSource methods. Set to "S" to remove temporary indexes when saving the source. Set to "R" to remove when restoring the source. csortascendinggraphic csortdescendinggraphic *sort *bindcontrol *indexexpressionhook *cleanup *search EXCEPTION HEADER COLUMN loGridb Buffering Buffering INDEX ON TTOC( , 3) TO ADDITIVE INDEX ON DTOS( ) TO ADDITIVE INDEX ON ADDITIVE INDEX ON ALLTRIM(UPPER( )) TO ADDITIVE INDEX ON ADDITIVE Picture &lcIndexExpr SET ORDER TO &lcIndexFile ASCENDING SET ORDER TO &lcIndexFile DESCENDING Buffering Error sorting: Error LOGRID LCRECORDSOURCE LNBUFFERING LAEVENT LOHEADER LOCOLUMN LCFIELDTYPE LCINDEXEXPR LCCONTROLSOURCE LCINDEXFILE LUKEY LNSELECT LCNEWINDEXEXPR THIS CGRIDEVAL CRECORDSOURCE RECORDSOURCE PARENT CONTROLSOURCE INDEXEXPRESSIONHOOK OINDEX GETKEY SETALL PICTURE CSORTASCENDINGGRAPHIC CSORTDESCENDINGGRAPHIC REFRESH MESSAGE COLUMN loGridb Header DblClick Click Search SaveSource SaveSource Cleanup RestoreSource Cleanup This.cGridEval doesn't evaluate to an object: LOGRID LOCOLUMN LOCONTROL THIS CGRIDEVAL COLUMNS CONTROLS BASECLASS CAUTOCLEANON TCINDEXEXPR TCCONTROLSOURCE1 loGridb Picture Header Buffering Buffering Safetyv Buffering SET SAFETY &lcSafety Collection LNSELECT LCRECORDSOURCE LCSAFETY LCINDEX LNBUFFERING LOGRID THIS CGRIDEVAL SETALL CRECORDSOURCE RECORDSOURCE OINDEX EXCEPTION HEADER COLUMN loGridb Buffering Buffering INDEX ON TTOC( , 3) TO ADDITIVE INDEX ON DTOS( ) TO ADDITIVE INDEX ON ADDITIVE INDEX ON ALLTRIM(UPPER( )) TO ADDITIVE INDEX ON ADDITIVE Picture &lcIndexExpr SET ORDER TO &lcIndexFile ASCENDING SET ORDER TO &lcIndexFile DESCENDING Buffering Error sorting: Error LOGRID LCRECORDSOURCE LNBUFFERING LAEVENT LOHEADER LOCOLUMN LCFIELDTYPE LCINDEXEXPR LCCONTROLSOURCE LCINDEXFILE LUKEY LNSELECT LCNEWINDEXEXPR THIS CGRIDEVAL CRECORDSOURCE RECORDSOURCE PARENT CONTROLSOURCE INDEXEXPRESSIONHOOK OINDEX GETKEY SETALL PICTURE CSORTASCENDINGGRAPHIC CSORTDESCENDINGGRAPHIC REFRESH MESSAGE- Collection OINDEX BINDCONTROL CLEANUP OINDEX sort, bindcontrolv indexexpressionhook cleanup search Destroy2 PROCEDURE sort ****************************************************************** * FUNCTION NAME: Sort * AUTHOR, DATE: * Paul Mrozowski, 5/7/2007 * PROCEDURE DESCRIPTION: * Handle sorting the grid. * INPUT PARAMETERS: * None * OUTPUT PARAMETERS: * None ****************************************************************** LOCAL loGrid AS Grid, ; lcRecordSource, ; lnBuffering, ; loEx AS Exception, ; laEvent[1], ; loHeader AS Header, ; loColumn AS Column, ; lcFieldType, ; lcIndexExpr, ; lcControlSource, ; lcIndexFile, ; luKey, ; lnSelect, ; lcNewIndexExpr lnSelect = SELECT() loGrid = EVALUATE(This.cGridEval) IF TYPE("loGrid") <> "O" EXIT ENDIF IF EMPTY(This.cRecordSource) lcRecordSource = ALLTRIM(loGrid.RecordSource) ELSE lcRecordSource = ALLTRIM(This.cRecordSource) ENDIF IF !EMPTY(lcRecordSource) * You can't index table-buffered cursors lnBuffering = CURSORGETPROP("Buffering", lcRecordSource) IF lnBuffering > 3 CURSORSETPROP("Buffering", 3, lcRecordSource) ENDIF AEVENTS(laEvent, 0) loHeader = laEvent[1] loColumn = loHeader.Parent lcControlSource = ALLTRIM(loColumn.ControlSource) IF !EMPTY(lcControlSource) IF ("." $ lcControlSource) lcFieldType = VARTYPE(EVALUATE(lcControlSource)) ELSE lcFieldType = VARTYPE(EVALUATE(lcRecordSource + "." + lcControlSource)) ENDIF lcIndexFile = FORCEEXT(ADDBS(SYS(2023)) + "_" + SYS(3), "IDX") DO CASE CASE lcFieldType = "T" lcIndexExpr = "INDEX ON TTOC(" + lcControlSource + ", 3) TO " + lcIndexFile + " ADDITIVE" CASE lcFieldType = "D" lcIndexExpr = "INDEX ON DTOS(" + lcControlSource + ") TO " + lcIndexFile + " ADDITIVE" CASE INLIST(lcFieldType, "N", "Y") lcIndexExpr = "INDEX ON " + lcControlSource + " TO " + lcIndexFile + " ADDITIVE" CASE lcFieldType = "C" lcIndexExpr = "INDEX ON ALLTRIM(UPPER(" + lcControlSource + ")) TO " + lcIndexFile + " ADDITIVE" CASE lcFieldType = "L" lcIndexExpr = "INDEX ON " + lcControlSource + " TO " + lcIndexFile + " ADDITIVE" OTHERWISE EXIT ENDCASE lcNewIndexExpr = This.IndexExpressionHook(lcIndexExpr, lcControlSource) IF VARTYPE(lcNewIndexExpr) = "C" AND !EMPTY(lcNewIndexExpr) lcIndexExpr = lcNewIndexExpr ENDIF luKey = This.oIndex.GetKey(lcControlSource) * Remove any existing header pictures, then add it to the current column loGrid.SetAll("Picture", "") SELECT (lcRecordSource) IF VARTYPE(luKey) = "N" AND luKey = 0 * Index doesn't exist yet This.oIndex.Add(lcIndexFile, lcControlSource) &lcIndexExpr loHeader.Picture = This.cSortAscendingGraphic ELSE lcIndexFile = JUSTSTEM(This.oIndex[luKey]) IF DESCENDING() SET ORDER TO &lcIndexFile ASCENDING loHeader.Picture = This.cSortAscendingGraphic ELSE SET ORDER TO &lcIndexFile DESCENDING loHeader.Picture = This.cSortDescendingGraphic ENDIF ENDIF LOCATE loGrid.Refresh() ENDIF IF lnBuffering > 3 CURSORSETPROP("Buffering", lnBuffering, lcRecordSource) ENDIF ENDIF CATCH TO loEx SET STEP ON MESSAGEBOX("Error sorting: " + loEx.Message, 48, "Error") FINALLY SELECT (lnSelect) ENDTRY ENDPROC PROCEDURE bindcontrol ****************************************************************** * FUNCTION NAME: Bindcontrol * AUTHOR, DATE: * Paul Mrozowski, 5/7/2007 * PROCEDURE DESCRIPTION: * Bind us to the headers in the grid. * INPUT PARAMETERS: * None * OUTPUT PARAMETERS: * None ****************************************************************** LOCAL loGrid AS Grid, ; loColumn AS Column, ; loControl loGrid = EVALUATE(This.cGridEval) IF TYPE("loGrid") = "O" FOR EACH loColumn IN loGrid.Columns FOR EACH loControl IN loColumn.Controls IF loControl.BaseClass = "Header" BINDEVENT(loControl, "DblClick", This, "Sort") BINDEVENT(loControl, "Click", This, "Search") EXIT ENDIF ENDFOR ENDFOR IF PEMSTATUS(loGrid, "SaveSource", 5) IF This.cAutoCleanOn = "S" BINDEVENT(loGrid, "SaveSource", This, "Cleanup") ENDIF IF This.cAutoCleanOn = "R" BINDEVENT(loGrid, "RestoreSource", This, "Cleanup") ENDIF ENDIF ENDIF CATCH MESSAGEBOX("This.cGridEval doesn't evaluate to an object: " + This.cGridEval) ENDTRY ENDPROC PROCEDURE indexexpressionhook LPARAMETERS tcIndexExpr, tcControlSource ****************************************************************** * FUNCTION NAME: IndexExpressionHook * AUTHOR, DATE: * Paul Mrozowski, 5/7/2007 * PROCEDURE DESCRIPTION: * Hook point to change how indexes are created or do things * like create an index on multiple fields when they click * on a particular header item. * INPUT PARAMETERS: * tcIndexExpr - Index expression * tcControlSource - Control source * OUTPUT PARAMETERS: * None ****************************************************************** * RETURN tcIndexExpr + ",SomeOtherField" ENDPROC PROCEDURE cleanup ****************************************************************** * FUNCTION NAME: Cleanup * AUTHOR, DATE: * Paul Mrozowski, 5/7/2007 * PROCEDURE DESCRIPTION: * Clean-un and remove any temp indexes. * INPUT PARAMETERS: * None * OUTPUT PARAMETERS: * None ****************************************************************** LOCAL lnSelect, ; lcRecordSource, ; lcSafety, ; lcIndex, ; lnBuffering, ; loEx, ; loGrid AS Grid lnBuffering = 0 lnSelect = SELECT() TRY loGrid = EVALUATE(This.cGridEval) IF TYPE("loGrid") <> "O" EXIT ENDIF loGrid.SetAll("Picture", "", "Header") IF EMPTY(This.cRecordSource) lcRecordSource = ALLTRIM(loGrid.RecordSource) ELSE lcRecordSource = ALLTRIM(This.cRecordSource) ENDIF SELECT (lcRecordSource) lnBuffering = CURSORGETPROP("Buffering", lcRecordSource) IF lnBuffering > 3 CURSORSETPROP("Buffering", 3, lcRecordSource) ENDIF SET INDEX TO CATCH TO loEx * The table/cursor may have already been closed ENDTRY lcSafety = SET("Safety") SET SAFETY OFF FOR EACH lcIndex IN This.oIndex TRY ERASE (lcIndex) CATCH ENDTRY ENDFOR IF VARTYPE(loEx) <> "O" AND lnBuffering > 3 CURSORSETPROP("Buffering", lnBuffering, lcRecordSource) ENDIF SET SAFETY &lcSafety SELECT (lnSelect) CATCH ENDTRY This.oIndex = CREATEOBJECT("Collection") ENDPROC PROCEDURE search LOCAL loGrid AS Grid, ; lcRecordSource, ; lnBuffering, ; loEx AS Exception, ; laEvent[1], ; loHeader AS Header, ; loColumn AS Column, ; lcFieldType, ; lcIndexExpr, ; lcControlSource, ; lcIndexFile, ; luKey, ; lnSelect, ; lcNewIndexExpr lnSelect = SELECT() loGrid = EVALUATE(This.cGridEval) IF TYPE("loGrid") <> "O" EXIT ENDIF IF EMPTY(This.cRecordSource) lcRecordSource = ALLTRIM(loGrid.RecordSource) ELSE lcRecordSource = ALLTRIM(This.cRecordSource) ENDIF IF !EMPTY(lcRecordSource) * You can't index table-buffered cursors lnBuffering = CURSORGETPROP("Buffering", lcRecordSource) IF lnBuffering > 3 CURSORSETPROP("Buffering", 3, lcRecordSource) ENDIF AEVENTS(laEvent, 0) loHeader = laEvent[1] loColumn = loHeader.Parent lcControlSource = ALLTRIM(loColumn.ControlSource) IF !EMPTY(lcControlSource) IF ("." $ lcControlSource) lcFieldType = VARTYPE(EVALUATE(lcControlSource)) ELSE lcFieldType = VARTYPE(EVALUATE(lcRecordSource + "." + lcControlSource)) ENDIF lcIndexFile = FORCEEXT(ADDBS(SYS(2023)) + "_" + SYS(3), "IDX") DO CASE CASE lcFieldType = "T" lcIndexExpr = "INDEX ON TTOC(" + lcControlSource + ", 3) TO " + lcIndexFile + " ADDITIVE" CASE lcFieldType = "D" lcIndexExpr = "INDEX ON DTOS(" + lcControlSource + ") TO " + lcIndexFile + " ADDITIVE" CASE INLIST(lcFieldType, "N", "Y") lcIndexExpr = "INDEX ON " + lcControlSource + " TO " + lcIndexFile + " ADDITIVE" CASE lcFieldType = "C" lcIndexExpr = "INDEX ON ALLTRIM(UPPER(" + lcControlSource + ")) TO " + lcIndexFile + " ADDITIVE" CASE lcFieldType = "L" lcIndexExpr = "INDEX ON " + lcControlSource + " TO " + lcIndexFile + " ADDITIVE" OTHERWISE EXIT ENDCASE lcNewIndexExpr = This.IndexExpressionHook(lcIndexExpr, lcControlSource) IF VARTYPE(lcNewIndexExpr) = "C" AND !EMPTY(lcNewIndexExpr) lcIndexExpr = lcNewIndexExpr ENDIF luKey = This.oIndex.GetKey(lcControlSource) * Remove any existing header pictures, then add it to the current column loGrid.SetAll("Picture", "") SELECT (lcRecordSource) IF VARTYPE(luKey) = "N" AND luKey = 0 * Index doesn't exist yet This.oIndex.Add(lcIndexFile, lcControlSource) &lcIndexExpr loHeader.Picture = This.cSortAscendingGraphic ELSE lcIndexFile = JUSTSTEM(This.oIndex[luKey]) IF DESCENDING() SET ORDER TO &lcIndexFile ASCENDING loHeader.Picture = This.cSortAscendingGraphic ELSE SET ORDER TO &lcIndexFile DESCENDING loHeader.Picture = This.cSortDescendingGraphic ENDIF ENDIF LOCATE loGrid.Refresh() ENDIF IF lnBuffering > 3 CURSORSETPROP("Buffering", lnBuffering, lcRecordSource) ENDIF ENDIF CATCH TO loEx SET STEP ON MESSAGEBOX("Error sorting: " + loEx.Message, 48, "Error") FINALLY SELECT (lnSelect) ENDTRY ENDPROC PROCEDURE Init ****************************************************************** * FUNCTION NAME: Init * AUTHOR, DATE: * Paul Mrozowski, 5/7/2007 * PROCEDURE DESCRIPTION: * Get things started. * INPUT PARAMETERS: * None * OUTPUT PARAMETERS: * None ****************************************************************** This.oIndex = CREATEOBJECT("Collection") This.BindControl() ENDPROC PROCEDURE Destroy ****************************************************************** * FUNCTION NAME: Destroy * AUTHOR, DATE: * Paul Mrozowski, 5/7/2007 * PROCEDURE DESCRIPTION: * Clean up. * INPUT PARAMETERS: * None * OUTPUT PARAMETERS: * None ****************************************************************** This.Cleanup() This.oIndex = NULL ENDPROC cgrideval = _memberdata = 954 crecordsource = oindex = .NULL. cautocleanon = S csortascendinggraphic = pr_SortAscending.bmp csortdescendinggraphic = pr_SortDescending.bmp Name = "gridsort" customBMx PLATFORM UNIQUEID TIMESTAMP CLASS CLASSLOC BASECLASS OBJNAME PARENT PROPERTIES PROTECTED METHODS OBJCODE RESERVED1 RESERVED2 RESERVED3 RESERVED4 RESERVED5 RESERVED6 RESERVED7 RESERVED8 COMMENT Class WINDOWS _39L029YY01087745590 COMMENT RESERVED VERSION = 3.00 reportlisteners.h> foxpro_reporting.hF reportlisteners_locs.hN pr_htmllistener2 reportlisteners.h Pixels Class custom pr_htmllistener2 _memberdata XML Metadata for customizable properties noutfile npagewidth npageheight nscreendpi ldebug ctargetfilename oactivelistener ldefaultmode nimgcounter _ctempfolder oimages cexternalfilelocation lcopyimagefilestoexternalfilelocation quietmode Specifies whether the ReportListener may provide any user feedback or interface. waitfornextreport *outputfromdata *render Occurs when Report Engine is ready to provide output for each layout object in a band. *beforereport Occurs just before Report Engine begins processing a report form. *afterreport Occurs directly after Report Engine finishes processing a report form. *getbandname *getfontstyle *rgbtohex *afterband Occurs directly after Report Engine finishes processing a report band. *beforeband Occurs just before Report Engine begins processing a report band. *getcontinuationtype *getpageimg *getpicturefromlistener *processimages *processtext *processlines *processshapes *getlinescnt *cropimage ^apagesimgs[1,0] Invalid parameter. Report listener not available Error The helper FRX table is not available. Output can't be created Error Datasessionv % - 100% - CCC TOLISTENER TCOUTPUTDBF TNWIDTH TNHEIGHT OACTIVELISTENER CFRXALIAS QUIETMODE LNSECS DOFOXYTHERM _GOHELPER _INITSTATUSTEXT LNSELECT LNORIGDATASESSION LISTENERDATASESSION LDEFAULTMODE NPAGEHEIGHT NSCREENDPI NPAGEWIDTH NOUTFILE CTARGETFILENAME CHTML LNPGFROM LNPGTO _CLAUSENRANGEFROM _CLAUSENRANGETO RENDER FRXRECNO WIDTH HEIGHT CONTTYPE UNCONTENTS LNPERCENT LNLASTPERCENT LNDELAY LNTOTRECS LNREC _SECONDSTEXT _RUNSTATUSTEXT AFTERREPORT4 ] FPUTS(THIS.nOutFile, lcDebugInfo) ENDIF #Define OBJ_COMMENT 0 #Define OBJ_LABEL 5 #Define OBJ_LINE 6 #Define OBJ_RECTANGLE 7 #Define OBJ_FIELD 8 #Define OBJ_PICTURE 17 #Define OBJ_VARIABLE 18 LOCAL lnAdjust lnAdjust = 1.10 * dpi2pix nLeft = CEILING(CEILING(THIS.nScreenDPI * nLeft / 960) * lnAdjust) nTop = ROUND(THIS.nScreenDPI * nTop / 960, 0) nWidth = CEILING(CEILING(THIS.nScreenDPI * nWidth / 960) * lnAdjust) nHeight = CEILING(THIS.nScreenDPI * nHeight / 960) IF PAGE > 1 nTop = THIS.nPageHeight * (PAGE - This.oActiveListener.CommandClauses.RangeFrom) + nTop && Original -1 ENDIF DO CASE CASE ObjType = OBJ_LINE lcHTML = This.ProcessLines(nLeft, nTop, nWidth, nHeight) CASE ObjType = OBJ_RECTANGLE lcHTML = This.ProcessShapes(nLeft, nTop, nWidth, nHeight, nObjectContinuationType) *!* 2011-08-17 - Jacques Parent *!* Added nObjectContinuationType parameter CASE INLIST(ObjType, OBJ_LABEL, OBJ_FIELD) lcHTML = This.ProcessText(nLeft, nTop, nWidth, nHeight, cContentsToBeRendered) CASE ObjType = OBJ_PICTURE lcHTML = This.ProcessImages(nLeft, nTop, nWidth, nHeight, cContentsToBeRendered) OTHERWISE RETURN ENDCASE IF VARTYPE(lcHTML) <> "C" RETURN ENDIF IF NOT EMPTY(lcHTML) =FPUTS(THIS.nOutFile, lcHtml) ENDIF ENDPROC PROCEDURE afterreport *!* * Determine the ".WaitForNextReport" status if using "lObjTypeMode" *!* IF This.lObjTypeMode *!* TRY *!* This.WaitForNextReport = This.CommandClauses.NoPageEject *!* CATCH *!* ENDTRY *!* ENDIF *!* IF NOT This.WaitForNextReport FPUTS(THIS.nOutFile, []) LOCAL llSaved llSaved = FCLOSE(THIS.nOutFile) * Delete the pages image files LOCAL n, lcFile FOR m.n = 1 TO ALEN(This.aPagesImgs,1) lcFile = This.aPagesImgs(m.n) IF NOT EMPTY(lcFile) TRY DELETE FILE (lcFile) CATCH ENDTRY ENDIF ENDFOR This.oActiveListener = "" *!* ENDIF ENDPROC PROCEDURE getbandname LPARAMETERS nBandObjCode DO CASE CASE nBandObjCode = FRX_OBJCOD_TITLE RETURN 'FRX_OBJCOD_TITLE' CASE nBandObjCode = FRX_OBJCOD_PAGEHEADER RETURN 'FRX_OBJCOD_PAGEHEADER' CASE nBandObjCode = FRX_OBJCOD_COLHEADER RETURN 'FRX_OBJCOD_COLHEADER' CASE nBandObjCode = FRX_OBJCOD_GROUPHEADER RETURN 'FRX_OBJCOD_GROUPHEADER' CASE nBandObjCode = FRX_OBJCOD_DETAIL RETURN 'FRX_OBJCOD_DETAIL' CASE nBandObjCode = FRX_OBJCOD_GROUPFOOTER RETURN 'FRX_OBJCOD_GROUPFOOTER' CASE nBandObjCode = FRX_OBJCOD_COLFOOTER RETURN 'FRX_OBJCOD_COLFOOTER' CASE nBandObjCode = FRX_OBJCOD_PAGEFOOTER RETURN 'FRX_OBJCOD_PAGEFOOTER' CASE nBandObjCode = FRX_OBJCOD_SUMMARY RETURN 'FRX_OBJCOD_SUMMARY' CASE nBandObjCode = FRX_OBJCOD_DETAILHEADER RETURN 'FRX_OBJCOD_DETAILHEADER' CASE nBandObjCode = FRX_OBJCOD_DETAILFOOTER RETURN 'FRX_OBJCOD_DETAILFOOTER' OTHERWISE RETURN '' ENDCASE ENDPROC PROCEDURE getfontstyle LPARAMETERS nFontStyle LOCAL cStyle cStyle = '' * extended styles IF nFontStyle = FRX_FONTSTYLE_UNDERLINED cStyle = 'U' nFontStyle = nFontStyle - FRX_FONTSTYLE_UNDERLINED ENDIF IF nFontStyle = FRX_FONTSTYLE_STRIKETHROUGH cStyle = cStyle + 'S' nFontStyle = nFontStyle - FRX_FONTSTYLE_STRIKETHROUGH ENDIF * standart styles DO CASE CASE nFontStyle = FRX_FONTSTYLE_NORMAL cStyle = cStyle + 'N' CASE nFontStyle = FRX_FONTSTYLE_BOLD cStyle = cStyle + 'B' CASE nFontStyle = FRX_FONTSTYLE_ITALIC cStyle = cStyle + 'I' CASE nFontStyle = FRX_FONTSTYLE_BOLD + FRX_FONTSTYLE_ITALIC cStyle = cStyle + 'BI' ENDCASE RETURN cStyle ENDPROC PROCEDURE rgbtohex LPARAMETERS nReg, nGreen, nBlue RETURN [#] + RIGHT(TRANSFORM(MAX(nReg, 0), [@0]), 2) + ; RIGHT(TRANSFORM(MAX(nGreen, 0), [@0]), 2) + RIGHT(TRANSFORM(MAX(nBlue, 0), [@0]), 2) ENDPROC PROCEDURE afterband LPARAMETERS nBandObjCode, nFRXRecno LOCAL cBand SET DATASESSION TO THIS.FRXDATASESSION GO nFRXRecno IN frx cBand = THIS.GetBandName(nBandObjCode) IF THIS.lDebug FPUTS(THIS.nOutFile, '') ENDIF IF ATC('pagefooter', cBand) > 0 * fputs(This.nOutFile, '
') ENDIF SET DATASESSION TO THIS.CURRENTDATASESSION ENDPROC PROCEDURE beforeband LPARAMETERS nBandObjCode, nFRXRecno SET DATASESSION TO THIS.FRXDATASESSION GO nFRXRecno IN frx IF THIS.lDebug FPUTS(THIS.nOutFile, '') ENDIF SET DATASESSION TO THIS.CURRENTDATASESSION ENDPROC PROCEDURE getcontinuationtype LPARAMETERS nObjectContinuationType DO CASE CASE nObjectContinuationType = LISTENER_CONTINUATION_NONE RETURN 'LISTENER_CONTINUATION_NONE' CASE nObjectContinuationType = LISTENER_CONTINUATION_START RETURN 'LISTENER_CONTINUATION_START' CASE nObjectContinuationType = LISTENER_CONTINUATION_MIDDLE RETURN 'LISTENER_CONTINUATION_MIDDLE' CASE nObjectContinuationType = LISTENER_CONTINUATION_END RETURN 'LISTENER_CONTINUATION_END' OTHERWISE RETURN '' ENDCASE ENDPROC PROCEDURE getpageimg #DEFINE OutputJPEG 102 #DEFINE OutputPNG 104 LOCAL loListener as ReportListener * loListener = IIF(VARTYPE(This.oActiveListener)="O", This.oActiveListener, This) loListener = This.oActiveListener LOCAL lnPage lnPage = PAGE - loListener.CommandClauses.RangeFrom + 1 DIMENSION This.aPagesImgs(lnPage) IF EMPTY(This.aPagesImgs(lnPage)) LOCAL lnDeviceType, lcFile, lnDeviceType, lnHandle lnDeviceType = OutputJpeg && OutputPNG lcFile = ADDBS(GETENV("TEMP")) + SYS(2015) + ".JPG" && ".PNG" loListener.OutputPage(lnPage, lcFile, lnDeviceType) This.aPagesImgs(lnPage) = lcFile ENDIF RETURN This.aPagesImgs(lnPage) ENDPROC PROCEDURE getpicturefromlistener * 2011/02/25 CChalom * When we can't access the image from the EXE or from a General field, we still can get * an image of the object, and draw it to the PDF document LPARAMETERS tnX, tnY, tnWidth, tnHeight, tcFile LOCAL lcFile lcFile = This.GetPageImg() IF EMPTY(lcFile) RETURN .F. && Could not load image ENDIF * Horizontal and Vertical factors to divide to convert to the correct coordinate LOCAL lnHor, lnVert lnHor = 9.972 lnVert = 9.996 lcNewFile = This.CropImage(lcFile, tnX / lnHor, tnY / lnVert, tnWidth / lnHor, tnHeight / lnVert, tcFile) RETURN lcNewFile ENDPROC PROCEDURE processimages LPARAMETERS tnLeft, tnTop, tnWidth, tnHeight, cContentsToBeRendered * TODO: * Manage new possibilities for storing images, using the new properties: * cExternalFileLocation = ".\images" * lCopyImageFilesToExternalFileLocation = .T. * Create Images directory LOCAL lcFile, lcPath, lcShortPath, lcImageCopy, lcPathLocation lcFile = This.cTargetFileName IF EMPTY(This.cExternalFileLocation) lcPathLocation = JUSTSTEM(lcFile) + "_IMAGES" ELSE lcPathLocation = This.cExternalFileLocation ENDIF lcPath = ADDBS(JUSTPATH(lcFile)) + lcPathLocation lcShortPath = lcPathLocation + "\" + JUSTFNAME(cContentsToBeRendered) IF NOT DIRECTORY(lcPath) MKDIR (lcPath) ENDIF DO CASE CASE EMPTY(cContentsToBeRendered) && General field This.nImgCounter = This.nImgCounter + 1 lcImageCopy = ADDBS(lcPath) + "_" + TRANSFORM(This.nImgCounter) + ".jpg" This.GetPictureFromListener(This.nX0, This.nY0, This.nW0, This.nH0, lcImageCopy) lcShortPath = JUSTSTEM(lcFile) + "_IMAGES" + "\" + "_" + TRANSFORM(This.nImgCounter) + ".jpg" CASE NOT EMPTY(SYS(2000, cContentsToBeRendered)) && File is accessible in the disk lcImageCopy = ADDBS(lcPath) + JUSTFNAME(cContentsToBeRendered) IF PR_PathFileExists(lcImageCopy + CHR(0)) = 0 && PR_PathFileExists function in FoxyPreviewer.app * IF NOT FILE(lcImageCopy) COPY FILE (cContentsToBeRendered) TO (lcImageCopy) ENDIF CASE EMPTY(SYS(2000, cContentsToBeRendered)) && Image embedded in EXE lcImageCopy = ADDBS(lcPath) + JUSTFNAME(cContentsToBeRendered) This.GetPictureFromListener(This.nX0, This.nY0, This.nW0, This.nH0, lcImageCopy) IF PR_PathFileExists(lcImageCopy + CHR(0)) = 0 && PR_PathFileExists function in FoxyPreviewer.app * IF NOT FILE(lcImageCopy) COPY FILE (cContentsToBeRendered) TO (lcImageCopy) ENDIF OTHERWISE RETURN "" ENDCASE * If we could not generate the image copy, leave IF PR_PathFileExists(lcImageCopy + CHR(0)) = 0 && PR_PathFileExists function in FoxyPreviewer.app RETURN "" ENDIF LOCAL lcHTML, lcImgHTML DO CASE CASE General = 0 && Clip * Get the picture size LOCAL lnWidth, lnHeight, lnPictWidth, lnPictHeight, lcHTML LOCAL loVFPImg as Image loVFPImg = CREATEOBJECT("Image") loVFPImg.Picture = lcImageCopy lnWidth = loVFPImg.Width lnHeight = loVFPImg.Height loVFPImg = NULL CLEAR RESOURCES (lcImageCopy) lcImgHTML = [] lcHTML = ; [] + ; lcImgHTML + ; [] *!* img { position: absolute; *!* clip: rect(0 100px 200px 0); *!* /* clip: shape(top right bottom left); NB 'rect' is the only available option */} * CASE General = 1 && Isometric * Calculating the image size for isometric images * Get the picture size LOCAL lnWidth, lnHeight, lnPictWidth, lnPictHeight, lcHTML LOCAL loVFPImg as Image loVFPImg = CREATEOBJECT("Image") loVFPImg.Picture = lcImageCopy lnPictWidth = loVFPImg.Width lnPictHeight = loVFPImg.Height loVFPImg = NULL CLEAR RESOURCES (lcImageCopy) * Isometric Adjustment LOCAL lnHorFactor, lnVertFactor, lnResizeFactor, lnIsoWidth, lnIsoHeight m.lnHorFactor = m.tnWidth / m.lnPictWidth m.lnVertFactor = m.tnHeight / m.lnPictHeight m.lnResizeFactor = MIN(m.lnHorFactor, m.lnVertFactor) m.lnIsoWidth = m.lnPictWidth * m.lnResizeFactor m.lnIsoHeight = m.lnPictHeight * m.lnResizeFactor lcImgHTML = [] lcHTML = ; [] + ; lcImgHTML + ; [] OTHERWISE *!* CASE .General = 2 && Stretch lcImgHTML = [] lcHTML = ; [] + ; lcImgHTML + ; [] ENDCASE RETURN lcHTML ENDPROC PROCEDURE processtext LPARAMETERS tnLeft, tnTop, tnWidth, tnHeight, cContentsToBeRendered LOCAL lcHTML, lcText, lcOrigText lcOrigText = ALLTRIM(STRCONV(cContentsToBeRendered, 6)) && STRCONV_UNICODE_UTF8) for Russian IF EMPTY(lcOrigText) RETURN "" ENDIF * Html special chars lcText = STRTRAN(lcOrigText, [&], [&]) && first! *lcText = STRTRAN(lcText, [ ], [ ]) lcText = STRTRAN(lcText, [<], [<]) lcText = STRTRAN(lcText, [>], [>]) * Alignment settings * Offset = 0 && Left Aligned * Offset = 1 && Right Aligned * Offset = 2 && Center Aligned LOCAL lcAlign DO CASE CASE Offset = 0 lcAlign = "text-align: left;" CASE Offset = 1 lcAlign = "text-align: right;" CASE Offset = 2 lcAlign = "text-align: center;" OTHERWISE lcAlign = "" ENDCASE * css style for span to output LOCAL lcFillHex, lcPreSpan, lcPostSpan, lcForeHex, lcPreFont, lcForeHex, lcPostFont * Mode: 0 = Opaque background; 1 = Transparent DO CASE *CASE (fillred = 255 AND fillgreen = 255 AND fillblue = 255) OR Mode = 1 && Transparent * lcFillHex = "" && white CASE Mode = 1 && Transparent lcFillHex = "" && white CASE fillred = -1 AND fillgreen = -1 AND fillblue = -1 lcFillHex = THIS.RgbToHex(255,255,255) && White * lcFillHex = "" && white OTHERWISE lcFillHex = THIS.RgbToHex(fillred, fillgreen, fillblue) ENDCASE IF PenRed = -1 lcForeHex = THIS.RgbToHex(0, 0, 0) ELSE lcForeHex = THIS.RgbToHex(penred, pengreen, penblue) ENDIF IF Stretch lcWWrap = [white-space:normal;] ELSE * Get the quantity of lines needed LOCAL lnLines lnLines = 0 lnLines = This.GetLinesCnt(lcOrigText, FontFace, FontSize, FontStyle, tnLeft, tnTop, tnWidth, tnHeight) IF lnLines <= 1 lcWWrap = [overflow:hidden ;] + [white-space:nowrap;] ELSE lcWWrap = [white-space:normal;] ENDIF ENDIF lcPreSpan = [] lcPostSpan = [] * [word-wrap:break-word;] + ; * [overflow:hidden ;] + ; * [white-space:normal;] + ; * [overflow: visible;] + ; * Font attrib lcForeHex = THIS.RgbToHex(penred, pengreen, penblue) *lcPreFont = [] *lcPostFont = [] lcPreFont = "" lcPostFont = "" * Set Html font style LOCAL lcFontStyle, lcPreStyle, lcPostStyle lcFontStyle = THIS.GetFontStyle(FontStyle) STORE '' TO lcPreStyle, lcPostStyle IF AT('B', lcFontStyle) > 0 lcPreStyle = [] lcPostStyle = [] ENDIF IF AT('I', lcFontStyle) > 0 lcPreStyle = lcPreStyle + [] lcPostStyle = [] + lcPostStyle ENDIF IF AT('U', lcFontStyle) > 0 lcPreStyle = lcPreStyle + [] lcPostStyle = [] + lcPostStyle ENDIF IF AT('S', lcFontStyle) > 0 lcPreStyle = lcPreStyle + [] lcPostStyle = [] + lcPostStyle ENDIF * write to file lcHtml = lcPreSpan + lcPreFont + lcPreStyle + lcText + lcPostStyle + lcPostFont + lcPostSpan RETURN lcHTML ENDPROC PROCEDURE processlines LPARAMETERS tnLeft, tnTop, tnWIdth, tnHeight LOCAL lcHTML *!* lcHTML = ; *!* [] + ; *!* [] lcHTML = ; [] + ; [] RETURN lcHTML ENDPROC PROCEDURE processshapes LPARAMETERS tnLeft, tnTop, tnWidth, tnHeight, tnObjectContinuationType *!* 2011-08-17 - Jacques Parent *!* Added tnObjectContinuationType parameter * Process Background information LOCAL lcFillHex * Mode : 0 = Opaque background; 1 = Transparent * FillPat : 0 = Transparent; others fill patterns (opaque) DO CASE CASE ((Mode = 1) OR (FillPat = 0)) AND (FillRed = -1) && Transparent lcFillHex = "" && white CASE fillred = -1 AND fillgreen = -1 AND fillblue = -1 * lcFillHex = "" && White lcFillHex = THIS.RgbToHex(255,255,255) && White OTHERWISE lcFillHex = THIS.RgbToHex(fillred, fillgreen, fillblue) ENDCASE lcFillHex = IIF(EMPTY(lcFillHex), "", [background-color:] + lcFillHex + [;]) * Process Border color LOCAL lcBorderHex lcBorderHex = "" * PenPat: 0 = Transparent (no border) DO CASE CASE PenPat = 0 && Transparent CASE PenRed = -1 lcBorderHex = THIS.RgbToHex(0,0,0) && Black OTHERWISE lcBorderHex = THIS.RgbToHex(PenRed, PenGreen, PenBlue) ENDCASE IF NOT EMPTY(lcBorderHex) *!* -------------------------------------------------------------------------------------------------------- *!* -------------------------------------------------------------------------------------------------------- *!* -------------------------------------------------------------------------------------------------------- *!* 2011-08-17 - Jacques Parent *!* In case tnObjectContinuationType is <> 0, we must deactivate some borders... DO CASE CASE tnObjectContinuationType == 1 && Top of box only lcBorderHex = [border-left:] + TRANSFORM(PenSize) + [px ] + lcBorderHex + [ solid;] +; [border-right:] + TRANSFORM(PenSize) + [px ] + lcBorderHex + [ solid;] +; [border-top:] + TRANSFORM(PenSize) + [px ] + lcBorderHex + [ solid;] CASE tnObjectContinuationType == 2 && Middle of box only lcBorderHex = [border-left:] + TRANSFORM(PenSize) + [px ] + lcBorderHex + [ solid;] +; [border-right:] + TRANSFORM(PenSize) + [px ] + lcBorderHex + [ solid;] CASE tnObjectContinuationType == 3 && Bottom of box only lcBorderHex = [border-left:] + TRANSFORM(PenSize) + [px ] + lcBorderHex + [ solid;] +; [border-right:] + TRANSFORM(PenSize) + [px ] + lcBorderHex + [ solid;] +; [border-bottom:] + TRANSFORM(PenSize) + [px ] + lcBorderHex + [ solid;] OTHERWISE && Complete box lcBorderHex = [border:] + TRANSFORM(PenSize) + [px ] + ; lcBorderHex + [ solid;] * border:1px solid ENDCASE *!* -------------------------------------------------------------------------------------------------------- *!* -------------------------------------------------------------------------------------------------------- *!* -------------------------------------------------------------------------------------------------------- ENDIF LOCAL lcHTML lcHTML = ; [] + [ ] + ; [] RETURN lcHTML ENDPROC PROCEDURE getlinescnt LPARAMETERS tcText, tcFontName, tnSize, tcStyle, tnLeft, tnTop, tnWidth, tnHeight LOCAL loFont, lnChars, lnLines, lnHeight, lnWidth, lnFactor LOCAL loRect as GpRectangle OF HOME() + "\ffc\_Gdiplus.vcx" loRect = NEWOBJECT("GPRectangle", "_Gdiplus.vcx", "", 0, 0, tnWidth, tnHeight) * Create a font object using the text object's settings. loFont = NEWOBJECT("GPFont", "_Gdiplus.vcx") loFont.Create(tcFontName, tnSize, tcStyle, 3) LOCAL loGfx as GpGraphics OF HOME() + "\ffc\_Gdiplus.vcx" loGfx = NEWOBJECT("GpGraphics", "_Gdiplus.vcx") lnFactor = 1 && 10 loGfx.CreateFromHWND(_Screen.HWnd) loGfx.PageUnit = 1 loGfx.PageScale = 0.3 loRect.w = tnWidth / lnFactor loRect.h = tnHeight / lnFactor LOCAL loSize as GpSize OF HOME() + "\ffc\_Gdiplus.vcx" loSize = loGfx.MeasureStringA(tcText, loFont, loRect.GdipRectF, .F., @lnChars, @lnLines) lnWidth = loSize.w lnHeight = loSize.h RETURN lnLines * loGfx.SetHandle(0) *RETURN (lnHeight / 960) * 72 * lnFactor ENDPROC PROCEDURE cropimage Lparameters lcFile As String, tnX, tnY, lnWidth As Integer, lnHeight As Integer, tcNewFile IF EMPTY(tcNewFile) tcNewFile = FORCEEXT(This._cTempFolder + Sys(2015), lcEXT) ENDIF Local loBmp As gpBitmap OF HOME() + "ffc\_gdiplus.vcx" loBmp = NEWOBJECT("GpBitmap", "_GdiPlus.vcx") loBmp.CreateFromFile(lcFile) lnHeight = MIN(lnHeight, loBmp.ImageHeight) lnWidth = MIN(lnWidth , loBmp.ImageWidth) LOCAL lhBitmap, lnStatus lhBitmap = 0 * Function used in the CropImage method DECLARE Long GdipCloneBitmapAreaI IN GDIPLUS.DLL AS pdfxGdipCloneBitmapAreaI Long x, Long y, Long nWidth, Long Height, Long PixelFormat, Long srcBitmap, Long @dstBitmap lnStatus = pdfxGdipCloneBitmapAreaI(tnX, tnY, lnWidth, lnHeight, loBmp.PixelFormat, loBmp.GetHandle(), @lhBitmap) IF (lnStatus <> 0) OR (lhBitmap = 0) loBmp = NULL * lnHandle = 0 RETURN "" ENDIF LOCAL loCropped As gpBitmap OF HOME() + "ffc\_gdiplus.vcx" loCropped = NEWOBJECT("GpBitmap", "_GdiPlus.vcx") loCropped.SetHandle(lhBitmap, .T.) && Owns handle, please destroy the Bmp object when releasing loCropped.SetResolution(loBmp.HorizontalResolution, loBmp.VerticalResolution) LOCAL lcEXT, lcEncoder lcEXT = UPPER(JUSTEXT(lcFile)) lcEncoder = IIF(lcEXT = "PNG", "image/png", "image/jpeg") LOCAL lcCroppedFile lcCroppedFile = tcNewFile && FORCEEXT(This._cTempFolder + Sys(2015), lcEXT) loCropped.SaveToFile(lcCroppedFile, lcEncoder) loCropped = NULL loBMP = NULL This.oImages.Add(lcCroppedFile) RETURN lcCroppedFile ENDPROC PROCEDURE Init * Author: aMaximum * Class adapted from the class posted at www.foxclub.ru * Original info: ************************************************** *-- Class: html_listener (c:\projects\vfp9_preview\html_listener.vcx) *-- ParentClass: reportlistener *-- BaseClass: reportlistener *-- Time Stamp: 06/18/04 03:09:01 PM * http://forum.foxclub.ru/read.php?29,144472 * http://translate.google.com/translate?js=n&prev=_t&hl=pt-BR&ie=UTF-8&layout=2&eotf=1&sl=ru&tl=en&u=http%3A%2F%2Fforum.foxclub.ru%2Fread.php%3F29%2C144472&act=url * http://forum.foxclub.ru/read.php?29,144639,144728 * http://translate.google.com/translate?js=n&prev=_t&hl=pt-BR&ie=UTF-8&layout=2&eotf=1&sl=ru&tl=en&u=http%3A%2F%2Fforum.foxclub.ru%2Fread.php%3F29%2C144639%2C144728&act=url * The report emerged, but the problem with the encoding of Russian letters. What is the trick? * Change in the method of render on strconv * cText = strconv (cContentsToBeRendered, 6) * Or changing * cHtml = [] + ; * to * cHtml = [] + ; * and then there is a UNICODE conversion to UTF-8 #define LOGPIXELSX 88 DECLARE INTEGER GetDeviceCaps IN WIN32API INTEGER HDC, INTEGER ITEM DECLARE INTEGER GetDC IN WIN32API INTEGER HWND LOCAL HDC, lnScreenDPI HDC = GetDC(0) lnScreenDPI = GetDeviceCaps( m.HDC, LOGPIXELSX ) THIS.nScreenDPI = lnScreenDPI THIS.lDebug = .F. && VERSION(2) = 2 This._cTempFolder = ADDBS(SYS(2023)) && ADDBS(GETENV("TEMP")) This.oImages = CREATEOBJECT("Collection") ENDPROC PROCEDURE Destroy FCLOSE(This.nOutFile) ENDPROC _memberdata = 1927 noutfile = -1 npagewidth = 0 npageheight = 0 nscreendpi = 0 ldebug = .F. ctargetfilename = oactivelistener = .NULL. ldefaultmode = .F. nimgcounter = 0 nx0 = 0 ny0 = 0 nw0 = 0 nh0 = 0 _ctempfolder = .F. oimages = cexternalfilelocation = lcopyimagefilestoexternalfilelocation = .T. quietmode = .F. waitfornextreport = .F. Name = "pr_htmllistener2" custom Nve?A Spreadsheet file FilterName MS Excel 97 TCSOURCE TCDESTINATION OOOOPENURL OOOCONVERTTOURL AONEARG CFILE OOOMAKEPROPERTYVALUE STORETOURL CLOSE Hiddena _blank ANOARGS OOOMAKEPROPERTYVALUE ODESKTOP OOOGETDESKTOP LOADCOMPONENTFROMURL com.sun.star.beans.PropertyValue nHandleb nStateb CNAME UVALUE NHANDLE NSTATE OPROPERTYVALUE OOOCREATESTRUCT VALUE HANDLE STATE' ERROR = DoNothing__ErrorHandler( ERROR(), MESSAGE(), LINENO(), SYS(16), PROGRAM(), SYS(2018) ) ON ERROR &cOldErrHandler CTYPENAME OSERVICEMANAGER OOOGETSERVICEMANAGER OSTRUCT COLDERRHANDLER BRIDGE_GETSTRUCT __OOORELEASECACHEDVARS{ goOOoDesktopb com.sun.star.frame.Desktop GOOOODESKTOP OOOSERVICEMANAGER_CREATEINSTANCEs goOOoServiceManagerb com.sun.star.ServiceManager GOOOOSERVICEMANAGER' ERROR = DoNothing__ErrorHandler( ERROR(), MESSAGE(), LINENO(), SYS(16), PROGRAM(), SYS(2018) ) ON ERROR &cOldErrHandler CSERVICENAME OSERVICEMANAGER OOOGETSERVICEMANAGER OINSTANCE COLDERRHANDLER CREATEINSTANCE __OOORELEASECACHEDVARS PNERROR PCERRMESSAGE PNLINENO PCPROGRAMFILESYS16 PCPROGRAM PCERRORPARAMSYS2018 GOOOOSERVICEMANAGER GOOOODESKTOP GOOOOCOREREFLECTIONv file:// CFILENAME OOoOpenURL OOoMakePropertyValue OOoCreateStruct OOoGetDesktop OOoGetServiceManagerK OOoServiceManager_CreateInstance DoNothing__ErrorHandlerz __OOoReleaseCachedVars OOoConvertToURL? FOXYPREVIEWER - Report preview and exporting utility http://foxypreviewer.codeplex.com -------------------------------------------------------------------- Created by Cesar Ch vfpimaging@hotmail.com http://weblogs.foxite.com/vfpimaging Main Features: - Preview miniature of pages - Export to image files (Bmp, Png, Tiff, Emf, Jpeg or Gif) - Export to HTML, PDF, RTF OR XLS - Send reports to email - Search texts in reports - Specify the quantity of pages to be printed - Change the printer and settings on the fly - Translate all dialogs, captions and tooltips to other languages than English Full online documentation: http://foxypreviewer.codeplex.com/documentation Get the latest release: http://foxypreviewer.codeplex.com/releases This utility uses some terrific tools created by other Foxers, that were provided as free and open source. These tools have received several tweaks and fixes in order to work in "FoxyPreviewer" and to support its features. 1 - PDFListener (for the PDF output) by Luis Navas PDFx Update Support for some SP2 Features http://weblogs.foxite.com/luisnavas/archive/2008/10/06/7025.aspx 2 - RTFListener (for the RTF output) by Vladimir Zhuravlev http://www.foxite.com/downloads/default.aspx?id=166 3 - Proof Miniatures sheet by Colin Nicholls published in the article: Exploring and Extending Report Previewing in VFP9 http://spacefold.com/colin/archive/articles/reportpreview/rp_extend.html 4 - Accessing the Printer settings window by Barbara Peisch posted in Foxite forum * http://www.foxite.com/archives/0000158197.htm 5 - ExcelListener (for the XLS output) by Alejandro Sosa http://www.portalfox.com/index.php?name=News&file=article&sid=2322&mode=nested&order=0&thold=0 http://www.universalthread.com/Report.aspx?Session=34485849353954544C2B4D3D204A377A5466623943753451502B72453358567A7544745843317A333869724B65 6 - HTMLListener in the simplified mode, with help of Max Arlikh 7 - Text search engine by Doug Hennig, based in his article: "Listening to a Report" 8 - CDO2000 class to send emails and several printer procedures by Sergey Berezniker 9 - The HARU PDF Library - used in the PDFListener by Luis Navas * << Haru Free PDF Library 2.0.8 >> * URL http://libharu.sourceforge.net/ * Copyright (c) 1999-2006 Takeshi Kanno * Permission to use, copy, modify, distribute and sell this software * and its documentation for any purpose is hereby granted without fee, * provided that the above copyright notice appear in all copies and * that both that copyright notice and this permission notice appear * in supporting documentation. * It is provided "as is" without express or implied warranty.BM6 zzzzzzzzzzzzzzz OBJTYPE OBJCODE OBJNAME OBJVALUE OBJINFO _NullFlags Title PH CH GH D GF CF PF Summary DH DF VFP-Report T E P S L V FontRes DataEnv DE-Cursor DE-Relation Group Reports Data VFP-RDL Pages Columns Column collection root nodename Pages collection root nodename Title Band nodename Page Header Band nodename Column Header Band nodename Group Header Band nodename Detail Band nodename Group Footer Band nodename Column Footer Band nodename Page Footer Band nodename Summary Band nodename Detail Header Band nodename Detail Footer Band nodename Report root nodename Text object nodename Expression object nodename Picture object nodename Shape object nodename Line object nodename Variable nodename FontResource nodename DataEnvironment nodename DE-Cursor nodename DE-Relation nodename Group selector nodename XML Document root nodename Report scope data root nodename 3VFP-RDL raw-format layout description root nodename NDELETEDVALUETYPENAMEOBJCODEFRXNODES objtype fec^]VUTSRQM objcode objname objvalue eportFP-RDLVitleTummarySReportsagesHFPLroupHGFFontResEEnvataHFRelationE-CursorDolumnsHCF DELETED() BCDEFGHIJKLMNOPQRSTUVWXYZ[\ objtype+objcode+IIF(objtype=1109,500,0) LHD@<840,($ xt\XPH PLATFORM UNIQUEID TIMESTAMP CLASS CLASSLOC BASECLASS OBJNAME PARENT PROPERTIES PROTECTED METHODS OBJCODE RESERVED1 RESERVED2 RESERVED3 RESERVED4 RESERVED5 RESERVED6 RESERVED7 RESERVED8 COMMENT Class WINDOWS _11W0RVA8Y 795638748 COMMENT RESERVED WINDOWS _1220YMYY4 795638870 COMMENT RESERVED WINDOWS _11R0OBRPZ 796152731 COMMENT RESERVED WINDOWS _11R0OANEG 815371681E COMMENT RESERVED WINDOWS _12G0NNCGK 823373366 COMMENT RESERVED WINDOWS _1360UZUFV 875730233J COMMENT RESERVED WINDOWS _11R0OJHC3 876772270 COMMENT RESERVED WINDOWS _1Q30Y83RB 876843690 COMMENT RESERVED WINDOWS _11R0O4T3U 878921974# COMMENT RESERVED WINDOWS _11R0O3J0I 8789222024 COMMENT RESERVED WINDOWS _11R0OMVRT 879259511B COMMENT RESERVED WINDOWS _11R0O2LAK 879259653 COMMENT RESERVED WINDOWS _11R0NJMU6 879259670: COMMENT RESERVED WINDOWS _11R0NL795 879259682 COMMENT RESERVED WINDOWS _11R0OM4OS 879259826 COMMENT RESERVED WINDOWS _11R0OKCMZ 879329451 COMMENT RESERVED VERSION = 3.00 Pixels 8Width = 200 Height = 112 BackStyle = 0 Name = "cnt" "Tahoma, 0, 8, 5, 13, 11, 21, 2, 0 Class textbox textbox Class resizegrabber Pixels Class image resizegrabber image Pixels WFontName = "Tahoma" FontSize = 8 Height = 22 Margin = 1 Width = 100 Name = "cbo" "Tahoma, 0, 8, 5, 13, 11, 21, 2, 0 Pixels Class label "Tahoma, 0, 8, 5, 13, 11, 21, 2, 0 +*resize Occurs when an object is resized. Pixels Class OPicture = images\grabber.gif Height = 12 Width = 12 Name = "resizegrabber" commandbutton *enabled_assign commandbutton checkbox Pixels optiongroup "Tahoma, 0, 8, 5, 13, 11, 21, 2, 0 optiongroup spinner spinner "Tahoma, 0, 8, 5, 13, 11, 21, 2, 0 Pixels Class listbox Class "Tahoma, 0, 8, 5, 13, 11, 21, 2, 0 Pixels *incomingvalue *action *resetincoming Pixels Class combobox combobox Pixels hyperlabel checkbox Class Class Pixels Class "Tahoma, 0, 8, 5, 13, 11, 21, 2, 0 optionbutton optionbutton Pixels Class shape shape container pageframe frxcontrols.vcx editbox label listbox Pixels ;Height = 46 Width = 162 SpecialEffect = 0 Name = "shp" Pixels label hyperlabel currentpage errored Pixels Class Class KFontName = "Tahoma" FontSize = 8 Height = 78 Width = 174 Name = "lst" Class container pageframe Pixels Class editbox "Tahoma, 0, 8, 5, 13, 11, 21, 2, 0 *enabled_assign AutoSize = .T. FontUnderline = .T. BackStyle = 0 Caption = "enter url here" MousePointer = 15 ForeColor = 0,0,255 Name = "hyperlabel" }FontName = "Tahoma" FontSize = 8 BackStyle = 0 Caption = "prompt" Height = 15 Width = 52 AutoSize = .T. Name = "opt" aFontName = "Tahoma" FontSize = 8 Caption = "Caption" Height = 187 Width = 187 Name = "pge" lFontName = "Tahoma" FontSize = 8 Height = 22 Margin = 1 SelectOnEntry = .T. Width = 100 Name = "txt" mAutoSize = .T. FontName = "Tahoma" FontSize = 8 Caption = "label" Height = 15 Width = 24 Name = "lbl" _Height = 25 Width = 75 FontName = "Tahoma" FontSize = 8 Caption = "Caption" Name = "cmd" MemberClassLibrary = frxcontrols.vcx MemberClass = "opt" ButtonCount = 0 BackStyle = 0 BorderStyle = 1 Value = 0 Height = 66 Width = 117 Name = "opg" NERROR CMETHOD NLINE PARENT ERROR PARENT RIGHTCLICK Error, RightClick PROCEDURE Error LPARAMETERS nError, cMethod, nLine THIS.Parent.Error( nError, cMethod, nLine ) ENDPROC PROCEDURE RightClick THIS.Parent.RightClick() ENDPROC WFontName = "Tahoma" FontSize = 8 Height = 53 Margin = 1 Width = 100 Name = "edt" PROCEDURE enabled_assign lparameters lEnabled THIS.Enabled = m.lEnabled ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine THIS.Parent.Error( nError, cMethod, nLine ) ENDPROC readonly Specifies if the user can edit a control, or specifies if a table or view associated with a Cursor object allows updates. *enabled_assign *readonly_assign *setfocus Sets the focus to a control. PROCEDURE Error LPARAMETERS nError, cMethod, nLine THIS.Parent.Error( nError, cMethod, nLine ) ENDPROC PROCEDURE RightClick THIS.Parent.RightClick() ENDPROC jPROCEDURE KeyPress lparameters iKey, iModifier *---------------------------------- * Do not allow nulls to be entered * with Ctrl-0 : *---------------------------------- if m.iKey = 48 and 0 < bitand( m.iModifier, 2 ) nodefault endif ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine THIS.Parent.Error( nError, cMethod, nLine ) ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine THIS.Parent.Error( nError, cMethod, nLine ) ENDPROC PROCEDURE When if THIS.Parent.ReadOnly return .F. else return .T. endif ENDPROC PROCEDURE KeyPress lparameters iKey, iModifier *---------------------------------- * Do not allow nulls to be entered * with Ctrl-0 : *---------------------------------- if m.iKey = 48 and 0 < bitand( m.iModifier, 2 ) nodefault endif ENDPROC NERROR CMETHOD NLINE PARENT ERROR< IKEY IMODIFIER Error, KeyPress LENABLED ENABLED. NERROR CMETHOD NLINE PARENT ERROR enabled_assign, Errore Width = 53 FontName = "Tahoma" FontSize = 8 AutoSize = .T. Alignment = 0 BackStyle = 0 Caption = "Check1" Value = .F. Name = "chk" jPROCEDURE KeyPress lparameters iKey, iModifier *---------------------------------- * Do not allow nulls to be entered * with Ctrl-0 : *---------------------------------- if m.iKey = 48 and 0 < bitand( m.iModifier, 2 ) nodefault endif ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine THIS.Parent.Error( nError, cMethod, nLine ) ENDPROC PROCEDURE enabled_assign lparameter lEnabled for each optbut in THIS.Buttons optbut.Enabled = m.lEnabled endfor ENDPROC PROCEDURE readonly_assign lparameter lReadOnly * Returning .F. in each button's .When() produces * a more visually acceptable effect: *for each optbut in this.Buttons * optbut.Enabled = not m.lReadOnly *endfor THIS.ReadOnly = m.lReadOnly ENDPROC PROCEDURE setfocus *---------------------------------------------------- * SetFocus() in containers doesn't work so well. This * compensates for that bug by doing it manually: *---------------------------------------------------- local oControl for each oControl in this.Buttons if oControl.TabIndex = 1 oControl.SetFocus() nodefault exit endif endfor ENDPROC PROCEDURE RightClick THIS.Parent.RightClick() ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine THIS.Parent.Error( nError, cMethod, nLine ) ENDPROC PROCEDURE enabled_assign lparameter lEnabled THIS.Enabled = m.lEnabled ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine THIS.Parent.Error( nError, cMethod, nLine ) ENDPROC PROCEDURE SetFocus local oControl for each oControl in this.Controls if type("oControl.TabIndex") = "N" if oControl.TabIndex = 1 if pemstatus( m.oControl,"setFocus",5) oControl.SetFocus() nodefault endif exit endif endif endfor ENDPROC PROCEDURE RightClick THIS.Parent.RightClick() ENDPROC jPROCEDURE Error LPARAMETERS nError, cMethod, nLine THIS.Parent.Error( nError, cMethod, nLine ) ENDPROC PROCEDURE KeyPress lparameters iKey, iModifier *---------------------------------- * Do not allow nulls to be entered * with Ctrl-0 : *---------------------------------- if m.iKey = 48 and 0 < bitand( m.iModifier, 2 ) nodefault endif ENDPROC PROCEDURE resetincoming THIS.incomingValue = THIS.Value ENDPROC PROCEDURE LostFocus if THIS.incomingValue <> THIS.Value this.action() endif ENDPROC PROCEDURE UpClick if THIS.incomingValue <> THIS.Value this.action() this.resetIncoming() endif ENDPROC PROCEDURE DownClick if THIS.incomingValue <> THIS.Value this.action() this.resetIncoming() endif ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine THIS.Parent.Error( nError, cMethod, nLine ) ENDPROC PROCEDURE GotFocus THIS.resetIncoming() ENDPROC PROCEDURE KeyPress lparameters iKey, iModifier *---------------------------------- * Do not allow nulls to be entered * with Ctrl-0 : *---------------------------------- if m.iKey = 48 and 0 < bitand( m.iModifier, 2 ) nodefault endif ENDPROC IKEY IMODIFIER. NERROR CMETHOD NLINE PARENT ERROR KeyPress, Error} jPROCEDURE Error LPARAMETERS nError, cMethod, nLine THIS.Parent.Error( nError, cMethod, nLine ) ENDPROC PROCEDURE KeyPress lparameters iKey, iModifier *---------------------------------- * Do not allow nulls to be entered * with Ctrl-0 : *---------------------------------- if m.iKey = 48 and 0 < bitand( m.iModifier, 2 ) nodefault endif ENDPROC NERROR CMETHOD NLINE PARENT ERROR< IKEY IMODIFIER Error, KeyPress FontName = "Tahoma" FontSize = 8 Height = 22 KeyboardLowValue = 0 Margin = 1 SelectOnEntry = .T. SpinnerLowValue = 0.00 Width = 121 incomingvalue = 0 Name = "spn" INCOMINGVALUE VALUE+ INCOMINGVALUE VALUE ACTION8 INCOMINGVALUE VALUE ACTION RESETINCOMING8 INCOMINGVALUE VALUE ACTION RESETINCOMING. NERROR CMETHOD NLINE PARENT ERROR RESETINCOMING< IKEY IMODIFIER resetincoming, LostFocusb UpClick DownClick$ Error GotFocus KeyPress NERROR CMETHOD NLINE PARENT ERROR PARENT RIGHTCLICK Error, RightClick IKEY IMODIFIER. NERROR CMETHOD NLINE PARENT ERROR KeyPress, Error} http:// http:// ShellExecute SHELL32.dll FindWindow WIN32API LCURL CAPTION FORECOLOR SHELLEXECUTE SHELL32 FINDWINDOW WIN32API Click, PARENT RIGHTCLICKS THIS.Controls[1]b CONTROLS SETFOCUS. NERROR CMETHOD NLINE PARENT ERROR RightClick, Activate] Error THISFORM HEIGHT WIDTH BORDERSTYLE VISIBLEV grabber.gif grabber2k.gif THEMES PICTURE resize, IKEY IMODIFIER. NERROR CMETHOD NLINE PARENT ERROR KeyPress, Error} NERROR CMETHOD NLINE PARENT ERROR0 PARENT READONLY< IKEY IMODIFIER Error, KeyPress LENABLED OPTBUT BUTTONS ENABLED LREADONLY READONLYM OCONTROL BUTTONS TABINDEX SETFOCUS PARENT RIGHTCLICK. NERROR CMETHOD NLINE PARENT ERROR enabled_assign, readonly_assign setfocus RightClickE Errorv LENABLED ENABLED. NERROR CMETHOD NLINE PARENT ERROR oControl.TabIndexb setFocus OCONTROL CONTROLS TABINDEX SETFOCUS PARENT RIGHTCLICK enabled_assign, Errore SetFocus RightClick NERROR CMETHOD NLINE PARENT ERROR PARENT RIGHTCLICK Error, RightClick #PROCEDURE RightClick THIS.Parent.RightClick() ENDPROC PROCEDURE Activate if type( "THIS.Controls[1]" ) = "O" THIS.Controls[1].SetFocus() catch endtry endif ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine THIS.Parent.Error( nError, cMethod, nLine ) ENDPROC -PROCEDURE Click local lcUrl if left( lower(THIS.Caption), 7 ) = [http://] lcUrl = THIS.Caption lcUrl = [http://] + THIS.Caption endif THIS.ForeColor = RGB(128,0,128) DECLARE INTEGER ShellExecute ; IN SHELL32.dll ; INTEGER nWinHandle,; STRING cOperation,; STRING cFileName,; STRING cParameters,; STRING cDirectory,; INTEGER nShowWindow DECLARE INTEGER FindWindow ; IN WIN32API STRING cNull,STRING cWinName =ShellExecute( FindWindow(0,_screen.Caption), "OPEN", m.lcUrl,"",sys(2023),1) ENDPROC aPROCEDURE resize *======================================================================= * Resize() * Useage: * In the form's resize event, call THIS.grabber.Resize() and the grabber * image will relocate itself to the bottom right corner of the window *======================================================================= THIS.Top = THISFORM.Height - THIS.Height THIS.Left = THISFORM.Width - THIS.Width if THISFORM.BorderStyle<>3 THIS.Visible = .F. endif ENDPROC PROCEDURE Init if _screen.Themes THIS.Picture = "grabber.gif" THIS.Picture = "grabber2k.gif" endif ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine THIS.Parent.Error( nError, cMethod, nLine ) ENDPROC PROCEDURE RightClick THIS.Parent.RightClick() ENDPROC ErasePage = .T. MemberClassLibrary = frxcontrols.vcx MemberClass = "pge" PageCount = 0 TabStyle = 1 ActivePage = 0 Width = 241 Height = 169 currentpage = 0 errored = .F. Name = "pgf" jPROCEDURE KeyPress lparameters iKey, iModifier *---------------------------------- * Do not allow nulls to be entered * with Ctrl-0 : *---------------------------------- if m.iKey = 48 and 0 < bitand( m.iModifier, 2 ) nodefault endif ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine THIS.Parent.Error( nError, cMethod, nLine ) ENDPROC PLATFORM UNIQUEID TIMESTAMP CLASS CLASSLOC BASECLASS OBJNAME PARENT PROPERTIES PROTECTED METHODS OBJCODE RESERVED1 RESERVED2 RESERVED3 RESERVED4 RESERVED5 RESERVED6 RESERVED7 RESERVED8 COMMENT Class WINDOWS _1620OUFP8 819679853G COMMENT RESERVED WINDOWS _19R0MDR54 819680088 COMMENT RESERVED WINDOWS _17X12M0M5 879329379 WINDOWS _17X136SEA 8793293795 WINDOWS _17X136SEQ 879329379 WINDOWS _17X136SER 879329379@ WINDOWS _17X136SES 879329379 WINDOWS _17X136SET 879329379 COMMENT RESERVED WINDOWS _1S90NDO63 8822068228 COMMENT RESERVED WINDOWS _1800VSTVB 911434274 COMMENT RESERVED WINDOWS _1620OTOI2 911434517q COMMENT RESERVED WINDOWS _1S90NDBMP 911784843( COMMENT RESERVED WINDOWS _15L0YBYJT 926370639M WINDOWS _1620OUFP8 926370639 WINDOWS _1MT10T1N1 926370639W COMMENT RESERVED WINDOWS _15L0YNARZ1065729474 WINDOWS _17L131CSM1065729474 WINDOWS _17L131CSN 824659832 WINDOWS _17L131CT2 824659832 WINDOWS _15L0ZJMCW1065729474 WINDOWS _17L131CT41065729474 WINDOWS _17L131CT5 824659832 WINDOWS _17L131CTH 824659832 WINDOWS _17L131CTI1065729474@ WINDOWS _1AU0YVMX51065729474 WINDOWS _15L0ZJMDC1065729474" WINDOWS _15L0ZJMDD1065729474 WINDOWS _15L0ZJMDR1065729474s WINDOWS _15L0ZJMDQ1065729474 COMMENT RESERVED WINDOWS _11R0TYA321065729481 COMMENT RESERVED VERSION = 3.00 "Tahoma, 0, 8, 5, 13, 11, 21, 2, 0 Pixels frxpreview.h foxpro_reporting.h frxpreview_loc.h "Tahoma, 0, 8, 5, 13, 11, 23, 2, 0 frxbaseform frxpreview.h Pixels Class frxbaseform frxpreviewastopform Class frxpreviewform iscreendpi *checkforlargefonts Called in the Init() to set font attributes if Large Fonts are detected. frxpreviewastopform frxpreview.vcx "Tahoma, 0, 8, 5, 13, 11, 21, 2, 0 frxpreviewinscreen Pixels Class frxpreviewform frxpreviewinscreen "Tahoma, 0, 8, 5, 13, 11, 21, 2, 0 frxpreview.h frxpreview.vcx frxpreviewform lastzoomlevel Pixels ShowWindow = 2 DoCreate = .T. MDIForm = .F. topform = .T. Name = "frxpreviewastopform" spacer.Name = "spacer" Label1.Name = "Label1" Class Label1 frxbaseform frxpreviewform frxpreviewform Pixels frxpreview.h foxpro_reporting.h frxpreview_loc.h "Tahoma, 0, 8, 5, 13, 11, 21, 2, 0 frxpreviewindesktop Class frxpreviewform PARENT RIGHTCLICK RightClick, label label frxpreviewform frxpreviewindesktop frxpreview.vcx PARENT Click, "Tahoma, 0, 8, 5, 13, 11, 21, 2, 0 frxgotopageform spacer shape shape frxpreview.h Pixels Class frxbaseform Pixels frxpreview.h foxpro_reporting.h frxpreview_loc.h frxgotopageform .PROCEDURE Click THIS.Parent.Hide() ENDPROC frxgotopageform cmdCancel commandbutton frxpreview.vcx gTop = 47 Left = 248 Width = 84 Cancel = .T. Caption = "Cancel" ZOrderSet = 4 Name = "cmdCancel" frxcontrols.vcx frxgotopageform cmdOK commandbutton PTop = 32 Left = 28 Height = 10 Width = 19 BorderStyle = 0 Name = "spacer" frxpreviewtoolbar Class PARENT PAGENO SPNPAGENO VALUE Click, `PROCEDURE Click THIS.Parent.pageNo = THIS.Parent.spnPageNo.Value THIS.Parent.Hide() ENDPROC frxcontrols.vcx frxgotopageform lblCaption label PARENT PREVIEWFORM ACTIONPRINT Click, Initn frxpreview.h foxpro_reporting.h frxpreview_loc.h "Tahoma, 0, 8, 5, 13, 11, 23, 2, 0 frxpreview.h toolbar frxpreviewtoolbar Top = 3 Left = 473 Height = 22 Width = 85 Picture = images\print.bmp Caption = " Print" ToolTipText = "Print report" SpecialEffect = 2 PicturePosition = 1 Name = "cmdPrint" cmdPrint frxpreview.vcx frxpreviewtoolbar frxcontrols.vcx frxgotopageform spnPageno `Top = 15 Left = 248 Width = 84 Caption = "OK" Default = .T. ZOrderSet = 3 Name = "cmdOK" spinner FontName = "Tahoma" FontSize = 8 BackStyle = 0 Caption = "(build)" Height = 17 Left = 2 Top = 1 Width = 40 ForeColor = 192,192,192 Name = "Label1" commandbutton frxcontrols.vcx frxpreviewtoolbar cmdClose shapecanvas Pixels Class shapecanvas Name = "shapecanvas" shape frxcontrols.vcx PARENT PREVIEWFORM ACTIONCLOSE Click, Initn PROCEDURE Click THIS.Parent.previewform.actionPrint() ENDPROC PROCEDURE Init dodefault() #IF USE_LOC_STRINGS_IN_UI THIS.Caption = UI_TOOLBAR_PRINT_LOC THIS.ToolTipText = UI_TOOLBAR_TT_PRINT_LOC #ENDIF ENDPROC PARENT PREVIEWFORM ACTIONGOLAST Click, Initr PROCEDURE Click THIS.Parent.previewform.actionClose() ENDPROC PROCEDURE Init dodefault() #IF USE_LOC_STRINGS_IN_UI THIS.Caption = UI_TOOLBAR_CLOSE_LOC THIS.ToolTipText = UI_TOOLBAR_TT_CLOSE_LOC #ENDIF ENDPROC Top = 3 Left = 388 Height = 22 Width = 85 Picture = images\preclose.bmp Caption = " Close" ToolTipText = "Close preview" SpecialEffect = 2 PicturePosition = 1 Name = "cmdClose" commandbutton frxcontrols.vcx frxpreviewtoolbar opgPageCount optiongroup frxcontrols.vcx separator imagecanvas Class frxpreviewtoolbar image imagecanvas gTop = 15 Left = 12 Height = 66 Width = 224 BackStyle = 0 ZOrderSet = 0 Style = 3 Name = "Shp1" ATop = 3 Left = 311 Height = 0 Width = 0 Name = "Separator4" Separator4 separator Height = 22 Left = 204 Style = 2 TabStop = .F. ToolTipText = "Choose page magnification" Top = 3 DisplayCount = 5 Name = "cboZoom" frxpreviewtoolbar cboZoom combobox PROCEDURE InteractiveChange THIS.Parent.ActionZoomLevel( THIS.Value ) ENDPROC PROCEDURE Init dodefault() #IF USE_LOC_STRINGS_IN_UI THIS.ToolTipText = UI_TOOLBAR_TT_ZOOMLEVEL_LOC #ENDIF ENDPROC ]Caption = " Go to page " Left = 20 Top = 8 ZOrderSet = 2 Style = 3 Name = "lblCaption" fHeight = 21 InputMask = "9999" Left = 64 Top = 36 Width = 126 ZOrderSet = 1 Name = "spnPageno" frxcontrols.vcx frxpreviewtoolbar separator Separator2 frxcontrols.vcx PROCEDURE LostFocus if THIS.Value < THIS.SpinnerLowValue THIS.Value = 1 endif if THIS.Value > THIS.SpinnerHighValue THIS.Value = THIS.SpinnerHighValue endif dodefault() ENDPROC frxcontrols.vcx frxgotopageform shape separator Height = 238 Width = 367 DoCreate = .T. AutoCenter = .T. Caption = "Form" FontName = "Tahoma" FontSize = 8 Icon = images\wwrite.ico screendpi = 96 Name = "frxbaseform" PARENT ACTIONZOOMLEVEL VALUE InteractiveChange, Inito ATop = 3 Left = 204 Height = 0 Width = 0 Name = "Separator2" PROCEDURE Click THIS.Parent.Parent.previewform.actionGoLast() ENDPROC PROCEDURE Init dodefault() #IF USE_LOC_STRINGS_IN_UI THIS.ToolTipText = UI_TOOLBAR_TT_LAST_LOC #ENDIF ENDPROC cmdBottom PARENT PREVIEWFORM ACTIONGONEXT Click, Initr Top = 0 Left = 23 Height = 22 Width = 23 Picture = images\prelast.bmp Caption = "" ToolTipText = "Last page" SpecialEffect = 2 Name = "cmdBottom" frxpreviewtoolbar.cntNext commandbutton frxpreviewproxy image frxcontrols.vcx PARENT PREVIEWFORM ACTIONGOTOPAGE Click, Initq frxpreviewtoolbar.cntNext cmdForward Class commandbutton tempfile cntNext custom Pixels PROCEDURE Click THIS.Parent.Parent.previewform.actionGoNext() ENDPROC PROCEDURE Init dodefault() #IF USE_LOC_STRINGS_IN_UI THIS.ToolTipText = UI_TOOLBAR_TT_NEXT_LOC #ENDIF ENDPROC frxcontrols.vcx frxpreviewtoolbar frxpreviewproxy frxpreview.h QTop = 3 Left = 151 Width = 46 Height = 22 BorderWidth = 0 Name = "cntNext" container frxcontrols.vcx ShowWindow = 0 DoCreate = .T. Name = "frxpreviewinscreen" spacer.Name = "spacer" canvas1.Name = "canvas1" canvas2.Name = "canvas2" canvas3.Name = "canvas3" canvas4.Name = "canvas4" Top = 0 Left = 0 Height = 22 Width = 23 Picture = images\prenext.bmp Caption = "" ToolTipText = "Next page" SpecialEffect = 2 Name = "cmdForward" PROCEDURE enabled_assign lparameter lEnabled THIS.cmdBottom.Enabled = m.lEnabled THIS.cmdForward.Enabled = m.lEnabled dodefault(m.lEnabled) ENDPROC frxpreviewtoolbar cmdGoToPage commandbutton frxcontrols.vcx frxpreviewtoolbar.cntPrev Pixels custom 2extensionhandler previewformclass getwindowref 9PROCEDURE RightClick THIS.Parent.RightClick() ENDPROC LENABLED THIS CMDBOTTOM ENABLED CMDFORWARD enabled_assign, Top = 3 Left = 51 Height = 22 Width = 100 Picture = images\gotopage.bmp Caption = " Go to page" ToolTipText = "Go to page" SpecialEffect = 2 PicturePosition = 1 Name = "cmdGoToPage" OStretch = 2 Height = 116 Width = 100 tempfile = ("") Name = "imagecanvas" Desktop = .T. DoCreate = .T. Name = "frxpreviewintopform" spacer.Name = "spacer" canvas1.Name = "canvas1" canvas2.Name = "canvas2" canvas3.Name = "canvas3" canvas4.Name = "canvas4" PARENT ACTIONPAGECOUNTg OBUTTON BUTTONS AUTOSIZE PICTUREPOSITION HEIGHT WIDTH InteractiveChange, Initb Opt1.Init Opt2.Init$ Opt3.Init4 PROCEDURE InteractiveChange THIS.Parent.ActionPageCount() ENDPROC PROCEDURE Init * Some kind of bug is re-sizing the buttons: for each oButton in THIS.Buttons oButton.AutoSize = .F. oButton.PicturePosition = 13 oButton.Top = 0 oButton.Height = 22 oButton.Width = 25 endfor ENDPROC PROCEDURE Opt1.Init dodefault() #IF USE_LOC_STRINGS_IN_UI THIS.ToolTipText = UI_TOOLBAR_TT_1PAGE_LOC #ENDIF ENDPROC PROCEDURE Opt2.Init dodefault() #IF USE_LOC_STRINGS_IN_UI THIS.ToolTipText = UI_TOOLBAR_TT_2PAGES_LOC #ENDIF ENDPROC PROCEDURE Opt3.Init dodefault() #IF USE_LOC_STRINGS_IN_UI THIS.ToolTipText = UI_TOOLBAR_TT_4PAGES_LOC #ENDIF ENDPROC cmdBack commandbutton frxcontrols.vcx frxpreviewtoolbar.cntPrev cmdTop frxpreview.h foxpro_reporting.h frxpreview_loc.h PARENT PREVIEWFORM ACTIONGOPREV Click, Initr PROCEDURE Click THIS.Parent.previewform.actionGoToPage() ENDPROC PROCEDURE Init dodefault() #IF USE_LOC_STRINGS_IN_UI THIS.Caption = UI_TOOLBAR_GOTOPAGE_LOC THIS.ToolTipText = UI_TOOLBAR_TT_GOTOPAGE_LOC #ENDIF ENDPROC commandbutton frxcontrols.vcx frxpreviewtoolbar cntPrev |pageno Provides the current page number for report output. pagetotal Provides a PageTotal for report output. oparentform Top = 14 Left = 12 Height = 92 Width = 345 ShowWindow = 1 DoCreate = .T. AutoCenter = .F. BorderStyle = 2 Closable = .F. MaxButton = .F. MinButton = .F. AlwaysOnTop = .T. AllowOutput = .F. pageno = 0 pagetotal = 0 oparentform = (.NULL.) Name = "frxgotopageform" iButtonCount = 3 BorderStyle = 0 Height = 22 Left = 311 Top = 3 Width = 77 Name = "opgPageCount" Opt1.Picture = images\1page.bmp Opt1.PicturePosition = 13 Opt1.Caption = "" Opt1.Height = 38 Opt1.Left = 0 Opt1.SpecialEffect = 2 Opt1.Style = 1 Opt1.ToolTipText = "One page" Opt1.Top = 0 Opt1.Width = 32 Opt1.AutoSize = .F. Opt1.Name = "Opt1" Opt2.Picture = images\2page.bmp Opt2.PicturePosition = 13 Opt2.Caption = "" Opt2.Height = 38 Opt2.Left = 25 Opt2.SpecialEffect = 2 Opt2.Style = 1 Opt2.ToolTipText = "Two pages" Opt2.Top = 0 Opt2.Width = 32 Opt2.AutoSize = .F. Opt2.Name = "Opt2" Opt3.Picture = images\4page.bmp Opt3.PicturePosition = 13 Opt3.Caption = "" Opt3.Height = 38 Opt3.Left = 50 Opt3.SpecialEffect = 2 Opt3.Style = 1 Opt3.ToolTipText = "Four pages" Opt3.Top = 0 Opt3.Width = 32 Opt3.AutoSize = .F. Opt3.Name = "Opt3" container frxcontrols.vcx PROCEDURE Init *---------------------------------------------------- * For final release we'll make this invisible *---------------------------------------------------- if type("SHOW_APPLICATION_VERSION") = "U" THIS.Visible = .F. endif THIS.Caption = PREVIEW_VERSION ENDPROC PARENT PREVIEWFORM ACTIONGOFIRST Click, Inits PROCEDURE Click THIS.Parent.Parent.previewform.actionGoPrev() ENDPROC PROCEDURE Init dodefault() #IF USE_LOC_STRINGS_IN_UI *THIS.Caption = THIS.ToolTipText = UI_TOOLBAR_TT_BACK_LOC #ENDIF ENDPROC Top = 0 Left = 23 Height = 22 Width = 23 Picture = images\preprev.bmp Caption = "" Enabled = .F. ToolTipText = "Previous page" SpecialEffect = 2 Name = "cmdBack" SHOW_APPLICATION_VERSIONb 9.5.0.0 VISIBLE CAPTION Init, PROCEDURE Click THIS.Parent.Parent.previewform.actionGoFirst() ENDPROC PROCEDURE Init dodefault() #IF USE_LOC_STRINGS_IN_UI *THIS.Caption = THIS.ToolTipText = UI_TOOLBAR_TT_FIRST_LOC #ENDIF ENDPROC Top = 0 Left = 0 Height = 22 Width = 23 Picture = images\prefirst.bmp Caption = "" Enabled = .F. ToolTipText = "First page" SpecialEffect = 2 Name = "cmdTop" toolbar PROCEDURE Show LPARAMETERS nStyle #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + "frxGoToPageForm::Show(" + trans(m.nStyle) + ")" #ENDIF *----------------------------------------- * Fix for SP1: Handle positioning in top-level form * See frxPreviewForm::ActionGoToPage() * Addresses bug# 474691 *----------------------------------------- THIS.pageNo = THIS.oParentForm.currentPage THIS.pageTotal = THIS.oParentForm.pageTotal THIS.Caption = DEFAULT_MBOX_TITLE_LOC THIS.lblCaption.Caption = REPORT_PREVIEW_GOTO_PAGE_LOC + " " + "(1-" + transform(THIS.pageTotal) + ")" if THIS.oParentForm.ShowWindow = 2 && as top-level form *----------------------------------- * If parent preview window is a top-level form, * center the child window in the view port: *----------------------------------- THIS.AutoCenter = .F. THIS.Left = THIS.oParentForm.ViewPortLeft + int(THIS.oParentForm.Width/2 - THIS.Width/2) THIS.Top = THIS.oParentForm.ViewPortTop + int(THIS.oParentForm.Height/2 - THIS.Height/2) THIS.AutoCenter = .T. endif *-------------- THIS.spnPageNo.SpinnerLowValue = 1 THIS.spnPageNo.SpinnerHighValue = THIS.pageTotal *THIS.spnPageNo.KeyboardLowValue = 1 *THIS.spnPageNo.KeyboardHighValue = THIS.pageTotal THIS.spnPageNo.Value = THIS.pageNo dodefault(m.nStyle) ENDPROC PROCEDURE Init dodefault() #if USE_LOC_STRINGS_IN_UI THIS.cmdOK.Caption = UI_CMD_OK_LOC THIS.cmdCancel.Caption = UI_CMD_CANCEL_LOC #endif ENDPROC FontName Segoe UI FontSize Margin Margin Margin Editbox Margin Textbox FontName MS Shell Dlg 2 FontSize FontName Tahoma FontSize FontName FontSize FontSize SETALL FONTNAME FONTSIZE SCREENDPI ErrorHandler pr_frxpreview.prg IERROR CMETHOD ILINE HANDLE THIS CANCELLED SUSPENDED GetDeviceCaps WIN32API GetDC WIN32API ReleaseDC WIN32API GETDEVICECAPS WIN32API GETDC RELEASEDC SCREENDPI CHECKFORLARGEFONTS checkforlargefonts, Error LENABLED CMDTOP ENABLED CMDBACK enabled_assign, Dcanvascount canvasheight canvaswidth currentpage frxfilename lastpainted oreport pageheight Specifies the height of the Page. pagewidth Specifies the width of the Page. pagetotal Provides a PageTotal for report output. toolbar toolbarisvisible unitconverter zoomlevel hidcommandwindow isnowait formcaption startoffset printonexit suppressrendering disabledoffscreenbmps extensionhandler _memberdata XML Metadata for customizable properties allowprintfrompreview lastzoomlevel textontoolbar tempstoprepaint memberclass Specifies the name of a member default class to use when new members are added to the container. memberclasslibrary Specifies the name of the class library containing the class associated with the MemberClass property. topform mouseflag ignoremouseclickinmagnifycode *actionclose *actiongofirst *actiongolast *actiongonext *actiongoprev *actiongotopage *actionprint *actionsetcanvascount *actionsetzoom *actiontoolbarvisibility *invokecontextmenu *renderpage *reset Resets the Timer control so that it starts counting from 0. *setreport *showtoolbar *synchcanvases *synchpageno *synchtoolbar *setcurrentpage parameters: iPage *actionshowinfo ^zoomlevels[1,2] *getzoompercent *renderpages *savetoresource *restorefromresource *getpixelsperdpi960 Returns the ratio between pixels and 960dpi based on the current zoomlevel. *createtoolbar *extensionhandler_assign *getpixelpageoffsets *showcommandwindow *hidecommandwindow *createcanvases *canvascount_assign *setzoomlevel *setcanvascount VALUE SPINNERLOWVALUE SPINNERHIGHVALUE LostFocus, PROCEDURE enabled_assign lparameter lEnabled THIS.cmdTop.Enabled = m.lEnabled THIS.cmdBack.Enabled = m.lEnabled dodefault(m.lEnabled) ENDPROC OTop = 3 Left = 5 Width = 46 Height = 22 BorderWidth = 0 Name = "cntPrev" previewform specialmousexcoord *previewform_assign *synchcontrols *actionzoomlevel parameter: iZoomIndex *getwindowref *actionpagecount Caption = "Toolbar1" Height = 28 KeyPreview = .T. Left = 0 Top = 0 Width = 563 ShowWindow = 1 previewform = .NULL. specialmousexcoord = 0 Name = "frxpreviewtoolbar" Report Preview Go to page number: NSTYLE PAGENO OPARENTFORM CURRENTPAGE PAGETOTAL CAPTION LBLCAPTION SHOWWINDOW AUTOCENTER VIEWPORTLEFT WIDTH VIEWPORTTOP HEIGHT SPNPAGENO SPINNERLOWVALUE SPINNERHIGHVALUE VALUE Show, oform Reference to the actual preview form. Not guaranteed to be valid available until after .Show() has been called. oreport Reference to the ReportListener class assisting the report run. Assigned via .SetReport() automatically. caption If not empty, this will override the default preview caption in the form title. topform Indicates that the Preview Form should be a TopForm. Forces non-modal operation. canvascount If not empty, overrides the initial number of pages shown in preview form. Valid values are 1,2, or 4. currentpage If not empty, overrides the initial page displayed by the preview form. (Default will be first page rendered.) zoomlevel If not empty, overrides the initial zoom level of the preview form. Valid values are 1 (10%) to 9 (500%) ,10 (Whole page),and 11 (fit to page width). toolbarisvisible If not null, overrides the default initial visibility of the preview form's toolbar. .T. to force visible; .F. to force not visible. extensionhandler Reference to an extension handler object, if one is assigned via the .SetExtensionHandler() method. previewformclass Class name of preview form to instantiate by default, or, class name of last class instantiated. Used to re-instantiate preview form if different from current form. _memberdata XML Metadata for customizable properties allowprintfrompreview If set to false, suppresses the Print action from the preview. textontoolbar If not null, overrides the default initial visibility of the preview toolbar's button captions: .T. to force visible; .F. to force not visible. Initially, button captions are not visible. memberclass Specifies the name of a member default class to use when new members are added to the container. memberclasslibrary Specifies the name of the class library containing the class associated with the MemberClass property. *getwindowref Returns an object reference to the window with the specified title. Parameter: cWindowTitle *hide Calls THIS.oForm.Hide(), if oForm is not null. *release Calls THIS.oForm.Release() and nulls out the internal object references .oReport and .oForm. *setreport Called automatically by the report engine, passed a reference to the active ReportListener object so that the preview may subsequently invoke its .OutputPage() method to display each page of the report. (Parameter: oReport) *show Called automatically by the report engine when the user has requested a new-style preview. The appropriate preview form class is instantiated and displayed, based on the REPORT FORM... command clauses. *setcurrentpage Commands the active preview form to navigate to a specific page. (Parameter: iPageNo) *setcanvascount Commands the active preview form to set the number of simultaneously visible pages to the specific value. Valid values: 1,2,4. (Parameter: iCount) *setzoomlevel Commands the active preview window to change its zoom level to the speciified value. Valid values: 1-11. (Parameter: iZoomLevel) *setextensionhandler Assign an object reference to handle preview extensions. (Parameter: oRef) *binstringtoint oform = .NULL. oreport = .NULL. caption = ("") canvascount = 0 currentpage = 0 zoomlevel = 0 toolbarisvisible = .NULL. extensionhandler = .NULL. previewformclass = frxPreviewForm _memberdata = 1732 allowprintfrompreview = .T. textontoolbar = .NULL. memberclass = ("") memberclasslibrary = ("") Name = "frxpreviewproxy" G(PROCEDURE getwindowref *----------------------------------------------------------------- * .GetWindowRef( cWindow ) * Given a window name from REPORT FORM.. WINDOW , * return an object reference to the window *----------------------------------------------------------------- lparameter cWindow *----------------------------------- * Fixed for SP1: declare oForm local *----------------------------------- local cTitle, oRef, oForm cTitle = wtitle(m.cWindow) oRef = null if not empty( m.cTitle ) for each oForm in _screen.Forms if upper(oForm.Caption) == upper(m.cTitle) and ; ((oForm.Class = "Form" and oForm.Name = "") or ; (upper(oForm.Name) == upper(m.cWindow))) oRef = m.oForm exit endif endfor endif return m.oRef ENDPROC PROCEDURE hide *----------------------------------------------------------------- * .Hide() *----------------------------------------------------------------- #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + "frxPreviewProxy::Hide()" #ENDIF if not isnull( THIS.oForm ) THIS.oForm.Hide() endif ENDPROC PROCEDURE release *----------------------------------------------------------------- * .Release() *----------------------------------------------------------------- #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + "frxPreviewProxy::Release()" #ENDIF if not isnull( THIS.oForm ) THIS.oForm.Release() endif THIS.ExtensionHandler = .null. THIS.oReport = .null. THIS.oForm = .null. ENDPROC PROCEDURE setreport *----------------------------------------------------------------- * .SetReport( oRef ) * This method will be called by the report engine, giving the * PreviewContainer a reference to the active ReportListener so * that it can invoke rendering methods to render the pages. * This reference will need to be saved in an internal property, * and nulled out appropriately in the .Reset()/.Destroy() events. *----------------------------------------------------------------- parameter toReport #IF DEBUG_METHOD_LOGGING debugout "" debugout space(program(-1)) + "frxPreviewProxy::SetReport(" + trans(m.toReport) + ")" #ENDIF *------------------------------------------ * SET STATUS BAR OFF * SET TALK ON * ... get lots of stuff echoed to the screen * so this will minimise it *------------------------------------------ if set("TALK")="ON" THIS.Tag = " " set talk off endif if not isnull( m.toReport ) and ; vartype( m.toReport ) = "O" *----------------------------------------------- * Change in SP2: This is no longer a constraint: *----------------------------------------------- * and toReport.BaseClass = "Reportlistener" *----------------------------------- * it's a valid Report Listener: *----------------------------------- THIS.oReport = m.toReport *------------------------------------------ * Support for a late addition to the * report listener's commandClauses object: *------------------------------------------ if vers(4) < "09.00.0000.2013" AddProperty( toReport.commandclauses, "IsDesignerProtected",.F.) endif *------------------------------------------ * Interrogate report protection and disable * the print button *------------------------------------------ if m.toReport.commandClauses.isDesignerProtected local iCurrSession, iRec, iProtFlags iCurrSession = set("DATASESSION") set datasession to (toReport.FrxDataSession) iRec = iif( eof("frx"),-1,recno("frx")) go top in frx iProtFlags = this.BinstringToInt( frx.ORDER ) if m.iRec = -1 go bottom in frx skip in frx else go m.iRec in frx endif set datasession to (m.iCurrSession) if bittest( m.iProtFlags, FRX_PROTECT_REPORT_NO_PRINT ) THIS.AllowPrintFromPreview = .F. endif endif *----------------------------------- * We're being passed a null reference * so clean up: *----------------------------------- if not isnull( THIS.oForm ) THIS.oForm.setReport( .NULL. ) * THIS.oForm.Release() endif THIS.oReport = .NULL. endif *------------------------------------------ * SET STATUS BAR OFF * SET TALK ON * ... get lots of stuff echoed to the screen * so this will minimise it *------------------------------------------ if THIS.Tag == " " THIS.Tag = "" set talk on endif ENDPROC PROCEDURE show *----------------------------------------------------------------- * .Show( imode ) * The Report engine / Listener object will invoke .Show() when * it is ready for the user to interact with the Preview UI. *----------------------------------------------------------------- lparameter iStyle #IF DEBUG_METHOD_LOGGING debugout "" debugout space(program(-1)) + "frxPreviewProxy::Show(" + trans(m.iStyle) + ")" #ENDIF *------------------------------------------ * Check for valid ReportListener reference. * We can not proceed if we don't have a * valid ReportListener guy: *------------------------------------------ if isnull(THIS.oReport) *------------------------------------- * Error. Show() may not be called * prior to .setReport() *------------------------------------- =messagebox(RP_INVALID_INITIALIZATION_LOC, 16, DEFAULT_MBOX_TITLE_LOC ) return endif *------------------------------------------ * SET STATUS BAR OFF * SET TALK ON * ... get lots of stuff echoed to the screen * so this will minimise it *------------------------------------------ if set("TALK")="ON" THIS.Tag = " " set talk off endif *------------------------------------------ * Ensure that Show() with no parameters is * handled correctly (we pass the param on) *------------------------------------------ if type("iStyle") = "L" iStyle = 0 endif #define DEFAULT_PREVIEW_CLASS "frxPreviewForm" local lcFormClass lcFormClass = DEFAULT_PREVIEW_CLASS && In current top form *------------------------------------------ * Determine the correct form class to instantiate: *------------------------------------------ do case case THIS.oReport.commandClauses.InScreen *-------------------------------------------- * Ensure the screen is visible and normal preview: *-------------------------------------------- lcFormClass = "frxPreviewInScreen" case THIS.oReport.commandClauses.InWindow = "SCREEN" *-------------------------------------------- * Just in case IN WINDOW SCREEN is resolved * as this clause instead: *-------------------------------------------- lcFormClass = "frxPreviewInScreen" case not empty( THIS.oReport.commandClauses.Window ) *-------------------------------------------- * Determine the kind of target window: *-------------------------------------------- local host host = THIS.getWindowRef( THIS.oReport.commandClauses.Window ) if not isnull( m.host ) and (host.Desktop or not empty(host.MacDesktop)) lcFormClass = "frxPreviewInDesktop" endif case THIS.TopForm *-------------------------------------------- * Not IN SCREEN, not IN WINDOW , and * explicitly asked for topform support: * Warning: Experimental! *-------------------------------------------- lcFormClass = "frxPreviewAsTopForm" endcase THIS.previewFormClass = m.lcFormClass *------------------------------------------ * Activate any other window involved in the * command. (e.g. to respect the IN WINDOW clause) *------------------------------------------ do case case THIS.oReport.commandClauses.InScreen *-------------------------------------------- * Ensure the screen is visible and normal preview: *-------------------------------------------- activate window screen case THIS.oReport.commandClauses.InWindow = "SCREEN" *-------------------------------------------- * Just in case IN WINDOW SCREEN is resolved * as this clause instead: *-------------------------------------------- activate window screen case not empty( THIS.oReport.commandClauses.InWindow ) *-------------------------------------------- * Determine the kind of host window: *-------------------------------------------- local host host = THIS.getWindowRef( THIS.oReport.commandClauses.InWindow ) if not isnull( m.host ) *-------------------------------------------- * Make sure it is active: *-------------------------------------------- activate window (THIS.oReport.commandClauses.InWindow) endif release host endcase *------------------------------------------ * Instantiate the preview form, if necessary: *------------------------------------------ local lReUse lReUse = .T. *------------------------------------------ * What prevents us from re-using the form? *------------------------------------------ do case case isnull( THIS.oForm ) *------------------------------------- * We don't have a form to re-use: *------------------------------------- lReUse = .F. case THIS.oForm.WindowType <> m.iStyle *------------------------------------- * We can't change modality on the fly *------------------------------------- lReUse = .F. case upper(THIS.oForm.Class) <> upper(THIS.PreviewFormClass) *------------------------------------- * It's the wrong class *------------------------------------- lReUse = .F. endcase if not m.lReUse if not isnull( THIS.oForm ) *-------------------------------------- * Dispose of the current form: *-------------------------------------- THIS.oForm.ExtensionHandler = null THIS.oForm.oReport = null THIS.oForm.Hide THIS.oForm = .null. endif *-------------------------------------- * Create a new form instance: *-------------------------------------- THIS.oForm = newobject(THIS.previewFormClass,"frxPreview") endif *------------------------------------------ * The new form needs a new reference to the listener: *------------------------------------------ THIS.oForm.setReport( THIS.oReport ) THIS.oForm.RestoreFromResource() *------------------------------------------ * Decorate the window: *------------------------------------------ do case case THIS.oReport.commandClauses.IsDesignerLoaded *------------------------------------------ * Called from the Report Designer. We can't use * IF WEXIST("REPORT DESIGNER") because it is possible * to use MODI REPORT ... WINDOW X where X has a different title. *------------------------------------------ local cDesignerWindow cDesignerWindow = wontop() if not empty(m.cDesignerWindow) cParent = wparent(m.cDesignerWindow) if empty(m.cParent) cParent = "SCREEN" endif local iRowPix, iColPix *-------------------------------------------------- * Calculate the co-ordinates of the Report Designer * in the parent window: *-------------------------------------------------- iRowPix = fontmetric(1, wfont(1,m.cParent), wfont(2,m.cParent), wfont(3,m.cParent) ) iColPix = fontmetric(6, wfont(1,m.cParent), wfont(2,m.cParent), wfont(3,m.cParent) ) THIS.oForm.Top = int( wlrow(m.cDesignerWindow) * m.iRowPix ) THIS.oForm.Left = int( wlcol(m.cDesignerWindow) * m.iColPix ) *-------------------------------------------------- * Calculate the width/height of the Report Designer: *-------------------------------------------------- iRowPix = fontmetric(1, wfont(1,m.cDesignerWindow), wfont(2,m.cDesignerWindow), wfont(3,m.cDesignerWindow) ) iColPix = fontmetric(6, wfont(1,m.cDesignerWindow), wfont(2,m.cDesignerWindow), wfont(3,m.cDesignerWindow) ) THIS.oForm.Width = int( wcols(m.cDesignerWindow) * m.iColPix ) THIS.oForm.Height = int( wrows(m.cDesignerWindow) * m.iRowPix ) THIS.oForm.Caption = m.cDesignerWindow * if wmaximum(m.cDesignerWindow) * THIS.oForm.WindowState = 2 * endif endif case not empty( THIS.oReport.commandClauses.Window ) *------------------------------------------ * Respect the WINDOW clause *------------------------------------------ local template template = THIS.getWindowRef( THIS.oReport.commandClauses.Window ) if not isnull( m.template ) with THIS.oForm .Caption = template.Caption .Top = template.Top .Left = template.Left .Width = template.Width .Height = template.Height .WindowState = template.WindowState && not minimised? .BorderStyle = template.BorderStyle .HalfHeightCaption = template.HalfHeightCaption endwith release template endif otherwise with THIS.oForm *------------------------------------- * Fix for SP2: Test for -1 * rather than 0 because otherwise you * can't override and set to 0. * Now of course, you can't set to -1. *------------------------------------- if THIS.Top > -1 .Top = THIS.Top endif if THIS.Left > -1 .Left = THIS.Left endif *------------------------------------- if THIS.Width > 0 .Width = THIS.Width endif if THIS.Height > 0 .Height = THIS.Height endif if not empty( THIS.Caption ) .Caption = THIS.Caption endif endwith endcase *------------------------------------------ * Changed for SP1: These have nothing to do * with the size and shape of the window: *------------------------------------------ with THIS.oForm *-------------------------------------------- * New in SP2: *-------------------------------------------- .MemberClass = THIS.MemberClass .MemberClassLibrary = THIS.MemberClassLibrary *-------------------------------------------- if THIS.canvasCount > 0 .canvasCount = THIS.canvasCount endif if THIS.currentPage > 0 .currentPage = THIS.currentPage endif if THIS.zoomLevel > 0 .zoomLevel = THIS.zoomLevel endif if not isnull( THIS.toolbarIsVisible ) .toolbarIsVisible = THIS.toolbarIsVisible endif if not isnull( THIS.TextOnToolbar ) .TextOnToolbar = THIS.TextOnToolbar endif .AllowPrintFromPreview = THIS.AllowPrintFromPreview endwith *------------------------------- * Hook in the extension handler: *------------------------------- if not isnull( THIS.ExtensionHandler ) THIS.oForm.extensionHandler = THIS.ExtensionHandler endif *------------------------------- * Show the form: *------------------------------- if THIS.oForm.ShowWindow = 2 *----------------------------------- * We're launching a top form which * must always be modeless. *----------------------------------- iStyle = 0 endif if m.iStyle = 1 *------------------------------------------ * Modal: We can show the form, then reset * the TALK setting: *------------------------------------------ THIS.oForm.Show(1) *------------------------------------------ * SET STATUS BAR OFF * SET TALK ON * ... get lots of stuff echoed to the screen * so this will minimise it *------------------------------------------ if THIS.Tag == " " THIS.Tag = "" set talk on endif *------------------------------------------ * Modeless. Restore TALK prior to showing *------------------------------------------ *------------------------------------------ * SET STATUS BAR OFF * SET TALK ON * ... get lots of stuff echoed to the screen * so this will minimise it *------------------------------------------ if THIS.Tag == " " THIS.Tag = "" set talk on endif THIS.oForm.Show() endif ENDPROC PROCEDURE setcurrentpage *----------------------------------------------------------------- * .SetCurrentPage( iPage ) *----------------------------------------------------------------- lparameter iPage THIS.currentPage = m.iPage if not isnull( THIS.oForm ) THIS.oForm.setCurrentPage( THIS.currentPage ) THIS.oForm.renderPages() return .T. return .F. endif ENDPROC PROCEDURE setcanvascount *----------------------------------------------------------------- * .SetCanvasCount( iCount ) *----------------------------------------------------------------- lparameter iCount THIS.canvasCount = m.iCount if not isnull( THIS.oForm ) THIS.oForm.actionSetCanvasCount( THIS.canvasCount ) THIS.oForm.renderPages() return .T. return .F. endif ENDPROC PROCEDURE setzoomlevel *----------------------------------------------------------------- * .SetZoomLevel( iLevel ) *----------------------------------------------------------------- lparameter iLevel THIS.zoomLevel = m.iLevel if not isnull( THIS.oForm ) THIS.oForm.actionSetZoom( THIS.zoomLevel ) return .F. endif ENDPROC PROCEDURE setextensionhandler *----------------------------------------------------------------- * .SetExtensionHandler( oRef ) *----------------------------------------------------------------- lparameter oRef THIS.ExtensionHandler = m.oRef if not isnull( THIS.oForm ) THIS.oForm.ExtensionHandler = THIS.ExtensionHandler return .T. return .F. endif ENDPROC PROCEDURE binstringtoint *======================================================= * BinstringToInt( char ) * Returns a numeric equivalent of a binary data in string * form. * BinChar & Integer conversion, based on code by RS *======================================================= lparameter cByte local iReturn, i, b iReturn = 0 for m.i = len( m.cByte ) to 1 step -1 b = asc( substr( m.cByte, m.i, 1 )) iReturn = (m.iReturn*256) + m.b endfor return m.iReturn ENDPROC PROCEDURE Init #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + "frxPreviewProxy::Init()" #ENDIF THIS.Width = 0 THIS.Height = 0 * New in SP1: THIS.Top = -1 THIS.Left = -1 ENDPROC PROCEDURE Destroy *----------------------------------------------------------------- * .Destroy() *----------------------------------------------------------------- #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + "frxPreviewProxy::Destroy()" #ENDIF *-------------------------------------------- * Try this to ensure no hanging references... *-------------------------------------------- if not isnull( THIS.oForm ) THIS.oForm.Release() endif ENDPROC OPREVIEWFORM PREVIEWFORM CBOZOOM CLEAR ZOOMLEVELS ADDITEM DISPLAYCOUNT CBOZOOM VALUE PREVIEWFORM ZOOMLEVEL IPAGESALLOWED ZOOMLEVELS OPGPAGECOUNT ENABLED CANVASCOUNT CURRENTPAGE CNTPREV CMDTOP CMDBACK PAGETOTAL CNTNEXT CMDFORWARD CMDBOTTOM CMDGOTOPAGE IZOOMINDEX OFORM PREVIEWFORM ZOOMLEVEL ACTIONSETZOOM IGNOREMOUSECLICKINMAGNIFYCODE CPOINT GETMOUSEPOINTERPOS CAPTION CBOZOOM WIDTH HEIGHT FONTNAME FONTSIZE VALUE SETMOUSEPOINTERPOS CWINDOW CTITLE OFORM FORMS CAPTION CLASS OPGPAGECOUNT VALUE PREVIEWFORM ACTIONSETCANVASCOUNT cmdPrint Caption AutoSizea AutoSize- Height PREVIEWFORM CAPTION FORMCAPTION CMDPRINT VISIBLE ALLOWPRINTFROMPREVIEW TEXTONTOOLBAR OCONTROL CONTROLS SETALL Print Preview PreviewToolbar GetCursorPos user32Q GetMousePointerPos SetCursorPos user32Q SetMousePointerPos CAPTION GETCURSORPOS USER32 GETMOUSEPOINTERPOS SETCURSORPOS SETMOUSEPOINTERPOS+ PREVIEWFORM TOOLBARISVISIBLE ErrorHandler pr_frxpreview.prg IERROR CMETHOD ILINE HANDLE THIS CANCELLED SUSPENDED previewform_assign, synchcontrols. actionzoomlevel* getwindowref actionpagecount( Refresh Destroy Error SUPPRESSRENDERING RELEASE- SETCURRENTPAGE RENDERPAGES SYNCHTOOLBAR< SETCURRENTPAGE PAGETOTAL CANVASCOUNT RENDERPAGES SYNCHTOOLBAR CURRENTPAGE CANVASCOUNT OREPORT OUTPUTPAGECOUNT SETCURRENTPAGE SUPPRESSRENDERING RENDERPAGES SYNCHTOOLBARj CURRENTPAGE SETCURRENTPAGE CANVASCOUNT RENDERPAGES SYNCHTOOLBAR frxGoToPageForm frxPreview.vcx LOFORM IPAGENO OPARENTFORM SHOWTOOLBAR PAGENO CURRENTPAGE SETCURRENTPAGE 09.00.0000.3504 OREPORT COMMANDCLAUSES NOWAIT PRINTCACHEDPAGES SUPPRESSRENDERING PRINTONEXIT RELEASE! ICOUNT SETCANVASCOUNT! IZOOMLEVEL SETZOOMLEVEL TOOLBAR TOOLBARISVISIBLE CREATETOOLBAR SHOWTOOLBAR First page prefirst.bmp Previous preprev.bmp First page prefirst.bmp Previous preprev.bmp prenext.bmp Last page prelast.bmp prenext.bmp Last page prelast.bmp Go to page... preview.bmp Pages to display Toolbar 09.00.0000.3301 Print print.bmp Close preclose.bmp oRef.actionGoFirst() oRef.actionGoPrev() oRef.actionGoNext() oRef.actionGoLast() oRef.actionGoToPage() ON BAR 7 OF (m.cShortcut) ACTIVATE POPUP &cZoom ON BAR 8 OF (m.cShortcut) ACTIVATE POPUP &cPages oRef.actionToolbarVisibility() oRef.actionPrint() oRef.actionClose() About... oRef.actionShowInfo() oref.actionSetZoom( bar() ) 1 page 2 pages 2 pages 4 pages 4 pages oRef.actionSetCanvasCount(1) oRef.actionSetCanvasCount(2) oRef.actionSetCanvasCount(4) AddBarsToMenu LVIAKEYPRESS ALLOWOUTPUT OPREVIEWCONTAINER CSHORTCUT CZOOM CPAGES SHOWWINDOW CURRENTPAGE CANVASCOUNT PAGETOTAL TOOLBAR TOOLBARISVISIBLE WINDOWTYPE ALLOWPRINTFROMPREVIEW ZOOMLEVELS ZOOMLEVEL IPAGESALLOWED EXTENSIONHANDLER ADDBARSTOMENU IGNOREMOUSECLICKINMAGNIFYCODE3 Image An exception ocurred invoking .OutputPage():C Report Preview Image IPAGE OCANVAS OREPORT OUTPUTPAGECOUNT BASECLASS VISIBLE OUTPUTPAGE MESSAGE TOREPORT OREPORT FRXFILENAME COMMANDCLAUSES LENABLED TOOLBAR CONTROLS ENABLED SYNCHTOOLBAR SHOWWINDOW CAPTION Image Image Image SUPPRESSRENDERING SPACER BACKCOLOR WIDTH HEIGHT ILEFT IWIDTH IHEIGHT IZOOMPERCENT GETZOOMPERCENT PAGEWIDTH SCREENDPI PAGEHEIGHT ZOOMLEVEL ZOOMLEVELS SCROLLBARS CANVASCOUNT CANVAS1 BASECLASS VISIBLE CANVAS2 CANVAS3 CANVAS4 - Page - Page ICURRENTPAGE CURRENTPAGE STARTOFFSET OREPORT COMMANDCLAUSES WINDOW CANVASCOUNT LASTPAGE PAGETOTAL CAPTION FORMCAPTION* TOOLBAR SYNCHCONTROLS IPAGE CURRENTPAGE OREPORT OUTPUTPAGECOUNT SYNCHPAGENO RENDERPAGES SYNCHTOOLBARZ Preview version: 9.5.0.0 .pageTotal = .currentPage = .canvasCount = .pageHeight = .pageWidth = _PAGENO = THIS.oReport.commandClauses: THIS.oReport.commandClauses.C Report Preview CTEXT THIS PAGETOTAL CURRENTPAGE CANVASCOUNT PAGEHEIGHT PAGEWIDTH OREPORT COMMANDCLAUSES CFIELD IZOOMPERCENT THIS ZOOMLEVEL ZOOMLEVELS NPREVIEWFORMASPECTRATIO NPAGEASPECTRATIO IREQUIREDHEIGHT IREQUIREDWIDTH WIDTH HEIGHT CANVASCOUNT PAGEWIDTH PAGEHEIGHT SCREENDPI RenderPages SUPPRESSRENDERING IPAGETORENDER CURRENTPAGE CANVASCOUNT RENDERPAGE CANVAS1 CANVAS2 CANVAS3 CANVAS4 EXTENSIONHANDLER RENDERPAGES NOTIFY NOTIFYv TALKv ResourceManager frxcommon.prg 92REPREVIEWC PreviewForm.Top PreviewForm.Left PreviewForm.Width PreviewForm.Width PreviewForm.Height PreviewForm.Height PreviewForm.WindowState PreviewForm.ToolbarIsVisible PreviewForm.CanvasCount PreviewForm.ZoomLevel PreviewToolbar.Top PreviewToolbar.Left PreviewToolbar.Width PreviewToolbar.Height PreviewToolbar.DockPosition 92REPREVIEWC LSETNOTIFY LSETNOTIFY2 LSETTALK ICURRENTSTATE WINDOWSTATE LOADRESOURCE FRXFILENAME OREPORT COMMANDCLAUSES ISDESIGNERLOADED WIDTH VIEWPORTWIDTH HEIGHT VIEWPORTHEIGHT TOOLBARISVISIBLE CANVASCOUNT ZOOMLEVEL TOOLBAR DOCKPOSITION SAVERESOURCE ResourceManager frxcommon.prg 92REPREVIEWC PreviewForm.Top PreviewForm.Left PreviewForm.Width PreviewForm.Height PreviewForm.WindowState PreviewForm.ToolbarIsVisible PreviewForm.CanvasCount PreviewForm.ZoomLevel PreviewToolbar.Top PreviewToolbar.Left PreviewToolbar.Width PreviewToolbar.Height PreviewToolbar.DockPosition ICURRENTSTATE CVALUE LOADRESOURCE FRXFILENAME WIDTH HEIGHT OREPORT COMMANDCLAUSES ISDESIGNERLOADED WINDOWSTATE TOOLBARISVISIBLE CANVASCOUNT ZOOMLEVEL TOOLBAR SHOWWINDOW CANVAS1 WIDTH PAGEWIDTH frxPreviewToolbar frxPreview.vcx InitializeToolbar TOOLBAR PREVIEWFORM EXTENSIONHANDLER INITIALIZETOOLBAR REFRESH PreviewForm OEXTHANDLER EXTENSIONHANDLER PREVIEWFORM Empty CONVERSIONFACTOR GETPIXELSPERDPI960 CANVAS1 OFFSETG Command STARTMODE HIDCOMMANDWINDOW COMMAND` Command STARTMODE COMMAND HIDCOMMANDWINDOW Canvas1 Canvas2 Canvas3 Canvas4 Canvas1 Canvas2 Canvas3 Canvas4 Canvas1 ShapeCanvas Canvas2 ShapeCanvas Canvas3 ShapeCanvas Canvas4 ShapeCanvas CreateCanvases MEMBERCLASS MEMBERCLASSLIBRARY NEWOBJECT CLASSLIBRARY CANVAS1 VISIBLE CANVAS2 CANVAS3 CANVAS4 EXTENSIONHANDLER CREATECANVASES8 THIS.Canvas1b Shape ICANVASCOUNT CANVASCOUNT CANVAS1 BASECLASS CANVAS2 VISIBLE CANVAS3 CANVAS49 IZOOMLEVEL ZOOMLEVELS ZOOMLEVEL SETVIEWPORT IPAGESALLOWED CANVASCOUNT TEMPSTOPREPAINT SYNCHCANVASES RENDERPAGES SYNCHPAGENO SYNCHTOOLBAR SCROLLBARS ICOUNT CANVASCOUNT SUPPRESSRENDERING SETVIEWPORT SYNCHCANVASES RENDERPAGES SYNCHPAGENO SYNCHTOOLBAR IBUTTON NSHIFT NXCOORD NYCOORD IGNOREMOUSECLICKINMAGNIFYCODE CANVAS1 WIDTH HEIGHT ZOOMLEVEL ZOOMLEVELS CLICKXOFFSETPERCENT CLICKYOFFSETPERCENT ACTIONSETZOOM NEWVIEWPORTX NEWVIEWPORTY SETVIEWPORT MOUSEFLAG8 TOOLBAR TOOLBARISVISIBLE2 TOOLBARISVISIBLE SHOWTOOLBAR RESIZE' TOOLBARISVISIBLE TOOLBAR Destroy EXTENSIONHANDLER DESTROY TOOLBAR PREVIEWFORM OREPORT% Whole Page Fit to Width ZOOMLEVELS CREATETOOLBAR MINWIDTH MINHEIGHT HandledKeyPress NKEYCODE NSHIFTALTCTRL LHANDLEDKEYPRESS IPAGESALLOWED ZOOMLEVELS ZOOMLEVEL EXTENSIONHANDLER HANDLEDKEYPRESS ACTIONCLOSE INVOKECONTEXTMENU ACTIONSETZOOM ACTIONGOTOPAGE SETVIEWPORT VIEWPORTLEFT VIEWPORTTOP ACTIONGOPREV ACTIONGONEXT ACTIONGOFIRST ACTIONGOLAST ACTIONSETCANVASCOUNT Image Paint TEMPSTOPREPAINT CANVAS1 BASECLASS RENDERPAGES EXTENSIONHANDLER PAINT RELEASE Release 09.00.0000.1800 OREPORT EXTENSIONHANDLER RELEASE SAVETORESOURCE COMMANDCLAUSES PRINTPAGECURRENT CURRENTPAGE ONPREVIEWCLOSE PRINTONEXIT SHOWCOMMANDWINDOW HIDE4 THIS ZOOMLEVEL ZOOMLEVELS SYNCHCANVASES INVOKECONTEXTMENUs InitializeToolbar There are no pages available to preview. Report Preview Report Preview 09.00.0000.3301 ISTYLE EXTENSIONHANDLER INITIALIZETOOLBAR PAGETOTAL OREPORT OUTPUTPAGECOUNT STARTOFFSET CANVASCOUNT ISNOWAIT CAPTION COMMANDCLAUSES ISDESIGNERLOADED WINDOW PRINTJOBNAME FRXFILENAME FORMCAPTION SETCURRENTPAGE CURRENTPAGE SHOWWINDOW TOOLBARISVISIBLE TOOLBAR REFRESH SHOWTOOLBAR IWIDTH IHEIGHT GETPAGEWIDTH GETPAGEHEIGHT PAGEWIDTH PAGEHEIGHT CREATECANVASES SYNCHCANVASES MINBUTTON HIDECOMMANDWINDOW RENDERPAGES INWINDOW HandledError IERROR CMETHOD ILINE EXTENSIONHANDLER HANDLEDERROR actionclose, actiongofirstp actiongolast actiongonext[ actiongoprev actiongotopage\ actionprint actionsetcanvascount actionsetzoom actiontoolbarvisibility3 invokecontextmenu renderpage setreportU showtoolbar synchcanvases synchpagenoc synchtoolbar setcurrentpage actionshowinfo getzoompercent renderpages$( savetoresourceB* restorefromresourcei0 getpixelsperdpi960\6 createtoolbar extensionhandler_assign getpixelpageoffsetsr8 showcommandwindow hidecommandwindowI: createcanvases canvascount_assign setzoomlevel setcanvascountiA MouseUp HidewE Activate Deactivate=F Destroy InitnG KeyPress Paint QueryUnload Release Resize RightClick Show3V Error PROCEDURE actionclose *--------------------------------------------------------------- * .ActionClose() - called from toolbar/context menu * The action we take depends on whether we're hiding or releasing... *--------------------------------------------------------------- THIS.suppressRendering = .T. THIS.Release() ENDPROC PROCEDURE actiongofirst *-------------------------------------------------------------- * ActionGoFirst() *-------------------------------------------------------------- THIS.setCurrentPage(1) THIS.RenderPages() THIS.synchToolbar() ENDPROC PROCEDURE actiongolast *-------------------------------------------------------------- * ActionGoLast() *-------------------------------------------------------------- THIS.setCurrentPage(THIS.pageTotal - (THIS.canvasCount - 1)) THIS.RenderPages() THIS.synchToolbar() ENDPROC PROCEDURE actiongonext *-------------------------------------------------------------- * ActionGoNext() *-------------------------------------------------------------- if (THIS.currentPage + THIS.canvasCount > THIS.oReport.OutputPageCount) ?? chr(7) THIS.setCurrentPage( THIS.currentPage + THIS.canvasCount ) if (THIS.oReport.OutputPageCount - THIS.currentPage) < (THIS.CanvasCount - 1) *------------------------------------------------ * Clear the form to remove unused canvas images * that will not be re-rendered: *------------------------------------------------ THIS.SuppressRendering = .T. THIS.Cls() THIS.SuppressRendering = .F. endif THIS.RenderPages() THIS.synchToolbar() endif ENDPROC PROCEDURE actiongoprev *-------------------------------------------------------------- * ActionGoPrev() *-------------------------------------------------------------- if THIS.currentPage > 1 THIS.setCurrentPage( max( THIS.currentPage - THIS.canvasCount, 1 )) THIS.RenderPages() THIS.synchToolbar() ?? chr(7) endif ENDPROC PROCEDURE actiongotopage *----------------------------------------------------------- * ActionGoToPage() *----------------------------------------------------------- #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + "frxPreviewForm::ActionGoToPage()" #ENDIF local loForm, iPageNo loForm = newobject("frxGoToPageForm","frxPreview.vcx") *----------------------------------------- * Fix for SP1: Pass it a ref to this form * Addresses bug# 474691 * See frxGoToPageForm::Show() *----------------------------------------- loForm.oParentForm = THIS THIS.ShowToolbar(.F.) loForm.Show( WINDOWTYPE_MODAL ) THIS.ShowToolbar(.T.) iPageNo = loForm.PageNo release m.loForm *------------------------------------ * Fix for SP1: * Ensure this form gets keypresses * after showing the child dialog: *------------------------------------ activate Window (THIS.Name) if m.iPageNo <> THIS.currentPage THIS.setCurrentPage( m.iPageNo ) endif ENDPROC PROCEDURE actionprint *--------------------------------------------------------------- * ActionPrint() - called from toolbar or context menu *--------------------------------------------------------------- *---------------------------------------------- * Enhancement for SP2: *---------------------------------------------- if version(4) > "09.00.0000.3504" *---------------------------------------------------- * SP2 behavior: If NOWAIT, print without terminating: *---------------------------------------------------- if THIS.oReport.commandClauses.NOWAIT THIS.oReport.PrintCachedPages() else * Terminate: THIS.suppressRendering = .T. THIS.printOnExit = .T. THIS.Release() endif *---------------------------------------------------- * Pre-SP2 behavior: terminate: *---------------------------------------------------- THIS.suppressRendering = .T. THIS.printOnExit = .T. THIS.Release() endif ENDPROC PROCEDURE actionsetcanvascount *----------------------------------------------------- * ActionSetCanvasCount() *----------------------------------------------------- lparameter iCount #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + "frxPreviewForm::ActionSetCanvasCount()" #ENDIF THIS.SetCanvasCount( m.iCount ) return ENDPROC PROCEDURE actionsetzoom *----------------------------------------------------- * ActionSetZoom() *----------------------------------------------------- lparameters iZoomLevel #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + "frxPreviewForm::ActionSetZoom()" #ENDIF THIS.SetZoomLevel( m.iZoomLevel ) return ENDPROC PROCEDURE actiontoolbarvisibility *-------------------------------------------------- * .ActionToolbarVisibility() - called from menu *-------------------------------------------------- if isnull( THIS.toolbar ) THIS.ToolbarIsVisible = .F. THIS.CreateToolbar() endif if THIS.ToolbarIsVisible * Hide the toolbar: THIS.Toolbar.Hide() THIS.ToolbarIsVisible = .F. * Show the toolbar: THIS.ShowToolbar(.T.) THIS.ToolbarIsVisible = .T. endif ENDPROC PROCEDURE invokecontextmenu *======================================================================= * .InvokeContextMenu() * Show the default context menu for the preview window: *======================================================================= lparameter lViaKeypress #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + "frxPreviewForm::InvokeContextMenu()" #ENDIF THIS.AllowOutput = .T. activate window (THIS.Name) *---------------------------------------------- * Enh for SP2: oPreviewContainer is also available *---------------------------------------------- private oRef, oPreviewContainer store THIS to ; oRef, oPreviewContainer local cShortcut, cZoom, cPages cShortcut = sys(2015) cZoom = sys(2015) cPages = sys(2015) if oRef.ShowWindow = SHOWWINDOW_AS_TOPFORM if m.lViaKeypress define popup (m.cShortcut) ; shortcut ; relative ; in window (oRef.Name) ; from 1,1 else define popup (m.cShortcut) ; shortcut ; relative ; in window (oRef.Name) ; from mrow(oRef.Name),mcol(oRef.Name) endif if m.lViaKeypress *------------------------------- * Fix in SP1: no in window clause *------------------------------- define popup (m.cShortcut) ; shortcut ; relative ; from 1,1 else define popup (m.cShortcut) ; shortcut ; relative ; from mrow(), mcol() endif endif if (THIS.currentPage > THIS.canvasCount ) DEFINE BAR 1 OF (m.cShortcut) PROMPT CONTEXT_MENU_PROMPT_FIRST_PAGE_LOC picture "prefirst.bmp" DEFINE BAR 2 OF (m.cShortcut) PROMPT CONTEXT_MENU_PROMPT_PREVIOUS_LOC picture "preprev.bmp" DEFINE BAR 1 OF (m.cShortcut) PROMPT "\"+CONTEXT_MENU_PROMPT_FIRST_PAGE_LOC picture "prefirst.bmp" DEFINE BAR 2 OF (m.cShortcut) PROMPT "\"+CONTEXT_MENU_PROMPT_PREVIOUS_LOC picture "preprev.bmp" endif if ( THIS.currentPage < (THIS.pageTotal - (THIS.canvasCount-1) )) DEFINE BAR 3 OF (m.cShortcut) PROMPT CONTEXT_MENU_PROMPT_NEXT_LOC picture "prenext.bmp" DEFINE BAR 4 OF (m.cShortcut) PROMPT CONTEXT_MENU_PROMPT_LAST_PAGE_LOC picture "prelast.bmp" DEFINE BAR 3 OF (m.cShortcut) PROMPT "\"+CONTEXT_MENU_PROMPT_NEXT_LOC picture "prenext.bmp" DEFINE BAR 4 OF (m.cShortcut) PROMPT "\"+CONTEXT_MENU_PROMPT_LAST_PAGE_LOC picture "prelast.bmp" endif DEFINE BAR 5 OF (m.cShortcut) PROMPT CONTEXT_MENU_PROMPT_GO_TO_PAGE_LOC DEFINE BAR 6 OF (m.cShortcut) PROMPT "\-" DEFINE BAR 7 OF (m.cShortcut) PROMPT CONTEXT_MENU_PROMPT_ZOOM_LOC picture "preview.bmp" DEFINE BAR 8 OF (m.cShortcut) PROMPT CONTEXT_MENU_PROMPT_PAGES_TO_DISPLAY_LOC DEFINE BAR 9 OF (m.cShortcut) PROMPT "\-" DEFINE BAR 10 OF (m.cShortcut) PROMPT CONTEXT_MENU_PROMPT_TOOLBAR_LOC if isnull( THIS.toolbar ) or THIS.ToolbarIsVisible = .F. set Mark of bar 10 of (m.cShortcut) to .F. set Mark of bar 10 of (m.cShortcut) to .T. endif *---------------------------------------------- * Fix for versions earlier than SP1: Bug# 475109 *---------------------------------------------- if version(4) < "09.00.0000.3301" if oRef.WindowType = WINDOWTYPE_MODAL and ; oRef.ShowWindow = SHOWWINDOW_IN_TOPFORM and ; not empty(wparent(THIS.Name)) * if we are modal and inside a topform app, * the toolbar will be unavailable, so don't * let it be shown: set Skip of bar 10 of (m.cShortCut) .T. endif endif DEFINE BAR 11 OF (m.cShortcut) PROMPT "\-" DEFINE BAR 12 OF (m.cShortcut) PROMPT CONTEXT_MENU_PROMPT_PRINT_LOC picture "print.bmp" DEFINE BAR 13 OF (m.cShortcut) PROMPT CONTEXT_MENU_PROMPT_CLOSE_LOC picture "preclose.bmp" ON SELECTION BAR 1 OF (m.cShortcut) oRef.actionGoFirst() ON SELECTION BAR 2 OF (m.cShortcut) oRef.actionGoPrev() ON SELECTION BAR 3 OF (m.cShortcut) oRef.actionGoNext() ON SELECTION BAR 4 OF (m.cShortcut) oRef.actionGoLast() ON SELECTION BAR 5 OF (m.cShortcut) oRef.actionGoToPage() ON BAR 7 OF (m.cShortcut) ACTIVATE POPUP &cZoom ON BAR 8 OF (m.cShortcut) ACTIVATE POPUP &cPages ON SELECTION BAR 10 OF (m.cShortcut) oRef.actionToolbarVisibility() ON SELECTION BAR 12 OF (m.cShortcut) oRef.actionPrint() ON SELECTION BAR 13 OF (m.cShortcut) oRef.actionClose() *------------------------------------------------------ * Fix for SP1: include "About..." option if via keypress *------------------------------------------------------ if DEBUG_MENU_INFO_OPTION or m.lViaKeypress DEFINE Bar 14 of (m.cShortcut) prompt CONTEXT_MENU_PROMPT_INFODEBUG_LOC ON SELECTION BAR 14 OF (m.cShortcut) oRef.actionShowInfo() endif if not THIS.AllowPrintFromPreview release bar 12 of (m.cShortcut) endif *------------------------------- Set the mark: set Mark of bar 10 of (m.cShortcut) to oRef.ToolbarIsVisible *------------------------------------------------------ * Define the Page Count popup: *------------------------------------------------------ DEFINE POPUP (m.cZoom) SHORTCUT RELATIVE local i for i = 1 to alen(THIS.zoomLevels,1) define Bar m.i of(m.cZoom) prompt THIS.zoomLevels[m.i,ZOOM_LEVEL_PROMPT] on Selection Bar m.i of (m.cZoom) oref.actionSetZoom( bar() ) endfor *---------------------- Set the mark: set mark of bar (THIS.ZoomLevel) of (m.cZoom) to .T. *------------------------------------------------------ * Define the Page Count popup: *------------------------------------------------------ DEFINE POPUP (m.cPages) SHORTCUT RELATIVE DEFINE BAR 1 OF (m.cPages) PROMPT CONTEXT_MENU_PROMPT_1PAGE_LOC *---------------------- Disable multi-page view for high zoom levels: local iPagesAllowed iPagesAllowed = THIS.zoomLevels[ THIS.zoomLevel, ZOOM_LEVEL_CANVAS ] if m.iPagesAllowed > 1 DEFINE BAR 2 OF (m.cPages) PROMPT CONTEXT_MENU_PROMPT_2PAGES_LOC DEFINE BAR 2 OF (m.cPages) PROMPT "\"+CONTEXT_MENU_PROMPT_2PAGES_LOC endif if m.iPagesAllowed > 2 DEFINE BAR 3 OF (m.cPages) PROMPT CONTEXT_MENU_PROMPT_4PAGES_LOC DEFINE BAR 3 OF (m.cPages) PROMPT "\"+CONTEXT_MENU_PROMPT_4PAGES_LOC endif ON SELECTION BAR 1 OF (m.cPages) oRef.actionSetCanvasCount(1) ON SELECTION BAR 2 OF (m.cPages) oRef.actionSetCanvasCount(2) ON SELECTION BAR 3 OF (m.cPages) oRef.actionSetCanvasCount(4) *---------------------- Set the mark: do case case THIS.canvasCount = 1 set Mark of bar 1 of (m.cPages) to .T. case THIS.canvasCount = 2 set Mark of bar 2 of (m.cPages) to .T. case THIS.canvasCount = 4 set Mark of bar 3 of (m.cPages) to .T. endcase *--------------------------------------------------- * Plug in extension handler: *------------------------------------------------------ if not isnull( THIS.Extensionhandler ) *----------------------------------- * Fixed for SP1: Only invoke the method * if it is defined: *----------------------------------- if pemstatus( THIS.ExtensionHandler, "AddBarsToMenu", 5 ) #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + " frxPreviewForm.ExtensionHandler::AddBarsToMenu()" #ENDIF *--------------------------------------------- * The form is available in commands as m.oRef *--------------------------------------------- THIS.ExtensionHandler.AddBarsToMenu( m.cShortcut, 15 ) endif endif *---------------------------------------------- * Fix in SP3 * See previewForm.MouseUp for code that respects this: *---------------------------------------------- THIS.IgnoreMouseClickInMagnifyCode = .T. #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + " activating popup " + m.cShortcut #ENDIF *------------------------------------------------------ * Display the menu: *------------------------------------------------------ activate popup (m.cShortcut) #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + " releasing popup" #ENDIF *------------------------------------------------------ * Cleanup: *------------------------------------------------------ release popup (m.cShortcut) release popup (m.cPages) release popup (m.cZoom) THIS.AllowOutput = .F. ENDPROC PROCEDURE renderpage *--------------------------------------------------------- * .RenderPage() * New in SP2: Support for Image canvas classes. *--------------------------------------------------------- lparameters iPage, oCanvas #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + "frxPreviewForm::RenderPage("+ trans( m.iPage ) + ")" #ENDIF if between( m.iPage, 1, THIS.oReport.OutputPageCount ) if m.oCanvas.BaseClass = "Image" and m.oCanvas.Visible = .F. oCanvas.Visible = .T. endif THIS.oReport.OutputPage( m.iPage, m.oCanvas, 2 ) catch to oErr =messagebox( RP_OUTPUTPAGE_ERROR_LOC + c_CR2 + oErr.Message, 0+16, DEFAULT_MBOX_TITLE_LOC ) endtry if oCanvas.BaseClass = "Image" oCanvas.Visible = .F. endif endif ENDPROC PROCEDURE setreport *--------------------------------------------------------------- * This method will be called by the report engine, giving the * PreviewUI a reference to the Listener so that it can invoke * rendering methods to render the pages. This reference will * need to be saved in an internal property, and nulled out * appropriately in the .Destroy() event. *--------------------------------------------------------------- parameter toReport #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + "frxPreviewForm::SetReport(" + trans(m.toReport) + ")" #ENDIF if not isnull( m.toReport ) and ; vartype( m.toReport ) = "O" *----------------------------------------------- * Change in SP2: This is no longer a constraint: *----------------------------------------------- * and toReport.BaseClass = "Reportlistener" *----------------------------------- * it's a valid Report Listener: *----------------------------------- THIS.oReport = m.toReport *------------------------------- * What report file are we running? *------------------------------- THIS.frxFilename = lower(justfname( THIS.oReport.commandclauses.file )) *----------------------------------- * Cleanup: *----------------------------------- THIS.oReport = .NULL. *--------------------------------------- * Without a reportListener to communicate with, * We have no reason to be visible: *--------------------------------------- THIS.Hide() endif ENDPROC PROCEDURE showtoolbar *--------------------------------------------------------------- * ShowToolbar() - called from .Show() *--------------------------------------------------------------- lparameter lEnabled #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + "frxPreviewForm::ShowToolbar(" + trans(m.lEnabled) + ")" #ENDIF if m.lEnabled * Show the toolbar, enabled and visible * Enable controls on the toolbar: local x for each x in THIS.toolbar.Controls x.Enabled = .T. endfor THIS.synchToolbar() *------------------------------------------ * Support for topforms: *------------------------------------------ if THIS.ShowWindow = SHOWWINDOW_AS_TOPFORM * Topforms are always modeless: if not upper(wontop())==upper(THIS.Name) activate window (THIS.Name) endif activate Window (THIS.toolbar.caption) in window (this.Name) *------------------------------------------ * Dock the toolbar if we're a topform: *------------------------------------------ this.toolbar.dock(0) else this.toolbar.Show() endif *----------------------------------- * Disable controls on the toolbar: *----------------------------------- local x for each x in THIS.toolbar.Controls x.Enabled = .F. endfor endif ENDPROC PROCEDURE synchcanvases *--------------------------------- * SynchCanvases() - * re-arrange the Shapes on the page to match the * current settings: *--------------------------------- #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + "frxPreviewForm::SynchCanvases()" #ENDIF with THIS *----------------------------------------------------- * Prevent .RenderPages() from being called from within * the .Paint() event: *----------------------------------------------------- .SuppressRendering = .T. *----------------------------------------------------- * Use a spacer to allow the scrolling to have a * a border to the right and bottom of the window: *----------------------------------------------------- .Spacer.BackColor = .BackColor .Spacer.Width = CANVAS_LEFT_OFFSET_PIXELS .Spacer.Height = CANVAS_TOP_OFFSET_PIXELS local iLeft, iWidth, iHeight, iZoomPercent iZoomPercent = THIS.getZoomPercent() iWidth = int( .pageWidth * .screenDPI * (m.iZoomPercent/100) ) iHeight = int( .pageHeight * .screenDPI * (m.iZoomPercent/100) ) do case case THIS.ZoomLevel < alen(THIS.zoomLevels,1)-1 *--------------------------------------------------- * Enable scrollbars for arbitary zoom: *--------------------------------------------------- if THIS.ScrollBars <> 3 THIS.ScrollBars = 3 endif case THIS.ZoomLevel = alen(THIS.ZoomLevels,1)-1 *--------------------------------------------------- * Turn off scrollbars for fit to page *--------------------------------------------------- if THIS.ScrollBars > 0 THIS.ScrollBars = 0 endif otherwise *--------------------------------------------------- * Just vertical for fit to width *--------------------------------------------------- if THIS.ScrollBars <> 2 THIS.ScrollBars = 2 endif endcase *-------------------------------- * Arrange the shapes on the page: * [1][2] * [3][4] *-------------------------------- do case case .canvasCount = 1 if this.Canvas1.Baseclass = "Image" store .T. to this.Canvas1.Visible store .F. to ; this.Canvas2.Visible,; this.Canvas3.Visible,; this.Canvas4.Visible endif if THIS.zoomLevel = alen(THIS.zoomLevels,1) *------------------------------------------- * Auto-zoom mode, center the page: *------------------------------------------- iLeft = int((.Width - m.iWidth)/2) else iLeft = CANVAS_LEFT_OFFSET_PIXELS endif .canvas1.Move( m.iLeft, ; CANVAS_TOP_OFFSET_PIXELS, ; m.iWidth, m.iHeight ) .spacer.Move( m.iLeft + m.iWidth, CANVAS_TOP_OFFSET_PIXELS + m.iHeight ) case .canvasCount = 2 if this.Canvas1.Baseclass = "Image" store .T. to ; this.Canvas1.Visible, ; this.Canvas2.Visible store .F. to ; this.Canvas3.Visible,; this.Canvas4.Visible endif .canvas1.Move( CANVAS_LEFT_OFFSET_PIXELS, ; CANVAS_TOP_OFFSET_PIXELS, ; m.iWidth, m.iHeight ) .canvas2.Move( CANVAS_LEFT_OFFSET_PIXELS + m.iWidth + CANVAS_HORIZONTAL_GAP_PIXELS, ; CANVAS_TOP_OFFSET_PIXELS, ; m.iWidth, m.iHeight ) .spacer.Move( .canvas2.Left + .canvas2.Width, ; .canvas2.Top + .canvas2.Height ) case .canvasCount = 4 if this.Canvas1.Baseclass = "Image" store .T. to ; this.Canvas1.Visible, ; this.Canvas2.Visible, ; this.Canvas3.Visible, ; this.Canvas4.Visible endif .canvas1.Move( CANVAS_LEFT_OFFSET_PIXELS, ; CANVAS_TOP_OFFSET_PIXELS, ; m.iWidth, m.iHeight ) .canvas2.Move( CANVAS_LEFT_OFFSET_PIXELS + m.iWidth + CANVAS_HORIZONTAL_GAP_PIXELS, ; CANVAS_TOP_OFFSET_PIXELS, ; m.iWidth, m.iHeight ) .canvas3.Move( CANVAS_LEFT_OFFSET_PIXELS, ; CANVAS_TOP_OFFSET_PIXELS + m.iHeight + CANVAS_VERTICAL_GAP_PIXELS, ; m.iWidth, m.iHeight ) .canvas4.Move( CANVAS_LEFT_OFFSET_PIXELS + m.iWidth + CANVAS_HORIZONTAL_GAP_PIXELS, ; CANVAS_TOP_OFFSET_PIXELS + m.iHeight + CANVAS_VERTICAL_GAP_PIXELS, ; m.iWidth, m.iHeight ) .spacer.Move( .canvas4.Left + .canvas4.Width, ; .canvas4.Top + .canvas4.Height ) endcase .SuppressRendering = .F. endwith ENDPROC PROCEDURE synchpageno *----------------------------------------------- * .SynchPageNo() *----------------------------------------------- local iCurrentPage iCurrentPage = THIS.currentPage + THIS.startOffset #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + "frxPreviewForm::SynchPageNo()" #ENDIF *----------------------------------- * Fix for SP2: * Only enhance the preview window title caption * if user has not specfied a target window: *----------------------------------- if empty( THIS.oReport.commandClauses.Window ) if THIS.canvasCount > 1 local lastPage lastPage = min( m.iCurrentPage+THIS.canvasCount-1, THIS.pagetotal ) THIS.Caption = THIS.formCaption ; + REPORT_PREVIEW_PAGE_CAPTION ; + transform( m.iCurrentPage ) + " - " + transform( m.lastPage ) else THIS.Caption = THIS.formCaption ; + REPORT_PREVIEW_PAGE_CAPTION ; + transform( m.iCurrentPage ) endif endif ENDPROC PROCEDURE synchtoolbar *---------------------------------------------------------- * .SynchToolbar() *---------------------------------------------------------- #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + "frxPreviewForm::SynchToolbar()" #ENDIF if not isnull( THIS.toolbar ) THIS.toolbar.SynchControls() endif ENDPROC PROCEDURE setcurrentpage *---------------------------------------------------------------------- * .SetCurrentPage() - *---------------------------------------------------------------------- lparameter iPage #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + "frxPreviewForm::SetCurrentPage()" #ENDIF if THIS.CurrentPage <> m.iPage if between( m.iPage, 1, THIS.oReport.OutputPageCount ) THIS.currentPage = m.iPage THIS.synchPageNo() * Fix in SP2: Add call to RenderPages: THIS.RenderPages() THIS.SynchToolbar() endif * Fix in SP2: update the caption on the first display: THIS.SynchPageNo() endif ENDPROC PROCEDURE actionshowinfo *======================================================= * ToString() * Returns a string representation of the event properties. *======================================================= local cText cText = "" cText = m.cText + "Preview version: " + PREVIEW_VERSION + chr(13) + chr(13) cText = m.cText + ".pageTotal = " + transform(THIS.pageTotal) + chr(13) cText = m.cText + ".currentPage = " + transform(THIS.currentPage) + chr(13) cText = m.cText + ".canvasCount = " + transform(THIS.canvasCount) + chr(13) cText = m.cText + ".pageHeight = " + transform(THIS.pageHeight) + chr(13) cText = m.cText + ".pageWidth = " + transform(THIS.pageWidth) + chr(13) cText = m.cText + "_PAGENO = " + transform(_PAGENO) + chr(13) + chr(13) cText = m.cText + "THIS.oReport.commandClauses:" + chr(13) amembers( ac, this.oReport.commandClauses ) for each cField in ac cText = m.cText + " " + m.cField+ " = " + trans(eval("THIS.oReport.commandClauses."+trim(m.cField))) + chr(13) endfor =messagebox(m.cText,64, DEFAULT_MBOX_TITLE_LOC ) return m.cText ENDPROC PROCEDURE getzoompercent *----------------------------------------------------------------------- * adjust this to suit THIS.zoomLevels[] array *----------------------------------------------------------------------- local iZoomPercent do case case THIS.zoomLevel < alen(THIS.zoomLevels,1)-1 *--------------------------------------------------- * Use a preset percentage *--------------------------------------------------- iZoomPercent = THIS.zoomLevels[ THIS.zoomLevel,ZOOM_LEVEL_PERCENT] case THIS.ZoomLevel = alen(THIS.zoomLevels,1)-1 *--------------------------------------------------- * Calculate zoom percent from current window size: * to procure a "fit to page" effect. * depends on: * - page aspect ratio * - .pageWidth in inches * - .pageHeight in inches * - .canvasCount * - form aspect ratio * - .Width of form in pixels * - .Height of form in pixels * CANVAS_TOP_OFFSET_PIXELS 15 * CANVAS_LEFT_OFFSET_PIXELS 15 * CANVAS_VERTICAL_GAP_PIXELS 10 * CANVAS_HORIZONTAL_GAP_PIXELS 10 * *--------------------------------------------------- local nPreviewFormAspectRatio, nPageAspectRatio local iRequiredHeight, iRequiredWidth nPreviewFormAspectRatio = THIS.Width/THIS.Height if THIS.canvasCount = 2 * Two pages aside: nPageAspectRatio = (THIS.PageWidth*2)/THIS.PageHeight else nPageAspectRatio = THIS.PageWidth/THIS.PageHeight endif do case case m.nPreviewFormAspectRatio <= m.nPageAspectRatio * Preview Form is taller, skinnier than the pages * limit by page width: do case case THIS.canvasCount = 1 iRequiredWidth = THIS.Width - (CANVAS_LEFT_OFFSET_PIXELS * 2) iZoomPercent = (m.iRequiredWidth * 100)/(THIS.pageWidth * .screenDPI) case THIS.canvasCount = 2 iRequiredWidth = THIS.Width - (CANVAS_LEFT_OFFSET_PIXELS * 2) - CANVAS_HORIZONTAL_GAP_PIXELS iRequiredWidth = int(m.iRequiredWidth/2) iZoomPercent = (m.iRequiredWidth * 100)/(THIS.pageWidth * .screenDPI) case THIS.canvasCount = 4 iRequiredWidth = THIS.Width - (CANVAS_LEFT_OFFSET_PIXELS * 2) - CANVAS_HORIZONTAL_GAP_PIXELS iRequiredWidth = int(m.iRequiredWidth/2) iZoomPercent = (m.iRequiredWidth * 100)/(THIS.pageWidth * .screenDPI) endcase case m.nPreviewFormAspectRatio > m.nPageAspectRatio * pages are taller, skinnier than preview area. * limit by page height: do case case THIS.canvasCount = 1 iRequiredHeight = THIS.Height - ( CANVAS_TOP_OFFSET_PIXELS * 2 ) iZoomPercent = (m.iRequiredHeight * 100)/(THIS.pageHeight * .screenDPI) case THIS.canvasCount = 2 iRequiredHeight = THIS.Height - ( CANVAS_TOP_OFFSET_PIXELS * 2 ) iZoomPercent = (m.iRequiredHeight * 100)/(THIS.pageHeight * .screenDPI) case THIS.canvasCount = 4 iRequiredHeight = THIS.Height - ( CANVAS_TOP_OFFSET_PIXELS * 2 ) - CANVAS_VERTICAL_GAP_PIXELS iRequiredHeight = int(m.iRequiredHeight/2) iZoomPercent = (m.iRequiredHeight * 100)/(THIS.pageHeight * .screenDPI) endcase endcase otherwise *--------------------------------------------------- * Calculate zoom percent from current window width: *--------------------------------------------------- local iRequiredHeight, iRequiredWidth do case case THIS.canvasCount = 1 iRequiredWidth = THIS.Width - (CANVAS_LEFT_OFFSET_PIXELS * 2) iZoomPercent = (m.iRequiredWidth * 100)/(THIS.pageWidth * .screenDPI) case THIS.canvasCount = 2 iRequiredWidth = THIS.Width - (CANVAS_LEFT_OFFSET_PIXELS * 2) - CANVAS_HORIZONTAL_GAP_PIXELS iRequiredWidth = int(m.iRequiredWidth/2) iZoomPercent = (m.iRequiredWidth * 100)/(THIS.pageWidth * .screenDPI) case THIS.canvasCount = 4 iRequiredWidth = THIS.Width - (CANVAS_LEFT_OFFSET_PIXELS * 2) - CANVAS_HORIZONTAL_GAP_PIXELS iRequiredWidth = int(m.iRequiredWidth/2) iZoomPercent = (m.iRequiredWidth * 100)/(THIS.pageWidth * .screenDPI) endcase endcase return m.iZoomPercent ENDPROC PROCEDURE renderpages if THIS.suppressRendering return endif #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + "frxPreviewForm::RenderPages()" #ENDIF local iPageToRender iPageToRender = THIS.currentPage do case case THIS.canvasCount = 1 THIS.RenderPage( m.iPageToRender, THIS.canvas1 ) case THIS.canvasCount = 2 THIS.RenderPage( m.iPageToRender, THIS.canvas1 ) THIS.RenderPage( m.iPageToRender+1, THIS.canvas2 ) case THIS.canvasCount = 4 THIS.RenderPage( m.iPageToRender, THIS.canvas1 ) THIS.RenderPage( m.iPageToRender+1, THIS.canvas2 ) THIS.RenderPage( m.iPageToRender+2, THIS.canvas3 ) THIS.RenderPage( m.iPageToRender+3, THIS.canvas4 ) endcase if not isnull( THIS.Extensionhandler ) *----------------------------------- * New in SP2: *----------------------------------- if pemstatus( THIS.ExtensionHandler, "RenderPages", 5 ) #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + " frxPreviewForm.ExtensionHandler::RenderPages()" #ENDIF THIS.ExtensionHandler.RenderPages() endif endif ENDPROC PROCEDURE savetoresource #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + "frxPreviewForm::SaveToResource()" #ENDIF *-------------------------------------------------------------- * Turn off the cursor notification in the status bar: *-------------------------------------------------------------- local lSetNotify, lSetNotify2, lSetTalk lSetNotify = (set("NOTIFY",1) = "ON") lSetNotify2 = (set("NOTIFY") = "ON") lSetTalk = (set("TALK") = "ON") if m.lSetNotify set notify cursor off endif if m.lSetNotify set notify off endif if m.lSetTalk set talk off endif local x, iCurrentState x = newobject( "ResourceManager", FRXCOMMON_PRG_CLASSLIB ) iCurrentState = THIS.WindowState if THIS.WindowState <> 0 THIS.WindowState = 0 endif if x.LoadResource( REPORTPREVIEW_RESOURCE_ID, upper(THIS.FrxFileName) ) if not THIS.oReport.commandClauses.isDesignerLoaded x.Set("PreviewForm.Top", THIS.Top ) x.Set("PreviewForm.Left", THIS.Left ) *------------------------------------------ * Fix for SP2: * form width,height does not include width * of scrollbars, if visible. Therefore add * back into saved value if applicable: *------------------------------------------ if (THIS.Width < THIS.ViewPortWidth) * Vertical Scrollbar is visible. Add to window size: x.Set("PreviewForm.Width", THIS.Width + sysmetric(5) ) else x.Set("PreviewForm.Width", THIS.Width ) endif if (THIS.Height < THIS.ViewPortHeight) * Horizontal Scrollbar is visible. Add to window size: x.Set("PreviewForm.Height", THIS.Height + sysmetric(8) ) else x.Set("PreviewForm.Height", THIS.Height ) endif *------------------------------------- endif x.Set("PreviewForm.WindowState", m.iCurrentState ) x.Set("PreviewForm.ToolbarIsVisible", THIS.ToolbarIsVisible ) x.Set("PreviewForm.CanvasCount", THIS.CanvasCount ) x.Set("PreviewForm.ZoomLevel", THIS.ZoomLevel ) if not isnull( THIS.Toolbar ) *------------------------------------------------------- * Only if toolbar is available: *------------------------------------------------------- x.Set("PreviewToolbar.Top", THIS.Toolbar.Top ) x.Set("PreviewToolbar.Left", THIS.Toolbar.Left ) x.Set("PreviewToolbar.Width", THIS.Toolbar.Width ) x.Set("PreviewToolbar.Height", THIS.Toolbar.Height ) x.Set("PreviewToolbar.DockPosition", THIS.Toolbar.DockPosition ) endif if x.SaveResource( REPORTPREVIEW_RESOURCE_ID, upper(THIS.FrxFileName) ) * well, success. If not, well, not. endif endif *-------------------------------------------------------------- * SP2: Don't leave the windowState toggled. It interferes with * other windows in the application: *-------------------------------------------------------------- if THIS.WindowState <> m.iCurrentState THIS.WindowState = m.iCurrentState endif release x *-------------------------------------------------------------- * Restore SET NOTIFY CURSOR status: *-------------------------------------------------------------- if m.lSetNotify set notify cursor on endif if m.lSetNotify2 set notify on endif if m.lSetTalk set talk on endif ENDPROC PROCEDURE restorefromresource #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + "frxPreviewForm::RestoreFromResource()" #ENDIF local x, iCurrentState, cValue x = newobject( "ResourceManager", FRXCOMMON_PRG_CLASSLIB ) if x.LoadResource( REPORTPREVIEW_RESOURCE_ID, upper(THIS.FrxFileName) ) cValue = x.Get("PreviewForm.Top") if not empty( m.cValue ) THIS.Top = int(val(m.cValue )) endif cValue = x.Get("PreviewForm.Left") if not empty( m.cValue ) THIS.Left = int(val(m.cValue )) endif cValue = x.Get("PreviewForm.Width") if not empty( m.cValue ) THIS.Width = int(val(m.cValue )) endif cValue = x.Get("PreviewForm.Height") if not empty( m.cValue ) THIS.Height = int(val(m.cValue )) endif if not THIS.oReport.commandClauses.IsDesignerLoaded cValue = x.Get("PreviewForm.WindowState") if not empty( m.cValue ) THIS.WindowState = int(val(m.cValue )) endif endif cValue = x.Get("PreviewForm.ToolbarIsVisible") if not empty( m.cValue ) THIS.ToolbarIsVisible = ( m.cValue = ".T.") endif cValue = x.Get("PreviewForm.CanvasCount") if not empty( m.cValue ) THIS.CanvasCount = int(val(m.cValue )) endif cValue = x.Get("PreviewForm.ZoomLevel") if not empty( m.cValue ) THIS.ZoomLevel = int(val(m.cValue )) endif cValue = x.Get("PreviewToolbar.Top") if not empty( m.cValue ) THIS.toolbar.Top = int(val(m.cValue )) endif cValue = x.Get("PreviewToolbar.Left") if not empty( m.cValue ) THIS.toolbar.Left = int(val(m.cValue )) endif cValue = x.Get("PreviewToolbar.Width") if not empty( m.cValue ) THIS.toolbar.Width = int(val(m.cValue )) endif cValue = x.Get("PreviewToolbar.Height") if not empty( m.cValue ) THIS.toolbar.Height = int(val(m.cValue )) endif cValue = x.Get("PreviewToolbar.DockPosition") if not empty( m.cValue ) if between( int(val( m.cValue )), 0, 3 ) and THIS.ShowWindow <> 2 THIS.toolbar.Dock( int(val( m.cValue )) ) endif endif endif release x ENDPROC PROCEDURE getpixelsperdpi960 *----------------------------------------------------------- * We need a conversion factor between 960dpi and pixels. * pixels/dpi960 = THIS.Canvas1.Width/(THIS.PageWidth * 960) *----------------------------------------------------------- return THIS.Canvas1.Width/(THIS.PageWidth * 960) ENDPROC PROCEDURE createtoolbar #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + "frxPreviewForm::CreateToolbar()" #ENDIF THIS.toolbar = newobject( "frxPreviewToolbar","frxPreview.vcx") THIS.toolbar.PreviewForm = THIS *---------------------------------------------------- * Fixed in SP1: Extension handler .InitializeToolbar() *---------------------------------------------------- if not isnull( THIS.Extensionhandler ) if pemstatus( THIS.ExtensionHandler, "InitializeToolbar", 5 ) #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + " frxPreviewForm.ExtensionHandler::InitializeToolbar()" #ENDIF THIS.ExtensionHandler.InitializeToolbar() endif endif *-------------------------------------------------------------- * Bug #441419 (Fixed for SP1): *-------------------------------------------------------------- THIS.Toolbar.Refresh() *-------------------------------------------------------------- ENDPROC PROCEDURE extensionhandler_assign *--------------------------------------------------- * Give the extension handler object a reference to * the preview form. Remove the reference if we are * nulling out the extension handler: *--------------------------------------------------- lparameters oExtHandler if not isnull( m.oExtHandler ) THIS.ExtensionHandler = m.oExtHandler AddProperty( oExtHandler, "PreviewForm" ) oExtHandler.PreviewForm = THIS if not isnull( THIS.ExtensionHandler ) THIS.ExtensionHandler.PreviewForm = .NULL. endif THIS.ExtensionHandler = .NULL. endif return ENDPROC PROCEDURE getpixelpageoffsets *---------------------------------------- * GetPixelPageOffset( x, y ) *---------------------------------------- lparameters x960, y960 if empty( m.x960 ) x960 = 0 endif if empty( m.y960 ) y960 = 0 endif local x, y, conversionFactor conversionFactor = THIS.GetPixelsPerDpi960() x = THIS.Canvas1.Left + int(m.x960 * m.conversionFactor) && - THIS.ViewPortLeft y = THIS.Canvas1.Top + int(m.y960 * m.conversionFactor) && - THIS.ViewPortTop offset = newobject("Empty") AddProperty( m.offset, "x", m.x ) AddProperty( m.offset, "y", m.y ) return m.offset ENDPROC PROCEDURE showcommandwindow if _vfp.StartMode = 0 *------------------------------------------------ * un-hide the command window, if we hid it *------------------------------------------------ if this.hidCommandWindow and not wvisible("Command") show window command endif endif ENDPROC PROCEDURE hidecommandwindow if _vfp.StartMode = 0 if wvisible("Command") hide Window command THIS.hidCommandWindow = .T. else THIS.hidCommandWindow = .F. endif endif ENDPROC PROCEDURE createcanvases *========================================= * CreateCanvases() - * New in SP2 * Create the canvas objects *========================================= #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + "frxPreviewForm::CreateCanvases()" #ENDIF do case case not empty(THIS.MemberClass) and ; not empty(THIS.MemberClassLibrary) THIS.NewObject("Canvas1", THIS.MemberClass, THIS.MemberClassLibrary) THIS.NewObject("Canvas2", THIS.MemberClass, THIS.MemberClassLibrary) THIS.NewObject("Canvas3", THIS.MemberClass, THIS.MemberClassLibrary) THIS.NewObject("Canvas4", THIS.MemberClass, THIS.MemberClassLibrary) case not empty(THIS.MemberClass) THIS.NewObject("Canvas1", THIS.MemberClass) THIS.NewObject("Canvas2", THIS.MemberClass) THIS.NewObject("Canvas3", THIS.MemberClass) THIS.NewObject("Canvas4", THIS.MemberClass) otherwise THIS.NewObject("Canvas1", "ShapeCanvas", THIS.ClassLibrary ) THIS.NewObject("Canvas2", "ShapeCanvas", THIS.ClassLibrary ) THIS.NewObject("Canvas3", "ShapeCanvas", THIS.ClassLibrary ) THIS.NewObject("Canvas4", "ShapeCanvas", THIS.ClassLibrary ) endcase store .F. to ; THIS.Canvas1.Visible, ; THIS.Canvas2.Visible, ; THIS.Canvas3.Visible, ; THIS.Canvas4.Visible *---------------------------------------------------- * New in SP2: *---------------------------------------------------- if not isnull( THIS.Extensionhandler ) if pemstatus( THIS.ExtensionHandler, "CreateCanvases", 5 ) #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + " frxPreviewForm.ExtensionHandler::CreateCanvases()" #ENDIF THIS.ExtensionHandler.CreateCanvases() endif endif return ENDPROC PROCEDURE canvascount_assign *---------------------------------------------- * CanvasCount_Assign() *---------------------------------------------- lparameter iCanvasCount if iCanvasCount <> THIS.CanvasCount if type("THIS.Canvas1")="O" if THIS.Canvas1.BaseClass <> "Shape" *---------------------------------------------- * Set the canvas visibility: *---------------------------------------------- do case case m.iCanvasCount = 1 store .F. to ; THIS.Canvas2.Visible, ; THIS.Canvas3.Visible, ; THIS.Canvas4.Visible case m.iCanvasCount = 2 store .T. to ; THIS.Canvas2.Visible store .F. to ; THIS.Canvas3.Visible, ; THIS.Canvas4.Visible case m.iCanvasCount = 4 store .T. to ; THIS.Canvas2.Visible, ; THIS.Canvas3.Visible, ; THIS.Canvas4.Visible endcase endif endif endif THIS.CanvasCount = m.iCanvasCount ENDPROC PROCEDURE setzoomlevel *----------------------------------------------------- * SetZoomLevel() * new in SP2 *----------------------------------------------------- lparameter iZoomLevel iZoomLevel = min( alen(THIS.zoomLevels,1), max( 1, m.iZoomLevel )) if THIS.zoomLevel <> m.iZoomLevel THIS.zoomLevel = m.iZoomLevel THIS.SetViewPort( 0, 0 ) local iPagesAllowed iPagesAllowed = THIS.zoomLevels[ m.iZoomLevel, ZOOM_LEVEL_CANVAS] if THIS.canvasCount > m.iPagesAllowed * Reduce the canvas count at high levels of zoom: THIS.canvasCount = m.iPagesAllowed endif THIS.TempStopRepaint = .T. THIS.Cls() THIS.SetViewPort(0,0) THIS.synchCanvases() THIS.RenderPages() THIS.synchPageNo() THIS.synchToolbar() * Fix the scrollbar refresh problem: THIS.Scrollbars = 0 THIS.ScrollBars = 3 endif ENDPROC PROCEDURE setcanvascount *----------------------------------------------------- * SetCanvasCount() * new in SP2 *----------------------------------------------------- lparameter iCount iCount = min(4, max(1, m.iCount )) if iCount = 3 iCount = 2 endif if THIS.canvasCount <> m.iCount THIS.SuppressRendering = .T. *------------------------------------------------ * Only clear the form if there are potentially * extra canvas images that need to be erased: *------------------------------------------------ if THIS.CanvasCount > m.iCount THIS.Cls() endif THIS.canvasCount = m.iCount THIS.SetViewPort(0,0) THIS.synchCanvases() THIS.SuppressRendering = .F. THIS.RenderPages() THIS.synchPageNo() THIS.synchToolbar() endif ENDPROC PROCEDURE MouseUp lparameters iButton, nShift, nXCoord, nYCoord *-------------------------------------------------- * ENH for SP2: * Allow magnify when clicking on page * See Toolbar.zoomCombo.interactiveChange() for code * that sets this flag: *-------------------------------------------------- if not this.IgnoreMouseClickInMagnifyCode do case case m.iButton <> 1 *-------------------------------------------------- * Wasn't a left click so do nothing: *-------------------------------------------------- case m.nXCoord > (CANVAS_LEFT_OFFSET_PIXELS + THIS.Canvas1.Width) ; or m.nYCoord > (CANVAS_TOP_OFFSET_PIXELS + THIS.Canvas1.Height) *-------------------------------------------------- * CLicked outside the page so do nothing: *-------------------------------------------------- case (THIS.ZoomLevel >= alen(THIS.zoomLevels,1)-1) ; or (THIS.ZoomLevel < 5) *-------------------------------------------------- * The current zoom level is "Whole page" * or less than 100%, so go to 100% and set view port * to be oriented on the clicked portion of the page: *-------------------------------------------------- ClickXOffsetPercent = (nXCoord - CANVAS_LEFT_OFFSET_PIXELS)/THIS.Canvas1.Width ClickYOffsetPercent = (nYCoord - CANVAS_TOP_OFFSET_PIXELS)/THIS.Canvas1.Height THIS.ActionSetZoom( 5 ) * Do we need to center the offset point? NewViewPortX = (THIS.Canvas1.Width*ClickXOffsetPercent) - THIS.Width/2 - CANVAS_LEFT_OFFSET_PIXELS NewViewPortY = (THIS.Canvas1.Height*ClickYOffsetPercent) - THIS.Height/2 - CANVAS_TOP_OFFSET_PIXELS THIS.SetViewPort( max(NewViewPortX,0), max(NewViewPortY,0) ) otherwise *-------------------------------------------------- * The current zoom level is not "Whole page" so * go to "Whole page" zoom: *-------------------------------------------------- THIS.ActionSetZoom( alen(THIS.zoomLevels,1)-1 ) endcase THIS.MouseFlag = .F. THIS.IgnoreMouseClickInMagnifyCode = .F. endif ENDPROC PROCEDURE Hide #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + "frxPreviewForm::Hide()" #ENDIF if not isnull( THIS.toolbar ) * Hide the toolbar: THIS.Toolbar.Hide() THIS.ToolbarIsVisible = .F. endif ENDPROC PROCEDURE Activate #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + "frxPreviewForm::Activate()" #ENDIF *--------------------------------------------------------------- * Ensure the toolbar is visible *--------------------------------------------------------------- if THIS.ToolbarIsVisible THIS.ShowToolbar(.T.) endif *--------------------------------------------------------------- * Fix for SP2: Ensure the scrollbars are respected * by SynchCanvases() *--------------------------------------------------------------- THIS.Resize() ENDPROC PROCEDURE Deactivate #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + "frxPreviewForm::Deactivate()" #ENDIF *--------------------------------------------------------------- * Deactivate() *--------------------------------------------------------------- if THIS.ToolbarIsVisible THIS.Toolbar.Show() * THIS.ShowToolBar(.F.) endif ENDPROC PROCEDURE Destroy #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + "frxPreviewForm::Destroy()" #ENDIF *--------------------------------------------------------------- * New in SP2: *--------------------------------------------------------------- if not isnull( THIS.Extensionhandler ) *----------------------------------- * New in SP2: *----------------------------------- if pemstatus( THIS.ExtensionHandler, "Destroy", 5 ) #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + " frxPreviewForm.ExtensionHandler::Destroy()" #ENDIF THIS.ExtensionHandler.Destroy() endif endif *--------------------------------------------------------------- * Get rid of that toolbar: *--------------------------------------------------------------- if not isnull( THIS.toolbar ) THIS.toolbar.PreviewForm = null THIS.toolbar = null endif THIS.oReport = null dodefault() ENDPROC PROCEDURE Init *--------------------------------------------------------------- * Init() *--------------------------------------------------------------- dodefault() *---------------------------------- * Build zoom level array: * Menu Prompt * percentage zoom * no. of pages to display *---------------------------------- dimension THIS.zoomLevels[11,3] *--------------------------------------------------- * Prompt *--------------------------------------------------- THIS.zoomLevels[ 1,ZOOM_LEVEL_PROMPT] = ZOOM_LEVEL_PROMPT_10_LOC THIS.zoomLevels[ 2,ZOOM_LEVEL_PROMPT] = ZOOM_LEVEL_PROMPT_25_LOC THIS.zoomLevels[ 3,ZOOM_LEVEL_PROMPT] = ZOOM_LEVEL_PROMPT_50_LOC THIS.zoomLevels[ 4,ZOOM_LEVEL_PROMPT] = ZOOM_LEVEL_PROMPT_75_LOC THIS.zoomLevels[ 5,ZOOM_LEVEL_PROMPT] = ZOOM_LEVEL_PROMPT_100_LOC THIS.zoomLevels[ 6,ZOOM_LEVEL_PROMPT] = ZOOM_LEVEL_PROMPT_150_LOC THIS.zoomLevels[ 7,ZOOM_LEVEL_PROMPT] = ZOOM_LEVEL_PROMPT_200_LOC THIS.zoomLevels[ 8,ZOOM_LEVEL_PROMPT] = ZOOM_LEVEL_PROMPT_300_LOC THIS.zoomLevels[ 9,ZOOM_LEVEL_PROMPT] = ZOOM_LEVEL_PROMPT_500_LOC THIS.zoomLevels[10,ZOOM_LEVEL_PROMPT] = ZOOM_LEVEL_PROMPT_WHOLE_PAGE_LOC THIS.ZoomLevels[11,ZOOM_LEVEL_PROMPT] = ZOOM_LEVEL_PROMPT_FIT_WIDTH_LOC *--------------------------------------------------- * Percentage zoom: *--------------------------------------------------- THIS.zoomLevels[ 1,ZOOM_LEVEL_PERCENT] = 10 THIS.zoomLevels[ 2,ZOOM_LEVEL_PERCENT] = 25 THIS.zoomLevels[ 3,ZOOM_LEVEL_PERCENT] = 50 THIS.zoomLevels[ 4,ZOOM_LEVEL_PERCENT] = 75 THIS.zoomLevels[ 5,ZOOM_LEVEL_PERCENT] = 100 THIS.zoomLevels[ 6,ZOOM_LEVEL_PERCENT] = 150 THIS.zoomLevels[ 7,ZOOM_LEVEL_PERCENT] = 200 THIS.zoomLevels[ 8,ZOOM_LEVEL_PERCENT] = 300 THIS.zoomLevels[ 9,ZOOM_LEVEL_PERCENT] = 500 THIS.zoomLevels[10,ZOOM_LEVEL_PERCENT] = -1 THIS.zoomLevels[11,ZOOM_LEVEL_PERCENT] = -2 *--------------------------------------------------- * Set how many pages can be viewed at once * depending on zoom level. * These may need tuning for memory: *--------------------------------------------------- THIS.zoomLevels[ 1,ZOOM_LEVEL_CANVAS] = 4 THIS.zoomLevels[ 2,ZOOM_LEVEL_CANVAS] = 4 THIS.zoomLevels[ 3,ZOOM_LEVEL_CANVAS] = 4 THIS.zoomLevels[ 4,ZOOM_LEVEL_CANVAS] = 4 THIS.zoomLevels[ 5,ZOOM_LEVEL_CANVAS] = 4 THIS.zoomLevels[ 6,ZOOM_LEVEL_CANVAS] = 2 THIS.zoomLevels[ 7,ZOOM_LEVEL_CANVAS] = 1 THIS.zoomLevels[ 8,ZOOM_LEVEL_CANVAS] = 1 THIS.zoomLevels[ 9,ZOOM_LEVEL_CANVAS] = 1 THIS.zoomLevels[10,ZOOM_LEVEL_CANVAS] = 1 THIS.zoomLevels[11,ZOOM_LEVEL_CANVAS] = 1 *------------------------------------------ * Create the toolbar and ensure the toolbar * has a reference to the main form: * SP1: See .Show() for extra extension handler call *------------------------------------------ THIS.CreateToolbar() *------------------------------------------ * prevent too small windows *------------------------------------------ THIS.MinWidth = CANVAS_LEFT_OFFSET_PIXELS * 5 THIS.MinHeight = CANVAS_TOP_OFFSET_PIXELS * 5 ENDPROC PROCEDURE KeyPress LPARAMETERS nKeyCode, nShiftAltCtrl #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + "frxPreviewForm::KeyPress(" + trans(m.nKeyCode) + ", " + trans(m.nShiftAltCtrl) + ")" #ENDIF #define JOG_PIXELS 50 local lHandledKeypress, iPagesAllowed iPagesAllowed = THIS.zoomLevels[ THIS.zoomLevel, ZOOM_LEVEL_CANVAS ] if not isnull( THIS.Extensionhandler ) *----------------------------------- * Fixed for SP1: Only invoke the method * if it is defined: *----------------------------------- if pemstatus( THIS.ExtensionHandler, "HandledKeyPress", 5 ) #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + " frxPreviewForm.ExtensionHandler::HandledKeyPress()" #ENDIF if THIS.ExtensionHandler.handledKeypress( m.nKeyCode, m.nShiftAltCtrl ) return endif endif endif *------------------------------------------------------------ * This will be set false if none of the explicit tests below * deal with the keypress. See the dodefault() call at the * end of the CASE statement. *------------------------------------------------------------ lHandledKeypress = .T. do case case m.nShiftAltCtrl = 2 *---------------------- * CONTROL - ? *---------------------- do case case m.nKeyCode = 23 && CTRL-W *-------------------------------------------------- * Support Ctrl-W to close window *-------------------------------------------------- THIS.ActionClose() otherwise lHandledKeyPress = .F. endcase case m.nShiftAltCtrl = 1 *---------------------- * SHIFT - ? *---------------------- do case case m.nKeyCode = 93 && SHIFT-F10 *-------------------------------------------------- * Shift-F10 is the code for the windows context menu *-------------------------------------------------- THIS.InvokeContextMenu(.T.) case m.nKeyCode = 90 && Z - Zoom in-and-out of the page if THIS.ZoomLevel >= alen(THIS.zoomLevels,1)-1 *-------------------------------------------------- * The current zoom level is "Whole page" so * go to 100% *-------------------------------------------------- THIS.ActionSetZoom( 5 ) else *-------------------------------------------------- * The current zoom level is not "Whole page" so * go to "Whole page" zoom: *-------------------------------------------------- THIS.ActionSetZoom( alen(THIS.zoomLevels,1) ) endif case m.nKeyCode = 76 && L - Toggle between various zoom levels *-------------------------------------------------- * The L key reduces/cycles the zoom level *-------------------------------------------------- local z z = THIS.zoomLevel - 1 if m.z = 0 m.z = alen(THIS.zoomLevels,1)-2 endif THIS.actionSetZoom(m.z) case m.nKeyCode = 71 && G - Go To Page THIS.ActionGoToPage() otherwise lHandledKeyPress = .F. endcase case m.nShiftAltCtrl = 0 *----------------------------------------------------------------------------------------- * Key bindings in the orginal preview window: *----------------------------------------------------------------------------------------- * ESC 27 Closes Print Preview window. * RIGHTARROW 4 Scrolls to the right of the page in the Print Preview window. * LEFTARROW 19 Scrolls to the left of the page in the Print Preview window. * UPARROW 5 Scrolls towards the top of the page in the Print Preview window. * DOWNARROW 24 Scrolls towards the bottom of the page in the Print Preview window. * PAGEUP 18 Moves to the previous page in the Print Preview window. * PAGEDOWN 3 Moves to the next page in the Print Preview window. * HOME 1 Moves to the first page in the Print Preview window. * END 6 Moves to the last page in the Print Preview window. * Z 122,90 Zooms in and out of the page. * L 108,76 Toggles between various zoom levels. * G 103,71 Opens Goto page dialog box. *----------------------------------------------------------------------------------------- do case case m.nKeyCode = 27 && ESC *-------------------------------------------------- * Support ESC to close window *-------------------------------------------------- THIS.ActionClose() case m.nKeyCode = 4 && Right THIS.SetViewPort( THIS.ViewPortLeft+JOG_PIXELS, THIS.ViewPortTop ) case m.nKeyCode = 19 && Left THIS.SetViewPort( max(THIS.ViewPortLeft-JOG_PIXELS,0), THIS.ViewPortTop ) case m.nKeyCode = 5 && Up THIS.SetViewPort( THIS.ViewPortLeft, max(THIS.ViewPortTop-JOG_PIXELS,0) ) case m.nKeyCode = 24 && Down THIS.SetViewPort( THIS.ViewPortLeft, THIS.ViewPortTop+JOG_PIXELS ) case m.nKeyCode = 18 && PageUp THIS.actionGoPrev() case m.nKeyCode = 3 && PagDown THIS.actionGoNext() case m.nKeyCode = 1 && Home THIS.actiongofirst() case m.nKeyCode = 6 && End THIS.actiongolast() * case m.nKeyCode = 99 && C - Close ? * THIS.actionclose() case inlist( m.nKeyCode, 103, 71 ) && G - Go To Page THIS.actiongotopage() case inlist( m.nKeyCode, 108, 76 ) && L - zoom cycle *-------------------------------------------------- * The L key reduces/cycles the zoom level *-------------------------------------------------- local z z = THIS.zoomLevel - 1 if m.z = 0 m.z = alen(THIS.zoomLevels,1)-2 endif THIS.actionSetZoom(m.z) case inlist(m.nKeyCode, 122, 90 ) && Z for Zoom toggle if THIS.ZoomLevel >= alen(THIS.zoomLevels,1)-1 *-------------------------------------------------- * The current zoom level is "Whole page" so * go to 100% *-------------------------------------------------- THIS.ActionSetZoom( 5 ) else *-------------------------------------------------- * The current zoom level is not "Whole page" so * go to "Whole page" zoom: *-------------------------------------------------- THIS.ActionSetZoom( alen(THIS.zoomLevels,1)-1 ) endif case m.nKeyCode = 49 && 1 page THIS.actionSetCanvasCount(1) case m.nKeyCode = 50 && 2 pages *------------------------------------------------------ * Fix for SP1: * Disable two-page view for high zoom levels *------------------------------------------------------ if m.iPagesAllowed > 1 THIS.actionSetCanvasCount(2) endif case m.nKeyCode = 52 && 4 pages *------------------------------------------------------ * Fix for SP1: * Disable 4-page view for high zoom levels *------------------------------------------------------ if m.iPagesAllowed > 2 THIS.actionSetCanvasCount(4) endif otherwise lHandledKeyPress = .F. endcase endcase if not m.lHandledKeyPress #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + " frxBaseForm::KeyPress(" + trans(m.nKeyCode) + ", " + trans(m.nShiftAltCtrl) + ")" #ENDIF dodefault( m.nKeyCode, m.nShiftAltCtrl ) endif ENDPROC PROCEDURE Paint #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + "frxPreviewForm::Paint()" #ENDIF *----------------------------------- * This is a kludge to prevent * the extra repaint we see when we * change zoom levels: *----------------------------------- if THIS.TempStopRepaint = .T. THIS.TempStopRepaint = .F. return endif *----------------------------------- * New in SP2: * Image controls do not need successive * repaints during the Paint() event: *----------------------------------- if THIS.Canvas1.BaseClass <> "Image" THIS.RenderPages() endif *----------------------------------- * See if the ExtensionHandler * wants to draw anything: *----------------------------------- if not isnull( THIS.Extensionhandler ) *----------------------------------------------------------- * Fixed for SP1: Only invoke the method if it is defined: * Noted for SP2: Deprecated in favor of .RenderPages() *----------------------------------------------------------- if pemstatus( THIS.ExtensionHandler, "Paint", 5 ) #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + " frxPreviewForm.ExtensionHandler::Paint()" #ENDIF THIS.ExtensionHandler.Paint() endif endif doevents ENDPROC PROCEDURE QueryUnload dodefault() THIS.Release() ENDPROC PROCEDURE Release #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + "frxPreviewForm::Release()" #ENDIF *------------------------------------------------ * Clear the report listener's reference to this form: *------------------------------------------------ if not isnull( THIS.oReport ) *----------------------------------- * Check with the extension handler: *----------------------------------- if not isnull( THIS.Extensionhandler ) *----------------------------------- * Fixed for SP1: Only invoke the method * if it is defined: *----------------------------------- if pemstatus( THIS.ExtensionHandler, "Release", 5 ) #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + " frxPreviewForm.ExtensionHandler::Release()" #ENDIF if THIS.ExtensionHandler.Release() *---------------------------------------------- * Clear out the reference. The assign method * will also clear out the back ref to the form: *---------------------------------------------- * THIS.ExtensionHandler = null else *---------------------------------------------- * The extension handler has indicated that it * does not want to release. So don't: *---------------------------------------------- NODEFAULT return endif endif endif THIS.SaveToResource() if version(4) > "09.00.0000.1800" *------------------------------------------- * Set the "Current page" value for the Print... dialog *------------------------------------------- THIS.oReport.commandClauses.printPageCurrent = THIS.currentPage endif *------------------------------------------- * Indicate that we are closing to the listener/engine: *------------------------------------------- THIS.oReport.onPreviewClose( THIS.PrintOnExit ) *------------------------------------------- * Clear out the reference to the report *------------------------------------------- THIS.oReport = .null. endif *------------------------------------------------ * Show the Command window if we previously hid it: *------------------------------------------------ THIS.ShowCommandWindow() *------------------------------------------------ * This is needed for .TopForm=.T. *------------------------------------------------ THIS.Hide() ENDPROC PROCEDURE Resize *------------------------------------------------------------------ * If in "Zoom Page to fit" mode: *------------------------------------------------------------------ if THIS.zoomlevel >= alen(THIS.zoomLevels,1)-1 THIS.synchCanvases() endif ENDPROC PROCEDURE RightClick THIS.invokeContextMenu() ENDPROC PROCEDURE Show *--------------------------------------------------------------- * The Report engine / Listener object can be assigned a preview * surface instance in advance of rendering a report, so it will * need to invoke .Show() when it is ready for the user to interact * with the Preview UI. *--------------------------------------------------------------- lparameter iStyle #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + "frxPreviewForm::Show(" + trans(m.iStyle) + ")" #ENDIF if parameters() = 0 iStyle = WINDOWTYPE_MODELESS endif *---------------------------------------------------- * Fixed in SP1: Extension handler .InitializeToolbar() * Additional call. THIS.CreateToolbar() was called in * the .Init(), before the extension handler could be * assigned. Now that it is possibly available, we * need to re-invoke its CreateToolbar() hook: *---------------------------------------------------- if not isnull( THIS.Extensionhandler ) if pemstatus( THIS.ExtensionHandler, "InitializeToolbar", 5 ) #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + " frxPreviewForm.ExtensionHandler::InitializeToolbar()" #ENDIF THIS.ExtensionHandler.InitializeToolbar() endif endif *------------------------------- * How many pages? *------------------------------- THIS.PageTotal = THIS.oReport.OutputPageCount *------------------------------- * a RANGE x,y clause can cause 0 pages rendered *------------------------------- if THIS.PageTotal < 1 =messagebox(RP_NO_OUTPUT_PAGES_LOC ,64,DEFAULT_MBOX_TITLE_LOC) nodefault return endif THIS.startOffset = 0 THIS.canvasCount = min( THIS.canvasCount, THIS.PageTotal) *------------------------------- * Should we be modal? *------------------------------- THIS.IsNoWait = not (m.iStyle = WINDOWTYPE_MODAL) *----------------------------------- * Set and save the current form caption for later * (See THIS.synchPageNo()) *----------------------------------- if empty( THIS.Caption ) THIS.Caption = REPORT_PREVIEW_CAPTION endif *----------------------------------- * Fix for SP2: * Only enhance the preview window title caption * if user has not specfied a target window: *----------------------------------- do case case THIS.oReport.commandClauses.IsDesignerLoaded * Caption includes file name already: THIS.Caption = proper(THIS.Caption) case not empty( THIS.oReport.commandClauses.Window ) * The caption has been specified via the WINDOW clause, * so don't change it: otherwise if not empty( THIS.oReport.PrintJobName) THIS.Caption = THIS.Caption + " - " + THIS.oReport.PrintJobName else THIS.Caption = THIS.Caption + " - " + THIS.frxFilename endif endcase THIS.formCaption = THIS.Caption *----------------------------------- * Update the form caption with the current page: *----------------------------------- THIS.setCurrentPage(THIS.currentPage) *----------------------------------- * Activate the extension handler: *----------------------------------- if not isnull( THIS.Extensionhandler ) *----------------------------------- * Fixed for SP1: Only invoke the method * if it is defined: *----------------------------------- if pemstatus( THIS.ExtensionHandler, "Show", 5 ) #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + " frxPreviewForm.ExtensionHandler::Show(" + trans(m.iStyle) + ")" #ENDIF THIS.ExtensionHandler.Show( m.iStyle ) endif endif *---------------------------------------------- * Fix for versions earlier than SP1: Bug# 475109 *---------------------------------------------- if version(4) < "09.00.0000.3301" if not THIS.IsNoWait and ; THIS.ShowWindow = SHOWWINDOW_IN_TOPFORM and ; not empty(wparent(THIS.Name)) * if we are modal and inside a topform app, * the toolbar will be unavailable, so don't * show it: THIS.ToolbarIsVisible = .F. endif endif *----------------------------------- * Update the toolbar, if necessary: *----------------------------------- THIS.Toolbar.Refresh() if THIS.ToolbarIsVisible THIS.showToolbar(SHOW_TOOLBAR_ENABLED) endif *---------------------------------- * Obtain page dimensions: *---------------------------------- local iWidth, iHeight iWidth = THIS.oreport.getPageWidth() iHeight = THIS.oReport.getPageHeight() THIS.PageWidth = m.iWidth/960 THIS.PageHeight = m.iHeight/960 *---------------------------------- * New in SP2: * Create the canvas objects: * Canvas1... Canvas4 *---------------------------------- THIS.CreateCanvases() *---------------------------------- * Adjust the canvases to suit: *---------------------------------- THIS.SynchCanvases() *----------------------------------- * If modal, no minimise button, and hide the command window: *----------------------------------- if not THIS.IsNoWait && m.iStyle = 1 THIS.MinButton = .F. *------------------------------------------------ * Hide the command window, if not NOWAIT *------------------------------------------------ THIS.HideCommandWindow() endif #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + " frxBaseForm::Show(" + trans(m.iStyle) + ")" #ENDIF *----------------------------------------------- * New in SP2: * Ensure pages are drawn once manually up front: *----------------------------------------------- THIS.RenderPages() *----------------------------------- * Support the IN WINDOW clause: *----------------------------------- if not empty( THIS.oReport.commandClauses.InWindow ) activate window (THIS.oReport.commandClauses.InWindow) activate window (THIS.Name) ; in window (THIS.oReport.commandClauses.InWindow) * This does not work for modal: * THIS.Visible = .T. * NODEFAULT dodefault(m.iStyle) dodefault(m.iStyle) endif ENDPROC PROCEDURE Cls #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + "frxPreviewForm::Cls()" #ENDIF ENDPROC PROCEDURE Error *=========================================== * Error( ) *=========================================== lparameters iError, cMethod, iLine if not isnull( THIS.Extensionhandler ) *----------------------------------- * ENH for SP2: *----------------------------------- if pemstatus( THIS.ExtensionHandler, "HandledError", 5 ) #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + " frxPreviewForm.ExtensionHandler::HandledError()" #ENDIF if THIS.ExtensionHandler.handledError( m.iError, m.cMethod, m.iLine ) return endif endif endif dodefault( m.iError, m.cMethod, m.iLine ) ENDPROC Top = 16 Left = 8 Height = 367 Width = 580 ShowWindow = 1 ScrollBars = 3 DoCreate = .T. AutoCenter = .F. Caption = "" KeyPreview = .T. BackColor = 128,128,128 AllowOutput = .F. canvascount = 1 canvasheight = 10 canvaswidth = 10 currentpage = 1 frxfilename = ("") lastpainted = 0 oreport = .NULL. pageheight = 11.5 pagewidth = 8 pagetotal = 0 toolbar = .NULL. toolbarisvisible = .T. unitconverter = .NULL. zoomlevel = 5 formcaption = ("") startoffset = 0 extensionhandler = .NULL. _memberdata = 4790 allowprintfrompreview = .T. lastzoomlevel = 0 textontoolbar = .F. tempstoprepaint = .F. memberclass = ("") memberclasslibrary = ("") topform = .F. mouseflag = .F. ignoremouseclickinmagnifycode = .F. screendpi = 96 Name = "frxpreviewform" PROCEDURE previewform_assign *------------------------------------------------------ * synch up the various controls *------------------------------------------------------ lparameter oPreviewForm THIS.PreviewForm = m.oPreviewForm if not isnull( THIS.PreviewForm ) THIS.cboZoom.Clear() for i = 1 to alen(THIS.PreviewForm.zoomLevels,1) THIS.cboZoom.AddItem( THIS.PreviewForm.zoomLevels[m.i,ZOOM_LEVEL_PROMPT], m.i ) endfor THIS.cboZoom.DisplayCount = m.i endif ENDPROC PROCEDURE synchcontrols *------------------------------------------------------ * SynchControls() - ensure toolbar displays correct values *------------------------------------------------------ #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + "frxPreviewToolbar::SynchControls()" #ENDIF *------------------------------------------------------ * Zoom level *------------------------------------------------------ THIS.cboZoom.Value = THIS.PreviewForm.zoomLevel *------------------------------------------------------ * Disable multi-page view for high zoom levels *------------------------------------------------------ local iPagesAllowed iPagesAllowed = THIS.PreviewForm.zoomLevels[ THIS.PreviewForm.zoomLevel, ZOOM_LEVEL_CANVAS ] THIS.opgPageCount.opt3.Enabled = (m.iPagesAllowed > 2) THIS.opgPageCount.opt2.Enabled = (m.iPagesAllowed > 1) *------------------------------------------------------ * Number of pages to display *------------------------------------------------------ do case case THIS.PreviewForm.canvasCount = 1 THIS.opgPageCount.Value = 1 case THIS.PreviewForm.canvasCount = 2 THIS.opgPageCount.Value = 2 case THIS.PreviewForm.canvasCount = 4 THIS.opgPageCount.Value = 3 endcase *------------------------------------------------------ * .synchControls() *------------------------------------------------------ with THIS.PreviewForm *------------------------------------------------------ * Disable the Top, Prev if we're on the first page: * Enable them if we are not: *------------------------------------------------------ if (.currentPage > 1 ) THIS.cntPrev.cmdTop.Enabled = .T. THIS.cntPrev.cmdBack.Enabled = .T. else THIS.cntPrev.cmdTop.Enabled = .F. THIS.cntPrev.cmdBack.Enabled = .F. endif *------------------------------------------------------ * Disable the Next, Last if we're closer than canvasCount * to the last page: *------------------------------------------------------ if (.currentPage + .canvasCount > .pageTotal) THIS.cntNext.cmdForward.Enabled = .F. THIS.cntNext.cmdBottom.Enabled = .F. else THIS.cntNext.cmdForward.Enabled = .T. THIS.cntNext.cmdBottom.Enabled = .T. endif *------------------------------------------------------ * Disable the GoToPage button if there is only one page: *------------------------------------------------------ THIS.cmdGoToPage.Enabled = .PageTotal > 1 endwith return ENDPROC PROCEDURE actionzoomlevel lparameter iZoomIndex #IF DEBUG_METHOD_LOGGING debugout "frxPreviewToolbar::ActionZoomLevel()" #ENDIF *----------------------------------- * Fixed for SP1: declare oForm local *----------------------------------- local oForm oForm = THIS.previewForm if oForm.ZoomLevel = m.iZoomIndex *---------------------------------- * there is no action to take *---------------------------------- return endif oForm.actionSetZoom(m.iZoomIndex ) *---------------------------------------------- * Belt & Braces mega kludge: Neither of the * following two methods are 100% reliable in * returning the mouse pointer to its original * position. This way, if one doesn't work (typically * the Win32 function call seems to be ignored, despite * the DOEVENTS), the other will prevent it from being * completely obvious that the mouse pointer is being * dicked around with. * And if you can figure out a better way of pulling the * keyboard focus out of the zoom combolist in the toolbar, * other than clicking on the main preview window, you're * welcome to replace this block of code. *---------------------------------------------- *---------------------------------------------- * Fix in SP2 * See previewForm.MouseUp for code that respects this: *---------------------------------------------- oForm.IgnoreMouseClickInMagnifyCode = .T. *---------------------------------------------- * Save the mouse position: *---------------------------------------------- *---------------------------------------------- * METHOD #1: Use windows API. * (see .Init() for declare statements) *---------------------------------------------- cPoint = space(8) =GetMousePointerPos( @cPoint ) mx = asc(substr(m.cPoint,1,1)) + asc(substr(m.cPoint,2,1))*256 my = asc(substr(m.cPoint,5,1)) + asc(substr(m.cPoint,6,1))*256 *---------------------------------------------- * METHOD #2: Use mrow() relative to toolbar window *---------------------------------------------- mr = mrow(THIS.Caption,3) mc = mcol(THIS.Caption,3) *----------------------------------------- * Fake a mouse click on the preview form * to pull keyboard focus away from the * Zoom level combo box on the toolbar: *----------------------------------------- mouse click at 1,1 window (oForm.Name) *----------------------------------------- * Return the mouse to its starting position: *----------------------------------------- *---------------------------------------------- * METHOD #2: Use mrow() relative to toolbar window *---------------------------------------------- if m.mc < 0 mc = THIS.cboZoom.Left + int(THIS.cboZoom.Width/2) endif if m.mr < 0 mr = THIS.cboZoom.Top + THIS.cboZoom.Height + int( fontmetric(1,THIS.cboZoom.FontName,THIS.cboZoom.FontSize)*(THIS.cboZoom.Value-0.5)) endif mouse at m.mr, m.mc pixels window (THIS.Caption) *----------------------------------------- * METHOD #2: Use Windows API function. * Note: Both DOEVENTS appear to be needed: *----------------------------------------- doevents =SetMousePointerPos( m.mx, m.my ) doevents ENDPROC PROCEDURE getwindowref *----------------------------------------------------------------- * .GetWindowRef( cWindow ) * Given a window name from REPORT FORM.. WINDOW , * return an object reference to the window *----------------------------------------------------------------- lparameter cWindow local cTitle, oRef, oForm cTitle = wtitle(m.cWindow) oRef = null if not empty( m.cTitle ) for each oForm in _screen.Forms if upper(oForm.Caption) == upper(m.cTitle) and ; ((oForm.Class = "Form" and oForm.Name = "") or ; (upper(oForm.Name) == upper(m.cWindow))) oRef = m.oForm exit endif endfor endif return m.oRef ENDPROC PROCEDURE actionpagecount #IF DEBUG_METHOD_LOGGING debugout "frxPreviewToolbar::ActionPageCount()" #ENDIF do case case THIS.opgPageCount.Value = 1 THIS.previewform.actionSetCanvasCount(1) case THIS.opgPageCount.Value = 2 THIS.previewform.actionSetCanvasCount(2) case THIS.opgPageCount.Value = 3 THIS.previewform.actionSetCanvasCount(4) endcase ENDPROC PROCEDURE Refresh #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + "frxPreviewToolbar::Refresh()" #ENDIF if not isnull( THIS.PreviewForm ) *-------------------------------------------------------------- * Fixed for SP2. Should not include page number *-------------------------------------------------------------- *THIS.Caption = THIS.PreviewForm.Caption THIS.Caption = THIS.PreviewForm.FormCaption *-------------------------------------------------------------- * Fixed for SP1. Doesn't barf if button doesn't exist. *-------------------------------------------------------------- if pemstatus( THIS, "cmdPrint", 5 ) THIS.cmdPrint.Visible = THIS.PreviewForm.AllowPrintFromPreview endif if not THIS.PreviewForm.TextOnToolbar *-------------------------------------------------------------- * Fixed for SP1: doesn't refer to objects specifically by name *-------------------------------------------------------------- for each oControl in THIS.Controls THIS.SetAll("Caption","","cmd") THIS.SetAll("AutoSize",.T.,"cmd") THIS.SetAll("AutoSize",.F.,"cmd") THIS.SetAll("Height",22,"cmd") endfor endif endif ENDPROC PROCEDURE Init #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + "frxPreviewToolbar::Init()" #ENDIF THIS.Caption = TOOLBAR_CAPTION THIS.Name = "PreviewToolbar" *-------------------------------- * Declare functions needed for * mouse pointer kludge * see ActionZoomlevel() *-------------------------------- declare GetCursorPos ; in user32 ; as GetMousePointerPos ; string @cpoint declare SetCursorPos ; in user32 ; as SetMousePointerPos ; integer x, integer y ENDPROC PROCEDURE Destroy #IF DEBUG_METHOD_LOGGING debugout space(program(-1)) + "frxPreviewToolbar::Destroy()" #ENDIF if not isnull( THIS.PreviewForm ) THIS.PreviewForm.ToolbarIsVisible = .F. endif ENDPROC PROCEDURE Error *==================================================================== * Error() * Use the ErrorHandler class to provide default error handling. Most * objects (in frxControls.vcx anyway) will defer error handling to their * containers, which ultimately ends up here: *==================================================================== lparameters iError, cMethod, iLine x = newobject("ErrorHandler","pr_frxpreview.prg") x.Handle( iError, cMethod, iLine, THIS ) do case case x.cancelled cancel case x.suspended suspend endcase ENDPROC CWINDOW CTITLE OFORM FORMS CAPTION CLASS NAME* OFORM HIDET OFORM RELEASE EXTENSIONHANDLER OREPORT< TALKv 09.00.0000.2013 IsDesignerProtected- DATASESSIONv frxO6 TOREPORT OREPORT COMMANDCLAUSES ISDESIGNERPROTECTED ICURRSESSION IPROTFLAGS FRXDATASESSION BINSTRINGTOINT ORDER ALLOWPRINTFROMPREVIEW OFORM SETREPORTE Report Preview has not been initialized correctly. It requires a ReportListener reference. Report Preview TALKv iStyleb frxPreviewForm frxPreviewInScreen SCREEN frxPreviewInScreen frxPreviewInDesktop frxPreviewAsTopForm SCREEN frxPreview SCREEN ISTYLE OREPORT LCFORMCLASS COMMANDCLAUSES INSCREEN INWINDOW WINDOW GETWINDOWREF DESKTOP MACDESKTOP TOPFORM PREVIEWFORMCLASS SCREEN LREUSE OFORM WINDOWTYPE CLASS EXTENSIONHANDLER HIDE SETREPORT RESTOREFROMRESOURCE ISDESIGNERLOADED CDESIGNERWINDOW CPARENT IROWPIX ICOLPIX WIDTH HEIGHT CAPTION TEMPLATE WINDOWSTATE BORDERSTYLE HALFHEIGHTCAPTION MEMBERCLASS MEMBERCLASSLIBRARY CANVASCOUNT CURRENTPAGE ZOOMLEVEL TOOLBARISVISIBLE TEXTONTOOLBAR ALLOWPRINTFROMPREVIEW SHOWWINDOW SHOWo IPAGE CURRENTPAGE OFORM SETCURRENTPAGE RENDERPAGESo ICOUNT CANVASCOUNT OFORM ACTIONSETCANVASCOUNT RENDERPAGESX ILEVEL THIS ZOOMLEVEL OFORM ACTIONSETZOOM_ EXTENSIONHANDLER OFORM CBYTE IRETURN WIDTH HEIGHT LEFT* OFORM RELEASE getwindowref, hide? release setreport setcurrentpagem setcanvascount setzoomlevel setextensionhandlera binstringtoint Destroy PROCEDURE checkforlargefonts *==================================================================== * CheckForLargeFonts() * This is invoked from the .Init() to set all contained objects to * use the "large font"-safe font, "MS Shell Dlg" which maps to the * appropriate font in Windows. *==================================================================== *---------------------------------------------------------------- * Initial, default font setting: *---------------------------------------------------------------- do case case OS(3) = "6" or DEBUG_FORCE_SEGOE_UI THIS.SetAll("FontName","Segoe UI") THIS.SetAll("FontSize",9) THIS.SetAll("Margin",0,"txt") THIS.SetAll("Margin",0,"edt") THIS.SetAll("Margin",0,"Editbox") THIS.SetAll("Margin",0,"Textbox") case OS(3) = "5" THIS.SetAll("FontName","MS Shell Dlg 2") THIS.SetAll("FontSize",8) otherwise THIS.SetAll("FontName","Tahoma") THIS.SetAll("FontSize",8) endcase *---------------------------------------------------------------- * Optional Fontname override: *---------------------------------------------------------------- if not empty(DIALOG_FONTNAME_OVERRIDE) THIS.SetAll("FontName", DIALOG_FONTNAME_OVERRIDE ) THIS.FontName = DIALOG_FONTNAME_OVERRIDE endif *---------------------------------------------------------------- * Adjustments for "large fonts": *---------------------------------------------------------------- do case case DIALOG_FONTSIZE_OVERRIDE > 0 *---------------------------------------------------------------- * We can force the use of a specific font size: *---------------------------------------------------------------- this.SetAll("FontSize", DIALOG_FONTSIZE_OVERRIDE ) this.FontSize = DIALOG_FONTSIZE_OVERRIDE *----------------------- * SP1 Fix: *----------------------- case DEBUG_FORCE_LARGE_FONTS or ; (DIALOG_ADJUST_FOR_LARGE_FONTS and THIS.screenDPI >= 120) *---------------------------------------------------------------- * Use a slightly larger font in 120 dpi to match the other * native VFP dialogs *---------------------------------------------------------------- this.SetAll("FontSize", 10 ) this.FontSize = 10 endcase ENDPROC PROCEDURE Error *==================================================================== * Error() * Use the ErrorHandler class to provide default error handling. Most * objects (in frxControls.vcx anyway) will defer error handling to their * containers, which ultimately ends up here: *==================================================================== lparameters iError, cMethod, iLine x = newobject("ErrorHandler","pr_frxpreview.prg") x.Handle( m.iError, m.cMethod, m.iLine, THIS ) do case case x.cancelled cancel case x.suspended suspend endcase ENDPROC PROCEDURE Init *==================================================================== * Init() * Make sure that if large fonts are in effect, to switch all controls * to use a large-font-safe font. *==================================================================== *--------------------------------- * SP1 - improve "large font" handling: * Determine the screen DPI: *--------------------------------- #define LOGPIXELSX 88 declare integer GetDeviceCaps in WIN32API integer HDC, integer item declare integer GetDC in WIN32API integer hWnd declare integer ReleaseDC in WIN32API integer hWnd, integer HDC local hdc, screenDPI hdc = GetDC(0) THIS.screenDPI = GetDeviceCaps( m.hdc, LOGPIXELSX ) ReleaseDC( 0, m.hdc ) *--------------------------------- * Adjust object font sizes if necessary: *--------------------------------- this.checkForLargeFonts() ENDPROC frxPreview.vcx TALKv frxPreviewProxy frxPreview.vcx frxPreviewProxy frxPreview.vcx ROREF FRXPREVIEW Line .Error() Do you want to suspend execution? Report Preview Error Report Preview Error IERROR CMETHOD ILINE THIS CANCELLED SUSPENDED CERRORMSG IRETVAL NAME ERRORTEXT Handle SUSPENDED CANCELLED ERRORTEXT ErrorHandler Custom }GO7% CTOKEN RETVAL IINDEX VALUES VVALUE IINDEX IKEYCOUNT VALUES IPAIR CTEXT VALUES? VALUESj CTEXT ILINECOUNT IKEYCOUNT CBUFF CVALUE ATEMP STRIPDELIMITERS RESOURCE RESOURCEv RESOURCE TYPE+ID+PADR(NAME,24) CURRENTWORKAREA RESOURCEWORKAREA PREFW CNAME OPENRESOURCEFILE LOADMEMO CURRENTWORKAREA PREFW PREFW CNAME RESOURCEWORKAREA OPENRESOURCEFILE LRETVAL CDATA GETMEMO READONLY CKVAL UPDATED CURRENTWORKAREA\ RESOURCEWORKAREA CURRENTWORKAREA .FontName .FontSize .FontBold .FontItalic FONTNAME FONTSIZE FONTBOLD FONTITALIC[ .FontName .FontSize .FontBold .FontItalic CVALUE FONTNAME FONTSIZE FONTBOLD FONTITALIC .Left .Width .Height .WindowState ICURRENTSTATE WINDOWSTATE WIDTH HEIGHT .Left .Width .Height .WindowState CVALUE WIDTH HEIGHT WINDOWSTATE getMemoK reset loadMemoY OpenResourceFile# LoadResource SaveResource Destroy0 SaveFontState RestoreFontState SaveWindowStateJ RestoreWindowState VALUES STRIPDELIMITERSm CURRENTWORKAREA RESOURCEWORKAREA NameValuePairManager Custom ResourceManager NameValuePairManager GIF89a GdipCreateImageAttributes gdiplus.dll GdipSetImageAttributesColorMatrix gdiplus.dll GdipSetImageAttributesRemapTable gdiplus.dll GDIPCREATEIMAGEATTRIBUTES GDIPLUS GDIPHANDLE DISPOSEIMAGEATTRIBUTES LHIMAGEATTR STAT! GDIPSETIMAGEATTRIBUTESCOLORMATRIX GDIPSETIMAGEATTRIBUTESREMAPTABLE GDIPHANDLE GDI+ error in CC Error code : Description: Press 'Retry' to debug the application. Error TNSTATUS LNOPTION THIS ERRORINFO STAT. GDIPHANDLE DISPOSEIMAGEATTRIBUTES{ TACOLMATRIX LCCOLORMATRIX MAKECOLORMATRIX STAT! GDIPSETIMAGEATTRIBUTESCOLORMATRIX GDIPHANDLEd GdipSetImageAttributesGamma GDIPLUS.dll TNGAMMA GDIPSETIMAGEATTRIBUTESGAMMA GDIPLUS GDIPHANDLE` GdipGetImageWidth GdiPlus.dll GdipGetImageHeight GdiPlus.dll TOIMAGE LNWIDTH LNHEIGHT LNNATIVEIMAGE GETHANDLE GDIPGETIMAGEWIDTH GDIPLUS GDIPGETIMAGEHEIGHT DRAWIMAGERECTRECT GdipGetImageGraphicsContext GdiPlus.dll GdipDrawImageRectRect gdiplus.dll GdipDeleteGraphics GdiPlus.dll TNIMAGE DSTWIDTH DSTHEIGHT SRCWIDTH SRCHEIGHT LNSCRUNIT LHGFX LNSRCUNIT GDIPGETIMAGEGRAPHICSCONTEXT GDIPLUS GDIPDRAWIMAGERECTRECT GDIPHANDLE GDIPDELETEGRAPHICS< TNOLDCOLOR TNNEWCOLOR TNOLDALPHA TNNEWALPHA LNARGBOLD LNARGBNEW LCCOLORMAP MAKECOLORMAP MAKEARGB STAT GDIPSETIMAGEATTRIBUTESREMAPTABLE GDIPHANDLEa GdipDisposeImageAttributes GdiPlus.dll TNIMGATTRIBUTES GDIPDISPOSEIMAGEATTRIBUTES GDIPLUS GDIPHANDLE TCCOLMATR1 TCCOLMATR2 CMRESULT F2INT2 MAKECOLORMATRIX- TNWIDTH TNHEIGHT TNCOLOR TNALPHA LNARGB LNRED LNGREEN LNBLUE TAINTPOINTS LCPOINTSFSEQUENCE LCPOINTF POINTF TACOLMATRIX LCCOLORMATRIX LCMATRIX TACOLORMAP LCCOLORMAP LNARGBOLD LNARGBNEW MAKEARGB CHARACTER GPBITMAP \ffc\_gdiPlus.vcx ENUMPIXELFORMAT GPBITMAP \ffc\_gdiPlus.vcx GpBitmap GPGRAPHICS \ffc\_gdiPlus.vcx GpGraphics GdipDrawImageRectRect gdiplus.dll GdipCloneImage GDIPlus.Dll TCCLRMATRIX TOBMP TIFORMAT TNBACKCOLOR SETCOLORMATRIX LNWIDTH LNHEIGHT IMAGEWIDTH IMAGEHEIGHT LONEWBMP CREATE LOGFX CREATEFROMIMAGE CLEAR LNSCRUNIT LHGFX LNSRCUNIT GDIPDRAWIMAGERECTRECT GDIPLUS STAT GETHANDLE GDIPHANDLE SETHANDLE DESTROY LHCLONED GDIPCLONEIMAGE Generic Error Invalid Parameter Out Of Memory Object Busy Insufficient Buffer Not Implemented Win32 Error Wrong State Aborted File Not Found Value Overflow Access Denied Unknown Image Format Font Family Not Found Font Style Not Found Not True Type Font Unsupported Gdiplus Version Gdiplus Not Initialized Property Not Found Property Not Supported Unknown Error TNSTATUSI CHARACTER GPBITMAP \ffc\_gdiPlus.vcx ENUMPIXELFORMAT GPBITMAP \ffc\_gdiPlus.vcx GpBitmap GPGRAPHICS \ffc\_gdiPlus.vcx GpGraphics GPBITMAP \ffc\_gdiPlus.vcx GPGRAPHICS \ffc\_gdiPlus.vcx GpBitmap GdipCloneImage GDIPlus.Dll GpGraphics GdipDrawImageRectRect gdiplus.dll TCCLRMATRIX TOBMP TIFORMAT SETCOLORMATRIX LNWIDTH LNHEIGHT IMAGEWIDTH IMAGEHEIGHT LONEWBMP CREATE LOGFX CREATEFROMIMAGE LOCLONEDBMP LHCLONED GDIPCLONEIMAGE GDIPLUS STAT GETHANDLE SETHANDLE CLEAR LNSCRUNIT LHGFX LNSRCUNIT GDIPDRAWIMAGERECTRECT GDIPHANDLE CHARACTER GPBITMAP \ffc\_gdiPlus.vcx ENUMPIXELFORMAT GPBITMAP \ffc\_gdiPlus.vcx GPGRAPHICS \ffc\_gdiPlus.vcx GpBitmap GdipCloneImage GDIPlus.Dll GpGraphics GdipDrawImageRectRect gdiplus.dll TCCLRMATRIX TOBMP TIFORMAT SETCOLORMATRIX LOCLONEDBMP LOGFX LHCLONED GDIPCLONEIMAGE GDIPLUS STAT GETHANDLE SETHANDLE CREATEFROMIMAGE CLEAR LNWIDTH LNHEIGHT IMAGEWIDTH IMAGEHEIGHT LNSCRUNIT LHGFX LNSRCUNIT GDIPDRAWIMAGERECTRECT GDIPHANDLE Init, GetHandle stat_Assign Destroy^ SetColorMatrix SetGamma ApplyImageAttributeU DrawImageRectRectC RemapTable DisposeImageAttributes MultiplyColorMatrix: POINTF8 RECTFo MAKEARGB MakePointsFSequence MakeColorMatrix ColorMatrix MakeColorMap ApplyColorMatrix ErrorInfo __ApplyColorMatrix ApplyColorMatrix_Orig@" f2int2 GDIPHANDLE GPATTRIB CUSTOM pr_pdfx.vcx pr_pdfx.vct pr_rtflistener.vcx pr_rtflistener.vct foxypreviewer.prg c:\users\cesi\appdata\local\temp\ foxypreviewer.fxp installfoxcode.prg installfoxcode.fxp images\ pr_top.bmp pr_previous.bmp pr_next.bmp pr_bottom.bmp pr_gotopage.bmp pr_close.bmp pr_print.bmp pr_printpref.bmp pr_save.bmp pr_img.bmp pr_pdf.bmp pr_html.bmp pr_word.bmp pr_locate.bmp pr_close2.bmp libhpdf.dll wwrite.ico pr_mail.bmp pr_excellistener.vcx pr_excellistener.vct pr_excel.bmp _frxcursor.vcx _frxcursor.vct pr_top_32.bmp pr_previous_32.bmp pr_next_32.bmp pr_bottom_32.bmp pr_gotopage_32.bmp pr_close_32.bmp pr_print_32.bmp pr_save_32.bmp pr_locate_32.bmp foxypreviewer_locs.dbf pr_1page_32.bmp pr_2page_32.bmp pr_4page_32.bmp pr_close2_32.bmp pr_mail_32.bmp pr_printpref_32.bmp pr_4page.bmp pr_1page.bmp pr_2page.bmp foxypreviewer_defaultsettings.dbf pr_settings.scx pr_settings.sct pr_gear.bmp pr_gear_32.bmp pr_sendmail.scx pr_sendmail.sct pr_attach.bmp _gdiplus.vcx _gdiplus.vct pr_search.scx pr_search.sct pr_search.bmp pr_search_32.bmp pr_searchagain.bmp pr_searchagain_32.bmp pr_searchback.bmp pr_searchback_32.bmp pr_ctl32_progressbar.vcx pr_ctl32_progressbar.vct pr_cpzero.prg pr_cpzero.fxp pr_foxyhelper.vcx pr_foxyhelper.vct pr_reportlistener.vcx pr_reportlistener.vct pr_sendmail2.scx pr_sendmail2.sct pr_htmledit.vcx pr_htmledit.vct pr_adress.bmp pr_sendmessage.bmp pr_align_left.bmp pr_align_center.bmp pr_align_right.bmp pr_textcolor.bmp pr_fontback.bmp pr_textmoveright.bmp pr_textmoveleft.bmp pr_listdot.bmp pr_listnumber.bmp pr_undo.bmp pr_hyperlink.bmp pr_getimage.bmp pr_redo.bmp pr_cut.bmp pr_copy.bmp pr_paste.bmp pr_new.bmp pr_open.bmp pr_clean.bmp pr_align_justify.bmp pr_adressbook.scx pr_adressbook.sct pr_mail03.ico pr_rcsgridsort.vcx pr_rcsgridsort.vct pr_sortascending.bmp pr_sortdescending.bmp pr_htmllistener2.vcx pr_htmllistener2.vct pr_ooxml2xls.prg pr_ooxml2xls.fxp __readme.txt pr_mht.bmp _reportoutputconfig.dbf _reportoutputconfig.fpt _reportoutputconfig.cdx frxcontrols.vcx frxcontrols.vct frxpreview.vcx frxpreview.vct pr_frxpreview.prg pr_frxpreview.fxp frxcommon.prg frxcommon.fxp grabber.gif prefirst.bmp preprev.bmp gotopage.msk prenext.bmp prelast.bmp 1page.msk 2page.msk 4page.msk preclose.bmp preclose.msk print.msk preview.bmp pr_gdiplushelper.prg pr_gdiplushelper.fxp