Import initial din SVN ROAAUTO/Trunk @HEAD
This commit is contained in:
407
COMUN/programe/oproceduri_evolutie.prg
Normal file
407
COMUN/programe/oproceduri_evolutie.prg
Normal file
@@ -0,0 +1,407 @@
|
||||
*!* 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
|
||||
***-----------------------------------------------------
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user