Import initial din SVN ROAAUTO/Trunk @HEAD
This commit is contained in:
315
COMUN/programe/proceduri_rapoarte.prg
Normal file
315
COMUN/programe/proceduri_rapoarte.prg
Normal file
@@ -0,0 +1,315 @@
|
||||
*!* PROCEDURI_RAPOARTE.PRG
|
||||
*!* 19.02.2009 marius.mutu
|
||||
*!* LISTAREUSERREPORT - calea se citeste din goExport.GetRepPath
|
||||
|
||||
*!* 23.01.2020
|
||||
*!* marius.mutu
|
||||
*!* Salveaza un raport de pe disk in baza de date
|
||||
|
||||
PROCEDURE LISTAREUSERREPORT_HASH
|
||||
LPARAMETERS toHash
|
||||
|
||||
LOCAL lcAlias, lcTipExport, lcRaport, loListener, lnPreview, lcImprimanta, lcCommandClauses
|
||||
|
||||
lcAlias = toHash.GetValue("cAlias")
|
||||
lcTipExport = toHash.GetValue("cTipExport")
|
||||
lcRaport = toHash.GetValue("cRaport")
|
||||
loListener = toHash.GetValue("oListener")
|
||||
lnPreview = toHash.GetValue("nPreview")
|
||||
lcImprimanta = toHash.GetValue("cImprimanta")
|
||||
lcCommandClauses = toHash.GetValue("cCommandClauses")
|
||||
IF EMPTY(lcTipExport)
|
||||
lcTipExport = 'FRX'
|
||||
ENDIF
|
||||
IF EMPTY(lcAlias)
|
||||
lcAlias = ALIAS()
|
||||
ENDIF
|
||||
|
||||
DO LISTAREUSERREPORT WITH lcAlias, lcTipExport, lcRaport, loListener, lnPreview, lcImprimanta, lcCommandClauses
|
||||
ENDPROC && LISTAREUSERREPORT_HASH
|
||||
|
||||
|
||||
*!* LISTARE RAPORT UTILIZATOR
|
||||
*!* PARAMETRI : tcAlias - alias-ul cursorului; tcTipExport - FRX/XLS; tcRaport - numele raportului
|
||||
*!* 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
|
||||
PROCEDURE LISTAREUSERREPORT
|
||||
LPARAMETERS tcAlias, tcTipExport, tcRaport, toListener, tnPreview, tcImprimanta, tcCommandClauses
|
||||
** Valori pentru tnPreview
|
||||
** 1 - cu vizualizare
|
||||
** 2 - listare directa
|
||||
** tcCommandClauses: PROMPT PREVIEW NOEJECT NORESET
|
||||
|
||||
LOCAL lcSelect, lcRaportPath, lcTipExport, lnPreview, lcImprimanta, lcCommandClauses
|
||||
STORE [] TO lcImprimanta
|
||||
|
||||
LOCAL loExport
|
||||
IF TYPE('goExport') = 'U'
|
||||
IF !'oexport'$LOWER(SET("Procedure"))
|
||||
SET PROCEDURE TO oexport.prg ADDITIVE
|
||||
ENDIF
|
||||
loExport = Createobject("oExportConfig")
|
||||
ELSE
|
||||
loExport = goExport
|
||||
ENDIF
|
||||
|
||||
IF TYPE('tcCommandClauses') = 'C'
|
||||
lcCommandClauses = tcCommandClauses
|
||||
ELSE
|
||||
lcCommandClauses = ""
|
||||
ENDIF
|
||||
|
||||
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
|
||||
IF EMPTY(tnPreview)
|
||||
lnPreview = 1
|
||||
ELSE
|
||||
lnPreview = tnPreview
|
||||
ENDIF
|
||||
|
||||
DO CASE
|
||||
CASE lcTipExport = 'FRX'
|
||||
IF !EMPTY(tcImprimanta)
|
||||
*!* verificare ca tcImprimanta este instalata pe calculatorul respectiv
|
||||
IF APRINTERS(laPrinters) > 0 AND ASCAN(laPrinters,tcImprimanta,1,ALEN(laPrinters,1),1,15) > 0
|
||||
lcImprimanta = tcImprimanta
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
RELEASE laPrinters
|
||||
|
||||
lcRaportPath = loExport.GetRepPath(tcRaport)
|
||||
*!* lcRaportPath = getUserRepPath() + [USR_] + JUSTSTEM(tcRaport) + [.FRX]
|
||||
|
||||
*!* IF !FILE(lcRaportPath)
|
||||
*!* lcRaportPath = tcRaport
|
||||
*!* ENDIF
|
||||
|
||||
lcSelect = SELECT()
|
||||
IF !EMPTY(tcAlias) AND USED(tcAlias)
|
||||
SELECT (tcAlias)
|
||||
ENDIF
|
||||
|
||||
lnRaspuns = 6
|
||||
DO WHILE lnRaspuns = 6
|
||||
TRY
|
||||
IF TYPE('toListener') = 'O'
|
||||
IF TYPE('gcReportOutput') = 'U'
|
||||
PUBLIC gcReportOutput
|
||||
gcReportOutput = ""
|
||||
ENDIF
|
||||
|
||||
IF EMPTY(gcReportOutput)
|
||||
gcReportOutput = gcAppPath + "ReportOutput.app"
|
||||
ENDIF
|
||||
|
||||
IF TYPE('gcReportPreview') = 'U'
|
||||
PUBLIC gcReportPreview
|
||||
gcReportPreview = ""
|
||||
ENDIF
|
||||
|
||||
IF EMPTY(gcReportPreview)
|
||||
gcReportPreview = gcAppPath + "ReportPreview.app"
|
||||
IF !FILE(m.gcReportPreview)
|
||||
AMESSAGEBOX('Nu exista fisierul ' + gcReportPreview, 0+48,_screen.Caption)
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
_REPORTOUTPUT = gcReportOutput
|
||||
_REPORTPREVIEW = gcReportPreview
|
||||
* LCREPORT = 'REPORT FORM (' + lcRaportPath + ') OBJECT toListener ' + lcCommandClauses
|
||||
* WAIT WINDOW LCREPORT
|
||||
REPORT FORM (lcRaportPath) OBJECT toListener &lcCommandClauses
|
||||
ELSE
|
||||
IF lnPreview = 1
|
||||
KEYBOARD '{CTRL+F10}'
|
||||
REPORT FORM (lcRaportPath) TO PRINTER PROMPT PREVIEW
|
||||
ELSE
|
||||
IF !EMPTY(lcImprimanta)
|
||||
lcImprimantaTemp = SYS(6)
|
||||
SET PRINTER TO NAME (lcImprimanta)
|
||||
REPORT FORM (lcRaportPath) TO PRINTER
|
||||
IF !EMPTY(NVL(lcImprimantaTemp,[]))
|
||||
SET PRINTER TO (lcImprimantaTemp)
|
||||
ELSE
|
||||
SET PRINTER TO
|
||||
ENDIF
|
||||
ELSE
|
||||
REPORT FORM (lcRaportPath) 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
|
||||
|
||||
SELECT (lcSelect)
|
||||
|
||||
CASE lcTipExport = 'XLS'
|
||||
export_xls(tcAlias)
|
||||
ENDCASE
|
||||
|
||||
|
||||
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
|
||||
*!* lcAppPath=ADDBS(JUSTPATH(SYS(16,0)))
|
||||
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)
|
||||
MD (lcUserRepPath)
|
||||
ENDIF
|
||||
lcUserRepPath = lcUserRepPath + gcS + '\'
|
||||
IF !DIRECTORY(lcUserRepPath)
|
||||
MD (lcUserRepPath)
|
||||
ENDIF
|
||||
lcUserRepPath = lcUserRepPath + lcAppName + '\'
|
||||
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
|
||||
|
||||
LOCAL loExport
|
||||
IF TYPE('goExport') = 'U'
|
||||
IF !'oexport'$LOWER(SET("Procedure"))
|
||||
SET PROCEDURE TO oexport.prg ADDITIVE
|
||||
ENDIF
|
||||
loExport = Createobject("oExportConfig")
|
||||
ELSE
|
||||
loExport = goExport
|
||||
ENDIF
|
||||
|
||||
|
||||
lcRaport = JUSTSTEM(lcRaport) + '.frx'
|
||||
|
||||
*!* lcFile = getUserRepPath() + "USR_" + lcRaport
|
||||
lcFile = loExport.GetRepPath(lcRaport)
|
||||
|
||||
IF FILE(lcFile)
|
||||
AMESSAGEBOX('Raportul ' + lcFile + ' exista deja!', 0+48, _screen.Caption)
|
||||
RETURN
|
||||
ENDIF
|
||||
|
||||
*!* TRY
|
||||
*!* USE (lcRaport) IN 0 again SHARED ALIAS crsRaportTemp
|
||||
*!* ENDTRY
|
||||
|
||||
IF !FILE(lcRaport)
|
||||
aMESSAGEBOX('Nu exista raportul ' + lcRaport, 0+48, _screen.Caption)
|
||||
ELSE
|
||||
USE (lcRaport) IN 0 AGAIN SHARED ALIAS crsRaportTemp
|
||||
SELECT crsRaportTemp
|
||||
COPY TO (lcFile)
|
||||
USE IN crsRaportTemp
|
||||
AMESSAGEBOX('S-a creat raportul ' + lcFile, 0+48, _screen.Caption)
|
||||
ENDIF
|
||||
|
||||
ENDPROC && UserReport2File
|
||||
|
||||
****************************************************************************
|
||||
* Salveaza un raport de pe disk in baza de date
|
||||
****************************************************************************
|
||||
PROCEDURE Report2Database
|
||||
Local lcFrtFileName, lcFrtInputFile, lcFrxFileName, lcFrxInputFile, llSucces, lnId
|
||||
llSucces = .F.
|
||||
lcInputFile = GETFILE('FRX', 'Alege un fisier FRX', 'Alege',0, 'Alege un fisier FRX')
|
||||
|
||||
IF !EMPTY(m.lcInputFile)
|
||||
lcFrxFileName = Forceext(Lower(Justfname(m.lcInputFile)), 'frx') && factura.frx
|
||||
lcFrtFileName = Forceext(Lower(Justfname(m.lcInputFile)), 'frt') && factura.frt
|
||||
|
||||
lcFrxInputFile = Forceext(Lower(m.lcInputFile), 'frx') && d:\roa\userreports\schema\usr_factura.frx
|
||||
lcFrtInputFile = Forceext(Lower(m.lcInputFile), 'frt') && d:\roa\userreports\schema\usr_factura.frt
|
||||
|
||||
llSucces = (FILE(m.lcFrxInputFile) AND FILE(m.lcFrtInputFile))
|
||||
IF m.llSucces
|
||||
lnId = File2Atasament(m.lcFrxInputFile)
|
||||
llSucces = (m.lnId > 0)
|
||||
ELSE
|
||||
AMESSAGEBOX('Nu exista fisierul ' + m.lcFrxFileName + ' sau ' + m.lcFrtFileName,0+48,_screen.Caption)
|
||||
ENDIF
|
||||
|
||||
If m.llSucces
|
||||
lnId = File2Atasament(m.lcFrtInputFile)
|
||||
llSucces = (m.lnId > 0)
|
||||
Endif
|
||||
ENDIF
|
||||
AMESSAGEBOX(IIF(m.llSucces, 'Raportul s-a salvat cu succes in baza de date.','Raportul NU s-a salvat in baza de date!'),0+64,_screen.Caption)
|
||||
|
||||
Return m.llSucces
|
||||
ENDPROC && Report2Database
|
||||
|
||||
****************************************************************************
|
||||
* Salveaza o imagine (ex: logo.jpg) in baza de date pentru a fi folosita la rapoarte
|
||||
****************************************************************************
|
||||
PROCEDURE Image2Database
|
||||
lcInputFile = GETFILE('Images:jpg,jpeg,bmp,png,gif,tiff', 'Alege un fisier', 'Alege',0, 'Alege un fisier')
|
||||
lnId = 0
|
||||
llSucces = .F.
|
||||
IF !EMPTY(m.lcInputFile)
|
||||
lnId = File2Atasament(m.lcInputFile)
|
||||
llSucces = (m.lnId > 0)
|
||||
ENDIF
|
||||
AMESSAGEBOX(IIF(m.llSucces, 'Imaginea s-a salvat cu succes in baza de date.','Imaginea NU s-a salvat in baza de date!'),0+64,_screen.Caption)
|
||||
RETURN m.llSucces
|
||||
ENDPROC && Image2Database
|
||||
Reference in New Issue
Block a user