315 lines
9.4 KiB
Plaintext
315 lines
9.4 KiB
Plaintext
*!* 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 |