!|VERSION = 3.00printdevOnprnhandle defprtname procheap hdocname declareapi long2char oblddocptr PixelsClass1customprintdevnprnhandle = (0) cprintername = (Space(0)) cfilename = (Space(0)) nerror = (0) defprtname = (Space(0)) procheap = (0) hdocname = (0) cdocname = (Space(0)) nopenerror = (0) Name = "printdev" custom cdosprintPixelsClass1custom cdosprintcustomnprnhandle Printer handle returned from OpenPrinter cprintername Name of the printer to open. cfilename File to use in oPrintFile() nerror Error returned from last API call. defprtname Default printer name procheap Current process heap hdocname Memory Handle for DocName cdocname Document name to show in print spooler nopenerror *oopen Open the printer device specified in cPrinterName, and store the result handle in nPrnHandle. *oclose Close a printer device previouly opened with oOpen() *oprintfile Send the file specified in the cFilename to a previously opened print device. *oprintmem Send the content of a string variable passed as parameter to a previouly opened printer device. *declareapi Declare API functions Required to access the printer device in raw mode. *oisopen Verify status of the print device. *long2char Long value to char conversion *oblddocptr Build a Pointer to String for use in the Doc_info_1 structure.  Q % U T T C CTCT C %TC TC %T %CBULNHANDLNDEFLCDOCTHIS DECLAREAPIOCLOSENERROR OPENPRINTER CPRINTERNAME NOPENERROR GETLASTERROR OBLDDOCPTRSTARTDOCPRINTER NPRNHANDLE CLOSEPRINTER C Ta%cCCT%CT BU LRESULTTHIS DECLAREAPI NPRNHANDLE ENDDOCPRINTER CLOSEPRINTERHDOCNAMEHEAPFREEPROCHEAP T T T-TCX C%|%C C0 xTC%TCC%S Ta+C OTC%%CC> K T-%t C BU LRESULTLNWRTCHRLCMEMOLNFLHNDNFSIZETHIS DECLAREAPI NPRNHANDLE CFILENAME WRITEPRINTER  T- C%'%CpcMemobC C> %%CC> Ta BUPCMEMOLRESULTLNWRTCHRTHIS DECLAREAPI NPRNHANDLE WRITEPRINTER~)| OpenPrinter WINSPOOL.DRV%| ClosePrinter WINSPOOL.DRV,|StartDocPrinter WINSPOOL.DRV&| EndDocPrinter WINSPOOL.DRV,| WritePrinter WINSPOOL.DRV"|GetProcessHeapWIN32API"| HeapAllocWIN32API!|HeapFreeWIN32API*|memcpyMSVCRTQ CopyMemory | GetLastErrorWIN32APIU OPENPRINTERWINSPOOLDRV CLOSEPRINTERSTARTDOCPRINTER ENDDOCPRINTER WRITEPRINTERGETPROCESSHEAPWIN32API HEAPALLOCHEAPFREEMEMCPYMSVCRT COPYMEMORY GETLASTERRORBUTHIS NPRNHANDLE TCC Q%CnLongValbNTC8KTCC CCC CCC CCC  BUNLONGVALLNLVLCRETVALw TCC Q%DTC%g Hi C T C T2#TVisual Foxpro DocumentTC #TCC>%cCC> "TC CC Q BU LCDOCPTRLCDOCSTRTHISPROCHEAPGETPROCESSHEAPCDOCNAME CFILENAMEHDOCNAME HEAPALLOC COPYMEMORY LONG2CHAR C%C C CTC%TCULAPRTLSTNPOSTHIS DECLAREAPI CPRINTERNAME DEFPRTNAME CUTHISOCLOSEoopen,oclose oprintfile  oprintmem declareapioisopen+ long2charU oblddocptr Init Destroy 1BABAA3qAABA3rA!!QAQQAAA!AAA3qAqQAAA2Wh$)33qBA2BAAB111A21B!AA2qqQAA32#840@TzSMdXZcRzmh)PROCEDURE oopen Local lnhand, lndef, lcdoc lnhand = 0 lndef = 0 this.DeclareAPI() this.oClose() this.nerror = OpenPrinter(this.cprintername, @lnhand, lndef) this.nopenerror = GetLastError() If this.nerror != 0 lcdoc = this.oBldDocPtr() this.nerror = StartDocPrinter(lnhand, 1, lcdoc) Endif If this.nerror != 0 this.nprnhandle = lnhand Else If lnhand != 0 ClosePrinter(lnhand) Endif Endif Return (this.nerror != 0) ENDPROC PROCEDURE oclose Local lresult this.DeclareAPI() lresult =.t. If this.nprnhandle != 0 EndDocPrinter(this.nprnhandle) ClosePrinter(this.nprnhandle) this.nprnhandle = 0 Endif If this.hdocname != 0 HeapFree(this.procheap, 0, this.hdocname) this.hdocname = 0 Endif Return lresult ENDPROC PROCEDURE oprintfile #define BLKSZ 65535 Local lresult, lnwrtchr, lcMemo, lnflhnd, nfsize nfsize = 0 lnwrtchr = 0 lresult = .f. lcMemo = Space(0) this.DeclareAPI() If this.nprnhandle != 0 If !Empty(this.cFilename) .And. File(this.cFilename) lnflhnd = Fopen(this.cFilename) If lnflhnd != -1 nfsize = Fseek(lnflhnd,0,2) Fseek(lnflhnd,0,0) Endif If nfsize > 0 lresult = .t. Do While !Feof(lnflhnd) lcMemo = FRead(lnflhnd, BLKSZ) If WritePrinter(this.nprnhandle, lcMemo, Len(lcMemo),@lnwrtchr) == 0 lresult = .f. Endif EndDo Endif If lnflhnd != -1 Fclose(lnflhnd) Endif Endif Endif Return lresult ENDPROC PROCEDURE oprintmem LPARAM pcMemo Local lresult, lnwrtchr lresult=.f. this.DeclareAPI() If this.nprnhandle != 0 If type('pcMemo')='C' .And. Len(pcMemo)>0 If WritePrinter(this.nprnhandle, pcMemo, Len(pcMemo), @lnwrtchr) != 0 lresult = .t. Endif Endif Endif Return lresult ENDPROC PROCEDURE declareapi *-- * pPrinterName - Pointer to a null-terminated string that specifies * the name of the printer or print server. * phPrinter - Pointer to a variable that receives the handle * identifying the opened printer or print server object. * pDefault - Pointer to a PRINTER_DEFAULTS structure. * This value can be NULL. *-- DECLARE INTEGER OpenPrinter IN WINSPOOL.DRV ; STRING pPrinterName, ; INTEGER @phPrinter, ; LONG pDefault *-- * hPrinter - Handle to the printer object to be closed. Use the OpenPrinter * or AddPrinter function to retrieve a printer handle. *-- DECLARE INTEGER ClosePrinter IN WINSPOOL.DRV ; INTEGER hPrinter *-- * hPrinter - Handle to the printer. Use the OpenPrinter or AddPrinter * function to retrieve a printer handle. * nLevel - Specifies the version of the structure to which * pDocInfo points. WinNT: 1, Win9x: 1 or 2. * pDocInfo - Pointer to a structure that describes the document to print. *-- DECLARE INTEGER StartDocPrinter IN WINSPOOL.DRV ; INTEGER hPrinter, ; LONG nLevel, ; STRING pDocInfo *-- * hPrinter - Handle to a printer for which the print job should be ended. * Use the OpenPrinter or AddPrinter function to retrieve a * printer handle. *-- DECLARE INTEGER EndDocPrinter IN WINSPOOL.DRV ; INTEGER hPrinter *-- * hPrinter - Handle to the printer. Use the OpenPrinter or AddPrinter * function to retrieve a printer handle. * pBuf - Pointer to an array of bytes that contains the data that * should be written to the printer. * cbBuf - Specifies the size, in bytes, of the array. * pcWritten - Pointer to a value that specifies the number of bytes of * data that were written to the printer. *-- DECLARE INTEGER WritePrinter IN WINSPOOL.DRV ; INTEGER hPrinter, ; STRING pBuf, ; LONG cbBuf, ; LONG @pcWritten *-- * Obtains a handle to the heap of the calling process. *-- DECLARE INTEGER GetProcessHeap IN WIN32API *-- * Allocates a block of memory from a heap. *-- DECLARE LONG HeapAlloc IN WIN32API ; INTEGER hHeap, ; INTEGER dwFlags, ; INTEGER dwBytes *-- * Frees a memory block allocated from a heap by HeapAlloc. *-- DECLARE INTEGER HeapFree IN WIN32API ; INTEGER hHeap, ; INTEGER dwFlags, ; LONG lpMem *-- * Copies a block of memory from one location to another. *-- DECLARE memcpy IN MSVCRT AS CopyMemory ; LONG Destination, ; STRING Source, ; INTEGER Length *-- * Get Last error in thread *-- DECLARE INTEGER GetLastError IN WIN32API ENDPROC PROCEDURE oisopen Return (this.nprnhandle != 0) ENDPROC PROCEDURE long2char LParameter nLongVal Local lnlv, lcRetval lcRetVal=Replicate(chr(0),4) If type('nLongVal') = 'N' lnlv = Int(nLongVal) lcRetval = chr(bitand(lnlv,255)) + ; chr(bitand(bitrshift(lnlv, 8), 255)) + ; chr(bitand(bitrshift(lnlv, 16), 255)) + ; chr(bitand(bitrshift(lnlv, 24), 255)) Endif Return lcRetVal ENDPROC PROCEDURE oblddocptr Local lcDocPtr, lcDocstr lcDocPtr = Replicate(Chr(0), 20) If this.procheap = 0 this.procheap = GetProcessHeap() Endif If this.procheap != 0 Do Case Case !Empty(this.cdocname) lcdocstr = this.cdocname Case !Empty(this.cfilename) lcdocstr = this.cfilename Otherwise lcdocstr = "Visual Foxpro Document" EndCase lcdocstr = lcDocStr+chr(0) this.hdocname = HeapAlloc(this.procheap, 0, Len(lcdocstr)+1) If this.hdocname != 0 CopyMemory(this.hdocname, lcDocstr, Len(lcDocstr) ) lcDocPtr = this.Long2Char(this.hdocname) + Replicate(chr(0), 16) Endif Endif Return lcDocPtr ENDPROC PROCEDURE Init Local laprtlst(1,2), npos this.DeclareAPI() If Empty(this.cprintername) .And. !Empty(this.defprtname) APrinters(laprtlst) npos = ASCAN(laprtlst, this.defprtname) If npos != 0 this.cprintername = laprtlst(npos) Endif Endif ENDPROC PROCEDURE Destroy this.oclose() ENDPROC Ycoutfile^ npl^ printformatdata^ ngroupcount^ setprinton^ setprintoff^ expandmacros^ lineno_access^ lineno_assign^ iprintstring^ igetmacroname^ printformat_assign^ iloadformat^ beforewrite^ footerlenght_access^ footerlenght_assign^ afterwrite^ agroups^ iaddgroup^ itoken^ printjobname_access^ printjobname_assign^ amacros^  topmargin Margen superior de la pgina (en lneas) bottommargin Margen inferior de la pgina (en lineas) leftmargin Margen izquierdo de la pgina (en columnas) paperlenght Longitud de la pgina (en lneas) startconfstring Cadena de configuracin inicial newpageconfstring Cadena de configuracin para nueva pgina coutfile Archivo temporal de salida npl Contador de lneas impresas por pgina pageno Contador de pginas footerlenght Nro. de lineas reservadas para pie de pgina. headerstring Cadena a utilizar como encabezado de pgina. footerstring Cadena a utilizar como pi de pgina onnewpage Comando a ejecutar cuando se inicia una nueva pgina lineno The line number where the error occurred. Same as LINENO(). cdocname Nombre del Documento en la Cola de Impresin, Agregado Esparta 27/08/2001 printformat Nombre del formato de impresin a utilizar. printformatdata Contenido del archivo indicado en PrintFormat detailstring Cadena que se imprime cuando se utiliza el mtodo PrintSection con el parmetro DETAIL. ngroupcount Nro. de grupos definidos autoeject Indica si se realizaran saltos de pgina automticamente. titlestring Texto a imprimir antes de iniciar el informe. summarystring Esto a imprimir al finalizar el informe. ejectaftertitle Indica si se saltar de pgina despus de imprimir la seccin Title. ejectbeforesummary Indica si se saltar la pgina antes de imprimir la seccin Summary. ejectstring Cadena a imprimir para lograr el efecto de Eject. printjobname Nombre del trabajo de impresin targetcp Cdigo de pgina del dispositivo de salida. sourcecp Cdigo de pgina nativo macroi *write Escribe el texto indicado sin avanzar la lnea *writeln Escribe el texto indicado avanzando la linea *eject Ejecuta un salto de pgina *print Imprime el reporte *clear Limpia el reporte *setprinton Activa la salida hacia la impresin *setprintoff Desactiva la salida hacia la impresora *expandmacros Expande los macros incluidos en la cadena indicada *printtofile Genera la salida del reporte en el archivo indicado *addmacro Aade un macro a la lista de macros ^macros[1,1] Lista de macros *setmacro Cambia el valor asociado a un macro *getmacro Devuelve el valor de un macro *lineno_access *lineno_assign *iprintstring Imprime la cadena en secciones de 250 caracteres, se agreg para solucionar el problema de ?? y ? *strexpand Expande macros contenidos en una cadena. *igetmacroname Devuelve el nombre de un macro, eliminando los marcadores $ *getformatsection Devuelve el texto asociado a una seccin del formato de impresin indicado *printformat_assign *iloadformat Carga el contenido de un archivo de formato. *printsection Imprime el contenido de una seccin del formato en uso. *beforewrite Ejecuta las verificaciones necesarias antes de escribir data al archivo de salida. *footerlenght_access *footerlenght_assign *afterwrite Realiza las verificaciones necesarias despus de haber escrito en el archivo de salida. ^agroups[1,1] Lista de grupos definidos *iaddgroup Aade un grupo a la lista de grupos *itoken Devuelve un elemento dado de una lista de elementos *evalgroups Evalua los grupos de salto definidos *startgroups Prepara los grupos definidos *endgroups Totaliza los grupos definidos *run Ejecuta un reporte basndose en el alias activo o en el alias indicado. *idocalc Realiza un clculo indicado. *printjobname_access *printjobname_assign *sectionheight Devuelve la altura en lineas de una seccin *macros_access *macros_assign ^amacros[1,1] ^bmacros[1,1] Z ZZ`'%wMXPU %C( T%M C C  TCC ( H# CCC=f#EXEC  T CCC\ &cCmd . C %CCC XC `CC % T C CUPCTEXTO PLLEFTMARGINTHISNPLWRITELN BEFOREWRITEALINEASINCOUNT EXPANDMACROSCCMD SETPRINTON IPRINTSTRINGLE_INI_FTMARGIN AFTERWRITE SETPRINTOFFi%C, T C  !TCC(U H# CCC=f#EXEC  T CCC\ &cCmd . C CC XC T  C C CUPCTEXTO PLDOCALCS PLNOEJECTTHIS BEFOREWRITEALINEASINCOUNT EXPANDMACROSCCMD SETPRINTON IPRINTSTRING LEFTMARGINNPL AFTERWRITE SETPRINTOFFW%C %  C T)(T CTCFOOTERa  C  CTT  2CPAGENOalltrim(str(This.PageNo)) U THIS FOOTERSTRING PAPERLENGHTIJ SETPRINTONNPL FOOTERLENGHT SETPRINTOFF PRINTSECTION EJECTSTRINGPAGENOSETMACROk  TCPrintDevN%CCST %CN B TT7TCCcLcDocbC Report Pvent6%C B-G*(T  (GC  C  C G*(U CPRINTERNAMEPNCOPIESOPDEVCLCDOCTHISCDOCNAMEOOPEN CFILENAMECOUTFILEI OPRINTMEMSTARTCONFSTRING OPRINTFILEOCLOSE G*(TC CG*(TT%CU TC,(TC, %C  < TU FHITHISCOUTFILENPLPAGENOICALCS_VAR_LISTNCOUNTCVARITOKENG(!G G* UG*G G(&Uf 5 T(C*TC%CC~TC TC,TCCCoThis. %   5:%CC"CbUCoThis.  FJC(%CC%CC\@JCCC\(J(J( %TC&JC(TC$%TC BU PCTEXTO PLDOCALCSOTHISTHISICMACROCEXPRLISCALCAMACROS IGETMACRONAME STREXPAND  %CN 8 TG*(%h(TC T(TCG*(U CFILENAMENCOPIESTHISCOUTFILECDATAICDATA2R TCf%C=$CT$%CR$pT$8%CCthis.aMacros[1,1]bC  TTCTTTUPCMACROPCSTRINGNCOUNTTHISAMACROS  TCTCf%C=$cT$%CR$T$( %CCC %CT!UPCMACROPCVALORINCOUNTTHISAMACROS TCTCf%C=$_T$%CR$T$(%CBC BUPCMACROINCOUNTTHISAMACROS BUTHISNPL UVNEWVALF4 %ZTC9TC(?TC T/TCCC> 8 CC> 86(C\T% ;U LCCADENAALINEASNCCICLOSNCOUNTITHISSOURCECPTARGETCP4# T +ajTC%%n!TC\TC%%!TC=TCTCb%U TC&T. H7G UO[T Cm N C8 TCCZ N C8 !TCCCdecimalsvZ DTC* L-TCSN62GTC_TC%% T +aTC[%!TC\TC]%!TC=TC>TCTCb%U`TC}T. H UOT C N C8 TCCZ N C8 4!TCCCdecimalsvZ DUTC* LTCSN62TC_ H CC\I&TC[]CC CC\D3&TC[]CC CC\Cu&TC[]CC2$TC[]C BU PCSTRINGCVARNAMENOCURNPOSNPOS2CVARTYPE UVARVALUENEXPRLONCVAREXPRBC$%UPCMACRO%C" B  TC TT  T T-( H8 CC=#C#EXEC C ."  CCCf F Ta.! CCCf  v T-! %//C-TCCC//C="TCC C  BU PCSECTIONTHIS PRINTFORMATATEXTNCOUNTI LINSECTIONCDATACOPENTAG CCLOSETAGPRINTFORMATDATAD%C 0=T C UVNEWVALTHIS PRINTFORMAT ILOADFORMATTCTC #INCLUDE +?TC\TC \TCCC C \#TCCC C =%C0TCT TTC #INCLUDE T<T CTITLE T CHEADER T CDETAIL T CFOOTER TCSUMMARY 5Ja(J-( TCCONFIG TC(TC=CTCCC=%C TCCC\%Cthis.bUTC,TCC C CHR(13)+CHR(10)%C JC(THIS.5 TCMACROI TCTCC> !5"#$(TC=CTCCC=%C TCCC\8%C%Cthis.bMacros[1,1]bC  TTC%%T%T%%C\@TCC\ 7T = C &cMacro 5 TCMACROS TC !5"#$(TC=CTCCC=%C TCCC\ H C_SUM[TC_SUM[T C\T C C] \T!C >T"C ;&T#C ;&T$C ;&KT >oThis.iDoCalc('SUM','%cMacro%','%cSum%','%cReset%','%cStart%')T C 'TC! [ C_COUNT[2 TC_COUNT[T C\T C C] \T!C >T#C ;&T$C ;&GT :oThis.iDoCalc('COUNT','%cMacro%','','%cReset%','%cStart%')T C 'TC! [ C_RET[| TC_RET[T C\T C C] \T!C >T"C ;&T#C ;&T$C ;&KT >oThis.iDoCalc('RET','%cMacro%','%cSum%','%cReset%','%cStart%')T C 'TC! [ C_INI[ TC_INI[T C\T C C] \T!C >T#C ;&T$C ;&ET 8oThis.iDoCalc('INI','%cMacro%','','%cReset%','%cStart%')T C 'TC! [ C_MIN[ TC_MIN[T C\T C C] \T!C >T"C ;&T#C ;&T$C ;&KT >oThis.iDoCalc('MIN','%cMacro%','%cSum%','%cReset%','%cStart%')T C 'TC! [ C_MAX[8TC_MAX[T C\T C C] \T!C >T"C ;&T#C ;&T$C ;&KT >oThis.iDoCalc('MAX','%cMacro%','%cSum%','%cReset%','%cStart%')T C 'TC! [ C_AVG[TC_AVG[T C\T C C] \T!C >T"C ;&T#C ;&T$C ;&KT >oThis.iDoCalc('AVG','%cMacro%','%cSum%','%cReset%','%cStart%')T C 'TC! [C()*+, -T)CGROUPS TC-)(TC=C-T*CCC-=%C* TCCC-\T+CC|&T,CC|&TCC|&C*+,.U/PCFORMATCDATANPOSCFILE CINCLUDEDCDATA1CDATA2THISPRINTFORMATDATA TITLESTRINGGETFORMATSECTION HEADERSTRING DETAILSTRING FOOTERSTRING SUMMARYSTRINGSINOTRUEFALSEYES CPROPLISTNCOUNTIJCPROPCEXPRAPROPS EXPANDMACROS CMACROLISTCMACROAMACROSMACROICSUMEXPRNLENCSUMCRESETCSTARTBMACROSITOKEN STREXPANDADDMACRO CGROUPLISTCGROUPCHEADERCFOOTERAGROUPS IADDGROUPq  TTCCf T- HP HEADERwT FOOTERT DETAILT Ta Ta2%C  TC  %- C %C C QBC U PCSECTION PLNOEJECTCDATA LEVALGROUPSLDOCALCSTHIS HEADERSTRING FOOTERSTRING DETAILSTRING PRINTFORMATGETFORMATSECTION EVALGROUPSWRITELN %CUB5 Ta% C%C p (TCHEADER C%C  T  &cCmd U _FROMBEFOREWRITETHISNPL SETPRINTONNEWPAGECONFSTRINGI TOPMARGIN PRINTSECTION SETPRINTOFF ONNEWPAGECCMD+TC BU NFOOTERLENGHTFOOTHIS FOOTERSTRING UVNEWVAL%CU B5 TaF%     CU PLNOEJECT_FROMAFTERWRITETHIS AUTOEJECT PAPERLENGHTNPL BOTTOMMARGIN FOOTERLENGHTEJECTTTTTTTTTUPCGROUPPCEXPRPCHEADERPCFOOTERNCOUNTTHIS NGROUPCOUNTAGROUPSa&%CpcSepbC C> GT, TTCTC> H C  T % T -!TCC\ `"TCC\2TCTCTC\%C pnNumTokensbNQT%M(I TC T BU PCLISTA PNELEMENTOPCSEP PNNUMTOKENSVELEMENTVNUMELEMIJNLENSEPTHISITOKEN%.B%(CTCTC%C\@TC = C&cMacro (C9TC%CC5.TC TC,T CCCoThis.  5% :%CC"CbUCoThis.  JC(J(5JC(   (TCTCT C 5%CbUT C T T !(TCT CTCT CJ(#%C    C % (TCT CTCT CJ (%C  C T UPLEOFICMACROCEXPRTHIS NGROUPCOUNTMACROIBMACROSAMACROS IGETMACRONAMELISCALCCHEADERCFOOTERURESULT ULASTRESULTCGROUPAGROUPS PRINTSECTION\(UTTUITHIS NGROUPCOUNTAGROUPSCaUTHIS EVALGROUPS%C%B%CCC Q Fe TC C C%CTITLECTITLE%   C  F#),~CC +CC ?CDETAIL F#6 C % %CSUMMARY%  C CSUMMARY% C %  C T)(gT CTCFOOTERCSUMMARYUPCALIASPCWHILEPCFORTHIS PRINTFORMATCLEAR STARTGROUPS SECTIONHEIGHT PRINTSECTION AUTOEJECTEJECTAFTERTITLEEJECT ENDGROUPSEJECTBEFORESUMMARYNPL PAPERLENGHTIJ SETPRINTON FOOTERLENGHT SETPRINTOFF6TCCfLTCCSUMCOUNTINIRETMINMAXAVGSUM64TCCC CbN 0.068TCCCCC''6.T.64TCCC CbN 0.06%CU=7 T5T  !TICALC_C_BUF!T ICALC_C_RST%CbU 7JC(T,%C bU5 7 JC( T,  T C% C JC(J (  H& SUMT CCJ ( COUNTT CJ ( INIAT CJ ( RETtT CJ ( MINT CCCFJ ( MAXT CCCDJ ( AVG&T CC J ( B U PCCALCPCNAMEPCEXPR PCRESETAT PCSTARTEXPRICALCS_VAR_LISTPAGENOTHISCBUFVAR CRESETVARCRESETNBUF BUTHISCDOCNAMET UVNEWVALTHISCDOCNAME$  H TITLEET HEADERlT DETAILT FOOTERT SUMMARYT2TC TC  BU PCSECTIONCDATANHEIGHTTHIS TITLESTRING HEADERSTRING DETAILSTRING FOOTERSTRING SUMMARYSTRINGGETFORMATSECTIONFOO+  BC UNINDEX1NINDEX2THISAMACROS  UVNEWVALNINDEX1NINDEX2TC].DPF+C0GTC].DPFTC CG*(TC 4C%PAGENO%alltrim(str(This.PageNo))C%DATE%C$C%TIME%C^C %DATETIME%C&C%SON%C C- C 'C%SOFF%C C- C %C%LON%C UC &C%LOFF%C UC  C%ION%C C4 !C%IOFF%C C5  C%DON%C C !C%DOFF%C C  C%PON%C S0!C%POFF%C T C%BON%C G C%BOFF%C HC%CON%C C%COFF%C C%C10%C PC%C12%C MC%C15%C gC%EON%C 0 C%EOFF%C 2!C%CRLF%C C C%TAB%CXUTHISCOUTFILEFH EJECTSTRINGADDMACRO:%C 3 CG*( UTHISCOUTFILECLEARwrite,writelnejectprint}clearr setprinton setprintoff expandmacros printtofile addmacro setmacroggetmacro lineno_access lineno_assign iprintstring strexpand igetmacronamegetformatsectionprintformat_assign% iloadformat printsection5/ beforewriteB1footerlenght_access2footerlenght_assign 3 afterwrite73 iaddgroup-4itokenu5 evalgroups48 startgroups= endgroups7>run^>idocalcBprintjobname_accessFprintjobname_assignF sectionheightG macros_accessH macros_assignIInit9IDestroy"M1AGAq1qAAQAqqAB5 Ar1qAAqrB86AqAqArAq$4RAAAq#qAb1rq1A4a!UqqAAA3qaa2aaq2r1QBQR!QAAAAAAqQ2AbQ1qAA4q!Aq!ArAd3Qq!Aq!ArAAAA4qQq!Aq!ArAAA33q3q1qAQr!rAAqAA3q4bAAe1AAa!AA1"""!ACbAAe1AAa1#AA1"""!BaaaAAB3q23q"ArA"AAA!AB3q!1A3qut!a1QAAu1QrQAAAAQAqrAaAAAAQqqaqQaqqQqaqQqaqQQqaqQqaqQqaqQARBAuQrAA5qrr1QAAAAA8QAAtE3AqA1e4qAC3q3q5qRAAtfB31rAa31bAraA!QAQqQAAA3qBAABAAAQAAQ!AAABAA2AAAAB2qA52%AAAQAAQaAQAqAAAAqAqAaqA6qAATqAuA!aAA!aAu1!AtAQc1BBBaBaBA33q"3qarrrQAQ33131Aq!&PAfqQa61aA2"2;;N nP b i~ 0|Q2 Q"!<V)mMbqu x/c//:f/{3@34i54Or@OyS_[SVrV9WvcWWxWYYZ[?_`_f#gmggggl3luluu5nvDv:qhvcx@xx\x%yb@y3fQ)ZPROCEDURE write lparameters pcTexto,plLeftMargin #DEFINE CRLF chr(13)+chr(10) if parameters()=0 pcTexto="" endif * (ESP) 20-AGO-2001 * Causaba inconvenientes el imprimir algo antes * de Imprimir el encabezado.... Por eso se agreg este * IF de This.nPL, de lo contrario WriteLn if this.nPL=0 this.WriteLn() endif * (VES) 07-OCT-2001 * Se reescribi completamente el cdigo a partir de este punto. * this.BeforeWrite() local array aLineas[1] local i,nCount nCount=alines(aLineas,this.ExpandMacros(pcTexto)) for i=1 to nCount * do case case upper(left(aLineas[i],6))=="#EXEC " local cCmd cCmd=allt(subs(aLineas[i],7)) &cCmd loop endcase this.SetPrintOn() if plLeftMargin this.iPrintString(space(this.Le_INI_ftMargin) + aLineas[i]) else this.iPrintString(aLineas[i]) endif if nCount > 1 and i < nCount ? this.nPL=this.nPL + 1 this.AfterWrite() endif * endfor this.SetPrintOff() ENDPROC PROCEDURE writeln lparameters pcTexto,plDoCalcs,plNoEject * (VES) * Este mtodo se modific para que reconociera cadenas multilineas y aadiera * el mrgen izquierdo a cada una de las lineas presentes * #DEFINE CRLF chr(13)+chr(10) if parameters()=0 pcTexto="" endif this.BeforeWrite() local array aLineas[1] local i,nCount nCount=alines(aLineas,this.ExpandMacros(pcTexto,plDoCalcs)) for i=1 to nCount * do case case upper(left(aLineas[i],6))=="#EXEC " local cCmd cCmd=allt(subs(aLineas[i],7)) &cCmd loop endcase this.SetPrintOn() this.iPrintString(space(this.LeftMargin) + aLineas[i]) ? this.nPL=this.nPL + 1 this.AfterWrite(plNoEject) this.BeforeWrite() && oscar * endfor this.SetPrintOff() ENDPROC PROCEDURE eject #DEFINE NOEJECT .T. *-- Si se indic un texto para pi de pgina, se generan tantas lineas en blanco como * sea necesario para llegar al punto de impresin del mismo * if not empty(this.FooterString) if this.PaperLenght > 0 local i,j this.SetPrintOn() j=0 for i=this.nPL+1 to (this.PaperLenght - this.FooterLenght) ? j=j + 1 endfor this.SetPrintOff() this.nPL=this.nPL + j endif this.PrintSection("FOOTER",NOEJECT) endif *-- Se salta la pgina y se actualizan los contadores * this.SetPrintOn() ??this.EjectString this.SetPrintOff() this.nPL=0 this.PageNo = this.PageNo + 1 * (ESP 20-AGO-2001) El numero de pagina se tiene que reasignar * (VES 07-OCT-2001) La instruccin fu modificada para usar el nuevo mtodo SetMacro() this.SetMacro("PAGENO","alltrim(str(This.PageNo))") ENDPROC PROCEDURE print LPARAMETERS cPrinterName,pnCopies local oPDev,cLcDoc oPDev=create("PrintDev") if vartype(cPrinterName)="C" oPDev.cPrinterName=cPrinterName endif if vartype(pnCopies)<>"N" or pnCopies < 1 return pnCopies=1 endif **** Agregado por Esparta 27/08/2001 **** Para incluir el nombre del documento en la cola de impresin cLcDoc = this.cDocName oPDev.cDocName = iif(type('cLcDoc')='C',cLcDoc,'Report Pvent') if not oPDev.oOpen() return .F. endif set printer to oPDev.cFileName=this.cOutFile local i for i=1 to pnCopies oPDev.oPrintMem(this.StartConfString) oPDev.oPrintFile() endfor oPDev.oClose() set printer to (this.cOutFile) additive ENDPROC PROCEDURE clear local fh,i set printer to fh=fcreate(this.cOutFile) =fclose(fh) set printer to (this.cOutFile) this.nPL=0 this.PageNo=1 *-- Se eliminan las variables de totalizacin creadas * if vartype(ICALCS_VAR_LIST)<>"U" local nCount,cVar nCount=occurs(",",ICALCS_VAR_LIST) + 1 for i=1 to nCount cVar=this.iToken(ICALCS_VAR_LIST,i,",") if not empty(cVar) release (cVar) endif endfor ICALCS_VAR_LIST="" endif ENDPROC PROCEDURE setprinton set device to print set cons off set print on ENDPROC PROCEDURE setprintoff set print off set cons on set device to screen ENDPROC PROCEDURE expandmacros lparameters pcTexto,plDoCalcs private oThis oThis=this local i,cMacro,cExpr,lIsCalc for i=1 to alen(this.aMacros,1) cMacro=this.aMacros[i,1] if vartype(cMacro)<>"C" * loop endif cMacro=this.iGetMacroName(cMacro) cExpr=this.aMacros[i,2] lIsCalc=(vartype(cExpr)="C" and atc("oThis.",cExpr)<>0) if not lIsCalc or plDoCalcs private (cMacro) if vartype(cExpr)="C" and (type(cExpr)<>"U" or atc("oThis.",cExpr)<>0) store eval(cExpr) to (cMacro) else if vartype(cExpr)="C" if substr(alltrim(cExpr),1,1) = "@" store eval(substr(alltrim(cExpr),2)) to (cMacro) else store cExpr to (cMacro) endif else store cExpr to (cMacro) endif endif if lIsCalc this.aMacros[i,3]=eval(cMacro) endif else store this.aMacros[i,3] to (cMacro) endif endfor pcTexto=chrt(pcTexto,"$","%") pcTexto=this.StrExpand(pcTexto) return pcTexto ENDPROC PROCEDURE printtofile LPARAMETERS cFileName,nCopies if vartype(nCopies)<>"N" or nCopies < 1 nCopies=1 endif set printer to if nCopies = 1 copy file (this.cOutFile) to (cFileName) else local cData,i,cData2 cData=filetostr(this.cOutFile) cData2="" for i=1 to nCopies cData2 = cData2 + cData endfor strtofile(cData2,cFileName) endif set printer to (this.cOutFile) additive ENDPROC PROCEDURE addmacro lparameters pcMacro,pcString pcMacro=upper(pcMacro) if left(pcMacro,1)<>"$" pcMacro="$" + pcMacro endif if right(pcMacro,1)<>"$" pcMacro=pcMacro + "$" endif local nCount if alen(this.aMacros,1)=1 and type("this.aMacros[1,1]")<>"C" nCount=1 else nCount=alen(this.aMacros,1) + 1 endif dimen this.aMacros[nCount,3] this.aMacros[nCount,1]=pcMacro this.aMacros[nCount,2]=pcString this.aMacros[nCount,3]="" ENDPROC PROCEDURE setmacro lparameters pcMacro,pcValor local i,nCount nCount=alen(this.aMacros,1) pcMacro=upper(pcMacro) if left(pcMacro,1)<>"$" pcMacro="$" + pcMacro endif if right(pcMacro,1)<>"$" pcMacro=pcMacro + "$" endif for i=1 to nCount if vartype(this.aMacros[i,1])="C" if this.aMacros[i,1]==pcMacro this.aMacros[i,2]=pcValor exit endif endif endfor ENDPROC PROCEDURE getmacro lparameters pcMacro local i,nCount nCount=alen(this.aMacros,1) pcMacro=upper(pcMacro) if left(pcMacro,1)<>"$" pcMacro="$" + pcMacro endif if right(pcMacro,1)<>"$" pcMacro=pcMacro + "$" endif for i=1 to nCount if this.aMacros[i,1]==pcMacro return this.aMacros[i,2] endif endfor return "" ENDPROC PROCEDURE lineno_access RETURN THIS.nPL ENDPROC PROCEDURE lineno_assign LPARAMETERS vNewVal ENDPROC PROCEDURE iprintstring Parameters lcCadena * (ESP AGO-2001) * Funcin Utilizada simplemente para simplificar * Es de ayuda para subsanar el conflicto de cadenas * mayores de 255 caracteres, Divide y Venceras!! * Forma de llamada * this.Imprimir(cadena) * PARAMETROS lcCadena * * (VES AGO-2001) * Se aadi cdigo para procesar los CRLF que puedan venir * incluidos en lcCadena * * (VES SEP-2001) * Se cambi el nombre del mtodo a iPrintString para mantener * consistencia con el resto de la interfaz. Tambin se declar * como oculto en lugar de protegido. * * (VES OCT-2001) * Se aadi el cdigo para conversin de cdigo de pgina. * local array aLineas[1] local nc, ciclos, nCount, i if this.SourceCP<>this.TargetCP lcCadena=cpconvert(this.SourceCP,this.TargetCP,lcCadena) endif ncount=alines(aLineas,lcCadena) for i=1 to nCount lcCadena=aLineas[i] nc=1 ciclos = iif(int(len(lccadena)/250)=0,1,int(len(lccadena)/250)) for i=1 to ciclos ?? substr(lcCadena,nc,250) nc=nc+250 endfor if nCount > 1 and i < nCount ? endif endfor ENDPROC PROCEDURE strexpand PARAMETERS pcString *-- Se declaran algunas variables temporales * local cVarName,nOcur,nPos,nPos2,cVarType,uVarValue,nExprLon,cVarExpr nOcur=1 *-- Se inicia un ciclo infinito. El ciclo termina cuando ya no haya ms ocurrencias * del signo %. * do while .T. * nPos=at("%",pcString,nOcur) if nPos=0 exit endif *-- Se obtiene el valor de la expresin * cVarName=subs(pcString,nPos+1) nPos2=at("%",cVarName) if nPos2=0 exit endif cVarName=left(cVarName,nPos2-1) cVarExpr=allt(cVarName) cVarType=type(cVarExpr) if cVarType<>"U" uVarValue=eval(cVarExpr) else nOcur=nOcur + 2 loop endif *-- Se substituye la entrada %Expr% por su valor real de acuerdo al tipo. Si la expresin * es incorrecta (tipo U) o d como resultado un objeto (tipo O), la cadena %Expr% no es * substituida. * do case case cVarType $ "UO" && Expresin incorrecta o un objeto. No se procesa. nOcur=nOcur + 2 case cVarType="C" && Cadena. Se substituye directamente. case cVarType="N" and int(uVarValue)=uVarValue && Entero. Se eliminan los espacios en blanco del STR(). uVarValue=allt(str(uVarValue)) case cVarType="N" and int(uVarValue)<>uVarValue && Flotante. Se utiliza la configuracin de DECIMALS y se eliminan los espacios en blanco del STR(). uVarValue=allt(str(uVarValue,20,set("decimals"))) case cVarType="D" && Fecha. Se convierte a caracteres. uVarValue=dtoc(uVarValue) case cVarType="L" && Lgico. Se subsitutye por S o N. uVarValue=iif(uVarValue,"S","N") otherwise && Otro. Se substituye por el resultado de TRANSFORM(). uVarValue=trans(uVarValue,"") endcase pcString=strtran(pcString,"%"+cVarName+"%",uVarValue) * enddo *-- Se inicia un ciclo infinito. El ciclo termina cuando ya no haya ms ocurrencias * del signo [. * nOcur=1 do while .T. * nPos=at("[",pcString,nOcur) if nPos=0 exit endif *-- Se obtiene el valor de la expresin * cVarName=subs(pcString,nPos+1) nPos2=at("]",cVarName) if nPos2=0 exit endif cVarName=left(cVarName,nPos2-1) nExprLon=len(cVarName) + 2 cVarExpr=allt(cVarName) cVarType=type(cVarExpr) if cVarType<>"U" uVarValue=eval(cVarExpr) else nOcur=nOcur + 2 loop endif *-- Se substituye la entrada [Expr] por su valor real de acuerdo al tipo. Si la expresin * es incorrecta (tipo U) o d como resultado un objeto (tipo O), la cadena %Expr% no es * substituida. * do case case cVarType $ "UO" && Expresin incorrecta o un objeto. No se procesa. nOcur=nOcur + 2 case cVarType="C" && Cadena. Se substituye directamente. case cVarType="N" and int(uVarValue)=uVarValue && Entero. Se eliminan los espacios en blanco del STR(). uVarValue=allt(str(uVarValue)) case cVarType="N" and int(uVarValue)<>uVarValue && Flotante. Se utiliza la configuracin de DECIMALS y se eliminan los espacios en blanco del STR(). uVarValue=allt(str(uVarValue,20,set("decimals"))) case cVarType="D" && Fecha. Se convierte a caracteres. uVarValue=dtoc(uVarValue) case cVarType="L" && Lgico. Se subsitutye por S o N. uVarValue=iif(uVarValue,"S","N") otherwise && Otro. Se substituye por el resultado de TRANSFORM(). uVarValue=trans(uVarValue,"") endcase do case case substr(alltrim(cVarName),1,1) = "I" pcString=strtran(pcString,"["+cVarName+"]",padr(alltrim(uVarValue),nExprLon)) case substr(alltrim(cVarName),1,1) = "D" pcString=strtran(pcString,"["+cVarName+"]",padl(alltrim(uVarValue),nExprLon)) case substr(alltrim(cVarName),1,1) = "C" pcString=strtran(pcString,"["+cVarName+"]",padc(alltrim(uVarValue),nExprLon)) other pcString=strtran(pcString,"["+cVarName+"]",padr(uVarValue,nExprLon)) endcase enddo *-- Se devuelve la cadena expandida * return pcString ENDPROC PROCEDURE igetmacroname lparameters pcMacro return chrt(pcMacro,"$%","") ENDPROC PROCEDURE getformatsection LPARAMETERS pcSection * if empty(this.PrintFormat) return "" endif local array aText[1] local nCount,i,lInSection,cData,cOpenTag,cCloseTag nCount=alines(aText,this.PrintFormatData) cOpenTag="<"+allt(upper(pcSection))+">" cCloseTag="" cData="" lInSection=.F. for i=1 to nCount * do case case left(aText[i],1)="#" and (atc("#EXEC ",aText[i])=0) loop case not lInSection and allt(upper(aText[i]))==cOpenTag lInSection=.T. loop case lInSection and allt(upper(aText[i]))==cCloseTag lInSection=.F. exit case lInSection if "//" $ aText[i] aText[i]=left(aText[i],at("//",aText[i])-1) endif cData=cData + aText[i] + CHR(13) + CHR(10) endcase * endfor return cData * ENDPROC PROCEDURE printformat_assign LPARAMETERS vNewVal if file(m.vNewVal) THIS.printformat = m.vNewVal THIS.iLoadFormat(m.vNewVal) endif ENDPROC PROCEDURE iloadformat lparameters pcFormat *-- Se carga el formato en memoria * local cData cData=filetostr(pcFormat) *-- Se procesan las directivas #INCLUDE * local nPos,cFile,cIncluded,cData1,cData2 nPos=atc("#INCLUDE ",cData) do while nPos<>0 cData1=subs(cData,1,nPos-1) cFile=subs(cData,nPos + 9) cData2=subs(cFile,at(chr(13)+chr(10),cData)) cFile=left(cFile,at(chr(13)+chr(10),cData) - 1) if file(cFile) cIncluded=filetostr(cFile) cData=cData1 + cIncluded + cData2 else cData=cData1 + cData2 endif nPos=atc("#INCLUDE ",cData) enddo this.PrintFormatData=cData release cData,cData1,cData2 *-- Se cargan las secciones fijas * this.TitleString=this.GetFormatSection("TITLE") this.HeaderString=this.GetFormatSection("HEADER") this.DetailString=this.GetFormatSection("DETAIL") this.FooterString=this.GetFormatSection("FOOTER") this.SummaryString=this.GetFormatSection("SUMMARY") *-- Se cargan las configuraciones * private SI,NO,TRUE,FALSE,YES store .T. to SI,TRUE,YES store .F. to NO,FALSE local cPropList,nCount,i,j,cProp,cExpr local array aProps[1] cPropList=this.GetFormatSection("CONFIG") nCount=alines(aProps,cPropList) for i=1 to nCount j=at("=",aProps[i]) cProp=allt(left(aProps[i],j-1)) if not empty(cProp) cExpr=allt(subs(aProps[i],j+1)) if type("this."+cProp)<>"U" cExpr=this.ExpandMacros(cExpr) cExpr=strt(cExpr,chr(13)+chr(10),"CHR(13)+CHR(10)") if not empty(cExpr) store eval(cExpr) to ("THIS."+cProp) endif endif endif endfor *********************************** *-- Se cargan las definiciones de macros * private cMacroList,nCount,i,j,cMacro,cExpr local array aMacros[1] cMacroList=this.GetFormatSection("MACROI") nCount=alines(aMacros,cMacroList) this.macroi = len(alltrim(cMacroList)) local nPos,cSumExpr,nLen private cSum,cReset,cStart for i=1 to nCount j=at("=",aMacros[i]) cMacro=allt(left(aMacros[i],j-1)) if not empty(cMacro) * cExpr=allt(subs(aMacros[i],j+1)) local nCount if alen(this.bMacros,1)=1 and type("this.bMacros[1,1]")<>"C" nCount=1 else nCount=alen(this.bMacros,1) + 1 endif dimen this.bMacros[nCount,3] this.bMacros[nCount,1]=cMacro this.bMacros[nCount,2]=cExpr if substr(cMacro,1,1) = '@' cMacro = alltrim(substr(cMacro,2)) public (cMacro) cMacro = cMacro+" = "+alltrim(cExpr) &cMacro endif endif endfor *********************************** *-- Se cargan las definiciones de macros * private cMacroList,nCount,i,j,cMacro,cExpr local array aMacros[1] cMacroList=this.GetFormatSection("MACROS") nCount=alines(aMacros,cMacroList) local nPos,cSumExpr,nLen private cSum,cReset,cStart for i=1 to nCount j=at("=",aMacros[i]) cMacro=allt(left(aMacros[i],j-1)) if not empty(cMacro) * cExpr=allt(subs(aMacros[i],j+1)) do case case atc("_SUM[",cExpr)<>0 nPos=atc("_SUM[",cExpr) cSumExpr=subs(cExpr,nPos+5) cSumExpr=subs(cSumExpr,1,at("]",cSumExpr)-1) nLen=len(cSumExpr) + 5 + 1 cSum=this.iToken(cSumExpr,1,";") cReset=this.iToken(cSumExpr,2,";") cStart=this.iToken(cSumExpr,3,";") cSumExpr="oThis.iDoCalc('SUM','%cMacro%','%cSum%','%cReset%','%cStart%')" cSumExpr=this.STRExpand(cSumExpr) cExpr=stuff(cExpr,nPos,nLen,cSumExpr) case atc("_COUNT[",cExpr)<>0 nPos=atc("_COUNT[",cExpr) cSumExpr=subs(cExpr,nPos+7) cSumExpr=subs(cSumExpr,1,at("]",cSumExpr)-1) nLen=len(cSumExpr) + 7 + 1 cReset=this.iToken(cSumExpr,1,";") cStart=this.iToken(cSumExpr,2,";") cSumExpr="oThis.iDoCalc('COUNT','%cMacro%','','%cReset%','%cStart%')" cSumExpr=this.STRExpand(cSumExpr) cExpr=stuff(cExpr,nPos,nLen,cSumExpr) case atc("_RET[",cExpr)<>0 nPos=atc("_RET[",cExpr) cSumExpr=subs(cExpr,nPos+5) cSumExpr=subs(cSumExpr,1,at("]",cSumExpr)-1) nLen=len(cSumExpr) + 5 + 1 cSum=this.iToken(cSumExpr,1,";") cReset=this.iToken(cSumExpr,2,";") cStart=this.iToken(cSumExpr,3,";") cSumExpr="oThis.iDoCalc('RET','%cMacro%','%cSum%','%cReset%','%cStart%')" cSumExpr=this.STRExpand(cSumExpr) cExpr=stuff(cExpr,nPos,nLen,cSumExpr) case atc("_INI[",cExpr)<>0 nPos=atc("_INI[",cExpr) cSumExpr=subs(cExpr,nPos+5) cSumExpr=subs(cSumExpr,1,at("]",cSumExpr)-1) nLen=len(cSumExpr) + 5 + 1 cReset=this.iToken(cSumExpr,1,";") cStart=this.iToken(cSumExpr,2,";") cSumExpr="oThis.iDoCalc('INI','%cMacro%','','%cReset%','%cStart%')" cSumExpr=this.STRExpand(cSumExpr) cExpr=stuff(cExpr,nPos,nLen,cSumExpr) case atc("_MIN[",cExpr)<>0 nPos=atc("_MIN[",cExpr) cSumExpr=subs(cExpr,nPos+5) cSumExpr=subs(cSumExpr,1,at("]",cSumExpr)-1) nLen=len(cSumExpr) + 5 + 1 cSum=this.iToken(cSumExpr,1,";") cReset=this.iToken(cSumExpr,2,";") cStart=this.iToken(cSumExpr,3,";") cSumExpr="oThis.iDoCalc('MIN','%cMacro%','%cSum%','%cReset%','%cStart%')" cSumExpr=this.STRExpand(cSumExpr) cExpr=stuff(cExpr,nPos,nLen,cSumExpr) case atc("_MAX[",cExpr)<>0 nPos=atc("_MAX[",cExpr) cSumExpr=subs(cExpr,nPos+5) cSumExpr=subs(cSumExpr,1,at("]",cSumExpr)-1) nLen=len(cSumExpr) + 5 + 1 cSum=this.iToken(cSumExpr,1,";") cReset=this.iToken(cSumExpr,2,";") cStart=this.iToken(cSumExpr,3,";") cSumExpr="oThis.iDoCalc('MAX','%cMacro%','%cSum%','%cReset%','%cStart%')" cSumExpr=this.STRExpand(cSumExpr) cExpr=stuff(cExpr,nPos,nLen,cSumExpr) case atc("_AVG[",cExpr)<>0 nPos=atc("_AVG[",cExpr) cSumExpr=subs(cExpr,nPos+5) cSumExpr=subs(cSumExpr,1,at("]",cSumExpr)-1) nLen=len(cSumExpr) + 5 + 1 cSum=this.iToken(cSumExpr,1,";") cReset=this.iToken(cSumExpr,2,";") cStart=this.iToken(cSumExpr,3,";") cSumExpr="oThis.iDoCalc('AVG','%cMacro%','%cSum%','%cReset%','%cStart%')" cSumExpr=this.STRExpand(cSumExpr) cExpr=stuff(cExpr,nPos,nLen,cSumExpr) endcase this.AddMacro(cMacro,cExpr) * endif endfor *-- Se cargan las definiciones de grupo * local cGroupList,cGroup,cExpr,cHeader,cFooter local array aGroups[1] cGroupList=this.GetFormatSection("GROUPS") nCount=alines(aGroups,cGroupList) for i=1 to nCount j=at("=",aGroups[i]) cGroup=allt(left(aGroups[i],j-1)) if not empty(cGroup) cExpr=allt(subs(aGroups[i],j+1)) cHeader=allt(this.iToken(cExpr,2,"|")) cFooter=allt(this.iToken(cExpr,3,"|")) cExpr=allt(this.iToken(cExpr,1,"|")) this.iAddGroup(cGroup,cExpr,cHeader,cFooter) endif endfor ENDPROC PROCEDURE printsection lparameters pcSection,plNoEject #DEFINE CRLF chr(13)+chr(10) *-- Se obtiene el texto de la seccin a imprimir local cData,lEvalGroups,lDoCalcs cData="" pcSection=allt(upper(pcSection)) lEvalGroups=.F. do case case pcSection=="HEADER" cData=this.HeaderString case pcSection=="FOOTER" cData=this.FooterString case pcSection=="DETAIL" cData=this.DetailString lEvalGroups=.T. lDoCalcs=.T. otherwise if not empty(this.PrintFormat) cData=this.GetFormatSection(pcSection) endif endcase *-- Si se indic que se evaluaran los grupos, se evaluan * if lEvalGroups this.EvalGroups() endif *-- Si no hay nada que imprimir, se cancela if empty(cData) and memlines(cData)=0 return endif *-- Se escribe el texto en el archivo de salida * this.WriteLn(cData,lDoCalcs,plNoEject) ENDPROC PROCEDURE beforewrite if vartype(_FROMBEFOREWRITE)<>"U" return endif *-- Esta variable evita que este mtodo se llame recursivamente * private _FROMBEFOREWRITE _FROMBEFOREWRITE=.T. *-- Si es la primera linea de la pgina, se imprime el encabezado * if this.nPL=0 * this.SetPrintOn() *-- Se genera al cadena de configuracin (si se indic una) if not empty(this.NewPageConfString) ??this.NewPageConfString endif *-- Se deja el margen superior indicado for i=1 to this.TopMargin ? endfor this.nPL=this.TopMargin *-- Se imprime la cabezera this.PrintSection("HEADER") this.SetPrintOff() *-- si se indic un comando para nueva pgina, se ejecuta if not empty(this.OnNewPage) local cCmd cCmd=this.OnNewPage &cCmd endif * endif ENDPROC PROCEDURE footerlenght_access local nFooterLenght nFooterLenght=alines(foo,this.FooterString) RETURN nfooterlenght ENDPROC PROCEDURE footerlenght_assign LPARAMETERS vNewVal *To do: Modify this routine for the Assign method *THIS.footerlenght = m.vNewVal ENDPROC PROCEDURE afterwrite lparameters plNoEject if vartype(_FROMAFTERWRITE)<>"U" return endif *-- Esta variable evita que este mtodo se llame recursivamente * private _FROMAFTERWRITE _FROMAFTERWRITE=.T. *-- Si se lleg al final de la pgina, se salta * if not plNoEject and this.AutoEject and this.PaperLenght > 0 and ; this.nPL + this.BottomMargin >= (this.PaperLenght - this.FooterLenght) this.Eject() endif ENDPROC PROCEDURE iaddgroup lparameters pcGroup,pcExpr,pcHeader,pcFooter local nCount nCount=this.nGroupCount + 1 dimen this.aGroups[nCount,6] this.aGroups[nCount,1]=pcGroup this.aGroups[nCount,2]=pcExpr this.aGroups[nCount,3]=pcHeader this.aGroups[nCount,4]=pcFooter this.aGroups[nCount,5]=NULL this.aGroups[nCount,6]=NULL this.nGroupCount=nCount ENDPROC PROCEDURE itoken lparameters pcLista,pnElemento,pcSep,pnNumTokens * if type("pcSep")#"C" or len(pcSep)=0 pcSep="," endif local vElement,vNumElem,i,j,nLenSep vElement="" vNumElem=occurs(pcSep,pcLista) + 1 nLenSep=len(pcSep) do case case empty(pcLista) or pnElemento > vNumElem vElement="" case vNumElem=1 if pnElemento=1 vElement=pcLista endif case pnElemento=1 vElement=subs(pcLista,1,atc(pcSep,pcLista,1)-1) case pnElemento=vNumElem vElement=subs(pcLista,atc(pcSep,pcLista,vNumElem-1) + nLenSep) otherwise i=at(pcSep,pcLista,pnElemento - 1) + nLenSep j=at(pcSep,pcLista,pnElemento) vElement=subs(pcLista,i,(j - i)) endcase if type("pnNumTokens")="N" pnNumTokens=pnNumTokens - 1 if pnElemento + pnNumTokens <= vNumElem for i=1 to pnNumTokens j=this.iToken(pcLista,pnElemento+i,pcSep) vElement=vElement + pcSep + j endfor endif endif return vElement ENDPROC PROCEDURE evalgroups lparameters plEOF local i,cMacro,cExpr if this.nGroupCount = 0 return endif if this.macroi > 0 *-- Se crean los macros definidos * for i=1 to alen(this.bMacros,1) cMacro=this.bMacros[i,1] cExpr=this.bMacros[i,2] if substr(cMacro,1,1) <> '@' cMacro = alltrim(cMacro)+" = "+alltrim(cExpr) &cMacro endif endfor endif for i=1 to alen(this.aMacros,1) cMacro=this.aMacros[i,1] if vartype(cMacro)<>"C" loop endif cMacro=this.iGetMacroName(cMacro) cExpr=this.aMacros[i,2] lIsCalc=(vartype(cExpr)="C" and atc("oThis.",cExpr)<>0) private (cMacro) if not lIsCalc if vartype(cExpr)="C" and (type(cExpr)<>"U" or atc("oThis.",cExpr)<>0) store eval(cExpr) to (cMacro) else store cExpr to (cMacro) endif else store this.aMacros[i,3] to (cMacro) endif endfor *-- Se obtienen los valores actuales para cada grupo local i,cExpr,cHEader,cFooter,uResult,uLastResult for i=1 to this.nGroupCount cGroup=this.aGroups[i,1] cExpr=this.aGroups[i,2] cFooter=this.aGroups[i,4] private (cGroup) if type(cExpr)<>"U" uResult=eval(cExpr) else uResult=cExpr endif this.aGroups[i,6]=uResult endfor *-- Se cierran los grupos abiertos * for i=this.nGroupCount to 1 step -1 cGroup=this.aGroups[i,1] cFooter=this.aGroups[i,4] uLastResult=this.aGroups[i,5] uResult=this.aGroups[i,6] store uLastResult to (cGroup) if (not isnull(uLastResult) and uResult<>uLastResult) or plEOF this.PrintSection(cFooter) endif endfor *-- Se evaluan los grupos definidos * if not plEOF * for i=1 to this.nGroupCount cGroup=this.aGroups[i,1] cHeader=this.aGroups[i,3] uLastResult=this.aGroups[i,5] uResult=this.aGroups[i,6] store uResult to (cGroup) if isnull(uLastResult) or uResult<>uLastResult this.PrintSection(cHeader) endif this.aGroups[i,5]=uResult endfor * endif ENDPROC PROCEDURE startgroups local i for i=1 to this.nGroupCount this.aGroups[i,5]=NULL this.aGroups[i,6]=NULL endfor ENDPROC PROCEDURE endgroups this.EvalGroups(.T.) ENDPROC PROCEDURE run LPARAMETERS pcAlias,pcWhile,pcFor *-- si no hay un formato cargado, se obvia * if empty(this.PrintFormat) return endif *-- Si se indic un alias y el mismo existe, se selecciona * if vartype(pcAlias)="C" and used(pcAlias) select (pcAlias) else pcAlias=alias() endif *-- Se inicializa el informe * this.Clear() this.StartGroups() if this.SectionHeight("TITLE") > 0 this.PrintSection("TITLE") if this.AutoEject and this.EjectAfterTitle this.Eject() endif endif *-- Se recorre el alias indicado * select (pcAlias) go top scan while (empty(pcWhile) or eval(pcWhile)) for (empty(pcFor) or eval(pcFor)) this.PrintSection("DETAIL") select (pcAlias) endscan go bottom *-- Se cierra el informe * this.EndGroups() if this.AutoEject if this.SectionHeight("SUMMARY") > 0 if this.EjectBeforeSummary this.Eject() endif this.PrintSection("SUMMARY") endif if this.nPL > 0 this.Eject() endif else if this.PaperLenght > 0 local i,j this.SetPrintOn() j=0 for i=this.nPL+1 to (this.PaperLenght - this.FooterLenght) ? j=j + 1 endfor this.SetPrintOff() this.nPL=this.nPL + j endif this.PrintSection("FOOTER") this.PrintSection("SUMMARY") endif ENDPROC PROCEDURE idocalc lparameters pcCalc,pcName,pcExpr,pcResetAt,pcStartExpr * *-- Se ajustan algunos parmetros * pcCalc=allt(upper(pcCalc)) pcCalc=iif(inlist(pcCalc,"SUM","COUNT","INI","RET","MIN","MAX","AVG"),pcCalc,"SUM") pcExpr=iif(vartype(pcExpr)="C" and type(pcExpr)="N",pcExpr,"0.0") pcResetAt=iif(vartype(pcResetAt)="C",iif(empty(pcResetAt),"''",pcResetAt),".T.") pcStartExpr=iif(vartype(pcStartExpr)="C" and type(pcStartExpr)="N",pcStartExpr,"0.0") *-- Se crea la variable que contiene la lista de variables de totalizacion almacenadas * if vartype(ICALCS_VAR_LIST)="U" public ICALCS_VAR_LIST ICALCS_VAR_LIST="" endif *-- Se crean algunas constantes * private PAGENO PAGENO=this.PageNo *-- Se define la variable de totalizacin y la de reset * local cBufVar,cResetVar cBufVar="ICALC_"+allt(pcName)+"_BUF" cResetVar="ICALC_"+allt(pcName)+"_RST" if type(cBufVar)="U" public (cBufVar) store eval(pcStartExpr) to (cBufVar) ICALCS_VAR_LIST=ICALCS_VAR_LIST + "," + cBufVar endif if type(cResetVar)="U" public (cResetVar) store eval(pcResetAt) to (cResetVar) ICALCS_VAR_LIST=ICALCS_VAR_LIST + "," + cResetVar endif *-- Si hay ruptura de control, se inicializa el buffer * local cReset cReset=eval(pcResetAt) if cReset<>eval(cResetVar) store eval(pcStartExpr) to (cBufVar) store cReset to (cResetVar) endif *-- Se realiza el clculo * local nBuf do case case pcCalc=="SUM" nBuf=eval(cBufVar) + eval(pcExpr) store nBuf to (cBufVar) case pcCalc=="COUNT" nBuf=eval(cBufVar) + 1 store nBuf to (cBufVar) case pcCalc=="INI" nBuf=eval(cBufVar) store nBuf to (cBufVar) case pcCalc=="RET" nBuf=eval(pcExpr) store nBuf to (cBufVar) case pcCalc=="MIN" nBuf=min(eval(cBufVar),eval(pcExpr)) store nBuf to (cBufVar) case pcCalc=="MAX" nBuf=max(eval(cBufVar),eval(pcExpr)) store nBuf to (cBufVar) case pcCalc=="AVG" nBuf=(eval(cBufVar) + eval(pcExpr)) / 2 store nBuf to (cBufVar) endcase return nBuf ENDPROC PROCEDURE printjobname_access RETURN THIS.cDocName ENDPROC PROCEDURE printjobname_assign LPARAMETERS vNewVal THIS.cDocName = m.vNewVal ENDPROC PROCEDURE sectionheight lparameters pcSection local cData,nHeight do case case pcSection=="TITLE" cData=this.TitleString case pcSection=="HEADER" cData=this.HeaderString case pcSection=="DETAIL" cData=this.DetailString case pcSection=="FOOTER" cData=this.FooterString case pcSection=="SUMMARY" cData=this.SummaryString otherwise cData=this.GetFormatSection(pcSection) endcase nHeight=alines(foo,cData) RETURN nHeight ENDPROC PROCEDURE macros_access LPARAMETERS m.nIndex1, m.nIndex2 RETURN this.aMacros[m.nIndex1, m.nIndex2] ENDPROC PROCEDURE macros_assign LPARAMETERS vNewVal, m.nIndex1, m.nIndex2 ENDPROC PROCEDURE Init #define ESC chr(27) *-- Se crea el archivo de salida * this.cOutFile=sys(3)+".DPF" do while file(this.cOutFile) this.cOutFile=sys(3)+".DPF" enddo local fh fh=fcreate(this.cOutFile) =fclose(fh) set printer to (this.cOutFile) *-- Se configuran algunas propiedades * this.EjectString=CHR(12) *-- Se definen los macros por defecto * ******************************************************************** * MACROS RECONOCIDOS: * * $EON$ Activa espaciado * $EOFF$ Desactiva espaciado * $PAGENO$ Nro. de pgina * $DATE$ Fecha actual * $TIME$ Hora actual * $DATETIME$ Fecha y hora actual * $BON$ Activa la negrita * $BOFF$ Desactiva la negrita * $DON$ Activa letra doble * $DOFF$ Desactiva letra doble * $PON$ Activa letra mini * $POFF$ Desactiva letra mini * $SON$ Activa la subrayado * $SOFF$ Desactiva subrayado * $ION$ Activa cursiva * $IOFF$ Desactiva cursiva * $CON$ Activa la compresin * $COFF$ Desactiva la compresin * $C10$ Activa la compresin a 10 cpi * $C12$ Activa la compresin a 12 cpi * $C15$ Activa la compresin a 15 cpi * $CRLF$ Avance de linea * $TAB$ Tabulador * * NOTA DE ACTUALIZACION: * Como consecuencia de la implementacin de STREXPAND() en esta clase * todos los macros reconocidos pueden ser ahora referenciados usando * la sintaxis %MACRO% as como la anterior $MACRO$. ********************************************************************** this.AddMacro("%PAGENO%","alltrim(str(This.PageNo))") this.AddMacro("%DATE%",date()) this.AddMacro("%TIME%",time()) this.AddMacro("%DATETIME%",datetime()) *this.AddMacro("%C128%",chr(27)+chr(40)+chr(66)+chr(18)+chr(0)+chr(5)+chr(2)+chr(0)+chr(18)+chr(0)+chr(3)+"999999999999") *this.AddMacro("%EAN%",chr(27)+chr(40)+chr(66)+chr(18)+chr(0)+chr(0)+chr(2)+chr(0)+chr(18)+chr(0)+chr(3)) *this.AddMacro("%EAN%",pvalor) *this.AddMacro("%C128%",ESC+'(B17006050111000000001234567801') *this.AddMacro("%C128%",BarCodeStr(1,6, 3, 1, 9,.T.,.T.,.T.,"123456789")) this.AddMacro("%SON%",ESC+chr(45)+chr(1)) this.AddMacro("%SOFF%",ESC+chr(45)+chr(0)) this.AddMacro("%LON%",chr(27)+"U"+chr(1)) this.AddMacro("%LOFF%",chr(27)+"U"+chr(0)) this.AddMacro("%ION%",ESC+chr(52)) this.AddMacro("%IOFF%",ESC+chr(53)) this.AddMacro("%DON%",ESC+chr(14)) this.AddMacro("%DOFF%",ESC+chr(20)) this.AddMacro("%PON%",ESC+"S0") this.AddMacro("%POFF%",ESC+"T ") this.AddMacro("%BON%",ESC+"G") this.AddMacro("%BOFF%",ESC+"H") this.AddMacro("%CON%",CHR(15)) this.AddMacro("%COFF%",CHR(18)) this.AddMacro("%C10%",ESC+"P") this.AddMacro("%C12%",ESC+"M") this.AddMacro("%C15%",ESC+"g") this.AddMacro("%EON%",ESC+"0") this.AddMacro("%EOFF%",ESC+"2") this.AddMacro("%CRLF%",CHR(13)+CHR(10)) this.AddMacro("%TAB%",space(5)) ENDPROC PROCEDURE Destroy if not empty(this.cOutFile) this.Clear() set printer to erase (this.cOutFile) endif ENDPROC ^topmargin = 0 bottommargin = 0 leftmargin = 0 paperlenght = 66 startconfstring = newpageconfstring = npl = 0 pageno = 1 footerlenght = 0 headerstring = footerstring = onnewpage = detailstring = ngroupcount = 0 autoeject = .T. titlestring = summarystring = ejectstring = targetcp = 850 sourcecp = 1252 Name = "cdosprint"