Files
vfp_roaauto/COMUN/programe/oexport.prg

3003 lines
98 KiB
Plaintext

*!* 19.02.2009 marius.mutu
*!* + oExportConfig.getReportPath(tcRaport) : intoarce calea raportului utilizator din DIRGEN > USERREPORT > SCHEMA sau DIRGEN > USERREPORT > SCHEMA > PROGRAM sau EXECUTABIL
*!* oExportConfig.export2frx,export2pdf
*!* 08.12.2010
*!* *!* marius.mutu
*!* oExportConfig.export2frx
*!* listare cu export pdf, xls
*!* + foxypreview v 2.01c
*!* 31.05.2011
*!* marius.mutu
*!* update foxypreview v 2.41a (email, reparat eroare listare inventarul patrimoniului - se inchidea cursorul din grid)
*!* 01.06.2011
*!* marius.mutu
*!* am reparat in foxypreviewcaller detectarea existentei raportului pe disc
*!* 07.06.2011
*!* oExportConfig.getRepPath
*** daca raportul este deja intr-un director pe disc (ex: c:\temp\tutun\rap_incasari_plati.frx) las calea asa cum este
*!* 06.01.2014
*!* marius.mutu
*!* FoxyPreview - se verifica daca exista proprietatea _Screen.oFoxyPreviewer.cLanguage
*!* 19.11.2018
*!* marius.mutu
*!* oExportConfig.export2frx - definire gcLogoPath pentru folosirea in factura sau alte rapoarte
*!* Se cauta in logo.jpg in directorul ROA si USERREPORTS
*!* 03.10.2019
*!* marius.mutu
*!* rapoarte personalizate salvate in baza de date atas_atasamente!
*!* getLogoPath, getRepPath - se cauta logo.jpg, logo_orizontal.jpg, raport.frx pe disc
*!* se cauta si in baza de date atas_atasamente. daca exista, se creeaza fisierele pe disc
*!* 06.07.2020
*!* FoxyPreview - tratare lDirectPrint mod silentios trimite direct la imprimanta
*!* 09.12.2020
*!* getRepPath - suprascriu raportul din USERREPORTS cu raportul din baza de date in functie de optiunea gnRAP_SUPRASCRIERE_USR
*!* 17.12.2020
*!* getRepPath - chiar daca exista raportul USR_*.frx in directorul firmei, il cauta si in directorul programului
*!* eroare introdusa in versiunea anterioara
*!* 10.01.2024
*!* export2frx - se listeaza tcRaport_IdClient daca exista, altfel tcRaport (Vadeco listeaza cu alte conturi bancare pentru OMV Petrom)
Define Class oExportConfig As wwConfig
Dimension aImprimante(1, 2)
nTip = 1 && 1 = registru ; 2 = settings.ini
cIniPath = "settings.ini"
cSectiune = "printers"
cRegPath = "SOFTWARE\ROMFAST"
cUserRepPath = []
cTempPath = []
cCursorCurent = []
cCaleCurenta = []
oApi = []
cReportPreview = []
cReportOutput = []
Dimension aExplicatii(3, 2)
aExplicatii(1, 1) = [FRX]
aExplicatii(1, 2) = [listare]
aExplicatii(2, 1) = [XLS]
aExplicatii(2, 2) = [export]
aExplicatii(3, 1) = [PDF]
aExplicatii(3, 2) = [export in PDF]
**** Init
**** getUserRepPath
**** open_default_app(tcNumeFisier)
**** getExcelMask(tcInputMask)
**** citesteSetareRegistru(tcCheie)
**** modificaSetareRegistru(tcCheie,tcValoare)
**** setCursorCurent()
**** getCursorCurent()
**** setCaleCurenta()
**** repuneCaleCurenta()
**** repuneCursorCurent()
**** verificaDate(tcAlias,tnTip)
**** export2frx(tcAlias, tcRaport, tlCereTitlu, tcSetareVizualizare, tcSetareImprimanta, tcParametriListare, toListener)
**** export2xls(tcAlias, tcNumeFisier, tcListaColoane, tcFiltru)
**** export2pdf(tcAlias, tcRaport, tlPreview, tnTip)
****
**** de sters dupa inlocuire in ROAFACTURARE
**** listareUserReport(tcAlias, tcTipExport, tcRaport, tnVizualizare, tcSetare, tcFiltru)
**** export_frx(tcAlias, tcRaport, tnVizualizare, tcSetare)
**** export_xls(tcAlias, tcNumeFisier, tnVizualizare, tcListaColoane, tcFiltru)
************************************** INCEPUT : Init
Procedure Init
Set Classlib To wwxml Additive
Set Procedure To wwApi.prg Additive
Set Classlib To _gdiplus Additive
Set Classlib To Listener Additive
Set Procedure To _libpdf.prg Additive
Set Procedure To build_err_msgs.prg Additive
Set Procedure To pdflistener.prg Additive
Set Procedure To frxoutput.prg Additive
This.oApi = Createobject("wwApi")
*!* This.cUserRepPath = This.getUserRepPath()
This.cTempPath = gcTempPath
Endproc
************************************** SFARSIT : Init
************************************** INCEPUT : setTip
Procedure setTip
Lparameters tnTip
This.nTip = tnTip
Endproc
************************************** SFARSIT : setTip
************************************** INCEPUT : setPath
Procedure setPath
Lparameters tcPath
If This.nTip = 1
This.cRegPath = tcPath
Else
This.cIniPath = tcPath
Endif
Endproc
************************************** SFARSIT : setPath
************************************** INCEPUT : setSectiune
Procedure setSectiune
Lparameters tcSectiune
This.cSectiune = tcSectiune
Endproc
************************************** SFARSIT : setSectiune
************************************** INCEPUT : setRegPath
Procedure setRegPath
Lparameters tcRegPath
This.cRegPath = tcRegPath
This.setTip(1)
Endproc
************************************** SFARSIT : setRegPath
*!* ************************************** INCEPUT : getUserRepPath
*!* Function getUserRepPath
*!* Local lcAppPath, lcAppName, liAt, lcDirgen, lcUserRepPath
*!* lcAppPath = gcAppPath
*!* lcAppName=Allt(Uppe(Juststem(Sys(16,0))))
*!* liAt=Rat("\",lcAppPath,2)
*!* lcDirgen=Addbs(Left(lcAppPath,liAt-1))
*!* lcUserRepPath = lcDirgen + 'USERREPORTS\'
*!* If !Directory(lcUserRepPath)
*!* Try
*!* Md (lcUserRepPath)
*!* Catch To oException
*!* Wait Window "Nu se poate crea directorul " + lcUserRepPath Nowait
*!* Endtry
*!* Endif
*!* If !Empty(Nvl(gcS,[]))
*!* lcUserRepPath = lcUserRepPath + gcS + '\'
*!* If !Directory(lcUserRepPath)
*!* Try
*!* Md (lcUserRepPath)
*!* Catch To oException
*!* Wait Window "Nu se poate crea directorul " + lcUserRepPath Nowait
*!* Endtry
*!* Endif
*!* Endif
*!* lcUserRepPath = lcUserRepPath + lcAppName + '\'
*!* If !Directory(lcUserRepPath)
*!* Try
*!* Md (lcUserRepPath)
*!* Catch To oException
*!* Wait Window "Nu se poate crea directorul " + lcUserRepPath Nowait
*!* Endtry
*!* Endif
*!* Return lcUserRepPath
*!* Endfunc
*!* ************************************** SFARSIT : getUserRepPath
*!* caut usr_raport in DIRGEN > USERREPORTS > SCHEMA, apoi in DIRGEN > USERREPORTS > SCHEMA > PROGRAM, altfel in executabil
************************************** INCEPUT : getRepPath
Function getRepPath
Lparameters tcRaport
* tcRaport = numele raportului
Local lcAppPath, lcAppName, liAt, lcDirgen, lcUserRepPath, llSuprascriereRaportUSR
lcAppPath = gcAppPath
lcAppName = Iif(Type('gcAppName') = 'C' And !Empty(gcAppName), gcAppName, Allt(Uppe(Juststem(Sys(16, 0)))))
liAt = Rat("\", lcAppPath, 2)
lcDirgen = Addbs(Left(lcAppPath, liAt - 1))
lcUserRepPath = lcDirgen + 'USERREPORTS\' + m.GCS + '\'
lcRaportPath = lcUserRepPath + [USR_] + Juststem(tcRaport) + [.FRX]
lcSchemaRaportFile = Lower(m.lcRaportPath)
poLog.Log('RepPath1: ' + TRANSFORM(File(lcRaportPath)) + ' ' + m.lcRaportPath, Program())
llSuprascriereRaportUSR = .F.
IF TYPE('gnRAP_SUPRASCRIERE_USR') = 'N'
llSuprascriereRaportUSR = (m.gnRAP_SUPRASCRIERE_USR = 1)
ENDIF
If !File(m.lcRaportPath) OR m.llSuprascriereRaportUSR
IF !FILE(m.lcRaportPath)
lcRaportPath = lcUserRepPath + lcAppName + [\USR_] + Juststem(tcRaport) + [.FRX]
poLog.Log('RepPath2: ' + TRANSFORM(File(lcRaportPath)) + ' ' + m.lcRaportPath, Program())
ENDIF
If !File(lcRaportPath) OR m.llSuprascriereRaportUSR
* Caut frx in atas_atasamente si il creez pe disc daca exista
llSucces = This.Report2File(Lower(Juststem(m.tcRaport)), m.lcSchemaRaportFile)
If m.llSucces And File(m.lcSchemaRaportFile)
lcRaportPath = m.lcSchemaRaportFile
poLog.Log('RepPath3: ' + TRANSFORM(File(lcRaportPath)) + ' ' + m.lcRaportPath, Program())
Endif && llBytesWritten
Endif && file
poLog.Log('RepPath4: ' + TRANSFORM(File(lcRaportPath)) + ' ' + m.lcRaportPath, Program())
If !File(lcRaportPath)
lcRaportPath = Juststem(tcRaport) + [.FRX]
Endif
Endif
*!* 07.06.2011
*** daca este calea completa pe disc, adica raportul este deja intr-un director pe disc (ex: c:\temp\tutun\rap_incasari_plati.frx), las calea asa cum este
If !Empty(Justpath(m.tcRaport))
lcRaportPath = m.tcRaport
poLog.Log('RepPath5: ' + TRANSFORM(File(lcRaportPath)) + ' ' + m.lcRaportPath, Program())
Endif
*!* 07.06.2011 ^
This.cUserRepPath = Addbs(Justpath(lcRaportPath))
Return lcRaportPath
Endfunc && getRepPath
************************************** SFARSIT : getRepPath
*!* caut logo.jpg/logo_orizontal.jpg in DIRGEN > USERREPORTS > SCHEMA, apoi in DIRGEN > USERREPORTS > SCHEMA > PROGRAM, altfel in executabil
************************************** INCEPUT : getLogoPath
Function getLogoPath
Lparameters tcLogoFileName
* tcLogoFileName : logo.jpg/logo_orizontal.jpg
Local lcAppPath, lcAppName, liAt, lcDirgen, lcUserLogoPath, lcLogoPath, lcSchemaLogoFile, lcSchemaAppLogoFile, lcFileName, lnBytesWritten
Private puFisier
lcAppPath = gcAppPath
lcAppName = Iif(Type('gcAppName') = 'C' And !Empty(gcAppName), gcAppName, Allt(Uppe(Juststem(Sys(16, 0)))))
lcLogoPath = ''
lcFileName = Lower(Justfname(m.tcLogoFileName))
liAt = Rat("\", lcAppPath, 2)
lcDirgen = Addbs(Left(lcAppPath, liAt - 1))
lcUserLogoPath = lcDirgen + 'USERREPORTS\' + m.GCS + '\'
lcLogoPath = lcUserLogoPath + tcLogoFileName
lcSchemaLogoFile = m.lcLogoPath
If !File(lcLogoPath)
lcLogoPath = lcUserLogoPath + lcAppName + [\] + m.tcLogoFileName
lcSchemaAppLogoFile = m.lcLogoPath
If !File(lcLogoPath)
lcLogoPath = Fullpath(m.tcLogoFileName)
If !File(m.lcLogoPath)
* Caut logo in atas_atasamente si il creez pe disc daca exista
lnBytesWritten = Atasament2File(, m.lcFileName, m.lcSchemaLogoFile)
If m.lnBytesWritten > 0 And File(m.lcSchemaLogoFile)
lcLogoPath = m.lcSchemaLogoFile
Endif && llBytesWritten
Endif && file
Endif && file
Endif && file
If !File(m.lcLogoPath)
lcLogoPath = ''
Endif
Return m.lcLogoPath
Endfunc && getLogoPath
************************************** SFARSIT : getLogoPath
**************************************
*** Extrage raport.frx si raport.frt din atas_atasamente, daca exista, si le salveaza pe disc usr_raport.frx si usr_raport.frt
*** Se apeleaza din GetRepPath
**************************************
Function Report2File
Lparameters tcFileName, tcOutputFile
* tcFileName: numele raportului salvat in atas_atasamente (factura/factura.frx)
* tcOutputFile: calea completa a raportului (d:\roa\userreports\schema\usr_factura.frx)
Local lcFrtFileName, lcFrtOuputFile, lcFrxFileName, lcFrxOuputFile, llSucces, lnBytesWritten
llSucces = .F.
lcFrxFileName = Forceext(Lower(Justfname(m.tcFileName)), 'frx') && factura.frx
lcFrtFileName = Forceext(Lower(Justfname(m.tcFileName)), 'frt') && factura.frt
lcFrxOuputFile = Forceext(Lower(m.tcOutputFile), 'frx') && d:\roa\userreports\schema\usr_factura.frx
lcFrtOuputFile = Forceext(Lower(m.tcOutputFile), 'frt') && d:\roa\userreports\schema\usr_factura.frt
lnBytesWritten = Atasament2File(, m.lcFrxFileName, m.lcFrxOuputFile)
If m.lnBytesWritten > 0 And File(m.lcFrxOuputFile)
lnBytesWritten = Atasament2File(, m.lcFrtFileName, m.lcFrtOuputFile)
llSucces = (m.lnBytesWritten > 0)
Endif
Return m.llSucces
Endfunc && Report2File
************************************** INCEPUT : open_default_app
Procedure OPEN_DEFAULT_APP
Parameters tcNumeFisier
Local lcActiune
Declare Integer ShellExecute In shell32.Dll ;
Integer hndWin, ;
String cAction, ;
String cFileName, ;
String cParams, ;
String cDir, ;
Integer nShowWin
lcActiune = "open"
ShellExecute(0, lcActiune, tcNumeFisier, "", "", 1)
Endproc && open_default_app
************************************** SFARSIT : open_default_app
************************************** INCEPUT : getExcelMask
Function getExcelMask
Lparameters tcInputMask
Local lnint, lndec, lcInputMask
lcInputMask = Strtran(tcInputMask, ' ', '')
lnint = Iif(At('.', lcInputMask, 1) > 0, At('.', lcInputMask, 1) - 1, Len(lcInputMask))
lndec = Iif(Rat('.', lcInputMask, 1) > 0, Len(lcInputMask) - Rat('.', lcInputMask, 1), 0)
lnrest = Mod(lnint, 3)
lcString = Replicate("#", lnrest)
lnint_ramas = lnint - lnrest
Do While lnint_ramas > 0
lcString = lcString + " " + Replicate("#", 3)
lnint_ramas = lnint_ramas - 3
Enddo
lcString = Substr(lcString, 1, Len(lcString) - 1) + "0"
If lndec > 0
lcString = lcString + "." + Replicate("0", lndec)
Endif
Return lcString
Endfunc && get_excel_mask
************************************** SFARSIT : getExcelMask
************************************** INCEPUT : citesteSetare
Function citesteSetare
Lparameters tcCheie
Return Iif(This.nTip = 1, This.citesteSetareRegistru(tcCheie), This.citesteSetareIni(This.cSectiune, tcCheie))
Endfunc
************************************** SFARSIT : citesteSetare
************************************** INCEPUT : modificaSetare
Procedure modificaSetare
Lparameters tcCheie, tcValoare
If This.nTip = 1
This.modificaSetareRegistru(tcCheie, tcValoare)
Else
This.modificaSetareIni(This.cSectiune, tcCheie, tcValoare)
Endif
Endproc
************************************** SFARSIT : modificaSetare
************************************** INCEPUT : citesteSetareIni
Function citesteSetareIni
Lparameters tcSectiune, tcCheie
Return Alltrim(This.oApi.GetProfileString(This.cIniPath, tcSectiune, tcCheie))
Endfunc
************************************** SFARSIT : citesteSetareIni
************************************** INCEPUT : modificaSetareIni
Procedure modificaSetareIni
Lparameters tcSectiune, tcCheie, tcValoare
This.oApi.WriteProfileString(This.cIniPath, tcSectiune, tcCheie, tcValoare)
Endproc
************************************** SFARSIT : modificaSetareIni
************************************** INCEPUT : citesteSetareRegistru
Function citesteSetareRegistru
Lparameters tcCheie
*!* This.cRegNode = tcCheie
Return Alltrim(This.oApi.ReadRegistryString(, This.cRegPath, tcCheie))
Endfunc
************************************** SFARSIT : citesteSetareRegistru
************************************** INCEPUT : modificaSetareRegistru
Procedure modificaSetareRegistru
Lparameters tcCheie, tcValoare
This.oApi.WriteRegistryString(, This.cRegPath, tcCheie, tcValoare, .T.)
Endproc
************************************** SFARSIT : modificaSetareRegistru
************************************** INCEPUT : setCursorCurent
Procedure setCaleCurenta
*!* This.cCaleCurenta = Sys(5)+Sys(2003)
This.cCaleCurenta = Set("Path")
Endproc
************************************** SFARSIT : setCursorCurent
************************************** INCEPUT : repuneCursorCurent
Procedure repuneCaleCurenta
Set Path To (This.cCaleCurenta)
Endproc
************************************** SFARSIT : repuneCursorCurent
************************************** INCEPUT : setCursorCurent
Procedure setCursorCurent
This.cCursorCurent = Select()
Endproc
************************************** SFARSIT : setCursorCurent
************************************** INCEPUT : getCursorCurent
Function getCursorCurent
Return This.cCursorCurent
Endfunc
************************************** SFARSIT : getCursorCurent
************************************** INCEPUT : repuneCursorCurent
Procedure repuneCursorCurent
Select (This.cCursorCurent)
Endproc
************************************** SFARSIT : repuneCursorCurent
************************************** INCEPUT : verificaDate
Function verificaDate
Lparameters tcAlias, tnTip, tlSilentios
Local llReturn
llReturn = .T.
Do Case
Case Empty(tcAlias)
If !tlSilentios
amessagebox("Nu au fost configurate datele! (VFPEXP-001)", 16, "Eroare")
Endif
llReturn = .F.
Case !Used(tcAlias)
If !tlSilentios
amessagebox("Nu exista datele! (VFPEXP-002)", 16, "Eroare")
Endif
llReturn = .F.
Case Reccount(tcAlias) = 0
If !tlSilentios
amessagebox("Nu exista inregistrari pentru " + This.aExplicatii(tnTip, 2) + " !", 0 + 48, "Atentie")
Endif
llReturn = .F.
Endcase
Return llReturn
Endfunc
************************************** SFARSIT : verificaDate
************************************** INCEPUT : export2frx_paginaregrup
Procedure export2frx_paginaregrup
Lparameters tcAlias, tcRaport, tlCereTitlu, tcSetareVizualizare, tcSetareImprimanta, tcParametriListare, toListener, tlMultiPreview, tcReportPreviewer, toPreviewerConfig
Private pcDataOra
pcDataOra = []
Create Cursor crsPaginiRaportGrup(id_grup N(20), pagina N(10))
Select (tcAlias)
Report Form (tcRaport)
Release pcDataOra
This.export2frx(tcAlias, tcRaport, tlCereTitlu, tcSetareVizualizare, tcSetareImprimanta, tcParametriListare, toListener, tlMultiPreview, tcReportPreviewer, toPreviewerConfig)
If Used('crsPaginiRaportGrup')
Use In crsPaginiRaportGrup
Endif
Endproc
************************************** SFARSIT : export2frx_paginaregrup
************************************** INCEPUT : frx_numeroteazapagtotalgrup
Procedure frx_numeroteazapagtotalgrup
Lparameters tnIdGrup, tnPagina
Local lcCursor
If Used('crsPaginiRaportGrup')
lcCursor = Select()
Select crsPaginiRaportGrup
Locate For Nvl(id_grup, 0) = Nvl(tnIdGrup, 0)
If Found()
Replace pagina With tnPagina
Else
Append Blank
Replace id_grup With Nvl(tnIdGrup, 0), pagina With tnPagina
Endif
Select (lcCursor)
Endif
Endproc
************************************** SFARSIT : frx_numeroteazapagtotalgrup
************************************** INCEPUT : frx_citestepagtotalgrup
Function frx_citestepagtotalgrup
Lparameters tnIdGrup
Local lcCursor, lnPagina
lnPagina = Null
If Used('crsPaginiRaportGrup')
lcCursor = Select()
Select crsPaginiRaportGrup
Locate For id_grup = tnIdGrup
If Found()
lnPagina = pagina
Endif
Select (lcCursor)
Endif
Return lnPagina
Endfunc
************************************** SFARSIT : frx_citestepagtotalgrup
************************************** INCEPUT : export2frx
Procedure export2frx
Lparameters tcAlias, tcRaport, tlCereTitlu, tcSetareVizualizare, tcSetareImprimanta, tcParametriListare, toListener, tlMultiPreview, tcReportPreviewer, toPreviewerConfig
** modificare 23.12.2008 : tcParametriListare, toListener
*!* Lparameters tcAlias, tcRaport, tlCereTitlu, tnVizualizare, tcSetareImprimanta, tcParametriListare
*!* ** tnVizualizare
*!* ** 1 - cu vizualizare
*!* ** 2 - listare directa
** tcSetareImprimanta = numele setarii care va fi citita din registri
** (valoarea ei reprezinta numele imprimantei pe care se va face listarea )
** tcParametriListare
** NOEJECT NORESET
*!* This.cUserRepPath = This.getUserRepPath()
*!* 08.12.2010
*!* tlMultiPreview = daca se foloseste reportpreview-ul din VFP9 cu FoxyPreview (salvare pdf, xls, rtf etc.)
*!* tcReportPreviewer - procedura pentru preview rapoarte "FoxyPreview" (default gcReportPreviewer)
*!* toPreviewerConfig - obiect PreviewerConfig cu setari pentru tcReportPreviewer
*!* loPreviewerConfig.SetValue("cDestFile", m.lcDestinationFile)
*!* loPreviewerConfig.SetValue("lOpenDestFile", .F.)
*!* loPreviewerConfig.SetValue("lPDFasImage", .T.)
Local llMultiPreview, lcReportPreviewer, loPreviewerConfig
Local lcImprimanta, lcImprimantaTemp, lcCaleRaport, llDataOraLocal, lcReportOutput, lcParametri, lcObiect
Local llDeleteRaport, llDeleteLogo, lcRaportPath, lcLogoPathDest
Private gcLogoPath, gcLogoOrizontalPath, gcTextFooterFact, gcStampilaPath, gcIsoPath
gcTextFooterFact = ''
gcLogoPath = ''
gcLogoOrizontalPath = ''
gcStampilaPath = ''
gcIsoPath = ''
llDeleteRaport = .F.
llDeleteLogo = .F.
lcRaportPath = ''
lcLogoPathDest = ''
llMultiPreview = Iif(Type('tlMultiPreview') <> 'L', .F., tlMultiPreview)
lcReportPreviewer = Iif(Type('tcReportPreviewer') <> 'C' Or Empty(m.tcReportPreviewer), Iif(Type('gcReportPreviewer') = 'C', m.gcReportPreviewer, ""), m.tcReportPreviewer)
loPreviewerConfig = Iif(Type('toPreviewerConfig') <> 'O', Createobject("PreviewerConfig"), m.toPreviewerConfig) && oexport.prg
*!* 08.12.2010 ^
If Type('tcSetareVizualizare') = 'C'
*!* modificare ROARESTAURANT v 1.0.0
*!* lnVizualizare = Iif(Empty(Nvl(tcSetareVizualizare,[])),1,Val(Nvl(This.citesteSetareRegistru(tcSetareVizualizare),[1])))
lnVizualizare = Iif(Empty(Nvl(tcSetareVizualizare, [])), 1, Val(Nvl(This.citesteSetare(tcSetareVizualizare), [1])))
*!* modificare ROARESTAURANT v 1.0.0 ^
Else
lnVizualizare = tcSetareVizualizare
Endif
This.setCursorCurent()
If This.verificaDate(tcAlias, 1)
llDataOraLocal = .F.
*!* modificare 23.12.2008
If !Empty(tcParametriListare)
lcParametri = tcParametriListare
Else
lcParametri = []
Endif
*!* modificare 23.12.2008 ^
Do Case
Case Empty(lnVizualizare) Or lnVizualizare = 1
lnVizualizare = 1
lcParametri = [PROMPT PREVIEW ] + lcParametri
Case !Inlist(lnVizualizare, 1, 2)
lnVizualizare = 1
lcParametri = [PROMPT PREVIEW ] + lcParametri
Otherwise
lcParametri = [PROMPT ] + lcParametri
Endcase
If Type('pcDataOra') = 'U'
Private pcDataOra
pcDataOra = get_ora(2)
llDataOraLocal = .T.
Endif
Aprinters(This.aImprimante)
If !Empty(tcSetareImprimanta) And Alen(This.aImprimante, 1) > 0
** verificare ca imprimanta este instalata pe calculatorul respectiv
*!* modificare ROARESTAURANT v 1.0.0
*!* lcImprimanta = This.citesteSetareRegistru(tcSetareImprimanta)
lcImprimanta = This.citesteSetare(tcSetareImprimanta)
*!* modificare ROARESTAURANT v 1.0.0 ^
If Ascan(This.aImprimante, lcImprimanta, 1, Alen(This.aImprimante, 1), 1, 15) = 0
lcImprimanta = []
*!* modificare ROARESTAURANT v 1.0.0
This.modificaSetare(tcSetareImprimanta, lcImprimanta)
*!* modificare ROARESTAURANT v 1.0.0 ^
Endif
Endif
* Obtin calea catre raport (tcRaport / usr_tcRaport / usr_tcRaport_id_client)
* Verific daca exista un raport pentru clientul respectiv
lnIdClient = 0
lcCaleRaportClient = ''
IF TYPE('poDate.id_client') = 'N' AND !EMPTY(NVL(poDate.id_client,0))
lnIdClient = poDate.id_client
ENDIF
*!* lcCaleRaport = This.cUserRepPath + [USR_] + Juststem(tcRaport) + [.FRX]
IF !EMPTY(m.lnIdClient)
lcRaportClient = STRTRAN(m.tcRaport, JUSTFNAME(m.tcRaport), JUSTFNAME(m.tcRaport) + '_' + ALLTRIM(STR(m.lnIdClient)))
lcCaleRaportClient = This.getRepPath(m.lcRaportClient)
ENDIF
IF !FILE(m.lcCaleRaportClient)
lcCaleRaport = This.getRepPath(tcRaport)
ELSE
lcCaleRaport = m.lcCaleRaportClient
ENDIF
poLog.Log('RepPath: ' + m.lcCaleRaport, Program())
*** Logo
gcLogoPath = This.getLogoPath('logo.jpg')
poLog.Log('LogoPath: ' + m.gcLogoPath, Program())
gcLogoOrizontalPath = This.getLogoPath('logo_orizontal.jpg')
poLog.Log('LogoOrizontalPath: ' + m.gcLogoOrizontalPath, Program())
gcIsoPath = This.getLogoPath('iso.jpg')
poLog.Log('IsoPath: ' + m.gcIsoPath, Program())
gcStampilaPath = This.getLogoPath('stampila.jpg')
poLog.Log('StampilaPath: ' + m.gcStampilaPath, Program())
* QR Code
IF TYPE('gnFACTURA_QR') <> 'U' AND m.gnFACTURA_QR > 0
SET PROCEDURE TO 'D:\ROA\ROAFACTURARE\COMUN\utile\barcode\foxbarcodeqr.prg' ADDITIVE
PRIVATE poFbc
poFbc = CREATEOBJECT("FoxBarcodeQR")
poFbc.nCorrectionLevel = 1 && Level_H
gnQRSize=3
lcQRText = IIF(m.gnFactura_Qr = 1, 'serie#nr#cod fiscal#total_plata', '')
gcQRPath = poFbc.FullQRCodeImage("https://comunidadvfp.blogspot.com",,132)
ENDIF
*!* gcLogoPath = ADDBS(JUSTPATH(m.lcCaleRaport)) + 'logo.jpg'
*!* gcLogoPath = FULLPATH(m.gcLogoPath) && directorul ROA (pentru rapoartele din executoabil) sau USERREPORTS (pentru rapoartele din USERREPORTS)
*!* If !File(m.gcLogoPath)
*!* IF TYPE('gcDirMare') = 'C'
*!* gcLogoPath = ADDBS(m.gcDirMare) + 'logo.jpg' && directorul ROA
*!* ELSE
*!* gcLogoPath = Addbs(Left(m.gcAppPath, Rat("\", m.gcAppPath, 2) - 1)) + 'logo.jpg'
*!* ENDIF
*!* If !File(m.gcLogoPath)
*!* gcLogoPath = ADDBS(JUSTPATH(m.gcLogoPath)) + 'USERREPORTS\logo.jpg' && directorul USERREPORTS
*!* ENDIF
*!* If !File(m.gcLogoPath)
*!* gcLogoPath = ''
*!* ENDIF
*!* ENDIF
*** Logo ^
*!* * daca raportul este in executabil si exista logo.jpg in USERREPORTS
*!* * extrag raportul din executabil in gcTempPath\usr_raport.frx
*!* * copii logo.jpg din directorul USERREPORTS (daca exista) in directorul gcTempPath, langa usr_raport.frx
*!* If !File(m.lcCaleRaport)
*!* lcCaleRaport = m.tcRaport
*!*
*!* lcRaport = Juststem(m.tcRaport) + [.FRX]
*!* lcRaportPath = Addbs(m.gcTempPath) + [USRX_] + m.lcRaport
*!* lcLogoPathDest = Addbs(m.gcTempPath) + "logo.jpg"
*!*
*!* If Used(Juststem(m.lcRaportPath))
*!* Use In (Select(Juststem(m.lcRaportPath)))
*!* Endif
*!* Use (m.lcRaport) In 0 Alias tmpRaport
*!* Select tmpRaport
*!* Copy To (m.lcRaportPath)
*!* Use In (Select('tmpRaport'))
*!* Use In Select(Juststem(m.lcRaport))
*!* IF EMPTY(m.gcLogoPath) OR !FILE(m.gcLogoPath)
*!* TEXT TO lcLogoTxt
*!* /9j/4AAQSkZJRgABAQEAYABgAAD/4QBmRXhpZgAATU0AKgAAAAgABAEaAAUAAAABAAAAPgEbAAUAAAABAAAARgEoAAMAAAABAAMAAAExAAIAAAAQAAAATgAAAAAAAJOjAAAD6AAAk6MAAAPocGFpbnQubmV0IDQuMS40AP/bAEMAAQEBAQEBAQEBAQEBAQEBAQEBAQEBAQEBAQEBAQEBAQEBAQEBAQEBAQEBAQEBAQEBAQEBAQEBAQEBAQEBAQEBAf/bAEMBAQEBAQEBAQEBAQEBAQEBAQEBAQEBAQEBAQEBAQEBAQEBAQEBAQEBAQEBAQEBAQEBAQEBAQEBAQEBAQEBAQEBAf/AABEIAAEAAQMBIgACEQEDEQH/xAAfAAABBQEBAQEBAQAAAAAAAAAAAQIDBAUGBwgJCgv/xAC1EAACAQMDAgQDBQUEBAAAAX0BAgMABBEFEiExQQYTUWEHInEUMoGRoQgjQrHBFVLR8CQzYnKCCQoWFxgZGiUmJygpKjQ1Njc4OTpDREVGR0hJSlNUVVZXWFlaY2RlZmdoaWpzdHV2d3h5eoOEhYaHiImKkpOUlZaXmJmaoqOkpaanqKmqsrO0tba3uLm6wsPExcbHyMnK0tPU1dbX2Nna4eLj5OXm5+jp6vHy8/T19vf4+fr/xAAfAQADAQEBAQEBAQEBAAAAAAAAAQIDBAUGBwgJCgv/xAC1EQACAQIEBAMEBwUEBAABAncAAQIDEQQFITEGEkFRB2FxEyIygQgUQpGhscEJIzNS8BVictEKFiQ04SXxFxgZGiYnKCkqNTY3ODk6Q0RFRkdISUpTVFVWV1hZWmNkZWZnaGlqc3R1dnd4eXqCg4SFhoeIiYqSk5SVlpeYmZqio6Slpqeoqaqys7S1tre4ubrCw8TFxsfIycrS09TV1tfY2dri4+Tl5ufo6ery8/T19vf4+fr/2gAMAwEAAhEDEQA/AP7+KKKKAP/Z
*!* ENDTEXT
*!* STRTOFILE(STRCONV(m.lcLogoTxt,14), m.lcLogoPathDest)
*!* ELSE
*!* COPY FILE (m.lcLogoPath) TO (m.lcLogoPathDest)
*!* ENDIF
*!* gcLogoPath = m.lcLogoPathDest
*!* goLog.Log(gcLogoPath, PROGRAM())
*!* llDeleteRaport = .T.
*!* llDeleteLogo = .T.
*!* ENDIF && !File(m.lcCaleRaport)
gcTextFooterFact = Iif(Type('GCTEXTFOOTERFACT1') = 'C' And !Empty(Nvl(m.GCTEXTFOOTERFACT1, '')), Allt(m.GCTEXTFOOTERFACT1), '') + ;
Iif(Type('GCTEXTFOOTERFACT2') = 'C' And !Empty(Nvl(m.GCTEXTFOOTERFACT2, '')), Chr(13) + Chr(10) + Allt(m.GCTEXTFOOTERFACT2), '') + ;
Iif(Type('GCTEXTFOOTERFACT3') = 'C' And !Empty(Nvl(m.GCTEXTFOOTERFACT3, '')), Chr(13) + Chr(10) + Allt(m.GCTEXTFOOTERFACT3), '') + ;
Iif(Type('GCTEXTFOOTERFACT4') = 'C' And !Empty(Nvl(m.GCTEXTFOOTERFACT4, '')), Chr(13) + Chr(10) + Allt(m.GCTEXTFOOTERFACT4), '') + ;
Iif(Type('GCTEXTFOOTERFACT5') = 'C' And !Empty(Nvl(m.GCTEXTFOOTERFACT5, '')), Chr(13) + Chr(10) + Allt(m.GCTEXTFOOTERFACT5), '')
If tlCereTitlu
If Type('pcTitlu') = 'U'
Private pcTitlu
Store '' To pcTitlu
Endif
pcTitlu = ceretitlu_rap('Titlul Raportului', pcTitlu)
Endif
*!* modificare 23.12.2008
If Type('toListener') = 'O'
If Empty(This.cReportOutput)
This.cReportOutput = gcAppPath + "ReportOutput.app"
Endif
If Empty(This.cReportPreview)
This.cReportPreview = gcAppPath + "ReportPreview.app"
Endif
_ReportOutput = This.cReportOutput
_ReportPreview = This.cReportPreview
lcObiect = [OBJECT toListener]
lcParametri = Strtran(Strtran(tcParametriListare, [PREVIEW], []), [PROMPT], [])
Else
lcObiect = [TO PRINTER]
Endif
*!* modificare 23.12.2008 ^
*!* modificare 19.06.2013
If Type('otool') = 'O'
otool.tool1.Visible = .F.
otool.tool1.Dock(-1)
Endif
*!* modificare 19.06.2013 ^
Select (tcAlias)
lnRaspuns = 6
Do While lnRaspuns = 6
Try
*!* modificare 23.12.2008
*!* If lnVizualizare = 1
*!* Keyboard "{ctrl+f10}"
*!* Report Form (lcCaleRaport) To Printer Prompt Preview
*!* Else
*!* If !Empty(lcImprimanta)
*!* lcImprimantaTemp = Sys(6)
*!* Set Printer To (lcImprimanta)
*!* Report Form (lcCaleRaport) To Printer
*!* If !Empty(Nvl(lcImprimantaTemp,[]))
*!* Set Printer To (lcImprimantaTemp)
*!* Else
*!* Set Printer To
*!* Endif
*!* Else
*!* Report Form (lcCaleRaport) To Printer Prompt
*!* Endif
*!* Endif
lcImprimantaTemp = []
If lnVizualizare = 1
If !Empty(lcImprimanta)
lcImprimantaTemp = Sys(6)
Set Printer To Name (lcImprimanta)
Endif
Keyboard "{ctrl+f10}"
Else
If !Empty(lcImprimanta)
lcImprimantaTemp = Sys(6)
Set Printer To Name (lcImprimanta)
lcParametri = Strtran(lcParametri, [PROMPT], [])
Endif
Endif
loPreviewerConfig.SetValue("nDockType", 0) && modificare 18.06.2013
*!* 08.12.2010
*!* Report Form (lcCaleRaport) &lcObiect &lcParametri
Do Case
Case !m.llMultiPreview
Report Form (m.lcCaleRaport) &lcObiect &lcParametri
Case Empty(m.lcReportPreviewer)
Report Form (lcCaleRaport) &lcObiect &lcParametri
Case Version(5) < 800
Report Form (m.lcCaleRaport) &lcObiect &lcParametri
Otherwise
Try
lcOldReportBehaviour = Set("ReportBehavior")
If Type('toListener') = 'O'
loPreviewerConfig.oListener = m.toListener
Endif
*!* If !EMPTY(m.lcParametri)
*!* loPreviewerConfig.cClauses = m.lcParametri
*!* ENDIF
Do &lcReportPreviewer With m.lcCaleRaport, m.loPreviewerConfig
Set REPORTBEHAVIOR &lcOldReportBehaviour
Catch To loEx
Messagebox('Eroare: ' + loEx.Message + CRLF + 'Procedura: ' + loEx.Procedure + CRLF + 'Cod: ' + loEx.LineContents + CRLF + 'Linia nr: ' + Transform(loEx.Lineno), 0 + 32, _Screen.Caption)
Try
Set REPORTBEHAVIOR 80 && disable FoxyPreviewer
Report Form (m.lcCaleRaport) &lcObiect &lcParametri
Set REPORTBEHAVIOR 90
Catch To loEx
Messagebox('Eroare: ' + loEx.Message + CRLF + 'Procedura: ' + loEx.Procedure + CRLF + 'Cod: ' + loEx.LineContents + CRLF + 'Linia nr: ' + Transform(loEx.Lineno), 0 + 32, _Screen.Caption)
Set REPORTBEHAVIOR 80 && disable FoxyPreviewer
*!* 31.05.2011
Select (tcAlias)
*!* 31.05.2011 ^
Report Form (m.lcCaleRaport) To Printer Prompt Preview
Set REPORTBEHAVIOR 90
Endtry
Endtry
Endcase
*!* 08.12.2010 ^
If !Empty(Nvl(lcImprimantaTemp, []))
Set Printer To Name (lcImprimantaTemp)
Else
Set Printer To
Endif
*!* modificare 23.12.2008 ^
lnRaspuns = 7
Catch To oEroare
If oEroare.Message = 'Error loading driver error.'
lnRaspuns = amessagebox("Eroare la driverul imprimantei.Doriti sa reincercati listarea?", 4 + 32 + 256, "Confirmare relistare")
Else
amessagebox(oEroare.Message, 16, "Eroare")
lnRaspuns = 7
Endif
Endtry
Enddo
*!* modificare 19.06.2013
If Type('otool') = 'O'
otool.tool1.Dock(0, 0, 0)
otool.tool1.Visible = .T.
Endif
If Type('ohelp') = 'O'
ohelp.tool_help1.Visible = .F.
If Type('otool') = 'O'
ohelp.tool_help1.Dock(0, otool.tool1.Width, 0)
Else
ohelp.tool_help1.Dock(0)
Endif
ohelp.tool_help1.Visible = .T.
Endif
*!* modificare 19.06.2013 ^
If m.llDeleteRaport And File(m.lcRaportPath)
Delete File Forceext(m.lcRaportPath, '*')
Endif
If m.llDeleteLogo And File(m.lcLogoPathDest)
Delete File (m.lcLogoPathDest)
Endif
If llDataOraLocal
Release pcDataOra
Endif
Endif
This.repuneCursorCurent()
Endproc && export2frx
************************************** SFARSIT : export2frx
************************************** INCEPUT : export2xls
Procedure export2xls
Lparameters tcAlias, tcNumeFisier, tcListaColoane, tcFiltru
Local lcDir, lcFisier, lcCursorTempXls, lcSelectie
*!* This.cUserRepPath = This.getUserRepPath()
This.setCursorCurent()
If This.verificaDate(tcAlias, 2)
lcCursorTempXls = [crsxprtxls]
If Empty(tcNumeFisier)
tcNumeFisier = 'Foaie_Excel'
Endif
lcFisier = Putfile('Nume fisier:', tcNumeFisier, 'XLS')
If Empty(lcFisier) && Esc pressed
Return
Endif
If Empty(tcListaColoane)
Select (tcAlias)
Export To (lcFisier) Type Xl5
Else
If Used(lcCursorTempXls)
Use In (lcCursorTempXls)
Endif
lcSelectie = [SELECT ] + tcListaColoane + [ FROM ] + tcAlias + ;
Iif(!Empty(tcFiltru), [ WHERE ] + tcFiltru, []) + [ INTO CURSOR ] + lcCursorTempXls
&lcSelectie
Select (lcCursorTempXls)
Export To (lcFisier) Type Xl5
Use In (lcCursorTempXls)
Endif
This.OPEN_DEFAULT_APP(lcFisier)
Endif
This.repuneCursorCurent()
Endproc && export2xls
************************************** SFARSIT : export2xls
************************************** INCEPUT : export2xlsx
Procedure export2xlsx
Lparameters tcAlias, tcNumeFisier, tcListaColoane, tcFiltru
Local lcDir, lcFisier, lcCursorTempXls, lcSelectie
Local llHead, llMemoAsComment, llOpen, lnCodePage, lnMaxIndexLen
*!* This.cUserRepPath = This.getUserRepPath()
This.setCursorCurent()
If This.verificaDate(tcAlias, 2)
lcCursorTempXls = [crsxprtxls]
If Empty(tcNumeFisier)
tcNumeFisier = 'Foaie_Excel'
Endif
lcFisier = Putfile('Nume fisier:', tcNumeFisier, 'XLSX')
If Empty(lcFisier) && Esc pressed
Return
Endif
llHead = .T.
lnMaxIndexLen = 60
llMemoAsComment = .F.
lnCodePage = 0
llOpen = .T.
If Empty(tcListaColoane)
copytoxlsx (m.tcAlias, m.lcFisier,llHead,lnMaxIndexLen,m.tcListaColoane,llMemoAsComment,lnCodePage,llOpen)
Else
Use In (SELECT(m.lcCursorTempXls))
lcSelectie = [SELECT ] + tcListaColoane + [ FROM ] + tcAlias + ;
Iif(!Empty(tcFiltru), [ WHERE ] + tcFiltru, []) + [ INTO CURSOR ] + lcCursorTempXls
&lcSelectie
Select (lcCursorTempXls)
copytoxlsx (m.tcAlias, m.lcFisier,llHead,lnMaxIndexLen,m.tcListaColoane,llMemoAsComment,lnCodePage,llOpen)
Use In (SELECT(lcCursorTempXls))
Endif
Endif
This.repuneCursorCurent()
Endproc && export2xlsx
************************************** SFARSIT : export2xlsx
******************
* Exporta coloanele unui grid in xlsxs
******************
Procedure export2xlsxGrid
Lparameters toGrid, tcNumeFisier, tcWhere, tcOrder
If Type('toGrid') # 'O'
Return
Endif
Local lcColumnList, lcHeaderList, lcSelect, llSelect, lcFrom, lcWhere, lcOrder, lcOutput
lcFrom = toGrid.RecordSource
lcWhere = Iif(!Empty(tcWhere) And Type('tcWhere') = 'C', tcWhere, Filter(lcFrom))
lcOrder = Iif(Empty(tcOrder) Or Type('tcOrder') # 'C', "", tcOrder)
lcColumnList = ''
lcHeaderList = ''
lcSelect = ''
llSelect = .T.
lcType = 'CURSOR'
lcOutput = Sys(2015)
get_schema_grid(toGrid,@lcColumnList, @lcHeaderList, @lcSelect, m.llSelect, m.lcType, m.lcFrom, m.lcWhere, m.lcOrder, m.lcOutput)
&lcSelect
If Used(m.lcOutput)
This.export2xlsx(m.lcOutput, m.tcNumeFisier)
Use In (m.lcOutput)
Endif
Endproc && export2xlsxGrid
************************************** INCEPUT : exportMultiTable2Xlsx
Procedure exportMultiTable2Xlsx
Lparameters tcTableList, tcFileName
Local loExcel As "VFPxWorkbookXLSX" OF "VFPxWorkbookXLSX.vcx"
Local lcCursorTempXls, lcFisier, lcTable, llFreeze, llOpen, llSave, lnTable, lnTables
This.setCursorCurent()
lcCursorTempXls = [crsxprtxls]
If Empty(tcFileName)
tcFileName = 'Foaie_Excel'
Endif
lcFisier = Putfile('Nume fisier:', m.tcFileName, 'xlsx')
If Empty(lcFisier) && Esc pressed
Return
Endif
llFreeze = .T.
llOpen = .T.
llSave = .T.
loExcel = NEWOBJECT("VFPxWorkbookXLSX", "VFPxWorkbookXLSX.vcx")
lnTables = GETWORDCOUNT(m.tcTableList, ",")
FOR lnTable = 1 TO m.lnTables
lcTable = GETWORDNUM(m.tcTableList, m.lnTable, ",")
If USED(m.lcTable)
loExcel.SaveTableToWorkbook(m.lcTable, m.lcFisier, m.llFreeze, m.llSave)
ENDIF
* tcAlias, tnWB, tlFreeze, tlSaveWB, tcSheetName, tnSheet, tnBegRow, tnBegCol
ENDFOR
This.open_default_app(m.lcFisier)
This.repuneCursorCurent()
Endproc && export2xlsx2
************************************** SFARSIT : exportMultiTable2Xlsx
**************************************
* export xml cu extensia xls pentru a fi deschis de office
* poate exporta si grid
**************************************
PROCEDURE Export2XmlXls
LPARAMETERS toGrid, tcFileName, tcSheetName, tlOpen
* toGrid (optional): referinta la grid sau numele unui cursor, default cursorul din zona curenta
* tcFileName (optional): numele fisierului
* tcSheetName (optional): numele sheet-ului, default 'Sheet 1'
* tlOpen (optional): se deschide xls dupa salvare, default .T.
local loExcelXML, llOk, lcSelect
lcSelect = SELECT()
lcFile = IIF(!EMPTY(m.tcFileName), m.tcFilename, SYS(2015) + '.xls')
lcFilePath = JUSTPATH(m.lcFile)
lcFileName = JUSTFNAME(m.lcFile)
IF EMPTY(m.lcFilePath)
lcFile = PUTFILE('XLS File', m.lcFileName, 'xls')
ENDIF
loExcelXML = CREATEOBJECT("ExcelXML")
loExcelXML.HasFilter = .t.
loExcelXML.LockHeader = .t.
loExcelXML.SheetName = IIF(!EMPTY(m.tcSheetName), m.tcSheetName, 'Sheet 1')
loExcelXML.OpenAfterSaving = IIF(PCOUNT()>=4, m.tlOpen, .T.)
IF TYPE('toGrid') = 'O'
loExcelXML.GridObject = m.toGrid
ELSE
IF TYPE('toGrid') = 'C' AND USED(toGrid)
SELECT (m.toGrid)
ELSE
SELECT (m.lcSelect)
ENDIF
ENDIF
llOk = loExcelXML.Save(m.lcFile)
SELECT (m.lcSelect)
RETURN m.llOk
ENDPROC && Export2XmlXls
************************************** INCEPUT : export2pdf
Procedure export2pdf
Lparameters tcAlias, tcRaport, tlPreview, tcCursorSalvare
Local llCaleModificata
llCaleModificata = .F.
This.setCursorCurent()
If This.verificaDate(tcAlias, 3, .T.)
*!* This.cUserRepPath = This.getUserRepPath()
*!* lcCaleRaport = This.cUserRepPath + [USR_] + Juststem(tcRaport) + [.FRX]
lcCaleRaport = This.getRepPath(tcRaport)
Local oL As pdflistener2 Of pdflistener.prg
oL = Newobject('pdflistener2', 'pdflistener.prg')
oL.enable_print = .T.
oL.enable_copy = .F.
*!* oL.user_passwd = Trim(Thisform.userpwd.Value)
Select (tcAlias)
If !Empty(This.cUserRepPath)
This.setCaleCurenta()
Set Path To (This.cUserRepPath)
llCaleModificata = .T.
Endif
If tlPreview
Report Form (lcCaleRaport) Preview Object oL
Else
Report Form (lcCaleRaport) Object oL
Endif
If llCaleModificata
This.repuneCaleCurenta()
Endif
If !Empty(tcCursorSalvare)
If Used(tcCursorSalvare)
Select (tcCursorSalvare)
Append Blank
Replace nume_frx With tcRaport, fisier With Filetostr(oL.pdfdoc)
Endif
Endif
If !tlPreview
Delete File(oL.pdfdoc)
Endif
Release oL
Endif
This.repuneCursorCurent()
Endproc && export2pdf
************************************** SFARSIT : export2pdf
************************************** INCEPUT : export2html
Procedure export2html
Lparameters tcTargetTables, tcNumeFisier, tcTableTitles, tlJustTables
*** tcTargetTables : lista cu tabelul/tabelele pentru export
*** tcNumeFisier: (optional) numele fisierului cu extensie (default "foaie_excel.xls")
*** tcTableTitles : (optional) titlurile tabelelor (default = tcTargetTables)
*** tlJustTables : (optional) doar codul pentru tabele, fara alte tag-uri
*** RETURN: creeaza un html cu extensia din tcNumeFisier si il deschide cu aplicatia implicita sau intoarce codul html pentru tabele in functie de tlJustTables
Local lcOldError, lcTable, lcTextMergeFile, lcTextMergeFileFull, lcXLSName, lnField, lnTable
Local lnTables, lcTargetTables, lcXLS, lcTableTitles, llJustTables
Local lcExtensie, lcNumeFisier, lcReportTitle, lcTableTitle
lcXLS = ""
lcTargetTables = m.tcTargetTables
llJustTables = m.tlJustTables
lcTableTitles = Iif(!Empty(m.tcTableTitles), m.tcTableTitles, m.lcTargetTables)
lcNumeFisier = Iif(!Empty(m.tcNumeFisier), Lower(tcNumeFisier), "foaie_excel")
lcExtensie = Justext(tcNumeFisier)
lcExtensie = Iif(Empty(m.lcExtensie), 'html', m.lcExtensie)
lcReportTitle = Strtran(Juststem(lcNumeFisier), "_", " ") && titlul raportului = numele fisierului
lcTextMergeFileFull = Putfile('Nume fisier:', m.lcNumeFisier, m.lcExtensie)
If Empty(m.lcTextMergeFileFull)
Return
Endif
This.setCursorCurent()
Set Console Off
Set Textmerge On To Memvar lcXLS Noshow
lnTables = Getwordcount(m.lcTargetTables, [,])
If !m.llJustTables
\<!DOCTYPE html Public "-//W3C//DTD HTML 4.01 Transitional//EN"
\"http://www.w3.org/TR/html4/loose.dtd">
\<html>
\<Head>
\<meta http-EQUIV='Content-Type' CONTENT='text/html; charset=windows-1252'>
\<meta Name='Generator' CONTENT='VFP'>
\<Title>x</Title>
\ <Style Type="text/css">
\<!--Table
&&Characters
\.xlChr
\ {mso-Style-Parent:style0;
\ Font-family:Arial, sans-serif;
\ mso-Font-charset:0;
\ Text-Align:Right;
\ white-Space:Normal;}
&& number no dec
\.xlN0
\ {mso-Style-Parent:style0;
\ mso-Number-Format:0;
\ white-Space:Normal;}
&& number 1 dec
\.xlN1
\ {mso-Style-Parent:style0;
\ mso-Number-Format:<<Chr(34)>>0\.0<<Chr(34)>>;
\ white-Space:Normal;}
&& number 2 dec
\.xlN2
\ {mso-Style-Parent:style0;
\ mso-Number-Format:<<Chr(34)>>0\.00<<Chr(34)>>;
\ white-Space:Normal;}
&& number 3 dec
\.xlN3
\ {mso-Style-Parent:style0;
\ mso-Number-Format:<<Chr(34)>>0\.000<<Chr(34)>>;
\ white-Space:Normal;}
&& number 4 dec
\.xlN4
\ {mso-Style-Parent:style0;
\ mso-Number-Format:<<Chr(34)>>0\.0000<<Chr(34)>>;
\ white-Space:Normal;}
&& number 5 dec
\.xlN5
\ {mso-Style-Parent:style0;
\ mso-Number-Format:<<Chr(34)>>0\.00000<<Chr(34)>>;
\ white-Space:Normal;}
&& number 6 dec
\.xlN6
\ {mso-Style-Parent:style0;
\ mso-Number-Format:<<Chr(34)>>0\.000000<<Chr(34)>>;
\ white-Space:Normal;}
&& number 7 dec
\.xlN7
\ {mso-Style-Parent:style0;
\ mso-Number-Format:<<Chr(34)>>0\.0000000<<Chr(34)>>;
\ white-Space:Normal;}
&& number 8 dec
\.xlN8
\ {mso-Style-Parent:style0;
\ mso-Number-Format:<<Chr(34)>>0\.00000000<<Chr(34)>>;
\ white-Space:Normal;}
&& number 9 dec
\.xlN9
\ {mso-Style-Parent:style0;
\ mso-Number-Format:<<Chr(34)>>0\.000000000<<Chr(34)>>;
\ white-Space:Normal;}
&& number 0 dec and comma
\.xlNC0
\ {mso-Style-Parent:style0;
\ mso-Number-Format:<<Chr(34)>>\#\,\#\#0<<Chr(34)>>;
\ white-Space:Normal;}
&& number 1 dec and comma
\.xlNC1
\ {mso-Style-Parent:style0;
\ mso-Number-Format:<<Chr(34)>>\#\,\#\#0\.0<<Chr(34)>>;
\ white-Space:Normal;}
&& number 2 dec and comma
\.xlNC2
\ {mso-Style-Parent:style0;
\ mso-Number-Format:<<Chr(34)>>\#\,\#\#0\.00<<Chr(34)>>;
\ white-Space:Normal;}
&& number 3 dec and comma
\.xlNC3
\ {mso-Style-Parent:style0;
\ mso-Number-Format:<<Chr(34)>>\#\,\#\#0\.000<<Chr(34)>>;
\ white-Space:Normal;}
&& number 4 dec and comma
\.xlNC4
\ {mso-Style-Parent:style0;
\ mso-Number-Format:<<Chr(34)>>\#\,\#\#0\.0000<<Chr(34)>>;
\ white-Space:Normal;}
&& number 5 dec and comma
\.xlNC5
\ {mso-Style-Parent:style0;
\ mso-Number-Format:<<Chr(34)>>\#\,\#\#0\.00000<<Chr(34)>>;
\ white-Space:Normal;}
&& number 6 dec and comma
\.xlNC6
\ {mso-Style-Parent:style0;
\ mso-Number-Format:<<Chr(34)>>\#\,\#\#0\.000000<<Chr(34)>>;
\ white-Space:Normal;}
&& number 7 dec and comma
\.xlNC7
\ {mso-Style-Parent:style0;
\ mso-Number-Format:<<Chr(34)>>\#\,\#\#0\.0000000<<Chr(34)>>;
\ white-Space:Normal;}
&& number 8 dec and comma
\.xlNC8
\ {mso-Style-Parent:style0;
\ mso-Number-Format:<<Chr(34)>>\#\,\#\#0\.00000000<<Chr(34)>>;
\ white-Space:Normal;}
&& number 9 dec and comma
\.xlNC9
\ {mso-Style-Parent:style0;
\ mso-Number-Format:<<Chr(34)>>\#\,\#\#0\.000000000<<Chr(34)>>;
\ white-Space:Normal;}
&& currency 0 dec
\.xlC0
\ {mso-Style-Parent:style0;
\ mso-Number-Format:<<Chr(34)>>\0022$\0022\#\,\#\#0<<Chr(34)>>;}
&& currency 1 dec
\.xlC1
\ {mso-Style-Parent:style0;
\ mso-Number-Format:<<Chr(34)>>\0022$\0022\#\,\#\#0\.0<<Chr(34)>>;}
&& currency 2 dec
\.xlC2
\ {mso-Style-Parent:style0;
\ mso-Number-Format:<<Chr(34)>>\0022$\0022\#\,\#\#0\.00<<Chr(34)>>;}
&&.xlC3 is currency 3 dec
\.xlC3
\ {mso-Style-Parent:style0;
\ mso-Number-Format:<<Chr(34)>>\0022$\0022\#\,\#\#0\.000<<Chr(34)>>;}
&&.xlC4 is currency 4 dec
\.xlC4
\ {mso-Style-Parent:style0;
\ mso-Number-Format:<<Chr(34)>>\0022$\0022\#\,\#\#0\.0000<<Chr(34)>>;}
\.xlDate
\ {mso-Style-Parent:style0;
\ mso-Number-Format:<<Chr(34)>>dd\/mm\/yyyy<<Chr(34)>>;}
\ -->
\ </Style>
\</Head>
\<body>
Endif && llJustTables
*** TITLU RAPORT
If !m.llJustTables
\<p><b><<m.lcReportTitle>></b></p>
Endif
For lnTable = 1 To m.lnTables
lcTable = Getwordnum(m.lcTargetTables, m.lnTable, [,])
lcTableTitle = Getwordnum(m.lcTableTitles, m.lnTable, [,])
If Empty(m.lcTableTitle)
lcTableTitle = m.lcTable
Endif
If !Used(m.lcTable)
Loop
Endif
Select (m.lcTable)
*** TITLU TABEL
If !m.llJustTables
\<p><b><<m.lcTableTitle>></b></p>
Endif
*** TABEL
\<Table cellspacing=0 Border=1 cellpadding=3 Width=264>
*** CAP TABEL
\<tr>
For lnField = 1 To Afields(laFields) &&headers
\<td Class=xlChr><b><<Strtran(laFields(m.lnField,1),"_", " ")>></b></td>
Endfor
\</tr>
*** DATE TABEL
Scan
\<tr>
For lnField = 1 To Afields(laFields)
Do Case &&Add Formats
Case (laFields(m.lnField, 2) = [N] Or laFields(m.lnField, 2) = [I] Or ;
laFields(m.lnField, 2) = [B]) And laFields(m.lnField, 3) <= 3&&Number/Decimal
\<td Class=xlN<<laFields(m.lnField,4)>>>
Case (laFields(m.lnField, 2) = [N] Or laFields(m.lnField, 2) = [I] Or ;
laFields(m.lnField, 2) = [B]) And laFields(m.lnField, 3) > 3&&Commas/Decimal
\<td Class=xlNC<<laFields(m.lnField,4)>>>
Case laFields(m.lnField, 2) = [D] Or laFields(m.lnField, 2) = [T]&&Date
\<td Class=xlDate>
Case laFields(m.lnField, 2) = [Y] &&Currency (US)
\<td Class=xlC2>
Otherwise &&Character
\<td Class=xlChr>
Endcase
&&STRTRAN allows html tags to work
\\<<Rtrim(Transform(Evaluate(Field(m.lnField))))>></td>
Endfor
\</tr>
Endscan
\</Table>
Endfor && lnTables
If !m.llJustTables
\</body></html>
Endif
Set Textmerge Off
Set Textmerge To
Set Console On
If !m.llJustTables
Strtofile(m.lcXLS, m.lcTextMergeFileFull)
OPEN_DEFAULT_APP(m.lcTextMergeFileFull)
Else
Return m.lcXLS
Endif
Endproc && export2html
************************************** SFARSIT : export2html
************************************** INCEPUT : listareUserReport
Procedure listareUserReport
Lparameters tcAlias, tcTipExport, tcRaport, tnVizualizare, tcSetare, tcFiltru
** FRX >>
** * tnVizualizare
** 1 - cu vizualizare
** 2 - listare directa
** * tcSetare = numele setarii care va fi citita din registri
** (valoarea ei reprezinta numele imprimantei pe care se va face listarea )
** XLS >>
** * tnVizualizare
** 1 - cursor
** 2 - selectie din cursor dupa coloanele din tcSetare
** * tcSetare = lista coloane selectie din tcAlias
Local lcTipExport, lnVizualizare
If Type('tcTipExport') = 'C'
lcTipExport = Upper(Alltrim(tcTipExport))
Else
amessagebox("Nu a fost configurat tipul exportului! (VFPEXP-001)", 16, "Eroare")
Return
Endif
If Empty(tcAlias)
amessagebox("Nu au fost configurate datele! (VFPEXP-002)", 16, "Eroare")
Return
Endif
If !Used(tcAlias)
amessagebox("Nu exista datele! (VFPEXP-003)", 16, "Eroare")
Return
Endif
If Empty(tnVizualizare)
lnVizualizare = 1
Else
lnVizualizare = tnVizualizare
Endif
If Reccount(tcAlias) = 0
amessagebox("Nu exista inregistrari pentru " + Iif(lcTipExport = [FRX], "listare", "export") + " !", 0 + 48, "Atentie")
Return
Endif
This.cCursorCurent = Select()
Do Case
Case lcTipExport = 'FRX'
This.export_frx(m.tcAlias, m.tcRaport, m.lnVizualizare, m.tcSetare)
Case lcTipExport = 'XLS'
This.export_xls(tcAlias, tcRaport, lnVizualizare, tcSetare, tcFiltru)
Endcase
Select (This.cCursorCurent)
Endproc
************************************** SFARSIT : listareUserReport
************************************** INCEPUT : export_frx
Procedure export_frx
Lparameters tcAlias, tcRaport, tnVizualizare, tcSetare
Local lcImprimanta, lcImprimantaTemp, lcCaleRaport, llDataOraLocal
Local llDeleteRaport, lcRaportPath
Private gcLogoPath
gcLogoPath = ''
llDeleteRaport = .F.
llDeleteLogo = .F.
llDataOraLocal = .F.
lcRaportPath = ''
If Type('pcDataOra') = 'U'
Private pcDataOra
pcDataOra = get_ora(2)
llDataOraLocal = .T.
Endif
Aprinters(This.aImprimante)
If !Empty(tcSetare) And Alen(This.aImprimante, 1) > 0
*!* verificare ca imprimanta este instalata pe calculatorul respectiv
*!* modificare ROARESTAURANT v 1.0.0
*!* lcImprimanta = This.citesteSetareRegistru(tcSetare)
lcImprimanta = This.citesteSetare(tcSetare)
*!* modificare ROARESTAURANT v 1.0.0 ^
If Ascan(This.aImprimante, lcImprimanta, 1, Alen(This.aImprimante, 1), 1, 15) = 0
lcImprimanta = []
*!* modificare ROARESTAURANT v 1.0.0 ^
*!* This.modificaSetareRegistru(tcSetare,lcImprimanta)
This.modificaSetare(tcSetare, lcImprimanta)
*!* modificare ROARESTAURANT v 1.0.0 ^
Endif
Endif
*** Logo
lcLogoPath = This.cUserRepPath + 'logo.jpg'
If !File(lcLogoPath)
lcLogoPath = ''
Endif
*** Logo ^
lcCaleRaport = This.cUserRepPath + [USR_] + Juststem(tcRaport) + [.FRX]
*** Logo
gcLogoPath = Addbs(Justpath(m.lcCaleRaport)) + 'logo.jpg'
gcLogoPath = Fullpath(m.gcLogoPath) && directorul ROA (pentru rapoartele din executoabil) sau USERREPORTS (pentru rapoartele din USERREPORTS)
If !File(m.gcLogoPath)
If Type('gcDirMare') = 'C'
gcLogoPath = Addbs(m.gcDirMare) + 'logo.jpg' && directorul ROA
Else
gcLogoPath = Addbs(Left(m.gcAppPath, Rat("\", m.gcAppPath, 2) - 1)) + 'logo.jpg'
Endif
If !File(m.gcLogoPath)
gcLogoPath = Addbs(Justpath(m.gcLogoPath)) + 'USERREPORTS\logo.jpg' && directorul USERREPORTS
Endif
If !File(m.gcLogoPath)
gcLogoPath = ''
Endif
Endif
*** Logo ^
If !Empty(m.tcAlias) And Used(m.tcAlias)
Select (tcAlias)
Endif
lnRaspuns = 6
Do While m.lnRaspuns = 6
Try
*!* If !Empty(toListener)
*!* Report Form (lcRaportPath) Object toListener
*!* Else
If tnVizualizare = 1
Keyboard "{ctrl+f10}"
Report Form (m.lcCaleRaport) To Printer Prompt Preview
Else
If !Empty(lcImprimanta)
lcImprimantaTemp = Sys(6)
Set Printer To Name (lcImprimanta)
Report Form (lcCaleRaport) To Printer
If !Empty(Nvl(lcImprimantaTemp, []))
Set Printer To Name (lcImprimantaTemp)
Else
Set Printer To
Endif
Else
Report Form (m.lcCaleRaport) To Printer Prompt
Endif
*!* Endif
Endif
lnRaspuns = 7
Catch To oEroare
If oEroare.Message = 'Error loading driver error.'
lnRaspuns = amessagebox("Eroare la driverul imprimantei.Doriti sa reincercati listarea?", 4 + 32 + 256, "Confirmare relistare")
Else
amessagebox(oEroare.Message, 16, "Eroare")
lnRaspuns = 7
Endif
Endtry
Enddo
If m.llDeleteRaport And File(m.lcRaportPath)
Delete File Forceext(m.lcRaportPath, '*')
Endif
If m.llDataOraLocal
Release pcDataOra
Endif
Endproc && export_frx
************************************** SFARSIT : export_frx
************************************** INCEPUT : export_xls
Procedure export_xls
Lparameters tcAlias, tcNumeFisier, tnVizualizare, tcListaColoane, tcFiltru
Local lcDir, lcFisier, lcCursorTempXls, lcSelectie
lcCursorTempXls = [crsxprtxls]
If Empty(tcNumeFisier)
tcNumeFisier = 'Foaie_Excel'
Endif
If Used(tcAlias)
lcDir = Addbs(This.cTempPath)
lcFisier = Putfile('Nume fisier:', tcNumeFisier, 'XLS')
If Empty(lcFisier) && Esc pressed
Return
Endif
If tnVizualizare = 1
Select (tcAlias)
Export To (lcFisier) Type Xl5
Else
If Used(lcCursorTempXls)
Use In (lcCursorTempXls)
Endif
lcSelectie = [SELECT ] + tcListaColoane + [ FROM ] + tcAlias + ;
Iif(!Empty(tcFiltru), [ WHERE ] + tcFiltru, []) + [ INTO CURSOR ] + lcCursorTempXls
&lcSelectie
Select (lcCursorTempXls)
Export To (lcFisier) Type Xl5
Use In (lcCursorTempXls)
Endif
This.OPEN_DEFAULT_APP(lcFisier)
Endif
Endproc && export_xls
************************************** SFARSIT : export_xls
* Intoarce un obiect oInfo.cFile, lOk, cMesaj
PROCEDURE export2xml_efactura
LPARAMETERS toDateFactura, tcCursorLiniiFactura, tlSilentios
* toDateFactura = obiect cu datele din capul de factura
* tcCursorLiniiFactura = numele cursorului cu liniile facturii, asa cum arata la listare
* tlSilentios .T.
LOCAL lcFile, loInfo
loInfo = getXmlEFactura(toDateFactura, tcCursorLiniiFactura, tlSilentios) && IN xmlEFactura.prg
RETURN loInfo
ENDPROC && export2xml_efactura
Enddefine
*!* Foxy Previewer mod simplificat FoxyPreviewer.app. Rapoartele trebuie sa existe fizic pe disc
Procedure FoxyPreview
Lparameters tcRaport, toPreviewerConfig && tcDestinationFile, tlDontOpenFile
***
Local loException As Exception
Local lcVersionFoxyPreview, lcWebsiteFoxyPreview, llDirectPrint
Local lRetVal, laProps[1], lcExtension, lcExtension2, lcFile, lcProperty, lnProperty, loDestinatie, loSursa, lcOldReportBehaviour
lcVersionFoxyPreview = "v2.99z30-20130913"
lcWebsiteFoxyPreview = "http://foxypreviewer.codeplex.com/releases/view/49471"
***
Local lcRaport, lcFoxyPath, lcComunPath
Local llOpenDestinationFile, llPDFasImage, lcDestinationFile, lcExtension, lcObjType, lcPreview
llOpenDestinationFile = .T.
llDirectPrint = .F. && trimite direct la imprimanta, fara preview
If Type('toPreviewerConfig') <> 'O'
toPreviewerConfig = Createobject("PreviewerConfig")
Endif
llOpenDestinationFile = Iif(Type('toPreviewerConfig.lOpenViewer') <> 'U', Nvl(toPreviewerConfig.lOpenViewer, .T.), .T.)
llDirectPrint = Iif(Type('toPreviewerConfig.lDirectPrint') <> 'U', Nvl(toPreviewerConfig.lDirectPrint, .F.), .F.)
lcDestinationFile = Iif(Type('toPreviewerConfig.cDestFile') <> 'U', Nvl(toPreviewerConfig.cDestFile, ''), '')
llPDFasImage = Iif(Type('toPreviewerConfig.lPDFasImage') <> 'U', Nvl(toPreviewerConfig.lPDFasImage, .F.), .F.)
lcRaport = Forceext(tcRaport, 'frx')
*goLog.Log('lcRaport ' + m.lcRaport, 'FoxyPreviewerSimple')
*goLog.Log('gcReportPreviewerPath ' + m.gcReportPreviewerPath, 'FoxyPreviewerSimple')
lcFoxyPath = Iif(Type('gcReportPreviewerPath') = 'C', Addbs(gcReportPreviewerPath) + "FoxyPreviewer.App", "FoxyPreviewer.App")
*goLog.Log('lcFoxyPath ' + m.lcFoxyPath, 'FoxyPreviewerSimple')
If !File(lcFoxyPath)
*goLog.Log('!FILE(lcFoxyPath)', 'FoxyPreviewerSimple')
lcComunPath = Left(Addbs(gcAppPath), Rat('\', Addbs(gcAppPath), 2)) + 'COMUNCONTAFIN\'
If !Directory(m.lcComunPath)
lcComunPath = Left(Addbs(gcAppPath), Rat('\', Addbs(gcAppPath), 2)) + 'COMUNROA\'
Endif
lcFoxyPath = lcComunPath + "FoxyPreviewer.App"
*goLog.Log('lcFoxyPath ' + m.lcFoxyPath, 'FoxyPreviewerSimple')
If !File(lcFoxyPath)
lcFoxyPath = Addbs(Getfile("app", "FoxyPreviewer.App", "Open", 0, "Alegeti locatia " + m.lcFoxyPath))
Endif
Endif
If Empty(Nvl(lcFoxyPath, ''))
Report Form (m.tcRaport) To Printer Prompt Preview
Return
Endif
If Type('_Screen.oFoxyPreviewer') <> 'O'
*goLog.Log([TYPE('_Screen.oFoxyPreviewer') <> 'O' ] + m.lcFoxyPath, 'FoxyPreviewerSimple')
Do (m.lcFoxyPath)
Else
If Isnull(_Screen.oFoxyPreviewer)
*goLog.Log([ISNULL(_Screen.oFoxyPreviewer) ] + m.lcFoxyPath, 'FoxyPreviewerSimple')
Do (m.lcFoxyPath)
Endif
Endif
**********************************************
* Optional available parameters
**********************************************
If Type('_Screen.oFoxyPreviewer') = 'O' And Type('toPreviewerConfig') = 'O' And !Isnull(_Screen.oFoxyPreviewer) And !Isnull(toPreviewerConfig)
loSursa = m.toPreviewerConfig
loDestinatie = _Screen.oFoxyPreviewer
lRetVal = .T.
= Amembers(laProps, m.loDestinatie)
For m.lnProperty = 1 To Alen(laProps, 1)
lcProperty = laProps[m.lnProperty]
If Pemstatus(m.loSursa, m.lcProperty, 5)
Try
loDestinatie.&lcProperty = loSursa.&lcProperty
Catch To loException
If loException.ErrorNo = 1743 && property is read-only
* nu face nimic
Endif
Endtry
Endif && pemstatus
Endfor && lnProperty
Endif && type
*!* modificare MA 03.12.2013
If Type('_Screen.oFoxyPreviewer') = 'O'
*********************************
* Agenda email
*********************************
If Used('cparteneriemail')
_Screen.oFoxyPreviewer.cAdressTable = "cparteneriemail"
_Screen.oFoxyPreviewer.cAdressSearch = "denumire"
Endif
* Limba
If Pemstatus(_Screen.oFoxyPreviewer, 'cLanguage', 5)
If Type('gcLocale') = 'C'
_Screen.oFoxyPreviewer.cLanguage = Upper(gcLocale)
Else
_Screen.oFoxyPreviewer.cLanguage = [ROMANA]
Endif
Endif
Endif
*!* modificare MA 03.12.2013 ^
If Empty(Justpath(m.lcRaport)) && raporte in executabil - trebuie create pe disc
* Retrieve the FRX and FRT files from the EXE
lcFile = Addbs(Getenv("TEMP")) + 'tmp_fp_' + Juststem(m.lcRaport) + '_' + Sys(2) + "."
poLog.Log('lcFile ' + m.lcFile, Program())
poLog.Log('lcRaport ' + m.lcRaport, Program())
If Empty(Sys(2000, m.lcRaport))
poLog.Log('Empty SYS(2000, lcRaport)', Program())
Strtofile(Filetostr(Forceext(lcRaport, "FRX")), lcFile + "frx")
poLog.Log('Forceext(lcRaport,"FRX") ' + Forceext(lcRaport, "FRX") + ' lcFile + frx: ' + m.lcFile + "frx", Program())
Strtofile(Filetostr(Forceext(lcRaport, "FRT")), lcFile + "frt")
poLog.Log('Forceext(lcRaport,"FRT") ' + Forceext(lcRaport, "FRT") + ' lcFile + frt: ' + m.lcFile + "frt", Program())
lcFile = lcFile + "frx"
Else
lcFile = m.lcRaport
Endif
Else
lcFile = m.lcRaport
Endif
*goLog.Log([lcFile ] + m.lcFile, 'FoxyPreviewerSimple')
lcOldReportBehaviour = Set("ReportBehavior")
IF TYPE('gnReportBehaviour') = 'N'
SET REPORTBEHAVIOR (m.gnReportBehaviour)
ELSE
Set REPORTBEHAVIOR 90
ENDIF
If !Empty(m.lcDestinationFile)
&& OBJTYPE 10 = PDF , 11 = PDF AS IMAGE , 12 = RTF , 13 = XLS , 14 = HTML
lcExtension = Upper(Justext(m.lcDestinationFile))
lcObjType = Iif(m.lcExtension = 'PDF' And m.llPDFasImage, '11', Iif(m.lcExtension = 'PDF', '10', Iif(m.lcExtension = 'RTF', '12', Iif(m.lcExtension = 'XLS', '13', '14'))))
lcPreview = Iif(m.llOpenDestinationFile, 'PREVIEW', '')
Report Form (m.lcFile) Object Type &lcObjType To File (m.lcDestinationFile) &lcPreview
ELSE
lcPreview = IIF(m.llDirectPrint, 'TO PRINTER', 'PREVIEW')
Report Form (m.lcFile) &lcPreview
Endif
Set REPORTBEHAVIOR &lcOldReportBehaviour
*** DELETE TEMP FILES
If Left(Justfname(m.lcFile), 7) = "tmp_fp_" && We have a temp ??X, ??T files to delete
Try
Delete File (m.lcFile)
lcExtension = Justext(m.lcFile)
lcExtension2 = Stuff(m.lcExtension, Len(m.lcExtension), 1, [T])
Delete File Forceext(m.lcFile, m.lcExtension2)
Catch
Endtry
Endif
Endproc && FoxyPreviewSimple
*!* Previewer rapoarte - foloseste gcReportPreviewerPath / gcAppPath pentru localizarea FoxyPreviewer.App
Procedure FoxyPreviewOld
Lparameters tcRaport, toPreviewerConfig && tcDestinationFile, tlDontOpenFile
***
Local lcVersionFoxyPreview, lcWebsiteFoxyPreview
lcVersionFoxyPreview = "2.41a"
lcWebsiteFoxyPreview = "http://foxypreviewer.codeplex.com/releases/view/49471"
***
Local lcRaport, lcFoxyPath, lcComunPath
Local llOpenDestinationFile
llOpenDestinationFile = .T.
If Type('toPreviewerConfig') <> 'O'
toPreviewerConfig = Createobject("PreviewerConfig")
Endif
lcRaport = Forceext(tcRaport, 'frx')
lcFoxyPath = Iif(Type('gcReportPreviewerPath') = 'C', Addbs(gcReportPreviewerPath) + "FoxyPreviewer.App", "FoxyPreviewer.App")
If !File(lcFoxyPath)
lcComunPath = Left(Addbs(gcAppPath), Rat('\', Addbs(gcAppPath), 2)) + 'COMUNCONTAFIN\'
If !Directory(m.lcComunPath)
lcComunPath = Left(Addbs(gcAppPath), Rat('\', Addbs(gcAppPath), 2)) + 'COMUNROA\'
Endif
lcFoxyPath = lcComunPath + "FoxyPreviewer.App"
If !File(lcFoxyPath)
lcFoxyPath = Addbs(Getfile("app", "FoxyPreviewer.App", "Open", 0, "Alegeti locatia " + m.lcFoxyPath))
Endif
Endif
If Empty(Nvl(lcFoxyPath, ''))
Report Form (m.tcRaport) To Printer Prompt Preview
Return
Endif
If !'FOXYPREVIEWER' $ Upper(Set("Procedure"))
Set Procedure To (lcFoxyPath) Additive
Endif
If Empty(Justpath(m.lcRaport)) && raporte in executabil - trebuie create pe disc
Local loReport As "FoxyPreviewerCaller" && Of "FoxyPreviewerCaller.Prg"
loReport = Createobject("FoxyPreviewerCaller")
Else && rapoarte pe disc
Local loReport As "PreviewHelper" Of "FoxyPreviewer.App"
loReport = Createobject("PreviewHelper")
Endif
If Type('loReport') <> 'O'
Report Form (m.tcRaport) To Printer Prompt Preview
Return
Endif
With loReport As ReportHelper
.AddReport(m.lcRaport, toPreviewerConfig.GetValue("cClauses"))
**********************************************
* Optional available parameters
**********************************************
Try
If Not Isnull(toPreviewerConfig.GetValue("cTitle"))
.cTitle = toPreviewerConfig.GetValue("cTitle")
Endif
If Not Isnull(toPreviewerConfig.GetValue("lSendToEmail"))
.lSendToEmail = toPreviewerConfig.GetValue("lSendToEmail")
Endif
If Not Isnull(toPreviewerConfig.GetValue("lSaveToFile"))
.lSaveToFile = toPreviewerConfig.GetValue("lSaveToFile")
Endif
If Not Isnull(toPreviewerConfig.GetValue("lShowCopies"))
.lShowCopies = toPreviewerConfig.GetValue("lShowCopies")
Endif
If Not Isnull(toPreviewerConfig.GetValue("lShowMiniatures"))
.lShowMiniatures = toPreviewerConfig.GetValue("lShowMiniatures")
Endif
If Not Isnull(toPreviewerConfig.GetValue("lShowSetup"))
.lShowSetup = toPreviewerConfig.GetValue("lShowSetup")
Endif
If Not Isnull(toPreviewerConfig.GetValue("lShowSearch"))
.lShowSearch = toPreviewerConfig.GetValue("lShowSearch")
Endif
If Not Isnull(toPreviewerConfig.GetValue("lPrintVisible"))
.lPrintVisible = toPreviewerConfig.GetValue("lPrintVisible")
Endif
If Not Isnull(toPreviewerConfig.GetValue("lPrinterPref"))
.lPrinterPref = toPreviewerConfig.GetValue("lPrinterPref")
Endif
If Not Isnull(toPreviewerConfig.GetValue("nCopies"))
.nCopies = toPreviewerConfig.GetValue("nCopies")
Endif
If Not Isnull(toPreviewerConfig.GetValue("lPrintVisible"))
.lPrintVisible = toPreviewerConfig.GetValue("lPrintVisible")
Endif
If Not Isnull(toPreviewerConfig.GetValue("cDefaultListener"))
.cDefaultListener = toPreviewerConfig.GetValue("cDefaultListener")
Endif
If Not Isnull(toPreviewerConfig.GetValue("cSuccessor"))
.cSuccessor = toPreviewerConfig.GetValue("cSuccessor")
Endif
If Not Isnull(toPreviewerConfig.GetValue("lUseListener"))
.lUseListener = toPreviewerConfig.GetValue("lUseListener")
Endif
If Not Isnull(toPreviewerConfig.GetValue("nCanvasCount"))
.nCanvasCount = toPreviewerConfig.GetValue("nCanvasCount")
Endif
If Not Isnull(toPreviewerConfig.GetValue("nZoomLevel"))
.nZoomLevel = toPreviewerConfig.GetValue("nZoomLevel ")
Endif
If Not Isnull(toPreviewerConfig.GetValue("oListener"))
.oListener = toPreviewerConfig.GetValue("oListener")
Endif
If Not Isnull(toPreviewerConfig.GetValue("cPrinterName"))
.cPrinterName = toPreviewerConfig.GetValue("cPrinterName")
Endif
If Not Isnull(toPreviewerConfig.GetValue("lSaveAsImage"))
.lSaveAsImage = toPreviewerConfig.GetValue("lSaveAsImage")
Endif
If Not Isnull(toPreviewerConfig.GetValue("lSaveAsHTML"))
.lSaveAsHTML = toPreviewerConfig.GetValue("lSaveAsHTML")
Endif
If Not Isnull(toPreviewerConfig.GetValue("lSaveAsRTF"))
.lSaveAsRTF = toPreviewerConfig.GetValue("lSaveAsRTF")
Endif
If Not Isnull(toPreviewerConfig.GetValue("lSaveAsXLS"))
.lSaveAsXLS = toPreviewerConfig.GetValue("lSaveAsXLS")
Endif
If Not Isnull(toPreviewerConfig.GetValue("lSaveAsPDF"))
.lSaveAsPDF = toPreviewerConfig.GetValue("lSaveAsPDF")
Endif
If Not Isnull(toPreviewerConfig.GetValue("nWindowState"))
.nWindowState = toPreviewerConfig.GetValue("nWindowState")
Endif
If Not Isnull(toPreviewerConfig.GetValue("nDockType"))
.nDockType = toPreviewerConfig.GetValue("nDockType")
Endif
If Not Isnull(toPreviewerConfig.GetValue("nMaxMiniatureDisplay"))
.nMaxMiniatureDisplay = toPreviewerConfig.GetValue("nMaxMiniatureDisplay")
Endif
If Not Isnull(toPreviewerConfig.GetValue("nPDFPageMode"))
.nPDFPageMode = toPreviewerConfig.GetValue("nPDFPageMode")
Endif
If Not Isnull(toPreviewerConfig.GetValue("nShowToolBar"))
.nShowToolBar = toPreviewerConfig.GetValue("nShowToolBar")
Endif
If Not Isnull(toPreviewerConfig.GetValue("lShowPrinters"))
.lShowPrinters = toPreviewerConfig.GetValue("lShowPrinters")
Endif
If Not Isnull(toPreviewerConfig.GetValue("cFormIcon"))
.cFormIcon = toPreviewerConfig.GetValue("cFormIcon")
Endif
If Not Isnull(toPreviewerConfig.GetValue("cLanguage"))
.cLanguage = toPreviewerConfig.GetValue("cLanguage")
Endif
If Not Isnull(toPreviewerConfig.GetValue("lEmailAuto"))
.lEmailAuto = toPreviewerConfig.GetValue("lEmailAuto")
Endif
If Not Isnull(toPreviewerConfig.GetValue("cEmailType"))
.cEmailType = toPreviewerConfig.GetValue("cEmailType")
Endif
If Not Isnull(toPreviewerConfig.GetValue("cEmailPRG"))
.cEmailPRG = toPreviewerConfig.GetValue("cEmailPRG")
Endif
If Not Isnull(toPreviewerConfig.GetValue("lEmailed"))
.lEmailed = toPreviewerConfig.GetValue("lEmailed")
Endif
*!* 2010-09-17 - Jacques Parent - Add the cSaveDefName
If Not Isnull(toPreviewerConfig.GetValue("cSaveDefName"))
.cSaveDefName = toPreviewerConfig.GetValue("cSaveDefName")
Endif
*!* IF NOT ISNULL(toPreviewerConfig.GetValue("cCodePage")
*!* .cCodePage = toPreviewerConfig.GetValue("cCodePage
*!* ENDIF
If Not Isnull(toPreviewerConfig.GetValue("nEmailMode"))
.nEmailMode = toPreviewerConfig.GetValue("nEmailMode")
Endif
If Not Isnull(toPreviewerConfig.GetValue("cSMTPServer"))
.cSMTPServer = toPreviewerConfig.GetValue("cSMTPServer")
Endif
If Not Isnull(toPreviewerConfig.GetValue("nSMTPPort"))
.nSMTPPort = toPreviewerConfig.GetValue("nSMTPPort")
Endif
If Not Isnull(toPreviewerConfig.GetValue("lSMTPUseSSL"))
.lSMTPUseSSL = toPreviewerConfig.GetValue("lSMTPUseSSL")
Endif
If Not Isnull(toPreviewerConfig.GetValue("cSMTPUserName"))
.cSMTPUserName = toPreviewerConfig.GetValue("cSMTPUserName")
Endif
If Not Isnull(toPreviewerConfig.GetValue("cSMTPPassword"))
.cSMTPPassword = toPreviewerConfig.GetValue("cSMTPPassword")
Endif
If Not Isnull(toPreviewerConfig.GetValue("cEmailTo"))
.cEmailTo = toPreviewerConfig.GetValue("cEmailTo")
Endif
If Not Isnull(toPreviewerConfig.GetValue("cEmailSubject"))
.cEmailSubject = toPreviewerConfig.GetValue("cEmailSubject")
Endif
If Not Isnull(toPreviewerConfig.GetValue("cEmailBody"))
.cEmailBody = toPreviewerConfig.GetValue("cEmailBody")
Endif
If Not Isnull(toPreviewerConfig.GetValue("cEmailFrom"))
.cEmailFrom = toPreviewerConfig.GetValue("cEmailFrom")
Endif
If Not Isnull(toPreviewerConfig.GetValue("nButtonSize"))
.nButtonSize = toPreviewerConfig.GetValue("nButtonSize")
Endif
If Not Isnull(toPreviewerConfig.GetValue("cDestFile"))
.cDestFile = toPreviewerConfig.GetValue("cDestFile")
Endif
If Not Isnull(toPreviewerConfig.GetValue("cEmailCC"))
.cEmailCC = toPreviewerConfig.GetValue("cEmailCC")
Endif
If Not Isnull(toPreviewerConfig.GetValue("cEmailBCC"))
.cEmailBCC = toPreviewerConfig.GetValue("cEmailBCC")
Endif
If Not Isnull(toPreviewerConfig.GetValue("cEmailReplyTo"))
.cEmailReplyTo = toPreviewerConfig.GetValue("cEmailReplyTo")
Endif
.lAutoSendMail = !Isnull(toPreviewerConfig.GetValue("cDestFile")) And toPreviewerConfig.GetValue("lAutoSendMail")
*!* *!* proprietatea exista in versiunea 2.01c
*!* If Type('lAutoSendMail') <> 'U' And Type('loReport.lAutoSendMail') <> 'U' And Not Isnull(This.lAutoSendMail)
*!* .lAutoSendMail = NOT ISNULL(This.cDestFile) AND This.lAutoSendMail
*!* ._lSendingEmail = .lAutoSendMail
*!* ENDIF
If Not Isnull(toPreviewerConfig.GetValue("lSilent"))
.lSilent = toPreviewerConfig.GetValue("lSilent")
Endif
If Not Isnull(toPreviewerConfig.GetValue("lDirectPrint")) And toPreviewerConfig.GetValue("lDirectPrint")
.lDirectPrint = .T.
Endif
If Not Isnull(toPreviewerConfig.GetValue("lSaveAsTXT"))
.lSaveAsTXT = toPreviewerConfig.GetValue("lSaveAsTXT")
Endif
If Not Isnull(toPreviewerConfig.GetValue("cOutputPath"))
.cOutputPath = toPreviewerConfig.GetValue("cOutputPath")
Endif
If Not Isnull(toPreviewerConfig.GetValue("nPrinterProptype"))
.nPrinterProptype = toPreviewerConfig.GetValue("nPrinterProptype")
Endif
If Not Isnull(toPreviewerConfig.GetValue("nThermType"))
.nThermType = toPreviewerConfig.GetValue("nThermType")
Endif
If Not Isnull(toPreviewerConfig.GetValue("nSearchPages"))
.nSearchPages = toPreviewerConfig.GetValue("nSearchPages")
Endif
If Not Isnull(toPreviewerConfig.GetValue("cDecryptProcedure"))
.cDecryptProcedure = toPreviewerConfig.GetValue("cDecryptProcedure")
Endif
If Not Isnull(toPreviewerConfig.GetValue("cEncryptProcedure"))
.cEncryptProcedure = toPreviewerConfig.GetValue("cEncryptProcedure")
Endif
If Not Isnull(toPreviewerConfig.GetValue("cCryptKey"))
.cCryptKey = toPreviewerConfig.GetValue("cCryptKey")
Endif
If Not Isnull(toPreviewerConfig.GetValue("lReadReceipt"))
.lReadReceipt = toPreviewerConfig.GetValue("lReadReceipt")
Endif
If Not Isnull(toPreviewerConfig.GetValue("lPriority"))
.lPriority = toPreviewerConfig.GetValue("lPriority")
Endif
If Not Isnull(toPreviewerConfig.GetValue("cEmailBodyFile"))
.cEmailBodyFile = toPreviewerConfig.GetValue("cEmailBodyFile")
Endif
If Not Isnull(toPreviewerConfig.GetValue("lPDFEmbedFonts"))
.lPDFEmbedFonts = toPreviewerConfig.GetValue("lPDFEmbedFonts")
Endif
If Not Isnull(toPreviewerConfig.GetValue("lPDFCanPrint"))
.lPDFCanPrint = toPreviewerConfig.GetValue("lPDFCanPrint")
Endif
If Not Isnull(toPreviewerConfig.GetValue("lPDFCanEdit"))
.lPDFCanEdit = toPreviewerConfig.GetValue("lPDFCanEdit")
Endif
If Not Isnull(toPreviewerConfig.GetValue("lPDFCanCopy"))
.lPDFCanCopy = toPreviewerConfig.GetValue("lPDFCanCopy")
Endif
If Not Isnull(toPreviewerConfig.GetValue("lPDFCanAddNotes"))
.lPDFCanAddNotes = toPreviewerConfig.GetValue("lPDFCanAddNotes")
Endif
If Not Isnull(toPreviewerConfig.GetValue("lPDFEncryptDocument"))
.lPDFEncryptDocument = toPreviewerConfig.GetValue("lPDFEncryptDocument")
Endif
If Not Isnull(toPreviewerConfig.GetValue("cPDFMasterPassword"))
.cPDFMasterPassword = toPreviewerConfig.GetValue("cPDFMasterPassword")
Endif
If Not Isnull(toPreviewerConfig.GetValue("cPDFUserPassword"))
.cPDFUserPassword = toPreviewerConfig.GetValue("cPDFUserPassword")
Endif
If Not Isnull(toPreviewerConfig.GetValue("lOpenViewer"))
.lOpenViewer = toPreviewerConfig.GetValue("lOpenViewer")
Endif
If Not Isnull(toPreviewerConfig.GetValue("cPdfAuthor"))
.cPdfAuthor = toPreviewerConfig.GetValue("cPdfAuthor")
Endif
If Not Isnull(toPreviewerConfig.GetValue("cPdfTitle"))
.cPdfTitle = toPreviewerConfig.GetValue("cPdfTitle")
Endif
If Not Isnull(toPreviewerConfig.GetValue("cPdfSubject"))
.cPdfSubject = toPreviewerConfig.GetValue("cPdfSubject")
Endif
If Not Isnull(toPreviewerConfig.GetValue("cPdfKeyWords"))
.cPdfKeyWords = toPreviewerConfig.GetValue("cPdfKeyWords")
Endif
If Not Isnull(toPreviewerConfig.GetValue("cPdfCreator"))
.cPdfCreator = toPreviewerConfig.GetValue("cPdfCreator")
Endif
If Not Isnull(toPreviewerConfig.GetValue("lPDFShowErrors"))
.lPDFShowErrors = toPreviewerConfig.GetValue("lPDFShowErrors")
Endif
If Not Isnull(toPreviewerConfig.GetValue("cPDFSymbolFontsList"))
.cPDFSymbolFontsList = toPreviewerConfig.GetValue("cPDFSymbolFontsList")
Endif
If Not Isnull(toPreviewerConfig.GetValue("cAdressTable"))
.cAdressTable = toPreviewerConfig.GetValue("cAdressTable")
Endif
If Not Isnull(toPreviewerConfig.GetValue("cAdressSearch"))
.cAdressSearch = toPreviewerConfig.GetValue("cAdressSearch")
Endif
If Not Isnull(toPreviewerConfig.GetValue("cAttachments"))
.cAttachments = toPreviewerConfig.GetValue("cAttachments")
Endif
If Not Isnull(toPreviewerConfig.GetValue("lShowClose"))
.lShowClose = toPreviewerConfig.GetValue("lShowClose")
Endif
If Not Isnull(toPreviewerConfig.GetValue("cPDFDefaultFont"))
.cPDFDefaultFont = toPreviewerConfig.GetValue("cPDFDefaultFont")
Endif
*!* 31.05.2011
If Not Isnull(toPreviewerConfig.GetValue("lOpenDestFile"))
.lOpenViewer = toPreviewerConfig.GetValue("lOpenDestFile")
Endif
*!* 31.05.2011 ^
Catch To loEx
Endtry
**********************************************
loReport.RunReport()
*!* llOpenDestinationFile = toPreviewerConfig.GetValue("lOpenDestFile") && automatically open the destination file after save
*!* If m.llOpenDestinationFile
*!* Do Case
*!* Case .lPrinted
*!* *!* Messagebox("Report was printed !",64, "Report status")
*!* Case loReport.lSaved
*!* Messagebox("Raportul a fost salvat ca fisier: " + Chr(13) + .cDestFile, 64, _Screen.Caption)
*!* =OPEN_DEFAULT_APP(.cDestFile)
*!* *!* Otherwise
*!* *!* Messagebox("Report Preview was closed without saving or printing",48, "Report status")
*!* Endcase
*!* Endif
Endwith
Endproc && FoxyPreview
*!* clasa pentru preview frx din executabil - le salveaza pe disc si apoi le previzualizeaza
Define Class FoxyPreviewerCaller As Custom
***
cVersionFoxyPreview = "2.41a"
cWebsiteFoxyPreview = "http://foxypreviewer.codeplex.com/releases/view/49471"
***
cPrinterName = Null && SET("Printer",3)
lSaveToFile = Null && = .T. && adds the save to file button
lSendToEmail = Null && = .T. && adds the send to email button
lPrintVisible = Null && = .T. && shows the print button in the toolbar
lShowCopies = Null && = .T. && shows the copies spinner
lShowMiniatures = Null && = .T. && shows the miniatures page
lShowSetup = Null && = .T. && shows the setup configuration form
lPrinterPref = Null && = .T. && shows the printer preferences button
lShowSearch = Null
lShowClose = Null
lClearPrinterInfo = .T. && NULL && = .T. && clears the EXPR, TAG, TAG2 fields of the FRX
* Output types allowed in the "Save as.." button from the toolbar
lSaveAsImage = Null && = .T.
lSaveAsHTML = Null && = .T.
lSaveAsRTF = Null && = .T.
lSaveAsXLS = Null && = .T.
lSaveAsPDF = Null && = .T.
lSaveAsTXT = Null
cOutputPath = Null
nPageTotal = Null && = 0 && Total pages of the current report
nCopies = Null && = 1 && The quantity of copies to be printed
cTitle = Null && = "" && The preview window title
oListener = Null
cDefaultListener = Null && = "FOXYLISTENER"
cSuccessor = Null
lUseListener = Null && = .T.
nCanvasCount = Null && = 1 && initial nr of pages rendered on the preview form.
&& Valid values are 1 (default), 2, or 4.
nZoomLevel = Null && = 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
lExtended = Null && = .T. && Flag that tells if the report is being run automatically
&& using the _REPORTPERVIEW global variable
nWindowState = Null && = 0 && Normal
nDockType = Null && = .F.
cDestFile = Null && = "" && the destination file (image, htm, pdf, etc)
lPrinted = Null && = .F. && knows if the user printed the report
lSaved = Null && = .F. && knows if the user saved the report to a file
nVersion = Null
cVersion = Null
cFormIcon = Null && = "" && "wwrite.ico"
lEmailAuto = Null && = .T.
cEmailType = Null && = "PDF"
cEmailPRG = Null && = ""
cSaveDefName = Null && "" *!* 2010-09-17 - Jacques Parent - Add the cSaveDefName
lEmailed = Null && = .F.
cCodePage = Null && = "CP1252" && CodePage, to be used by PDF Listener
&& No more need to leave this property, because this is set automatically
&& left for backwards compatibility
nMaxMiniatureDisplay = Null && = 64 && Number of miniature proof
nPDFPageMode = Null && = 0
cLanguage = Null && = ""
nShowToolBar = Null && = 1 && Visible
lShowPrinters = Null && = .T. && determines if the available printers combo will be shown
lAutoSendMail = Null
nEmailMode = Null && = 1 && 1 = MAPI, 2 = CDOSYS, 3 = Custom procedure
cSMTPServer = Null && = ""
nSMTPPort = Null && = 25
lSMTPUseSSL = Null && = .F.
cSMTPUserName = Null && = ""
cSMTPPassword = Null && = ""
cEmailTo = Null && = ""
cEmailSubject = Null && = ""
cEmailCC = Null
cEmailBCC = Null
cEmailBody = Null && = ""
cEmailFrom = Null && = ""
cEmailReplyTo = Null
cEmailBodyFile = Null
nButtonSize = Null && = 1 && 1=16x16 pixels (default), 2=32x32 pixels
lSilent = Null && Tell Foxypreviewer to stay silent and to write message to the cErrors property
cErrors = ""
lDirectPrint = .F.
nPrinterProptype = Null
nThermType = Null
nSearchPages = Null
cEncryptProcedure = Null
cDecryptProcedure = Null
cCryptKey = Null
lReadReceipt = Null
lPriority = Null
* PDF properties
lPDFEmbedFonts = Null
lPDFCanPrint = Null
lPDFCanEdit = Null
lPDFCanCopy = Null
lPDFCanAddNotes = Null
lPDFEncryptDocument = Null
cPDFMasterPassword = Null
cPDFUserPassword = Null
lOpenViewer = Null
cPdfAuthor = Null
cPdfTitle = Null
cPdfSubject = Null
cPdfKeyWords = Null
cPdfCreator = Null
lPDFShowErrors = Null
cPDFSymbolFontsList = Null
cPDFDefaultFont = Null
cAdressTable = Null
cAdressSearch = Null
cAttachments = Null
* Internal use properties
_oReports = "" && Internal use, collection that contains the report names to be used
_oClauses = ""
_oAliases = ""
_oNames = ""
_oFoxy = ""
Procedure Init
Endproc
Procedure AddReport(tcReport, tcClauses)
* populates a collection object with the report files and clauses
* This method can be called many times, providing an easy way to merge reports.
Local lcReport, lcTempDir, lcFile
lcTempDir = Addbs(Getenv("TEMP"))
* Retrieve the FRX and FRT files from the EXE
*!* 01.06.2011
*!* lcFile = lcTempDir + "TMP_FP_" + Sys(2015) + "."
lcFile = lcTempDir + Juststem(tcReport) + '_' + Sys(2) + "."
*!* 01.06.2011 ^
If Empty(Sys(2000, tcReport))
Strtofile(Filetostr(Forceext(tcReport, "FRX")), lcFile + "FRX")
Strtofile(Filetostr(Forceext(tcReport, "FRT")), lcFile + "FRT")
Else
lcFile = tcReport
Endif
If Vartype(This._oReports) <> "O"
This._oReports = Createobject("Collection")
This._oClauses = Createobject("Collection")
Endif
This._oReports.Add(Forceext(lcFile, "FRX"))
This._oClauses.Add(Evl(tcClauses, ""))
Endproc
Procedure RunReport
Local lcFoxyPath, lcComunPath
If !'FOXYPREVIEWER' $ Upper(Set("Procedure"))
lcFoxyPath = Iif(Type('gcReportPreviewerPath') = 'C', Addbs(gcReportPreviewerPath) + "FoxyPreviewer.App", "FoxyPreviewer.App")
If !File(lcFoxyPath)
lcComunPath = Left(Addbs(gcAppPath), Rat('\', Addbs(gcAppPath), 2)) + 'COMUNCONTAFIN\'
If !Directory(m.lcComunPath)
lcComunPath = Left(Addbs(gcAppPath), Rat('\', Addbs(gcAppPath), 2)) + 'COMUNROA\'
Endif
lcFoxyPath = lcComunPath + "FoxyPreviewer.App"
If !File(lcFoxyPath)
lcFoxyPath = Addbs(Getfile("app", "FoxyPreviewer.App", "Open", 0, "Alegeti locatia " + m.lcFoxyPath))
Endif
Endif
If Empty(Nvl(m.lcFoxyPath, ''))
Report Form (m.tcRaport) To Printer Prompt Preview
Return
Endif
Set Procedure To (m.lcFoxyPath) Additive
Endif
Local loReport As "PreviewHelper" Of "FoxyPreviewer.App"
loReport = Createobject("PreviewHelper")
* TRY
With loReport
Local N, lnCount
lnCount = This._oReports.Count
For N = 1 To lnCount
loReport.AddReport(This._oReports(N), This._oClauses(N))
*!* LPARAMETERS tcreport, tcclauses, tcalias, tcname
Endfor
If Not Isnull(This.cTitle)
.cTitle = This.cTitle
Endif
If Not Isnull(This.lSendToEmail )
.lSendToEmail = This.lSendToEmail
Endif
If Not Isnull(This.lSaveToFile )
.lSaveToFile = This.lSaveToFile
Endif
If Not Isnull(This.lShowCopies )
.lShowCopies = This.lShowCopies
Endif
If Not Isnull(This.lShowMiniatures )
.lShowMiniatures = This.lShowMiniatures
Endif
If Not Isnull(This.lShowSetup)
.lShowSetup = This.lShowSetup
Endif
If Not Isnull(This.lShowSearch)
.lShowSearch = This.lShowSearch
Endif
If Not Isnull(This.lPrintVisible)
.lPrintVisible = This.lPrintVisible
Endif
If Not Isnull(This.lPrinterPref)
.lPrinterPref = This.lPrinterPref
Endif
If Not Isnull(This.nCopies)
.nCopies = This.nCopies
Endif
If Not Isnull(This.lPrintVisible)
.lPrintVisible = This.lPrintVisible
Endif
If Not Isnull(This.cDefaultListener)
.cDefaultListener = This.cDefaultListener
Endif
If Not Isnull(This.cSuccessor)
.cSuccessor = This.cSuccessor
Endif
If Not Isnull(This.lUseListener)
.lUseListener = This.lUseListener
Endif
If Not Isnull(This.nCanvasCount)
.nCanvasCount = This.nCanvasCount
Endif
If Not Isnull(This.nZoomLevel)
.nZoomLevel = This.nZoomLevel
Endif
If Not Isnull(This.oListener)
.oListener = This.oListener
Endif
If Not Isnull(This.cPrinterName)
.cPrinterName = This.cPrinterName
Endif
If Not Isnull(This.lSaveAsImage)
.lSaveAsImage = This.lSaveAsImage
Endif
If Not Isnull(This.lSaveAsHTML)
.lSaveAsHTML = This.lSaveAsHTML
Endif
If Not Isnull(This.lSaveAsRTF)
.lSaveAsRTF = This.lSaveAsRTF
Endif
If Not Isnull(This.lSaveAsXLS)
.lSaveAsXLS = This.lSaveAsXLS
Endif
If Not Isnull(This.lSaveAsPDF)
.lSaveAsPDF = This.lSaveAsPDF
Endif
If Not Isnull(This.nWindowState)
.nWindowState = This.nWindowState
Endif
If Not Isnull(This.nDockType)
.nDockType = This.nDockType
Endif
If Not Isnull(This.nMaxMiniatureDisplay)
.nMaxMiniatureDisplay = This.nMaxMiniatureDisplay
Endif
If Not Isnull(This.nPDFPageMode)
.nPDFPageMode = This.nPDFPageMode
Endif
If Not Isnull(This.nShowToolBar)
.nShowToolBar = This.nShowToolBar
Endif
If Not Isnull(This.lShowPrinters)
.lShowPrinters = This.lShowPrinters
Endif
If Not Isnull(This.cFormIcon)
.cFormIcon = This.cFormIcon
Endif
If Not Isnull(This.cLanguage)
.cLanguage = This.cLanguage
Endif
If Not Isnull(This.lEmailAuto)
.lEmailAuto = This.lEmailAuto
Endif
If Not Isnull(This.cEmailType)
.cEmailType = This.cEmailType
Endif
If Not Isnull(This.cEmailPRG)
.cEmailPRG = This.cEmailPRG
Endif
If Not Isnull(This.lEmailed)
.lEmailed = This.lEmailed
Endif
*!* 2010-09-17 - Jacques Parent - Add the cSaveDefName
If Not Isnull(This.cSaveDefName)
.cSaveDefName = This.cSaveDefName
Endif
*!* IF NOT ISNULL(This.cCodePage)
*!* .cCodePage = This.cCodePage
*!* ENDIF
If Not Isnull(This.nEmailMode)
.nEmailMode = This.nEmailMode
Endif
If Not Isnull(This.cSMTPServer)
.cSMTPServer = This.cSMTPServer
Endif
If Not Isnull(This.nSMTPPort)
.nSMTPPort = This.nSMTPPort
Endif
If Not Isnull(This.lSMTPUseSSL)
.lSMTPUseSSL = This.lSMTPUseSSL
Endif
If Not Isnull(This.cSMTPUserName)
.cSMTPUserName = This.cSMTPUserName
Endif
If Not Isnull(This.cSMTPPassword)
.cSMTPPassword = This.cSMTPPassword
Endif
If Not Isnull(This.cEmailTo)
.cEmailTo = This.cEmailTo
Endif
If Not Isnull(This.cEmailSubject)
.cEmailSubject = This.cEmailSubject
Endif
If Not Isnull(This.cEmailBody)
.cEmailBody = This.cEmailBody
Endif
If Not Isnull(This.cEmailFrom)
.cEmailFrom = This.cEmailFrom
Endif
If Not Isnull(This.nButtonSize)
.nButtonSize = This.nButtonSize
Endif
If Not Isnull(This.cDestFile)
.cDestFile = This.cDestFile
Endif
If Not Isnull(This.cEmailCC)
.cEmailCC = This.cEmailCC
Endif
If Not Isnull(This.cEmailBCC)
.cEmailBCC = This.cEmailBCC
Endif
If Not Isnull(This.cEmailReplyTo)
.cEmailReplyTo = This.cEmailReplyTo
Endif
*!* proprietatea exista in versiunea 2.01c
If Type('This.lAutoSendMail') <> 'U' And Type('loReport.lAutoSendMail') <> 'U' And Not Isnull(This.lAutoSendMail)
.lAutoSendMail = Not Isnull(This.cDestFile) And This.lAutoSendMail
._lSendingEmail = .lAutoSendMail
Endif
If Not Isnull(This.lSilent)
.lSilent = This.lSilent
Endif
If Not Isnull(This.lDirectPrint) And This.lDirectPrint
.lDirectPrint = .T.
Endif
If Not Isnull(This.lSaveAsTXT)
.lSaveAsTXT = This.lSaveAsTXT
Endif
If Not Isnull(This.cOutputPath)
.cOutputPath = This.cOutputPath
Endif
If Not Isnull(This.nPrinterProptype)
.nPrinterProptype = This.nPrinterProptype
Endif
If Not Isnull(This.nThermType)
.nThermType = This.nThermType
Endif
If Not Isnull(This.nSearchPages)
.nSearchPages = This.nSearchPages
Endif
If Not Isnull(This.cDecryptProcedure)
.cDecryptProcedure = This.cDecryptProcedure
Endif
If Not Isnull(This.cEncryptProcedure)
.cEncryptProcedure = This.cEncryptProcedure
Endif
If Not Isnull(This.cCryptKey)
.cCryptKey = This.cCryptKey
Endif
If Not Isnull(This.lReadReceipt)
.lReadReceipt = This.lReadReceipt
Endif
If Not Isnull(This.lPriority)
.lPriority = This.lPriority
Endif
If Not Isnull(This.cEmailBodyFile)
.cEmailBodyFile = This.cEmailBodyFile
Endif
If Not Isnull(This.lPDFEmbedFonts)
.lPDFEmbedFonts = This.lPDFEmbedFonts
Endif
If Not Isnull(This.lPDFCanPrint)
.lPDFCanPrint = This.lPDFCanPrint
Endif
If Not Isnull(This.lPDFCanEdit)
.lPDFCanEdit = This.lPDFCanEdit
Endif
If Not Isnull(This.lPDFCanCopy)
.lPDFCanCopy = This.lPDFCanCopy
Endif
If Not Isnull(This.lPDFCanAddNotes)
.lPDFCanAddNotes = This.lPDFCanAddNotes
Endif
If Not Isnull(This.lPDFEncryptDocument)
.lPDFEncryptDocument = This.lPDFEncryptDocument
Endif
If Not Isnull(This.cPDFMasterPassword)
.cPDFMasterPassword = This.cPDFMasterPassword
Endif
If Not Isnull(This.cPDFUserPassword)
.cPDFUserPassword = This.cPDFUserPassword
Endif
If Not Isnull(This.lOpenViewer)
.lOpenViewer = This.lOpenViewer
Endif
If Not Isnull(This.cPdfAuthor)
.cPdfAuthor = This.cPdfAuthor
Endif
If Not Isnull(This.cPdfTitle)
.cPdfTitle = This.cPdfTitle
Endif
If Not Isnull(This.cPdfSubject)
.cPdfSubject = This.cPdfSubject
Endif
If Not Isnull(This.cPdfKeyWords)
.cPdfKeyWords = This.cPdfKeyWords
Endif
If Not Isnull(This.cPdfCreator)
.cPdfCreator = This.cPdfCreator
Endif
If Not Isnull(This.lPDFShowErrors)
.lPDFShowErrors = This.lPDFShowErrors
Endif
If Not Isnull(This.cPDFSymbolFontsList)
.cPDFSymbolFontsList = This.cPDFSymbolFontsList
Endif
If Not Isnull(This.cAdressTable)
.cAdressTable = This.cAdressTable
Endif
If Not Isnull(This.cAdressSearch)
.cAdressSearch = This.cAdressSearch
Endif
If Not Isnull(This.cAttachments)
.cAttachments = This.cAttachments
Endif
If Not Isnull(This.lShowClose)
.lShowClose = This.lShowClose
Endif
If Not Isnull(This.cPDFDefaultFont)
.cPDFDefaultFont = This.cPDFDefaultFont
Endif
*!* IF NOT ISNULL(THIS.)
*!* . = THIS.
*!* ENDIF
*!* 27.05.2011
If Used('cparteneriemail')
.cAdressTable = "cparteneriemail"
.cAdressSearch = "denumire"
Endif
*!* 27.05.2011
Endwith
*!* CATCH TO loEx
*!* ENDTRY
loReport.RunReport(This) && This flag will tell FoxyPreviewer that it has a caller object in an EXE
&& The main class will update the properties
&& "lSaved", "lPrinted", "lEmailed", "nVersion", "cVersion", "cErrors"
Endproc
Procedure Destroy
*/ [20100517]... Now supporting Labels also (LBX,LBT) by Nick Porfyris
* Clean up, delete the temporary FRX, FRT, LBX, LBT, ??X, ??T files...
Local N, lnCount, lcFile, lcExtension, lcExtension2
lnCount = This._oReports.Count
For N = 1 To lnCount
lcFile = This._oReports(N)
If Left(Justfname(lcFile), 7) = "TMP_FP_" && We have a temp ??X, ??T files to delete
Try
Delete File (lcFile)
lcExtension = Justext(lcFile)
lcExtension2 = Stuff(lcExtension, Len(lcExtension), 1, [T])
Delete File Forceext(lcFile, lcExtension2)
Catch
Endtry
Endif
Endfor
Endproc
Enddefine
Define Class PreviewerConfig As Custom
***
cVersionFoxyPreview = "2.41a"
cWebsiteFoxyPreview = "http://foxypreviewer.codeplex.com/releases/view/49471"
***
cClauses = ""
***
cPrinterName = Null && SET("Printer",3)
lSaveToFile = Null && = .T. && adds the save to file button
lSendToEmail = Null && = .T. && adds the send to email button
lPrintVisible = Null && = .T. && shows the print button in the toolbar
lShowCopies = Null && = .T. && shows the copies spinner
lShowMiniatures = Null && = .T. && shows the miniatures page
lShowSetup = Null && = .T. && shows the setup configuration form
lPrinterPref = Null && = .T. && shows the printer preferences button
lShowSearch = Null
lShowClose = Null
lClearPrinterInfo = .T. && NULL && = .T. && clears the EXPR, TAG, TAG2 fields of the FRX
* Output types allowed in the "Save as.." button from the toolbar
lSaveAsImage = Null && = .T.
lSaveAsHTML = Null && = .T.
lSaveAsRTF = Null && = .T.
lSaveAsXLS = Null && = .T.
lSaveAsPDF = Null && = .T.
lSaveAsTXT = Null
cOutputPath = Null
nPageTotal = Null && = 0 && Total pages of the current report
nCopies = Null && = 1 && The quantity of copies to be printed
cTitle = Null && = "" && The preview window title
oListener = Null
cDefaultListener = "FOXYLISTENER"
cSuccessor = Null
lUseListener = Null && = .T.
nCanvasCount = Null && = 1 && initial nr of pages rendered on the preview form.
&& Valid values are 1 (default), 2, or 4.
nZoomLevel = Null && = 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
lExtended = Null && = .T. && Flag that tells if the report is being run automatically
&& using the _REPORTPERVIEW global variable
lOpenDestFile = Null && .T. && automatically open the destination file after save
nWindowState = Null && = 0 && Normal
nDockType = Null && = .F.
cDestFile = Null && = "" && the destination file (image, htm, pdf, etc)
lPrinted = Null && = .F. && knows if the user printed the report
lSaved = Null && = .F. && knows if the user saved the report to a file
nVersion = Null
cVersion = Null
cFormIcon = Null && = "" && "wwrite.ico"
lEmailAuto = Null && = .T.
cEmailType = Null && = "PDF"
cEmailPRG = Null && = ""
cSaveDefName = Null && "" *!* 2010-09-17 - Jacques Parent - Add the cSaveDefName
lEmailed = Null && = .F.
cCodePage = Null && = "CP1252" && CodePage, to be used by PDF Listener
&& No more need to leave this property, because this is set automatically
&& left for backwards compatibility
nMaxMiniatureDisplay = Null && = 64 && Number of miniature proof
nPDFPageMode = Null && = 0
cLanguage = Null && = ""
nShowToolBar = Null && = 1 && Visible
lShowPrinters = Null && = .T. && determines if the available printers combo will be shown
lAutoSendMail = Null
nEmailMode = Null && = 1 && 1 = MAPI, 2 = CDOSYS, 3 = Custom procedure
cSMTPServer = Null && = ""
nSMTPPort = Null && = 25
lSMTPUseSSL = Null && = .F.
cSMTPUserName = Null && = ""
cSMTPPassword = Null && = ""
cEmailTo = Null && = ""
cEmailSubject = Null && = ""
cEmailCC = Null
cEmailBCC = Null
cEmailBody = Null && = ""
cEmailFrom = Null && = ""
cEmailReplyTo = Null
cEmailBodyFile = Null
nButtonSize = Null && = 1 && 1=16x16 pixels (default), 2=32x32 pixels
lSilent = Null && Tell Foxypreviewer to stay silent and to write message to the cErrors property
cErrors = ""
lDirectPrint = .F.
nPrinterProptype = Null
nThermType = Null
nSearchPages = Null
cEncryptProcedure = Null
cDecryptProcedure = Null
cCryptKey = Null
lReadReceipt = Null
lPriority = Null
* PDF properties
lPDFEmbedFonts = Null
lPDFCanPrint = Null
lPDFCanEdit = Null
lPDFCanCopy = Null
lPDFCanAddNotes = Null
lPDFEncryptDocument = Null
cPDFMasterPassword = Null
cPDFUserPassword = Null
lOpenViewer = Null
cPdfAuthor = Null
cPdfTitle = Null
cPdfSubject = Null
cPdfKeyWords = Null
cPdfCreator = Null
lPDFShowErrors = Null
cPDFSymbolFontsList = Null
cPDFDefaultFont = Null
cAdressTable = Null
cAdressSearch = Null
cAttachments = Null
Procedure Init
*
Endproc && Init
*!* Seteaza valoarea unei proprietati daca exista sau adauga proprietatea, si intoarce valoarea
Procedure SetValue
Lparameters tcProperty, tuValue
If Type('THIS.&tcProperty') <> 'U'
This.&tcProperty = tuValue
Else
This.AddProperty(tcProperty, tuValue)
Endif
Return This.&tcProperty
Endproc && SetValue
*!* Intoarce valoarea unei proprietati daca exista, altfel valoarea empty() corespunzator tipului proprietatii
Function GetValue
Lparameters tcProperty
Local lcProperty, luValue
lcProperty = 'THIS.' + tcProperty
If Type('THIS.&tcProperty') <> 'U'
luValue = This.&tcProperty
Else
luValue = This.GetDefaultValue(tcProperty)
Endif
Return luValue
Endfunc && GetValue
*!* Intoarce valoarea empty() a unei proprietati dupa tip = prima litera din numele proprietatii daca nu primeste decat tcProperty
*!* Converteste tcValue la tipul variabilei tcProperty daca tcValue e primit ca parametru
Function GetDefaultValue
Lparameters tcProperty, tcValue
Local lcType, luValue
luValue = ""
lcType = Upper(Left(tcProperty, 1))
llEmptyValue = Iif(Pcount() = 1, .T., .F.)
Do Case
Case lcType $ "CM"
luValue = Iif(llEmptyValue, '', tcValue)
Case lcType $ "NIF"
luValue = Iif(llEmptyValue, 0, Val(tcValue))
Case lcType = "T"
luValue = Iif(llEmptyValue, Dtot({}), Ctot(tcValue))
Case lcType = "D"
luValue = Iif(llEmptyValue, {}, Ctod(tcValue))
Case lcType = "L"
luValue = Iif(llEmptyValue, .F., Iif(tcValue = "1" Or Upper(tcValue) = "T" Or Upper(tcValue) = '.T.' Or Upper(tcValue) = 'YES', .T., .F.))
Otherwise
luValue = ""
Endcase
Return luValue
Endfunc && GetDefaultValue
*!* Intoarce .T. daca exista proprietatea
Function HasProperty
Lparameters tcProperty
Local lcProperty, llReturn
lcProperty = 'THIS.' + tcProperty
llReturn = .F.
If Type('THIS.&tcProperty') <> 'U'
llReturn = .T.
Endif
Return llReturn
Endfunc && HasProperty
Enddefine && PreviewerConfig