Files
tasks/programe/rapoarte.prg
2026-04-21 15:46:20 +03:00

976 lines
31 KiB
Plaintext

*** RAPOARTE
*!* Listare raport "LISTAREUSERREPORT(lcAlias, "FRX/XLS", lcRaport)"
*!* Generare raport "do UserReport2File"
*!* Modificare raport "DO MODIFICA_RAPORT_UTILIZATOR"
*!* Printer Setup "sys(1037)"
*!* 26.10.2009
*!* marius.mutu
*!* listareuserreport - cautare raport in getuserreppath si in reg_report_path
*!* listareuserreport - cautare logo.jpg in getuserreppath si in reg_report_path daca nu e dat ca parametru
*!* get_report_path - cautare si creare raport usr in CONTAFIN\USERREPORTS\CONGEST\FIRMA
*!* 04.11.2009
*!* marius.mutu
*!* + GetReportPath - intoarce directorul CONTAFIN\USERREPORTS
*!* Get_Report_Path - tratare variabila glFacturiPersonalizate
*!* listareuserreport - nu am mai folosit get_report_path pentru logo si raport ci GetReportPath(era folosit in ACNPRO si nu era definita variabila glFacturiPersonalizate)
*!* 07.04.2010
*!* marius.mutu
*!* getUserRepPath - lcAppPath = gcAppPath
*!* + getUserRepFile
*!* 30.08.2010
*!* marius.mutu
*!* rapoarte_ultime_modificari
*!* se cere data initiala, data finala, titlu pentru ultimele modificari
*!* ultima versiune instalata sau data initiala <-> versiunea maxima sau data finala
#DEFINE CRLF CHR(13) + CHR(10)
Procedure rapoarte_speciale_cl
Local lcConnect, lnSucces,lAeroare
*!* PRIVATE pdDatainc,pdDataSf
*!* STORE {} to pdDatainc,pdDataSf
*!* pdDatainc = DATE(2007,7,1)
*!* pdDatasf = DATE(2007,7,31)
lcConnect = SQLConnect('ROA_CENTRAL','soft','soft')
lnSucces = SQLExec(lcConnect,[select sters, validat, id_utilizator, id_client, nume_client, id, titlu, localizare, explicatie_client, ] + ;
[ tip_lucrare, special, datal, id_program, nume_program, prenume_utilizator, nume_utilizator, ROUND(ore_lucrate,2) as ore_lucrate ] + ;
[ from luc_vlucrari_clienti_special where special = 1 and DATAL between ]+;
[ to_date(] + Dtos(pdData1) + [,'YYYYMMDD') and to_date(] + Dtos(pdData2) + [,'YYYYMMDD') ] + ;
[order by nume_client, nume_program, datal desc],'crslucCli')
If lnSucces < 0
Aerror(lAeroare)
Messagebox(lAeroare(3))
Else
Select crslucCli
If Reccount() = 0
Messagebox('Nu exista inregistrari pentru selectia facuta',0+16)
ELSE
DO LISTAREUSERREPORT WITH 'crslucCli', 'FRX', 'rap_clienti_special'
*!* Report Form rap_clienti_special To Printer Prompt Preview
Endif
Endif
SQLDisconnect(lcConnect)
Use In (Select("crslucCli"))
Endproc
********************* inceput rapoarte_cl_CONTAFIN ******************
Procedure rapoarte_cl_CONTAFIN
Local lcConnect, lnSucces,lAeroare
lcConnect = SQLConnect('ROA_CENTRAL','soft','soft')
lnSucces= SQLExec(lcConnect,[select * from luc_vlucrari l where ]+;
[ l.tip_lucrare in (2,3) AND l.VALIDAT=1 and l.id_grup = 1 and l.special = 0 ]+;
[ and DATAL between ]+;
[ to_date(']+Dtos(pdData1)+[','YYYYMMDD') and to_date(']+Dtos(pdData2)+[','YYYYMMDD') ]+ ;
[order by nume_program, DATAL desc ],'crslucCli')
If lnSucces < 0
Aerror(lAeroare)
Messagebox(lAeroare(3))
Else
Select crslucCli
If Reccount() = 0
Messagebox('Nu exista inregistrari pentru selectia facuta',0+16)
ELSE
DO LISTAREUSERREPORT WITH 'crslucCli', 'FRX', 'rap_clienti'
*!* Report Form rap_clienti To Printer Prompt Preview
Endif
Endif
SQLDisconnect(lcConnect)
Use In (Select("crslucCli"))
Endproc
********************* inceput rapoarte_cl_ROA ***************************
Procedure rapoarte_cl_ROA
Local lcConnect, lnSucces,lAeroare
Set Date Dmy
Set Century On
*!* pddata1 = DATE(2007,7,1)
*!* pddata2 = DATE(2007,7,31)
lcConnect = SQLConnect('ROA_CENTRAL','soft','soft')
lnSucces = SQLExec(lcConnect,[select * from luc_vlucrari l where ]+;
[ l.tip_lucrare in (2,3) AND l.VALIDAT=1 and l.id_grup = 11 and l.special = 0 ]+;
[ and DATAL between ]+;
[ to_date(] + Dtos(pdData1) + [,'YYYYMMDD') and to_date(] + Dtos(pdData2)+[,'YYYYMMDD') ]+ ;
[order by nume_program, DATAL desc ],'crslucCli')
If lnSucces < 0
Aerror(lAeroare)
Messagebox(lAeroare(3))
Else
Select crslucCli
If Reccount() = 0
Messagebox('Nu exista inregistrari pentru selectia facuta',0+16)
ELSE
DO LISTAREUSERREPORT WITH 'crslucCli', 'FRX', 'rap_clienti'
*!* Report Form rap_clienti To Printer Prompt Preview
Endif
Endif
SQLDisconnect(lcConnect)
Use In (Select("crslucCli"))
Endproc
***************************** soft_trimis_clienti **************************
Procedure soft_trimis_cl
* Select crs_prg_clie
* Report Form rap_inform To Printer Prompt Preview
Endproc
PROCEDURE soft_trimis_cl_manual
LOCAL loFrm
loFrm = CREATEOBJECT("frm_raport_versiuni")
loFrm.Show(1)
RELEASE loFrm
ENDPROC
*************************** rapoarte_ultime_modificari
Procedure rapoarte_ultime_modificari
Lparameters tnCustId, tcListaPrograme
PRIVATE pdDataInitiala, pdDataFinala, pcTitlu
Local lcConnect, lnSucces, lAeroare, lcVersiune, lcSql, x, i, lcLista, lcWhere, lnCustId
* lcVersiune = versiune(crsProgs.versiune)
* lclist = [(]
lnCustId = tnCustId
*!* 30.08.2010
pcTitlu = PADR('BULETIN INFORMATIV', 100, ' ')
pcTitlu = rbInputBox( "Titlu raport", "Titlu", m.pcTitlu)
pdDataInitiala = {}
pdDataInitiala = rbInputBox( "Data initiala", "Data", m.pdDataInitiala)
pdDataFinala = {}
pdDataFinala = rbInputBox( "Data finala", "Data", m.pdDataFinala)
lcSql = [select vsc.program,l.versiune,vsc.versiune_maxima,l.explicatie_client, ] + ;
[ vsc.customer_id,vsc.data_plec, vsc.id as id_program ,l.datal, l.titlu, l.localizare ] + ;
[ from vsc_versiune_max_inst_dv vsc ] + ;
[ join luc_lucrari l on l.id_program = vsc.id ] + ;
[ and ] + IIF(EMPTY(m.pdDataInitiala), [trunc(vsc.data_plec)], [?m.pdDataInitiala]) + [ <= trunc(l.datal) ] + ;
IIF(EMPTY(m.pdDataFinala), [], [ and ?m.pdDataFinala >= trunc(l.datal) ]) + ;
[ where vsc.customer_id = ] + ALLTRIM(STR(lncustid)) + ;
IIF(EMPTY(m.pdDataInitiala), [ and vsc.versiune <> vsc.versiune_maxima ], []) + ;
[ and l.explicatie_client is not null ] + ;
[ and l.versiune <> vsc.versiune ] + ; && v 1.0.38
[ and (L.SPECIAL = 0 OR (L.SPECIAL = 1 AND l.id_client = ] + ALLTRIM(STR(lncustid)) + [)) ] + ;
[ order by 1]
*!* 30.08.2010 ^
goExecutor.oexecute(lcSql,"crsTest")
*!* 25.01.2011
*!* x = SQLConnect("JCSSERVER","SOFT_SERII","123")
x = SQLConnect(goApp.cHostSerii, goApp.cUsernameSerii, goApp.cPasswordSerii)
If x < 0
AERROR(laEroare)
MESSAGEBOX(laEroare(3))
Return
Endif
*!* 25.01.2011 ^
lcSql = [select DISTINCT customer_id, NUME, ID_PROGRAM, (CASE WHEN Upper(PROGRAM) ] + ;
[LIKE 'INDEX%' THEN 'MANUAL' ELSE PROGRAM END) AS PROGRAM from vgen_programe ]
lnSucces = SQLExec(x, lcSql, "crsProgsTemp1") && crsprogstemp1
* [WHERE ID_CLIENT =]+Transform(lnIdClient)+[ ORDER BY 2, 4]
SQLDisconnect(x)
* lcwhere =[ WHERE ] + IIF(ALLTRIM(tcListaPrograme)!=[()],[ct.id_program in &tcListaPrograme ],[1=2 ] )
If Alltrim(tcListaPrograme)!=[()]
lcWhere = [ where cp.id_program in ] + tcListaPrograme
Else
lcWhere = [ where 1=2 ]
Endif
Select ct.Program As nume_program, ct.explicatie_client, ct.datal, ct.titlu, ;
ct.localizare, ct.versiune, ct.versiune_maxima ;
From crsTest ct;
JOIN crsprogstemp1 cp On cp.customer_id = ct.customer_id And cp.id_program = ct.id_program ;
&lcWhere ;
ORDER By ct.Program, ct.datal Into Cursor crslucCli
Select Min(datal) As data1, Max(datal) As Data2 From crslucCli Into Cursor crsData
Select crsData
pdData1 = data1
pdData2 = data2
Select crslucCli
If Reccount() = 0
Messagebox('Nu exista inregistrari pentru selectia facuta',0+16)
Else
*!* Report Form rap_clienti To Printer Prompt Preview
DO LISTAREUSERREPORT WITH 'crslucCli', 'FRX', 'rap_clienti'
&& tcAlias, tcTipExport, tcRaport, tcLogoPath, tcReportPreviewer, toPreviewerConfig && tcDestinationFile, tlDontOpenFile
Endif
Release paAles
Use In (Select("crstest"))
Use In (Select("crsprogstemp1"))
Use In (Select("crslucCli"))
Endproc && rapoarte_ultime_modificari^
********************* INCEPUT GetReportPath **********************
* PROCEDURE GetReportPath ( tcReportName )
* Date : 04.11.2009
* author : marius.mutu
* description: intoarce calea CONTAFIN\USERREPORTS
******************************************
PROCEDURE GetReportPath
Local lcAppPath, lcAppName, liAt, lcDirgen, lcUserRepPath,lcAlias
lcAppPath=Addbs(Justpath(Sys(16,0)))
lcAppName=Allt(Uppe(Juststem(Sys(16,0))))
liAt=Rat("\",lcAppPath,2)
lcDirgen=Addbs(Left(lcAppPath,liAt-1))
lcUserRepPath = lcDirgen + 'USERREPORTS\'
If !Directory(lcUserRepPath)
Md (lcUserRepPath)
ENDIF
RETURN lcUserRepPath
ENDPROC
********************* INCEPUT Get_report_path **********************
* PROCEDURE Get_report_path( tcReportName )
* Date : 26.04.2005, 16:22:03
* author : marius.mutu
* description: intoarce calea raportului (EXE SAU USERREPORTPATH\PROGRAM\FIRMA\USR_RAPORT.FRX daca glFacturiPersonalizate)
******************************************
Procedure Get_report_path
Lparameters tcReportName
Local lcReportName, llFacturiPersonalizate
lcReportName = Alltrim(tcReportName) + ".FRX"
*!* 04.11.2009
llFacturiPersonalizate = .F.
IF TYPE('glFacturiPersonalizate') <> 'U'
llFacturiPersonalizate = glFacturiPersonalizate
ENDIF
*!* 04.11.2009 ^
If llFacturiPersonalizate
*!* 26.10.2009
*!* lcFile = GetReportPath() + "USR_" + lcReportName
lcFile = getUserRepPath() + "USR_" + lcReportName
*!* 26.10.2009 ^
If !File(lcFile)
Use (lcReportName) In 0 Alias UserReport Again Shared
Select UserReport
Copy To (lcFile)
Use In UserReport
Endif
lcReportPath = lcFile
Else
lcReportPath = lcReportName
Endif
Return lcReportPath
Endproc
********************* SFARSIT Get_report_path **********************
********************* INCEPUT Modifica_raport_utilizator **********************
* PROCEDURE Modifica_raport_utilizator( )
* Date : 26.04.2005, 17:44:33
* author : marius.mutu
* description:
Procedure Modifica_raport_utilizator( )
Cd (gcUserReports)
lcFile = Getfile("frx","Alegeti un raport","Alege")
If File(lcFile) And Upper(Justext(lcFile)) = "FRX"
Modify Report (lcFile)
Endif
Endproc
********************* SFARSIT Modifica_raport_utilizator **********************
*!* PROCEDURI_RAPOARTE.PRG
*!* LISTARE RAPORT UTILIZATOR
*!* PARAMETRI : tcAlias - alias-ul cursorului; tcTipExport - FRX/XLS; tcRaport - numele raportului; tcLogoPath - daca pe raport trebuie sa am o imagine logo in acelasi director cu raportul
*!* Se listeaza raportul USR_<tcRaport> din directorul \\SERVER\ROA\USERREPORTS\<APPLICATIE>\<FIRMA>\ daca exista
*!* Daca nu exista raporturl USR_<tcRaport> se listeaza raportul <tcRaport> default
*!* tcReportPreviewer - procedura pentru preview rapoarte "FoxyPreview" (default gcReportPreviewer)
*!* toPreviewerConfig - obiect PreviewerConfig cu setari pentru tcReportPreviewer
Procedure LISTAREUSERREPORT
Lparameters tcAlias, tcTipExport, tcRaport, tcLogoPath, tcReportPreviewer, toPreviewerConfig && tcDestinationFile, tlDontOpenFile
Local lcEroare, laEroare,llEroare
Dimension laEroare[1,1]
Local lcSelect, lcRaportPath, lcTipExport, lcLogoPath, lcLogoPathDest, llDeleteRaport, llDeleteLogo
LOCAL lcOldReportPreview, lcOldReportBehaviour
LOCAL loEx
llDeleteRaport = .F.
llDeleteLogo = .F.
*!* 07.04.2010
LOCAL lcReportPreviewer
lcReportPreviewer = IIF(EMPTY(tcReportPreviewer), IIF(TYPE('gcReportPreviewer') = 'C', gcReportPreviewer, ""), tcReportPreviewer)
*!* 07.04.2010 ^
If Type('tcTipExport') = 'C'
lcTipExport = Upper(Alltrim(tcTipExport))
Else
If Empty(tcRaport)
lcTipExport = 'XLS'
Else
lcTipExport = 'FRX'
Endif
Endif
If Empty(tcAlias)
Return
Endif
If !Used(tcAlias)
Return
Endif
*!* 26.10.2009
lcLogoPath = Iif(Type('tcLogoPath') <> 'C' Or Empty(tcLogoPath), getUserRepPath() + 'logo.jpg', tcLogoPath) && USERREPORTS\PROGRAM\FIRMA\LOGO.JPG
If !File(lcLogoPath)
lcLogoPath = GetReportPath() + 'logo.jpg' && USERREPORTS\LOGO.JPG
If !File(lcLogoPath)
lcLogoPath = ''
ENDIF
ENDIF
*!* 26.10.2009 ^
Do Case
Case lcTipExport = 'FRX'
lcRaportPath = getUserRepPath() + [USR_] + Juststem(tcRaport) + [.FRX] && USERREPORTS\PROGRAM\FIRMA\USR_RAPORT.FRX
*!* 04.11.2009
IF !FILE(lcRaportPath)
lcRaportPath = GetReportPath() + [USR_] + Juststem(tcRaport) + [.FRX] && USERREPORTS\USR_RAPORT.FRX
*!* Get_report_path(Juststem(tcRaport))
ENDIF
*!* 04.11.2009 ^
If !File(lcRaportPath)
lcRaportPath = tcRaport && raportul din executabil
If !Empty(lcLogoPath)
***--- inlocuire logo
lcRaport = Juststem(tcRaport) + [.FRX]
lcRaportPath = Addbs(gcTempPath) + [USR_] + lcRaport
*!* 07.04.2010
lcLogoPathDest = Addbs(gcTempPath) + JUSTFNAME(lcLogoPath) && "logo.jpg"
*!* 07.04.2010 ^
If Used(Juststem(lcRaportPath))
Use In (Select(Juststem(lcRaportPath)))
Endif
Use (lcRaport) In 0 Alias rapFactura
Select rapFactura
Copy To (lcRaportPath)
Use In (Select('rapFactura'))
Use In Select(Juststem(lcRaport))
Copy File (lcLogoPath) To (lcLogoPathDest)
llDeleteRaport = .T.
llDeleteLogo = .T.
Endif
***---
Endif
lcSelect = Select()
If !Empty(tcAlias) And Used(tcAlias)
Select (tcAlias)
Endif
lcError = On('error')
llEroare = .F.
On Error llEroare = .T.
Do While .T.
*!* 07.04.2010
DO CASE
CASE EMPTY(lcReportPreviewer)
Report Form (lcRaportPath) To Printer Prompt Preview
CASE VERSION(5) < 800
Report Form (lcRaportPath) To Printer Prompt Preview
OTHERWISE
TRY
lcOldReportBehaviour = SET("ReportBehavior")
DO &lcReportPreviewer WITH lcRaportPath, toPreviewerConfig && tcDestinationFile, tlDontOpenFile
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)
* llEroare = .F.
Report Form (lcRaportPath) To Printer Prompt Preview
ENDTRY
ENDCASE
*!* 07.04.2010 ^
If llEroare
Aerror(laEroare)
If laEroare[1] = 1958
lnRaspuns = Messagebox("Eroare la driverul imprimantei.Doriti sa reincercati listarea?",4+32+256,"Confirmare relistare")
If lnRaspuns <> 6
Exit
Else
llEroare = .F.
Endif
Else
Messagebox(laEroare[2] + [ ] + Alltrim(Str(laEroare[1])) + [ ] + ALLTRIM(TRANSFORM(laEroare(3))))
Exit
Endif
Else
Exit
Endif
Enddo
On Error &lcError
Select (lcSelect)
Case lcTipExport = 'XLS'
export_xls(tcAlias)
Endcase
If llDeleteRaport And File(lcRaportPath)
Delete File FORCEEXT(lcRaportPath,'*')
Endif
If llDeleteLogo And File(lcLogoPathDest)
Delete File (lcLogoPathDest)
Endif
Release lcEroare, laEroare,llEroare
Endproc && LISTAREUSERREPORT
********************* INCEPUT Modifica_raport_utilizator **********************
* PROCEDURE Modifica_raport_utilizator
* Date : 26.07.2006, 17:44:33
* author : marius.mutu
Procedure Modifica_raport_utilizator
lcUserRepPath = getUserRepPath()
Cd (lcUserRepPath)
lcFile = Getfile("frx","Alegeti un raport","Alege")
If File(lcFile) And Upper(Justext(lcFile)) = "FRX"
Modify Report (lcFile)
Endif
Endproc && Modifica_raport_utilizator
********************* SFARSIT Modifica_raport_utilizator **********************
*!* INTOARCE DIRECTORUL CU RAPOARTE UTILIZATOR PENTRU APLICATIA, SCHEMA CURENTA
Function getUserRepPath
Local lcAppPath, lcAppName, liAt, lcDirgen, lcUserRepPath,lcAlias
*!* 07.04.2010
IF TYPE('gcAppPath') = 'C'
lcAppPath = gcAppPath
ELSE
lcAppPath=Addbs(Justpath(Sys(16,0)))
lcAppPath = STRTRAN(lcAppPath,'PROGRAME\','')
ENDIF
IF TYPE('gcAppName') = 'C'
lcAppName = gcAppName
ELSE
lcAppName = Allt(Uppe(Juststem(Sys(16,0))))
ENDIF
*!* 07.04.2010 ^
liAt=Rat("\",lcAppPath,2)
lcDirgen=Addbs(Left(lcAppPath,liAt-1))
lcUserRepPath = lcDirgen + 'USERREPORTS\'
If !Directory(lcUserRepPath)
Md (lcUserRepPath)
Endif
lcUserRepPath = lcUserRepPath + lcAppName + '\'
If !Directory(lcUserRepPath)
Md (lcUserRepPath)
Endif
lcUserRepPath = lcUserRepPath + IIF(TYPE('nfscurt') = 'C', ALLTRIM(m.nfscurt) + '\', '')
If !Directory(lcUserRepPath)
Md (lcUserRepPath)
Endif
Return lcUserRepPath
Endfunc
****************************************************************************
*!* extrage frx din executabil pe disc in directorul USERREPORTS
Procedure UserReport2File
Lparameters tcRaport
Local lcRaport, lcFile
If Empty(tcRaport)
lcRaport= Inputbox("Raport","Scrieti numele raportului","raport.frx")
Else
lcRaport = tcRaport
Endif
If Empty(lcRaport)
Return
Endif
lcRaport = Juststem(lcRaport) + '.frx'
lcFile = getUserRepPath() + "USR_" + lcRaport
If File(lcFile)
Return
Endif
*!* TRY
*!* USE (lcRaport) IN 0 again SHARED ALIAS crsRaportTemp
*!* ENDTRY
If !File(lcRaport)
Messagebox('Nu exista raportul ' + lcRaport)
Else
Use (lcRaport) In 0 Again Shared Alias crsRaportTemp
Select crsRaportTemp
Copy To (lcFile)
Use In crsRaportTemp
Endif
Endproc && UserReport2File
*!* INTOARCE CALEA COMPLETA A RAPORTULUI UTILIZATOR USR_<RAPORT>.FRX, DACA EXISTA, ALTFEL, <RAPORT.FRX>
FUNCTION getUserRepFile
LPARAMETERS tcRaport
LOCAL lcRaportFile
lcRaportFile = getUserRepPath() + [USR_] + Juststem(tcRaport) + [.FRX] && USERREPORTS\PROGRAM\FIRMA\USR_RAPORT.FRX
IF !FILE(lcRaportFile)
lcRaportFile = Juststem(tcRaport) + [.FRX] && RAPORTUL IN EXECUTABIL
ENDIF
RETURN lcRaportFile
ENDFUNC && getUserRepFile
*!* Previewer rapoarte - foloseste gcReportPreviewerPath / gcAppPath pentru localizarea FoxyPreviewer.App
Procedure FoxyPreview
Lparameters tcRaport, toPreviewerConfig && tcDestinationFile, tlDontOpenFile
Local lcRaport, lcFoxyPath, lcComunContafinPath
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)
lcComunContafinPath = LEFT(ADDBS(gcAppPath), RAT('\',ADDBS(gcAppPath),2)) + 'COMUNCONTAFIN\'
lcFoxyPath = lcComunContafinPath + "FoxyPreviewer.App"
IF !FILE(lcFoxyPath)
lcFoxyPath = ADDBS(GETFILE("app","FoxyPreviewer.App","Open",0,"Alegeti locatia COMUNCONTAFIN\FoxyPreviewer.App"))
ENDIF
ENDIF
IF EMPTY(NVL(lcFoxyPath,''))
Report Form (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 (tcRaport) To Printer Prompt Preview
RETURN
ENDIF
With loReport As ReportHelper
.AddReport(m.lcRaport, toPreviewerConfig.GetValue("cClauses"))
**********************************************
* Optional available parameters
**********************************************
.cTitle = toPreviewerConfig.GetValue("cTitle")
.cDestFile = toPreviewerConfig.GetValue("cDestFile") && destination file - if not empty then save without preview
.lSendToEmail = toPreviewerConfig.GetValue("lSendToEmail") && adds the send to email button
.lSaveToFile = toPreviewerConfig.GetValue("lSaveToFile") && adds the save to file button
.lSaveAsImage = toPreviewerConfig.GetValue("lSaveAsImage")
.lSaveAsHTML = toPreviewerConfig.GetValue("lSaveAsHTML")
.lSaveAsRTF = toPreviewerConfig.GetValue("lSaveAsRTF")
.lSaveAsXLS = toPreviewerConfig.GetValue("lSaveAsXLS")
.lSaveAsPDF = toPreviewerConfig.GetValue("lSaveAsPDF")
.lShowCopies = toPreviewerConfig.GetValue("lShowCopies") && shows the copies spinner
.lShowMiniatures = toPreviewerConfig.GetValue("lShowMiniatures") && shows the miniatures page
.nCopies = toPreviewerConfig.GetValue("nCopies") && The quantity of copies to be printed
.lPrintVisible = toPreviewerConfig.GetValue("lPrintVisible") && shows the print button in the toolbar
.cDefaultListener = toPreviewerConfig.GetValue("cDefaultListener")
.nCanvasCount = toPreviewerConfig.GetValue("nCanvasCount") && initial nr of pages rendered on the preview form.
*!* && Valid values are 1 (default), 2, or 4.
.nZoomLevel = toPreviewerConfig.GetValue("nZoomLevel") && 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
.lPDFasImage = toPreviewerConfig.GetValue("lPDFasImage")
.lPrinterPref = toPreviewerConfig.GetValue("lPrinterPref")
.oListener = toPreviewerConfig.GetValue("oListener")
.cPrinterName = toPreviewerConfig.GetValue("cPrinterName")
.nWindowState = toPreviewerConfig.GetValue("nWindowState")
.nDockType = toPreviewerConfig.GetValue("nDockType")
.cFormIcon = toPreviewerConfig.GetValue("cFormIcon")
.lEmailAuto = toPreviewerConfig.GetValue("lEmailAuto")
.cEmailType = toPreviewerConfig.GetValue("cEmailType")
.lEmailed = toPreviewerConfig.GetValue("lEmailed")
.cCodePage = toPreviewerConfig.GetValue("cCodePage")
**********************************************
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
cPrinterName = SET("Printer",3)
lSaveToFile = .T. && adds the save to file button
lSendToEmail = .T. && adds the send to email button
lPrintVisible = .T. && shows the print button in the toolbar
lShowCopies = .T. && shows the copies spinner
lShowMiniatures = .T. && shows the miniatures page
lPrinterPref = .T. && shows the printer preferences button
* Output types allowed in the "Save as.." button from the toolbar
lSaveAsImage = .T.
lSaveAsHTML = .T.
lSaveAsRTF = .T.
lSaveAsXLS = .T.
lSaveAsPDF = .T.
nPageTotal = 0 && Total pages of the current report
nCopies = 1 && The quantity of copies to be printed
cTitle = "" && The preview window title
oListener = NULL
cDefaultListener = "FXLISTENER"
nCanvasCount = 1 && initial nr of pages rendered on the preview form.
&& Valid values are 1 (default), 2, or 4.
nZoomLevel = 5 && initial zoom level of the preview window. Possible values are:
&& 1-10%, 2-25%, 3-50%, 4-75%, 5-100% default, 6-150% ;
&& 7-200%, 8-300%, 9-500%, 10-whole page
lExtended = .T. && Flag that tells if the report is being run automatically
&& using the _REPORTPERVIEW global variable
nWindowState = 0 && Normal
nDockType = .F.
cDestFile = "" && the destination file (image, htm, pdf, etc)
lPrinted = .F. && knows if the user printed the report
lSaved = .F. && knows if the user saved the report to a file
cFormIcon = "" && "wwrite.ico"
lEmailAuto = .T.
cEmailType = "PDF"
lEmailed = .F.
cCodePage = "CP1252" && CodePage, to be used by PDF Listener
lPDFasImage = .F.
* Internal use properties
_oReports = "" && Internal use, collection that contains the report names to be used
_oClauses = ""
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
lcFile = lcTempDir + "TMP_FP_" + SYS(2015) + "."
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, lcComunContafinPath
If !'FOXYPREVIEWER'$Upper(Set("Procedure"))
lcFoxyPath = IIF(TYPE('gcReportPreviewerPath') = 'C', ADDBS(gcReportPreviewerPath) + "FoxyPreviewer.App", "FoxyPreviewer.App")
IF !FILE(lcFoxyPath)
lcComunContafinPath = LEFT(ADDBS(gcAppPath), RAT('\',ADDBS(gcAppPath),2)) + 'COMUNCONTAFIN\'
lcFoxyPath = lcComunContafinPath + "FoxyPreviewer.App"
IF !FILE(lcFoxyPath)
lcFoxyPath = ADDBS(GETFILE("app","FoxyPreviewer.App","Open",0,"Alegeti locatia COMUNCONTAFIN\FoxyPreviewer.App"))
ENDIF
ENDIF
IF EMPTY(NVL(lcFoxyPath,''))
Report Form (tcRaport) To Printer Prompt Preview
RETURN
ENDIF
Set Procedure To (lcFoxyPath) Additive
ENDIF
LOCAL loReport as "PreviewHelper" OF "FoxyPreviewer.App"
loReport = CREATEOBJECT("PreviewHelper")
WITH loReport
LOCAL n, lnCount
lnCount = This._oReports.Count
FOR n = 1 TO lnCount
loReport.AddReport(This._oReports(n), This._oClauses(n))
ENDFOR
.cTitle = This.cTitle
.lSendToEmail = This.lSendToEmail
.lSaveToFile = This.lSaveToFile
.lShowCopies = This.lShowCopies
.lShowMiniatures = This.lShowMiniatures
.lPrintVisible = This.lPrintVisible
.lPrinterPref = This.lPrinterPref
.nCopies = This.nCopies
.lPrintVisible = This.lPrintVisible
.cDefaultListener = This.cDefaultListener
.nCanvasCount = This.nCanvasCount
.nZoomLevel = This.nZoomLevel
.oListener = This.oListener
.cPrinterName = This.cPrinterName
.lSaveAsImage = This.lSaveAsImage
.lSaveAsHTML = This.lSaveAsHTML
.lSaveAsRTF = This.lSaveAsRTF
.lSaveAsXLS = This.lSaveAsXLS
.lSaveAsPDF = This.lSaveAsPDF
.nWindowState = This.nWindowState
.nDockType = This.nDockType
.cDestFile = This.cDestFile
IF NOT EMPTY(This.cFormIcon)
.cFormIcon = This.cFormIcon
ENDIF
.lEmailAuto = This.lEmailAuto
.cEmailType = This.cEmailType
.lEmailed = This.lEmailed
.cCodePage = This.cCodePage
.lPDFasImage = This.lPDFasImage
ENDWITH
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" and "lPrinted"
ENDPROC
PROCEDURE Destroy
* Clean up, delete the temporary FRX files
LOCAL n, lnCount, lcFile
lnCount = This._oReports.Count
FOR n = 1 TO lnCount
lcFile = This._oReports(n)
IF LEFT(JUSTFNAME(lcFile),7) = "TMP_FP_" && We have a temp FRX file to delete
TRY
DELETE FILE (lcFile)
DELETE FILE FORCEEXT(lcFile, "FRT")
CATCH
ENDTRY
ENDIF
ENDFOR
ENDPROC
ENDDEFINE
DEFINE CLASS PreviewerConfig as Custom
cPrinterName = SET("Printer",3)
lSaveToFile = .T. && adds the save to file button
lSendToEmail = .T. && adds the send to email button
lPrintVisible = .T. && shows the print button in the toolbar
lShowCopies = .T. && shows the copies spinner
lShowMiniatures = .T. && shows the miniatures page
lPrinterPref = .T. && shows the printer preferences button
* Output types allowed in the "Save as.." button from the toolbar
lSaveAsImage = .T.
lSaveAsHTML = .T.
lSaveAsRTF = .T.
lSaveAsXLS = .T.
lSaveAsPDF = .T.
nPageTotal = 0 && Total pages of the current report
nCopies = 1 && The quantity of copies to be printed
cTitle = "" && The preview window title
oListener = NULL
cDefaultListener = "FXLISTENER"
nCanvasCount = 1 && initial nr of pages rendered on the preview form.
&& Valid values are 1 (default), 2, or 4.
nZoomLevel = 5 && initial zoom level of the preview window. Possible values are:
&& 1-10%, 2-25%, 3-50%, 4-75%, 5-100% default, 6-150% ;
&& 7-200%, 8-300%, 9-500%, 10-whole page
lExtended = .T. && Flag that tells if the report is being run automatically
&& using the _REPORTPERVIEW global variable
nWindowState = 0 && Normal
nDockType = .F.
cDestFile = "" && the destination file (image, htm, pdf, etc)
lOpenDestFile = .T. && automatically open the destination file after save
*!* lPrinted = .F. && knows if the user printed the report
*!* lSaved = .F. && knows if the user saved the report to a file
cFormIcon = "" && "wwrite.ico"
lEmailAuto = .T.
cEmailType = "PDF"
*!* lEmailed = .F.
cCodePage = "CP1252" && CodePage, to be used by PDF Listener
lPDFasImage = .F. && save PDF as image
cClauses = ""
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