408 lines
10 KiB
Plaintext
408 lines
10 KiB
Plaintext
*!* 24.06.2011
|
|
*!* marius.mutu
|
|
*!* calc_indicatori_randuri
|
|
*!* daca un indicator avea valoare negativa, formula dadea eroare
|
|
*!* am transformat +-valoare in +(-valoare)
|
|
|
|
*!* 31.07.2012
|
|
*!* marius.mutu
|
|
*!* evalueaza_randul
|
|
*** Nu reevaluez totalurile cu CASE/IIF (ex R15 = CASE WHEN R15A > 0 THEN R15A ELSE 0 END)
|
|
*** pentru ca doresc sa suprascriu R15
|
|
|
|
*!* 27.02.2019
|
|
*!* marius.mutu
|
|
*!* evalueaza_randul - upper(allt(rand))
|
|
|
|
*!* 13.02.2026
|
|
*!* calc_indicatori_randuri - lcRandEval = 0 daca nu exista randul
|
|
|
|
Procedure viz_set_calc
|
|
Parameters tctable, tnId_set, tlFaraGrafic, tcNumeSet, tnId_sectie, tnId_venchelt
|
|
|
|
Private pcDataOra
|
|
pcDataOra = Get_Ora(2)
|
|
|
|
Local llFaraGrafic, lcTitlu
|
|
llFaraGrafic = tlFaraGrafic
|
|
|
|
If !Empty(tcNumeSet)
|
|
lcTitlu = Alltrim(tcNumeSet)
|
|
Else
|
|
lcTitlu = ''
|
|
Endif
|
|
|
|
*!* If !Empty(tcFCentru)
|
|
*!* If !("FIRMA"$Upper(Alltrim(tcFCentru)))
|
|
*!* lcTitlu = Proper(Alltrim(tcFCentru)) + ' - ' + lcTitlu
|
|
*!* Endif
|
|
*!* Endif
|
|
|
|
If !Used(tctable)
|
|
Return
|
|
Endif
|
|
|
|
Select (tctable) && id_ind, rand, nume_ind, comentariu -> ....date
|
|
frml = Createobject("frm_viz_set_calc", tnId_set, tlFaraGrafic, lcTitlu, tnId_sectie, tnId_venchelt)
|
|
frml.lb_titlu_alb_b121.Caption = "Set calculat - " + lcTitlu
|
|
frml.grid1.RecordSource = tctable
|
|
frml.grid1.DeleteColumn(1) && id_ind
|
|
frml.grid1.DeleteColumn(1) && ord_rand
|
|
|
|
|
|
frml.grid1.DeleteColumn(3) && comentariu
|
|
* frml.grid1.FontName = "Arial Narrow"
|
|
lnnrcoloane = frml.grid1.ColumnCount
|
|
frml.grid1.column4.Width = 300 && nume_ind
|
|
|
|
For i = 6 To lnnrcoloane+3
|
|
cformat = "frml.grid1.Column"+Alltrim(Str(i))+".format='rk'"
|
|
&cformat
|
|
cinputmask = "frml.grid1.Column"+Alltrim(Str(i))+".inputmask"
|
|
&cinputmask = "999 999 999 999.99"
|
|
Endfor
|
|
|
|
*!* frml.grid1.Width = frml.edtcomentariu.Left + frml.edtcomentariu.Width
|
|
frml.edtComentariu.ControlSource = tctable + ".comentariu"
|
|
|
|
*!* If tlcalculat
|
|
*!* frml.cb_save1.Visible = .F.
|
|
*!* frml.cb_print1.Left = frml.cb_print1.Left+frml.cb_print1.Width+1
|
|
*!* frml.cb_excel1.Left=frml.cb_excel1.Left+frml.cb_excel1.Width+1
|
|
*!* frml.cb_explorer1.Left=frml.cb_explorer1.Left+frml.cb_explorer1.Width+1
|
|
*!* Endif
|
|
|
|
*frml.lockscreen=.f.
|
|
|
|
frml.Show(1)
|
|
|
|
|
|
If Used('gtemp')
|
|
Use In gtemp
|
|
Endif
|
|
|
|
If Used('xtab')
|
|
Use In xtab
|
|
Endif
|
|
Endproc && viz_set_calc
|
|
***------------------------------------------------------------------------------------
|
|
Procedure lanseaza_excel
|
|
Parameters tcalias, tcTitlu, tlfara_grafic
|
|
|
|
Private pctitlu
|
|
Local llEsteExcel
|
|
llEsteExcel = .F.
|
|
llEsteExcel=isComobject("Excel.Application")
|
|
If !llEsteExcel
|
|
Do mesaj With "Instalati Microsoft Excel",""
|
|
Return
|
|
Endif
|
|
|
|
If Empty(tcTitlu)
|
|
pctitlu="Indicatori"
|
|
Else
|
|
pctitlu=Alltrim(tcTitlu)
|
|
Endif
|
|
|
|
Declare aranduri[1]
|
|
Declare acoloane[1]
|
|
Declare arand[1]
|
|
|
|
Select (tcalias)
|
|
lcField2=Field(4) && campul cu descrierea indicatorilor
|
|
lcSelect = [select ] + lcField2 + " "+[from ] + tcalias +" "+[into cursor tdesc]
|
|
&lcSelect
|
|
lnCount = _Tally
|
|
Dimension aranduri[lnCount]
|
|
|
|
&&& obtin array pt grafic
|
|
i=0
|
|
Select tdesc
|
|
Scan
|
|
i=i+1
|
|
aranduri[i]=tdesc.nume_ind
|
|
Endscan
|
|
|
|
If Used("tdesc")
|
|
Use In tdesc
|
|
Endif
|
|
|
|
***
|
|
Select (tcalias)
|
|
|
|
lcField1=Field(3) && campul cu numele randului (indicatorului)
|
|
lcSelect1 = [select ] + lcField1 + " "+[from ] + tcalias +" "+[into cursor trand]
|
|
&lcSelect1
|
|
lnCount1 = _Tally
|
|
Dimension arand[lnCount1]
|
|
|
|
j=0
|
|
|
|
Select trand
|
|
Scan
|
|
j=j+1
|
|
arand[j]=Right(Alltrim(trand.Rand),2)
|
|
Endscan
|
|
|
|
If Used("trand")
|
|
Use In trand
|
|
Endif
|
|
|
|
Select (tcalias)
|
|
lnFields=Fcount()
|
|
Dimension acoloane[lnFields]
|
|
|
|
Select (tcalias)
|
|
lcSelect = [select ]
|
|
|
|
For i=5 To lnFields
|
|
lcField=Field(i)
|
|
lcSelect = lcSelect + lcField + [,]
|
|
Endfor
|
|
lcSelect=Left(lcSelect,Len(lcSelect)-1)
|
|
lcSelect = lcSelect +" "+[ from ]+tcalias+" "+[ into cursor tExcel]
|
|
&lcSelect
|
|
lnCount = _Tally
|
|
|
|
&&& obtin d200331001 , 200304
|
|
Select (tcalias)
|
|
For i=5 To lnFields
|
|
lcTipCumul=Left(Field(i),1)
|
|
lcan=Substr(Field(i),2,4)
|
|
lcgrup=Right(Field(i),2)
|
|
acoloane[i-4]=cluna(lcgrup,lcTipCumul,lcan)
|
|
Endfor
|
|
|
|
lcfis = Alltrim(pctitlu)
|
|
For i=0 To Len(lcfis)-1
|
|
lccar = Substr(lcfis,i,1)
|
|
If Inlist(lccar,":","*","/","\","<",">",'"',"|","?")
|
|
lcfis= Strtran(lcfis,lccar,"_")
|
|
Endif
|
|
Endfor
|
|
|
|
lcexcel= Addbs(Strtran(gcTempPath,"\\","\"))+lcfis+"_"+Sys(2)+".XLS"
|
|
|
|
lcClasa = "EXCELX"
|
|
x=Newobject("XL_Manager",lcClasa) && alternatively you can drop this class on a VFP form
|
|
x.SaveAs=lcexcel && PART.XLS to be created in your TEMP folder
|
|
Dimension x.oWorkSheet[1] && need one page
|
|
x.oWorkSheet[1] = "Page 1 (with chart)"
|
|
x.Go() && remember this calls .populate_pages().
|
|
*WAIT WINDOW 'Check out! ' + x.SAVEAS && Presto! (the output XLS document)
|
|
Release x
|
|
|
|
OLEAPP = Getobject("","Excel.Application")
|
|
If Type('OLEAPP')!='O'
|
|
OLEAPP = Createobject("Excel.Application")
|
|
Endif
|
|
OLEAPP.WorkBooks.Open(lcexcel)
|
|
OLEAPP.Visible=1
|
|
|
|
Use In texcel
|
|
Return
|
|
Endproc &&lanseaza_excel
|
|
***------------------------------------------------------------------------------------
|
|
***------------------------------------------------------------------------------------
|
|
Procedure lanseaza_html
|
|
Parameters tcFile, tcTitluHtml, tlFaraGrafic
|
|
|
|
Local llFaraGrafic, lcTitluHtml
|
|
llFaraGrafic = tlFaraGrafic
|
|
lcTitluHtml = Alltrim(tcTitluHtml)
|
|
|
|
Select (tcFile)
|
|
lcfisd = gcTempPath + "copie.dbf"
|
|
Copy To (lcfisd)
|
|
Use (lcfisd) In 0 Exclusive
|
|
Select Copie
|
|
|
|
losc = Createobject("aShowCursor")
|
|
With losc
|
|
.lAlternateRows = .T.
|
|
.CTABLEWIDTH = '100%'
|
|
.cCellspacing = '3'
|
|
.cAlternatingBGColor = "white"
|
|
.cTableBorder = "1"
|
|
.nForceToPreList = 75000
|
|
.ShowCursor()
|
|
Endwith
|
|
|
|
******
|
|
*!* DEBUG
|
|
*!* SUSPEND
|
|
lcBar = ""
|
|
loGraph = Createobject('wwWebGraphs')
|
|
*** Make sure you pick a directory that exists
|
|
*** and is accessible through the Web
|
|
If Type("loGraph") = "O"
|
|
loGraph.cPhysicalPath = gcTempPath
|
|
loGraph.cLogicalPath = gcTempPath
|
|
|
|
loGraph.ShowGraphFromCursor()
|
|
lcBar = loGraph.GetOutput()
|
|
Endif
|
|
******
|
|
|
|
lcFile = Strtran(Addbs(gcTempPath),"\\","\")+"Indicatori.htm"
|
|
lchtml = [<html><body><h2><center> &lcTitluHtml </center></h2>]
|
|
lchtml = lchtml + losc.ohtml.coutput
|
|
|
|
If !llFaraGrafic &&daca am bifat optiunea "fara grafic"
|
|
lchtml = lchtml + [<br>] + lcBar
|
|
Endif
|
|
|
|
lchtml = lchtml + [</body></html>]
|
|
Strtofile(lchtml, lcFile)
|
|
|
|
orep = Createobject("frm_webreporter")
|
|
orep.cReportFileName = lcFile
|
|
orep.displayreport
|
|
|
|
Use In Copie
|
|
Endproc && lanseaza_html
|
|
***------------------------------------------------------------------------------------
|
|
*!* ***------------------------------------------------------------------------------------
|
|
*!* Procedure calc_indicatori_randuri
|
|
*!* Parameters tcFormula, tcTabel, tcColoana
|
|
|
|
*!* lcFormula = ALLTRIM(tcFormula)
|
|
*!* lcColoana = ALLTRIM(tcColoana)
|
|
*!* lcTabel = tcTabel
|
|
*!* lcFormEvaluata = ''
|
|
|
|
*!* Select * From (lcTabel) Into Cursor cLucru
|
|
|
|
*!* Do While Len(lcFormula) > 0
|
|
*!* lnRand = At('R',lcFormula)
|
|
*!* If lnRand > 0 Then
|
|
*!* lnNext = At(']',lcFormula)
|
|
*!* lcRand = ALLTRIM(Substr(lcFormula, lnRand + 1, (lnNext - lnRand - 1)))
|
|
|
|
*!* Select cLucru
|
|
*!* Calculate Sum(&lcColoana) For ALLTRIM(Rand) = lcRand To lnSumaRand
|
|
|
|
*!* lcFormEvaluata = lcFormEvaluata + Substr(lcFormula, 1, lnRand - 2) + '(' + Alltrim(Str(lnSumaRand,20,gnPA) + ')')
|
|
|
|
*!* lcFormula = Substr(lcFormula, lnNext + 1)
|
|
*!* Else
|
|
*!* lcFormEvaluata = lcFormEvaluata + Substr(lcFormula, 1)
|
|
*!* lcFormula = ''
|
|
*!* Endif
|
|
*!* Enddo
|
|
|
|
*!* If !Empty(lcFormEvaluata) And !Isnull(lcFormEvaluata)
|
|
*!* lcOldError = On("error")
|
|
*!* On Error lnret = 0
|
|
*!* lnret = &lcFormEvaluata
|
|
*!* On Error &lcOldError
|
|
*!* Endif
|
|
|
|
*!* Use In cLucru
|
|
*!* Return lnret
|
|
|
|
*!* Endproc && calc_indicatori_randuri
|
|
*!* ***------------------------------------------------------------------------------------
|
|
****------------------------------------------------------------------------------------
|
|
Procedure calc_indicatori_randuri
|
|
Parameters tcFormula, tcTabel, tcColoana
|
|
|
|
Local lnRet, lcFormula, lcColoana, lcTabel, lcFormEvaluata
|
|
Store 0 To lnRet
|
|
lcFormula = Alltrim(UPPER(tcFormula))
|
|
lcFormula = Strtran(lcFormula,'CASE WHEN','IIF(')
|
|
lcFormula = Strtran(lcFormula,'THEN',',')
|
|
lcFormula = Strtran(lcFormula,'ELSE',',')
|
|
lcFormula = Strtran(lcFormula,'END',')')
|
|
|
|
lcColoana = Alltrim(tcColoana)
|
|
lcTabel = tcTabel
|
|
lcFormEvaluata = ''
|
|
|
|
Select * From (lcTabel) with (buffering = .T.) Into Cursor cLucru
|
|
|
|
If Len(lcFormula) > 0
|
|
Do While At('[R',lcFormula)>0
|
|
lnRand = At('[R',lcFormula)
|
|
IF lnRand > 0
|
|
lnRand = lnRand + 1 && pozitia R
|
|
ENDIF
|
|
lnNext = At(']',lcFormula)
|
|
|
|
lcRandCompl = Substr(lcFormula, lnRand - 1, (lnNext - lnRand + 2))
|
|
lcRand = Alltrim(Substr(lcFormula, lnRand + 1, (lnNext - lnRand - 1)))
|
|
*STRTOFILE(TRANSFORM(lcRand) + CHR(13) + CHR(10), 'e:\rand.txt',.T.)
|
|
lcRandEval = evalueaza_randul(lcRand, "cLucru", lcColoana)
|
|
IF EMPTY(NVL(m.lcRandEval, ''))
|
|
lcRandEval = '0'
|
|
ENDIF
|
|
|
|
lnRandEval = At('[R',lcRandEval)
|
|
If lnRandEval > 0
|
|
lnRandEval = lnRandEval + 1 && pozitia R
|
|
lcRandEval = '(' + ALLTRIM(lcRandEval) + ')'
|
|
ENDIF
|
|
|
|
*!* 24.06.2011
|
|
IF LEFT(lcRandEval,1) = [-]
|
|
lcRandEval = '(' + ALLTRIM(lcRandEval) + ')'
|
|
ENDIF
|
|
*!* 24.06.2011 ^
|
|
|
|
lcFormula = Strtran(lcFormula,lcRandCompl,lcRandEval)
|
|
|
|
Enddo
|
|
Endif
|
|
|
|
If !Empty(lcFormula) And !Isnull(lcFormula)
|
|
lcOldError = On("error")
|
|
On Error lnRet = 0
|
|
lnRet = &lcFormula
|
|
On Error &lcOldError
|
|
Endif
|
|
|
|
If Used("cLucru")
|
|
Use In cLucru
|
|
Endif
|
|
|
|
Return lnRet
|
|
|
|
Endproc && calc_indicatori_randuri
|
|
***------------------------------------------------------------------------------------
|
|
Function evalueaza_randul
|
|
Parameters tcRand, tcTabel, tcColoana
|
|
|
|
Local lcReturn, lcRand, lcTabel, lcColoana
|
|
Store "" To lcReturn
|
|
lcRand = tcRand
|
|
lcTabel = tcTabel
|
|
lcColoana = tcColoana
|
|
|
|
Select (lcTabel)
|
|
Locate For UPPER(ALLTRIM(Rand)) = lcRand
|
|
If Found()
|
|
lnTip = tip
|
|
If tip = 5
|
|
*** Nu reevaluez totalurile cu CASE/IIF (ex R15 = CASE WHEN R15A > 0 THEN R15A ELSE 0 END)
|
|
*** pentru ca doresc sa suprascriu R15
|
|
IF !('CASE'$UPPER(NVL(formula,'')) OR 'IIF'$UPPER(NVL(formula,'')))
|
|
lcReturn = UPPER(formula)
|
|
lcReturn = Strtran(lcReturn,'CASE WHEN','IIF(')
|
|
lcReturn = Strtran(lcReturn,'THEN',',')
|
|
lcReturn = Strtran(lcReturn,'ELSE',',')
|
|
lcReturn = Strtran(lcReturn,'END',')')
|
|
ELSE
|
|
lcReturn = Alltrim(Str(NVL(&tcColoana,0),20,2))
|
|
ENDIF
|
|
Else
|
|
lcReturn = Alltrim(Str(NVL(&tcColoana,0),20,2))
|
|
Endif
|
|
Endif
|
|
|
|
Return lcReturn
|
|
Endfunc && evalueaza_randul
|
|
***-----------------------------------------------------
|
|
|
|
|
|
|