*!* 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
***-----------------------------------------------------