romfast/roacontracte
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial: flux text FoxBin2Prg (git urmareste .??2 in-arbore, binarele VFP git-ignored)

Browse Source 
Inrolare ROACONTRACTE conform COMUN\docs\inrolare-proiect-git-text.md:
- .gitignore/.gitattributes dupa modelul ROACONT (COMUN/ exclus, are repo propriu)
- 439 texte FoxBin2Prg generate in arbore (vc2/sc2/fr2/mn2/pj2/db2)
- Clase\registry.vcx ramane binar: memo .vct corupt (Error 41), nu se poate converti
- Clase\ferestre_contracte.vcx: text generat, roundtrip scutit (fara write-back)
- CLAUDE.md, docs/README.md, roa_sync.bat

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_01RYbiinqXxdEqXi53x4Ro7K
This commit is contained in:
Marius Mutu
2026-08-03 01:51:36 +03:00
commit 7cc3bff358
158 changed files with 80639 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

107
Programe/1proverb.prg Normal file
View File

@@ -0,0 +1,107 @@
WAIT WIND 'Se genereaza raportul. Asteptati...' nowait
SET SAFETY OFF
COPY FILE &DIRGEN\DEVIZE\DATE\TEMPO\PROVERB.* TO &LOC\&NFSCURT\TEMPO\PROVERB.*
SELE 0
USE &LOC\&NFSCURT\TEMPO\PROVERB EXCL ALIAS PROVERB
sele proverb
zap
public m.g,m.nrinmat,m.tipauto
LOCAL M.DENUMIRE,M.CODMAT,M.CODFURN,M.CANT,M.PRET
STORE '' TO M.DENUMIRE,M.CODMAT,M.CODFURN,m.tipauto
STORE ' ' TO m.nrinmat
STORE 0 TO M.CANT,M.PRET,m.g
sele rul
set filter to subs(nrord,1,1)='G'
SCAN
m.nrord = nrord
M.DENUMIRE = DENUMIRE
M.CODMAT=CODMAT
M.CODFURN=EXP4
M.CANT=CANTE
M.PRET=PRETV
m.fel = 'A'
do nrcirc
SELE PROVERB
APPE BLANK
GATHER MEMVAR
SELE RUL
ENDSCAN
sele OPER
set filter to subs(nrord,1,1)='G'
SCAN
m.nrord = nrord
M.DENUMIRE = DENOP
M.CODMAT=CODOP
M.CODFURN=codfurn
M.CANT=TIMPN
M.PRET=PRET
m.fel = 'B'
do nrcirc
sele oper
SELE PROVERB
APPE BLANK
GATHER MEMVAR
SELE OPER
ENDSCAN
sele proverb
set order to tag codfel
TOTAL ON DENUMIRE+STR(PRET,10) FIELDS CANT TO &LOC\&NFSCURT\TEMPO\PROVERB1
SELE 0
*USE C:\CONTAFIN\AUTOSTAL\TEMPO\PROVERB1
USE &LOC\&NFSCURT\TEMPO\PROVERB1
**************
INDEX ON TIPAUTO+CODFURN+DENUMIRE+STR(PRET,10) to &LOC\&NFSCURT\TEMPO\PROVERB1
***************
report format proverb TO PRINTER PROMPT preview
USE IN PROVERB
USE IN PROVERB1
RETURN
*************
procedure nrcirc
m.g=1
m.tipauto=''
m.nrinmat=''
do case
case subs(nrord,1,1)='/'
m.g=2
case subs(nrord,2,1)='/'
m.g=3
case subs(nrord,3,1)='/'
m.g=4
case subs(nrord,4,1)='/'
m.g=5
case subs(nrord,5,1)='/'
m.g=6
case subs(nrord,6,1)='/'
m.g=7
case subs(nrord,7,1)='/'
m.g=8
case subs(nrord,8,1)='/'
m.g=9
case subs(nrord,9,1)='/'
m.g=10
case subs(nrord,10,1)='/'
m.g=11
case subs(nrord,11,1)='/'
m.g=12
case subs(nrord,12,1)='/'
m.g=13
case subs(nrord,13,1)='/'
m.g=14
case subs(nrord,14,1)='/'
m.g=15
case subs(nrord,15,1)='/'
m.g=16
endcase
m.nrinmat = subs(nrord,m.g,20-m.g)
sele masini
loca for ALLT(m.nrinmat) = ALLT(nrinmat)
if found()
m.tipauto = masina
else
m.tipauto=''
endif
return

96
Programe/Log_mesaje.prg Normal file
View File

@@ -0,0 +1,96 @@
*!* in programul principal :
*!* public poLog && obiect pt logarea mesajelor sistemului
*!* poLog = NEWOBJECT("Log_Mesaje","Log_Mesaje.prg")
*!* pe parcursul programului:
*!* lcLog = [1]
*!* poLog.Log(lcLog,PROGRAM())
DEFINE CLASS log_mesaje as Relation
cLogFile = "c:\log.txt"
lLogging = .F.
&& ------------------------------INCEPUT: Init ------------------------------
*!* Procedura: Init
*!* Parametri:
*!* Data/Ora generarii: 20/02/2004 12:41:53
*!* Autor: MARIUS.MUTU
PROCEDURE Init
LPARAMETERS tcLogFile, tlAdditive
lLog = IIF(FILE(ADDBS(JUSTPATH(SYS(16,0)))+"LOG.txt"),.T.,.F.) && daca exista fisierul log
this.lLogging = lLog or this.lLogging && creez log daca exista in directorul aplicatiei fisierul <log.txt> sau daca proprietatea lLogging = .T.
IF !this.lLogging
RETURN
ENDIF
SET console off
SET TALK OFF
cLogFile = IIF(EMPTY(tcLogFile),ADDBS(JUSTPATH(SYS(16,0)))+"LOG_"+JUSTSTEM(SYS(16,0))+".txt","")
this.cLogFile = cLogFile
IF PARAMETERS() < 2
llAdditive = IIF(FILE(cLogFile),.T.,.F.)
ELSE
llAdditive = tlAdditive
ENDIF
IF llAdditive
SET TEXTMERGE ON TO (cLogFile) ADDITIVE
ELSE
SET TEXTMERGE ON TO (cLogFile)
ENDIF
\
\\<<TIME()>>
SET TEXTMERGE TO
ENDPROC
&& ------------------------------SFARSIT: Init ------------------------------
&& ------------------------------INCEPUT: Log ------------------------------
*!* Procedura: Log
*!* Parametri: tcText
*!* Data/Ora generarii: 20/02/2004 12:48:57
*!* Autor: MARIUS.MUTU
PROCEDURE Log
LPARAMETERS tcText, tcProgram
IF !this.lLogging
RETURN
ENDIF
LOCAL lcText, lcLogFile
SET console off
SET TALK OFF
lcText = IIF(EMPTY(tcText),"",ALLTRIM(tcText))
lcProgram = IIF(EMPTY(tcProgram),"",ALLTRIM(tcProgram))
lcSpatiu = SPACE(10)
lcLogFile = this.cLogFile
lcAddText = TIME() + IIF(!EMPTY(lcProgram),lcSpatiu+lcProgram,"") + IIF(!EMPTY(lcText),lcSpatiu+lcText,"")
SET TEXTMERGE ON TO (lcLogFile) ADDITIVE
\ <<lcAddText>>
SET TEXTMERGE TO
ENDPROC
&& ------------------------------SFARSIT: Log ------------------------------
ENDDEFINE && log_mesaje

270
Programe/actualizari.prg Normal file
View File

@@ -0,0 +1,270 @@
SELE CALENDAR
M=4*RECCOUNT()+4
OP=CREA('PROGRESBAR')
op.titlu.caption='Actualizari'
OP.SHOW()
close database
IF !USED('FISTOTVdev')
do deschidf with '&dirgen\devize\date\datean\','&dirgen\devize\date\datean\','fistotvdev','fistotv','CALE',''
ENDIF
sele 0
use &calefirma\datean\calendar alias calendar
sele calendar
J=0
scan
scatter memvar
date=calefirma+'\AN'+m.an+'\DATE'+M.nl
if file('&date\oper.dbf')
*DO PR WITH J
*do pfactura
DO PR WITH J
do pordl
DO PR WITH J
do poper
DO PR WITH J
do popersal
DO PR WITH J
do psalarii
endif
endscan
***
DO PR WITH J
do pclie
DO PR WITH J
DO PSECTIE
DO PR WITH J
DO PMECANICI
DO PR WITH J
do pmasini
DO PR WITH J
DO PMARCI
OP.RELEASE
RETURN
*____________________________________________
procedure pfactura
dele file &date\facturaa.*
dele file &date\facturav.*
copy file &dirgen\devize\date\date00\factura.* to &date\facturaa.*
sele 0
use &date\facturaa.dbf AGAIN ALIAS facturaa exclusive
sele facturaa
zap
sele facturaa
append from &date\factura
sele facturaa
reindex
use
rename &date\factura.* to &date\facturav.*
rename &date\facturaa.* to &date\factura.*
*do refRULL
return
*____________________________________________
procedure psalarii
dele file &date\salariia.*
dele file &date\salariiv.*
copy file &dirgen\devize\date\date00\salarii.* to &date\salariia.*
sele 0
use &date\salariia.dbf AGAIN ALIAS salariia exclusive
sele salariia
zap
sele salariia
append from &date\salarii
sele salariia
reindex
use
rename &date\salarii.* to &date\salariiv.*
rename &date\salariia.* to &date\salarii.*
*do refRULL
return
*____________________________________________
procedure pordl
dele file &date\ordla.*
dele file &date\ordlv.*
copy file &dirgen\devize\date\date00\ordl.* to &date\ordla.*
sele 0
use &date\ordla.dbf AGAIN ALIAS ordla exclusive
sele ordla
zap
sele ordla
append from &date\ordl
sele ordla
reindex
use
rename &date\ordl.* to &date\ordlv.*
rename &date\ordla.* to &date\ordl.*
&&&&&&do refact
return
*____________________________________________
procedure poper
dele file &date\opera.*
dele file &date\operv.*
copy file &dirgen\devize\date\date00\oper.* to &date\opera.*
sele 0
use &date\opera.dbf AGAIN ALIAS opera exclusive
sele opera
zap
sele opera
append from &date\oper
sele opera
reindex
use
rename &date\oper.* to &date\operv.*
rename &date\opera.* to &date\oper.*
return
*____________________________________________
procedure popersal
dele file &date\opersala.*
dele file &date\opersalv.*
copy file &dirgen\devize\date\date00\opersal.* to &date\opersala.*
sele 0
use &date\opersala.dbf AGAIN ALIAS opersala exclusive
sele opersala
zap
sele opersala
append from &date\opersal
sele opersala
reindex
use
rename &date\opersal.* to &date\opersalv.*
rename &date\opersala.* to &date\opersal.*
return
*______________________________________________________________
procedure pclie
dele file &calefirma\datean\cliea.*
dele file &calefirma\datean\cliev.*
copy file &dirgen\devize\date\datean\clie.* to &calefirma\datean\cliea.*
sele 0
use &calefirma\datean\cliea.dbf AGAIN ALIAS cliea exclusive
sele cliea
zap
sele cliea
append from &calefirma\datean\clie
sele cliea
reindex
use
rename &calefirma\datean\clie.* to &calefirma\datean\cliev.*
rename &calefirma\datean\cliea.* to &calefirma\datean\clie.*
*DO refRUL
return
*______________________________________________________________
procedure pSECTIE
dele file &calefirma\datean\SECTIEa.*
dele file &calefirma\datean\SECTIEv.*
copy file &dirgen\devize\date\datean\SECTIE.* to &calefirma\datean\SECTIEa.*
sele 0
use &calefirma\datean\SECTIEa.dbf AGAIN ALIAS SECTIEa exclusive
sele SECTIEa
zap
sele SECTIEa
append from &calefirma\datean\SECTIE
sele SECTIEa
reindex
use
rename &calefirma\datean\SECTIE.* to &calefirma\datean\SECTIEv.*
rename &calefirma\datean\SECTIEa.* to &calefirma\datean\SECTIE.*
*DO refRUL
return
*______________________________________________________________
procedure pMECANICI
dele file &calefirma\datean\MECANICIa.*
dele file &calefirma\datean\MECANICIv.*
copy file &dirgen\devize\date\datean\MECANICI.* to &calefirma\datean\MECANICIa.*
sele 0
use &calefirma\datean\MECANICIa.dbf AGAIN ALIAS MECANICIa exclusive
sele MECANICIa
zap
sele MECANICIa
append from &calefirma\datean\MECANICI
sele MECANICIa
reindex
use
rename &calefirma\datean\MECANICI.* to &calefirma\datean\MECANICIv.*
rename &calefirma\datean\MECANICIa.* to &calefirma\datean\MECANICI.*
*DO refRUL
return
*______________________________________________________________
procedure pmasini
dele file &calefirma\datean\masinia.*
dele file &calefirma\datean\masiniv.*
copy file &dirgen\devize\date\datean\masini.* to &calefirma\datean\masinia.*
sele 0
use &calefirma\datean\masinia.dbf AGAIN ALIAS masinia exclusive
sele masinia
zap
sele masinia
append from &calefirma\datean\masini
sele masinia
reindex
use
rename &calefirma\datean\masini.* to &calefirma\datean\masiniv.*
rename &calefirma\datean\masinia.* to &calefirma\datean\masini.*
return
*______________________________________________________________
procedure pMARCI
dele file &calefirma\datean\MARCIa.*
dele file &calefirma\datean\MARCIv.*
copy file &dirgen\devize\date\datean\MARCI.* to &calefirma\datean\MARCIa.*
sele 0
use &calefirma\datean\MARCIa.dbf AGAIN ALIAS MARCIa exclusive
sele MARCIa
zap
sele MARCIa
append from &calefirma\datean\MARCI
sele MARCIa
reindex
use
rename &calefirma\datean\MARCI.* to &calefirma\datean\MARCIv.*
rename &calefirma\datean\MARCIa.* to &calefirma\datean\MARCI.*
return
*____________________________________
PROC PR
PARAM J
IF J>M
RETURN
ENDIF
OP.PRBAR.VALUE=J
OP.P=ROUND(100*OP.PRBAR.VALUE/OP.PRBAR.MAX,2)
OP.REFRESH
J=J+1
RETURN

2183
Programe/genhtml.db2 Normal file
View File

File diff suppressed because it is too large Load Diff

43
Programe/mesaje.prg Normal file
View File

@@ -0,0 +1,43 @@
*_________________________________________
PROCEDURE anunta_rezultat
LPARAMETERS lcCategorie, lcSursa, lcMesaj, llEroare, llInTabel, lnId_ref
IF llInTabel
scrie_in_mesaje(lcCategorie, lcSursa, lcMesaj, llEroare, lnId_ref)
ELSE
DO mesaj With lcMesaj, ''
ENDIF
ENDPROC
PROCEDURE scrie_in_mesaje
LPARAMETERS lcCategorie, lcSursa, lcMesaj, llEroare, lnId_ref
LOCAL lnOrdine
SELECT mesaje
CALCULATE MAX(ordine) TO m.lnOrdine
m.lnOrdine = m.lnOrdine + 1
APPEND BLANK
replace ordine WITH m.lnOrdine, sursa WITH lcSursa, mesaj WITH lcMesaj, ;
eroare WITH llEroare, categorie WITH lcCategorie, id_ref WITH lnId_ref
ENDPROC
PROCEDURE sterge_mesaje
ZAP IN mesaje
ENDPROC
PROCEDURE raport_mesaje
PARAMETERS tcPerioada
PRIVATE pcTitlu,pcPerioada,pcDataOra
*!* PRIVATE toFirma
*!* SELECT FIRMA
*!* LOCATE FOR NFSCURT=FSCURT
*!* SCATTER NAME m.toFirma
*!* SELECT mesaje
*!* IF RECNO() > 0
*!* SET ORDER TO ordine
*!* REPORT FORM mesaje TO PRINTER PROMPT PREVIEW
*!* ENDIF
pcTitlu=[VERIFICARE GLOBALA]
pcPerioada=[Perioada ]
pcdataora = get_ora(2)
SELECT crsverificari
REPORT FORM rap_mesaje TO PRINTER PROMPT preview
ENDPROC

214
Programe/onom_clienti.prg Normal file
View File

@@ -0,0 +1,214 @@
*******************************************
Procedure viz_delegati
Lparameters tnidpartener
Private podelegati,pcschema1,pcselect1,odetalii
LOCAL llAfiseaza
Store '' To podelegati
If Used('v_delegati')
Use In v_delegati
Endif
pcschema1=['']
pcselect1=['select * from ] + gcS + [.vnom_delegati where 1=2']
pcorder1 = [nume]
*!* pcfiltru1=[sters=0]
pcfiltru1=[1=2]
llAfiseaza=.F.
gencursor('podelegati','v_delegati',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfiseaza)
podelegati.ca_baza1.afisare()
ofrmdelegati=Createobject('frm_delegati',tnidpartener)
ofrmdelegati.Show(1)
Select v_delegati
Scatter Name odetalii
Use In v_delegati
Release podelegati
Return odetalii
ENDPROC && viz_delegati
**********************sfarsit procedura viz_delegati*******************
******************************************* INCEPUT:viz_responsabili *******************************************
PROCEDURE viz_responsabili( )
PRIVATE poresponsabili, pcschema1, pcselect1
STORE '' TO poresponsabili
pcschema1 = ['']
pcselect1=['select * from ] + gcS + [.vnom_responsabili where 1=2']
pcorder1=[nume]
pcfiltru1 = [2=2]
llAfiseaza = .F.
gencursor('poresponsabili','v_responsabili',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfiseaza)
poresponsabili.ca_baza1.afisare()
ofrmres=CREATEOBJECT('frm_responsabili')
ofrmres.SHOW(1)
RELEASE poresponsabili
ENDPROC && viz_responsabili
******************************************* SFARSIT: viz_responsabili *******************************************
Procedure viz_curs
Private poCurs
Store '' To poCurs
Local lcSchema1, lcSelect1, lcOrder1, lcFiltru1, llAfiseaza
lcSchema1 = ['id_curs N(10), nume_val C(10), curs N(10,4), data D(8), data2 D(8), id_valuta N(5)']
lcSelect1 = [select id_curs, nume_val, curs, data, data2, id_valuta from ] + gcS + [.vcrm_curs]
lcOrder1 = [data desc]
lcFiltru1 = [1=2]
lcFiltruOriginal = []
llModParam = .T.
llAfiseaza = .F.
lcgroup = []
*gencursor('poCurs','cIntermediar', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza, lcgroup, llModParam, lcFiltruOriginal)
gencursor('poCurs','tCurs', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza, lcgroup, llModParam, lcFiltruOriginal)
poCurs.ca_baza1.afisare()
Select tCurs
lovc = Createobject("frm_curs")
lovc.Show(1)
Release poCurs
Endproc && viz_curs
***-----------------------------------------------------------------------------------------------------------------------------
Procedure viz_tipc
Private poTipc
Store '' To poTipc
Local lcSchema1, lcSelect1, lcOrder1, lcFiltru1, llAfiseaza
lcSchema1 = ['']
lcSelect1 = [select * from ] + gcS + [.crm_tipc]
lcOrder1 = [id_tipc]
lcFiltru1 = [2=2]
lcFiltruOriginal = []
llModParam = .T.
llAfiseaza = .F.
lcgroup = []
gencursor('poTipc','tTipc', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza, lcgroup, llModParam, lcFiltruOriginal)
poTipc.ca_baza1.afisare()
Select tTipc
lotc = Createobject("frm_tipc")
lotc.Show(1)
Release poTipc
Endproc && viz_tipc
***-----------------------------------------------------------------------------------------------------------------------------
********* Inceput: viz_articole
Procedure viz_articole
Private poArticole
Store '' To poArticole
Local lcSchema1, lcSelect1, lcOrder1, lcFiltru1, llAfiseaza
lcSchema1 = ['']
lcSelect1 = [select * from ] + gcS + [.nom_articole]
lcOrder1 = [denumire]
lcFiltru1 = [1=2]
lcFiltruOriginal = []
llModParam = .T.
llAfiseaza = .F.
lcgroup = []
gencursor('poArticole','tArticole', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza, lcgroup, llModParam, lcFiltruOriginal)
poArticole.ca_baza1.afisare()
of_art = Createobject('frm_articole')
of_art.Show(1)
Endproc
********* Sfarsit: viz_articole
******************************************************************************************************************
Procedure viz_clienti()
Private poClie,pcschema1,pcselect1
Local llAfiseaza
Store .F. To llAfiseaza
Store '' To poClie
If Used('v_clie')
Use In v_clie
Endif
pcschema1=['']
pcselect1=['select b.* from vcoresp_tip_part a left join vnom_parteneri b '+]+;
['on a.id_part=b.id_part where a.id_tip_part=16 and b.inactiv=0']
pcorder1=[b.nume]
pcfiltru1 = [1 = 2]
llAfiseaza = .F.
gencursor('poclie','v_clie',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfiseaza)
poClie.ca_baza1.afisare()
ofrmclienti=Createobject('frm_clienti')
ofrmclienti.Show(1)
Release ofrmclienti,poClie
Endproc && viz_clienti
******************************************************************************************************************
******************************************************************************************************************
Procedure viz_agenti
Private poagenti,pcschema1,pcselect1
Local llAfiseaza
Store .F. To llAfiseaza
Store '' To poagenti
If Used('crsagenti')
Use In crstagenti
Endif
pcschema1=['']
pcselect1=['select * from ]+gcS+[.vnom_agenti where 2=2']
pcorder1=[nume_agent]
pcfiltru1 = [1 = 2]
llAfiseaza = .F.
gencursor('poagenti','crsagenti',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfiseaza)
poagenti.ca_baza1.afisare()
ofrmagenti=Createobject('frm_agenti')
ofrmagenti.Show(1)
Release ofrmtipuri,potipurieven
Endproc && viz_agenti
******************************************************************************************************************
*****************************************************************************
function cauta_zona
Lparameters tnIdZona,tcNumeZona
Local locauta,llReturn
Store "" To locauta
Store .F. To llReturn
pcselect = ["select id_zona,zona from ] + gcS + [.crm_vzone where inactiv=0"]
pcfiltru = [1=2]
pcschema = ['']
pcorder = [2]
pccoloane = [Zona]
pcTitlu = [Zona]
pcTitluColoane = [Zona]
locauta = cauta_alfa(pcselect,pcfiltru,pcschema,pcorder,pccoloane,pcTitlu,pcTitluColoane,"")
If !Empty(locauta.id_zona)
tnIdZona=locauta.id_zona
tcNumeZona=Alltrim(locauta.zona)
llReturn=.T.
Endif
Return llReturn
Endfunc && cauta_zona
*****************************************************************************
Procedure update_clienti( )
LPARAMETERS tnid_partener
LOCAL lcFiltru
IF !EMPTY(tnid_partener)
lcFiltru = [ and p.id_part=]+ALLTRIM(STR(tnid_partener))
ELSE
lcFiltru = []
ENDIF
If Used('v_clienti')
Use In v_clienti
Endif
lcSql = [select distinct p.nume, p.cod_fiscal, p.id_part FROM ] + gcS + [.vcoresp_tip_part p ] + ;
[join ] + gcS + [.vcoresp_tip_cont c on p.id_tip_part=c.id_tip_part where c.cont ='4111' ] + ;
[and p.inactiv=0 ]+lcFiltru+[ order by p.nume ]
lcCursor = 'v_clienti'
lnSucces = goExecutor.oExecute(lcSql,lcCursor)
goExecutor.oReset()
Return lnSucces
Endproc
**********************sfarsit procedura update_clienti*******************

687
Programe/oparteneri.prg Normal file
View File

@@ -0,0 +1,687 @@
*!* APEL DE PROCEDURA
*!* DO lans_ireg_parteneri WITH tlTest,tcCont,tlActiv
*-----------------------------------------------------------
PROCEDURE lans_ireg_parteneri
PARAMETERS tlTest,tcCont,tlactiv,tlTitluTot,tcDenumire,tcDenDebit,tcDenCredit
*!* tlTitluTot = daca denumirea titlului este totala i.e.: Nu trebuie sa mai adaug Balanta parteneri
*!* tcDenumire = titlul balantei
*!* tcDenDebit = peste tot pe unde apare debit se va inlocui cu aceasta denumire
*!* tcDenCredit = peste tot pe unde apare credit se va inlocui cu aceasta denumire
LOCAL lcCont, llActiv, llParametri,llTitluTot,lcDenumire,lcDenDebit,lcDenCredit
llParametri = .F.
IF EMPTY(tlTitluTot)
llTitluTot = .F.
ELSE
llTitluTot = tlTitluTot
ENDIF
IF EMPTY(tcDenumire)
lcDenumire = ""
ELSE
lcDenumire= tcDenumire
ENDIF
IF EMPTY(tcDenDebit)
lcDenDebit = "Debit"
ELSE
lcDenDebit = tcDenDebit
ENDIF
IF EMPTY(tcDenCredit)
lcDenCredit = "Credit"
ELSE
lcDenCredit = tcDenCredit
ENDIF
IF !EMPTY(tcCont)
lcCont = ALLTRIM(tcCont)
ELSE
lcCont = ''
ENDIF
IF !EMPTY(tlactiv)
llActiv = tlactiv
ELSE
llActiv = .F.
ENDIF
llParametri = .F.
*If PCOUNT() = 3
*!* IF !EMPTY(tlActiv) AND !EMPTY(tcCont) AND !EMPTY(tlActiv)
*!* llParametri = .T.
*!* Endif
IF !EMPTY(tcCont)
llParametri = .T.
ENDIF
LOCAL NOU, lnTdeb, lnTcred, lnSold, lcContPart, lclista
STORE 0 TO lnTdeb, lnTcred, lnSold
NOU=.T.
IF glPrimaLuna
NOU = .F.
ENDIF
PRIVATE plActiv
STORE .T. TO plActiv
PRIVATE eActiv
STORE .T. TO eActiv
IF !llParametri
PRIVATE polista,pcschema1,pcselect1,pcfiltru1,pcorder1
STORE "" TO polista
IF USED('clista')
USE IN clista
ENDIF
pcschema1=['cont c(4),acont c(4),explicatie c(50)']
pcselect1=['select distinct cont,rpad(CHR(32),4,CHR(32)) as acont,explicatie from ]+gcS+[.vcoresp_tip_cont where 1=2']
pcfiltru1=[2=2]
pcorder1=[cont]
llAfisare=.F.
gencursor('polista','clista',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfisare)
polista.ca_baza1.afisare()
SELECT clista
loCont=myscatter('blank')
Ol=CREATEOBJECT("frm_sel_cont")
WITH Ol
.Lb_titlu_alb_b121.CAPTION= 'Selectati contul'
IF EMPTY(.cboCont.ROWSOURCE)
.cboCont.ROWSOURCE="clista.cont,acont"
ENDIF
.ocont=loCont
IF EMPTY(.cAlias)
.cAlias=LEFT(.cboCont.ROWSOURCE,AT(".",.cboCont.ROWSOURCE)-1)
ENDIF
.HEIGHT = 190
ENDWITH
Ol.SHOW(1)
IF buton = 2
USE IN clista
RETURN
ENDIF
lcContPart = loCont.CONT
IF !llTitluTot AND EMPTY(lcDenumire)
lcDenumire = "Inregistrari " + ALLTRIM(clista.explicatie) + "( " + lcContPart + " )"
ELSE
IF !EMPTY(lcDenumire) AND !llTitluTot
lcDenumire = "Inregistrari " + lcDenumire + "( " + lcContPart + " )"
ENDIF
ENDIF
USE IN clista
plActiv = eActiv
ELSE
eActiv = llActiv
plActiv = llActiv
lcContPart = lcCont
IF !llTitluTot AND EMPTY(lcDenumire)
lcDenumire = "Inregistrari " + "( " + lcContPart + " )"
ELSE
IF !EMPTY(lcDenumire) AND !llTitluTot
lcDenumire = "Inregistrari " + lcDenumire + "( " + lcContPart + " )"
ENDIF
ENDIF
ENDIF
*** verificare INAINTE_DE
DO inainte WITH "IREG_PARTENERI",lcContPart IN oinainte_de.prg
IF tlTest
DO test_ireg WITH lcContPart,llActiv
ENDIF
pcCont = lcContPart
PRIVATE poireg_parteneri,pcschema1,pcselect1
STORE '' TO poireg_parteneri
pcschema1 = ['id_ireg_part n(20),an n(4), luna n(2),ID_FACT N(20),id_part n(20),cont c(4),acont c(4), ID_VALUTA N(5), ID_VENCHELT N(5), PROC_TVA N(8,2),' +] + ;
['PRECDEB N(20,4),PRECCRED N(20,4),PRECVALDEB N(20,4),PRECVALCRED N(20,4),' +] + ;
['debit n(20,4),credit n(20,4),valdebit n(20,4), valcredit n(20,4),' +] + ;
['NRACT N(14),DATAACT D,DATAIREG D,DATASCAD D,CURS N(9,3),' +] + ;
['COD N(20),EXPLICATIA C(100),EXPLICATIA4 C(100),EXPLICATIA5 C(100), ' +] + ;
['ID_RESPONSABIL N(5),ID_FDOC N(5),ID_LUCRARE N(5),ID_SET N(20),ID_ACT N(20),' +] + ;
['NUME C(100),COD_FISCAL C(30),FDOC C(50),NRESP C(50),NRORD C(50),NUME_VAL C(10),VENCHELT C(50)' ]
pcselect1=['SELECT I.ID_IREG_PART, I.AN, I.LUNA, ID_FACT, I.ID_PART, I.CONT, I.ACONT, I.ID_VALUTA, I.ID_VENCHELT, I.PROC_TVA,' + ] +;
['I.PRECDEB, I.PRECCRED, I.PRECVALDEB, I.PRECVALCRED, ' + ] +;
['I.DEBIT, I.CREDIT, I.VALDEBIT, I.VALCREDIT, ' + ] +;
['I.NRACT, I.DATAACT, I.DATAIREG, I.DATASCAD, I.CURS,' + ] +;
['I.COD, I.EXPLICATIA, I.EXPLICATIA4, I.EXPLICATIA5,' + ] +;
['I.ID_RESPONSABIL, I.ID_FDOC, I.ID_LUCRARE, I.ID_SET, I.ID_ACT,' + ] +;
['I.NUME,I.COD_FISCAL,I.FDOC,I.NRESP,I.NRORD,I.NUME_VAL,I.VENCHELT' + ] + ;
[' FROM ] + GCS + [.VIREG_PARTENERI I WHERE 1=2']
*!* pcselect1=['select i.*,p.cod_fiscal from ] + gcS + [.vireg_parteneri i join ] + gcS + ;
*!* [.vnom_parteneri p on p.id_part = i.id_part where 1=2']
pcorder1=[dataact]
pcfiltru1 = [1=2]
*!* pcfiltru1 = [cont = '] + Alltrim(pcCont) + [' and luna = ] + Alltrim(Str(gnLuna)) + [ and an = ] + Alltrim(Str(gnAn))
gencursor('poireg_parteneri','actcv',pcselect1,pcfiltru1,pcschema1,pcorder1)
poireg_parteneri.ca_baza1.afisare()
SELECT actcv
tcFis2 = "ActCv"
tlVisible = .T.
LOCAL c
c="nume+ALLTRIM(STR(YEAR(dataact)))+RIGHT('0'+ALLTRIM(STR(MONTH(dataact))),2)+RIGHT('0'+ALLTRIM(STR(DAY(dataact))),2)"
buton=1
IF tlTest AND .F.
PRIVATE pcCampVerif
pcCampVerif = ofis.camp_verif
SELECT (tcFis2)
SET FILTER TO
lcProc='inainte_'+ALLTRIM(tcFis2)
DO &lcProc IN inaintede.prg
IF buton=2
RETURN
ENDIF
ENDIF
SELE actcv
PRIVATE pcAnalitic,pcLucrare
STORE '' TO pcAnalitic,pcLucrare
Oreg=CREATEOBJECT("FRM_IREG_PARTENERI")
WITH Oreg
.lActiv = llActiv
.cCont = lcContPart
*!* .LABEL10.Caption=Proper(tctitlu)&&& trebuie facut
.LABEL10.CAPTION= PROPER(lcDenumire)
.grid1.column12.VISIBLE=.T.
.CONT=ALLT(pcCont)
.fisier=ALLTRIM(tcFis2)
.Ck_valuta.VISIBLE=tlVisible
.CK_explicatia.VISIBLE=tlVisible
.CHECK7.VISIBLE=tlVisible
.CHECK9.VISIBLE=tlVisible
.grid1.column2.VISIBLE=tlVisible
.grid1.column11.VISIBLE=tlVisible
.grid1.column13.VISIBLE=tlVisible
.grid1.column14.VISIBLE=tlVisible
.grid1.column7.VISIBLE=tlVisible
.grid1.column8.VISIBLE=tlVisible
.grid1.column10.VISIBLE=tlVisible
IF !tlVisible
.CHECK3.CAPTION='Regularizate'
.CHECK4.CAPTION='Neregularizate'
.check10.CAPTION='Regularizat'
.grid1.column12.header1.CAPTION='Regularizat'
.grid1.column2.WIDTH=0
ENDIF
IF !plActiv
.grid1.column9.CONTROLSOURCE = "(preccred+credit)-(precdeb+debit)"
.grid1.column14.CONTROLSOURCE ="(precvalcred+valcredit)-(precvaldeb+valdebit)"
.ck_sold.camp_nume = "credit+preccred-precdeb-debit"
.grid1.column1.CONTROLSOURCE = "preccred+credit"
.grid1.column12.CONTROLSOURCE = "precdeb+debit"
.grid1.column11.CONTROLSOURCE = "precvalcred+valcredit"
.grid1.column13.CONTROLSOURCE = "precvaldeb+valdebit"
.grid1.column20.CONTROLSOURCE = "credit"
.grid1.column21.CONTROLSOURCE = "debit"
.grid1.column22.CONTROLSOURCE = "valcredit"
.grid1.column23.CONTROLSOURCE = "valdebit"
.grid1.column18.CONTROLSOURCE = "preccred"
.grid1.column19.CONTROLSOURCE = "precdeb"
.grid1.column1.header1.CAPTION = "Total " + lcDenCredit
.grid1.column12.header1.CAPTION = "Total " + lcDenDebit
.grid1.column11.header11.CAPTION = "Total " + lcDenCredit + " valuta"
.grid1.column13.header1.CAPTION = "Total " + lcDenDebit + " valuta"
.grid1.column20.header1.CAPTION = lcDenCredit
.grid1.column21.header1.CAPTION = lcDenDebit
.grid1.column22.header1.CAPTION = lcDenCredit + " valuta"
.grid1.column23.header1.CAPTION = lcDenDebit + " valuta"
.grid1.column18.header1.CAPTION = "Prec " + lcDenCredit
.grid1.column19.header1.CAPTION = "Prec " + lcDenDebit
ELSE
.grid1.column9.CONTROLSOURCE = "(precdeb+debit)-(preccred+credit)"
.grid1.column14.CONTROLSOURCE ="(precvaldeb+valdebit)-(precvalcred+valcredit)"
.ck_sold.camp_nume = "precdeb+debit-credit-preccred"
.grid1.column1.header1.CAPTION = "Total " + lcDenDebit
.grid1.column12.header1.CAPTION = "Total " + lcDenCredit
.grid1.column11.header11.CAPTION = "Total " + lcDenDebit + " valuta"
.grid1.column13.header1.CAPTION = "Total " + lcDenCredit + " valuta"
.grid1.column20.header1.CAPTION = lcDenDebit
.grid1.column21.header1.CAPTION = lcDenCredit
.grid1.column22.header1.CAPTION = lcDenDebit + " valuta"
.grid1.column23.header1.CAPTION = lcDenCredit + " valuta"
.grid1.column18.header1.CAPTION = "Prec " + lcDenDebit
.grid1.column19.header1.CAPTION = "Prec " + lcDenCredit
ENDIF
IF TYPE('pcTotctva')#'U' AND TYPE('pcAchitat')#'U'
.grid1.column12.header1.CAPTION=pcAchitat
.grid1.column1.header1.CAPTION=pcTotctva
ENDIF
IF TYPE('pcSumaTotal')#'U' AND TYPE('pcSumaAchi')#'U'
.CHECK13.CAPTION=pcSumaTotal
.check10.CAPTION=pcSumaAchi
ENDIF
IF TYPE('actcv.nresp') # 'U'
.grid1.column17.VISIBLE= .T.
.grid1.column17.CONTROLSOURCE = 'nresp'
.Ck_responsabil.VISIBLE = .T.
ENDIF
ENDWITH
Oreg.SHOW(1)
*!* Select actcv
*!* If Used('actcv')
*!* Use In actcv
*!* Endif
*!* Release ofis
RELEASE Oreg
USE IN actcv
ENDPROC && lans_ireg_parteneri
*---------------------------------------------------------------------------------
PROCEDURE lans_balanta_parteneri
LPARAMETERS tcCont,tlactiv,tlTitluTot,tcDenumire,tcDenDebit,tcDenCredit &&initital cu 2 parametrii
*!* tlTitluTot = daca denumirea titlului este totala i.e.: Nu trebuie sa mai adaug Balanta parteneri
*!* tcDenumire = titlul balantei
*!* tcDenDebit = peste tot pe unde apare debit se va inlocui cu aceasta denumire
*!* tcDenCredit = peste tot pe unde apare credit se va inlocui cu aceasta denumire
LOCAL llParametri, lcCont, llActiv,llTitluTot,lcDenumire,lcDenDebit,lcDenCredit
llParametri = .F.
lcCont = ''
llActiv = .F.
IF EMPTY(tlTitluTot)
llTitluTot = .F.
ELSE
llTitluTot = tlTitluTot
ENDIF
IF EMPTY(tcDenumire)
lcDenumire = ""
ELSE
lcDenumire= tcDenumire
ENDIF
IF EMPTY(tcDenDebit)
lcDenDebit = "Debit"
ELSE
lcDenDebit = tcDenDebit
ENDIF
IF EMPTY(tcDenCredit)
lcDenCredit = "Credit"
ELSE
lcDenCredit = tcDenCredit
ENDIF
*!* IF PCOUNT() < 2
IF EMPTY(tcCont) AND EMPTY(tlactiv)
llParametri = .F.
ELSE
llParametri = .T.
lcCont = ALLTRIM(tcCont)
llActiv = tlactiv
ENDIF
LOCAL NOU, lnTdeb, lnTcred, lnSold, lcContPart, lclista
STORE 0 TO lnTdeb, lnTcred, lnSold
NOU=.T.
IF .F.
SELECT calendar
GO TOP
IF an=pcAn AND NL=pcNl
NOU=.F.
ENDIF
ENDIF
*!* IF glPrimaLuna
*!* nou = .F.
*!* ENDIF
PRIVATE polista,pcschema1,pcselect1,pcfiltru1,pcorder1
STORE "" TO polista
IF !llParametri
IF USED('clista')
USE IN clista
ENDIF
pcschema1=['cont c(4),acont c(4),explicatie c(50)']
pcselect1=['select distinct cont,rpad(CHR(32),4,CHR(32)) as acont,explicatie from ]+gcS+[.vcoresp_tip_cont where 1=2']
pcfiltru1=[2=2]
pcorder1=[cont]
llAfisare=.F.
gencursor('polista','clista',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfisare)
polista.ca_baza1.afisare()
*!* SELECT DISTINCT cont, '' as acont FROM coresp_tip_cont INTO CURSOR clista
SELECT clista
loCont=myscatter('blank')
PRIVATE eActiv
STORE .T. TO eActiv
Ol=CREATEOBJECT("frm_sel_cont")
WITH Ol
.Lb_titlu_alb_b121.CAPTION= 'Selectati contul'
IF EMPTY(.cboCont.ROWSOURCE)
.cboCont.ROWSOURCE="clista.cont,acont"
ENDIF
.ocont=loCont
IF EMPTY(.cAlias)
.cAlias=LEFT(.cboCont.ROWSOURCE,AT(".",.cboCont.ROWSOURCE)-1)
ENDIF
.HEIGHT = 190
ENDWITH
Ol.SHOW(1)
IF buton = 2
USE IN clista
RETURN
ENDIF
lcContPart = loCont.CONT
IF !llTitluTot AND EMPTY(lcDenumire)
lcDenumire = "Balanta " + ALLTRIM(clista.explicatie) + "( " + lcContPart + " )"
ELSE
IF !EMPTY(lcDenumire) AND !llTitluTot
lcDenumire = "Balanta " + lcDenumire + "( " + lcContPart + " )"
ENDIF
ENDIF
USE IN clista
ELSE
lcContPart = lcCont
eActiv = llActiv
IF !llTitluTot AND EMPTY(lcDenumire)
lcDenumire = "Balanta " + "( " + lcContPart + " )"
ELSE
IF !EMPTY(lcDenumire) AND !llTitluTot
lcDenumire = "Balanta " + lcDenumire + "( " + lcContPart + " )"
ENDIF
ENDIF
ENDIF
IF eActiv
lnSemn = -1
ELSE
lnSemn = 1
ENDIF
*** verificare INAINTE_DE
DO inainte WITH "BALANTA_parteneri",lcContPart IN oinainte_de.prg
PRIVATE pobalpartext,pcschema2,pcselect2,pcfiltru2,pcorder2,pobalpartint,pcschema3,pcselect3,pcfiltru3,pcorder3,pcgroup3
STORE "" TO pobalpartext,pobalpartint
pcschema2=['PRECDEB1 N(19,2),PRECCRED1 N(19,2),PRECDEB N(19,2),PRECCRED N(19,2),'+]+;
['DEB N(19,2),CRED N(19,2),PRECVALDEB1 N(19,2),PRECVALCRED1 N(19,2),PRECVALDEB N(19,2),'+]+;
['PRECVALCRED N(19,2),VALDEBIT N(19,2),VALCREDIT N(19,2),NUME_VAL C(5),ID_PART N(10),'+]+;
['NUME C(50),COD_FISCAL C(30),CONT C(4),ACONT C(4),AN N(4),LUNA N(2),TOTCRED N(19,2),TOTDEB N(19,2),'+]+;
['TOTVALCRED N(19,2),TOTVALDEB N(19,2),ID_VALUTA N(5)']
pcselect2=['select PRECDEB1,PRECCRED1,PRECDEB,PRECCRED,'+]+;
['DEBIT as DEB,CREDIT as CRED,PRECVALDEB1,PRECVALCRED1,PRECVALDEB,'+]+;
['PRECVALCRED,VALDEBIT,VALCREDIT,NUME_VAL,ID_PART,'+]+;
['NUME,COD_FISCAL,CONT,ACONT,AN,LUNA,'+]+;
['PRECCRED+CREDIT as TOTCRED,PRECDEB+DEBIT as TOTDEB,'+]+;
['PRECVALCRED+VALCREDIT as TOTVALCRED,PRECVALDEB+VALDEBIT as TOTVALDEB,ID_VALUTA '+]+;
['from ]+gcS+[.vbalanta_parteneri where 1=2']
pcfiltru2=[1=2]
pcorder2=[nume,acont]
llAfisare=.F.
gencursor('pobalpartext','xtemp',pcselect2,pcfiltru2,[''],pcorder2,llAfisare)
pobalpartext.ca_baza1.afisare()
pcschema3=['PRECDEB1 N(19,2),PRECCRED1 N(19,2),PRECDEB N(19,2),PRECCRED N(19,2),'+]+;
['DEB N(19,2),CRED N(19,2),PRECVALDEB1 N(19,2),PRECVALCRED1 N(19,2),PRECVALDEB N(19,2),'+]+;
['PRECVALCRED N(19,2),VALDEBIT N(19,2),VALCREDIT N(19,2),NUME_VAL C(5),ID_PART N(10),'+]+;
['NUME C(50),COD_FISCAL C(30),CONT C(4),ACONT C(4),AN N(4),LUNA N(2),TOTCRED N(19,2),TOTDEB N(19,2),'+]+;
['TOTVALCRED N(19,2),TOTVALDEB N(19,2),ID_VALUTA N(5)']
pcselect3=['select SUM(PRECDEB1) AS PRECDEB1,SUM(PRECCRED1) AS PRECCRED1,SUM(PRECDEB) AS PRECDEB,SUM(PRECCRED) AS PRECCRED,'+]+;
['SUM(DEBIT) as DEB,SUM(CREDIT) as CRED,0 AS PRECVALDEB1,0 AS PRECVALCRED1,0 AS PRECVALDEB,'+]+;
["0 AS PRECVALCRED,0 AS VALDEBIT,0 AS VALCREDIT,'LEI' AS NUME_VAL,ID_PART,"+]+;
['NUME,COD_FISCAL,CONT,ACONT,AN,LUNA,'+]+;
['SUM(PRECCRED+CREDIT) as TOTCRED,SUM(PRECDEB+DEBIT) as TOTDEB,'+]+;
['SUM(PRECVALCRED+VALCREDIT) as TOTVALCRED,SUM(PRECVALDEB+VALDEBIT) as TOTVALDEB,0 AS ID_VALUTA '+]+;
['from ]+gcS+[.vbalanta_parteneri where 1=2']
pcfiltru3=[1=2]
pcorder3=[nume,acont]
pcgroup3=[CONT,ACONT,AN,LUNA,ID_PART,NUME,COD_FISCAL]
llAfisare=.F.
gencursor('pobalpartint','xtemp',pcselect3,pcfiltru3,[''],pcorder3,llAfisare,pcgroup3)
pobalpartint.ca_baza1.afisare()
OVIZ=CREATEOBJECT("frm_bal_parteneri")
WITH OVIZ
*!* .LABEL10.Caption='SITUATIA ANALITICA - BALANTA PARTENERI (' + Alltrim(lcContPart) + ')'
.LABEL10.CAPTION = PROPER(lcDenumire)
IF eActiv
.grid1.column6.CONTROLSOURCE='- cred + deb'
.grid1.column10.CONTROLSOURCE='- totcred + totdeb'
.grid1.column9.CONTROLSOURCE='- preccred + precdeb'
.grid1.column21.CONTROLSOURCE='- totvalcred + totvaldeb'
.grid1.column18.CONTROLSOURCE='- precvalcred + precvaldeb'
*!* .grid1.column6.header1.Caption='Sold (deb-cred)'
*!* .grid1.COLUMN4.header1.Caption='Debit'
*!* .grid1.COLUMN5.header1.Caption='Credit'
.grid1.column6.header1.CAPTION= "Sold("+ALLTRIM(lcDenDebit)+"-"+ALLTRIM(lcDenCredit)+")"&&'Sold (cred-deb)'
.grid1.COLUMN4.header1.CAPTION= lcDenDebit&&Debit'
.grid1.COLUMN5.header1.CAPTION= lcDenCredit&&'Credit'
.grid1.column11.header1.CAPTION= "Prec." + lcDenDebit&&Debit'
.grid1.column12.header1.CAPTION= "Prec." + lcDenCredit&&'Credit'
.grid1.COLUMN15.header1.CAPTION= "Total" + lcDenDebit&&Debit'
.grid1.COLUMN16.header1.CAPTION= "Total" + lcDenCredit&&'Credit'
.pcfel='A'
ELSE
.grid1.column6.CONTROLSOURCE='cred - deb'
.grid1.column10.CONTROLSOURCE='totcred - totdeb'
.grid1.column9.CONTROLSOURCE='preccred - precdeb'
.grid1.column21.CONTROLSOURCE='totvalcred - totvaldeb'
.grid1.column18.CONTROLSOURCE='precvalcred - precvaldeb'
.grid1.column6.header1.CAPTION= "Sold("+ALLTRIM(lcDenCredit)+"-"+ALLTRIM(lcDenDebit)+")"&&'Sold (cred-deb)'
.grid1.COLUMN4.header1.CAPTION= lcDenDebit&&Debit'
.grid1.COLUMN5.header1.CAPTION= lcDenCredit&&'Credit'
.grid1.column12.header1.CAPTION= "Prec." + lcDenCredit&&'Credit'
.grid1.column11.header1.CAPTION= "Prec." + lcDenDebit&&'Debit'
*!* .grid1.column11.controlsource = "preccred"
*!* .grid1.column12.controlsource = "precdeb"
.grid1.COLUMN16.header1.CAPTION= "Total" + lcDenCredit&&'Credit'
.grid1.COLUMN17.header1.CAPTION= "Total" + lcDenDebit&&'Debit'
*!* .grid1.COLUMN15.controlsource= "totCred" &&Credit'
*!* .grid1.COLUMN16.controlsource= "TotDeb" &&'Debit'
.pcfel='P'
ENDIF
.grid1.column18.VISIBLE=.F.
.grid1.column19.VISIBLE=.F.
.grid1.column20.VISIBLE=.F.
.grid1.column21.VISIBLE=.F.
.grid1.column22.VISIBLE=.F.
.TABEL = 'BALANTA_PARTENER'
.pcCont = ALLTRIM(lcContPart)
.grid1.column8.WIDTH=0
.grid1.column13.WIDTH=0
.grid1.column14.WIDTH=0
.grid1.column8.VISIBLE=.F.
.grid1.column13.VISIBLE=.F.
.grid1.column14.VISIBLE=.F.
.label7.VISIBLE=.F.
.text4.VISIBLE=.F.
.TEXT5.VISIBLE=.F.
.text9.VISIBLE=.F.
ENDWITH
IF !NOU
WITH OVIZ.grid1
.column2.COLUMNORDER=2
FOR I=9 TO 16
lcViz='.column'+ALLTRIM(STR(I))+'.visible=.f.'
*lcWidth='.column'+ALLTRIM(STR(i))+'.width=0'
&lcViz
*&lcWidth
ENDFOR
ENDWITH
ENDIF
OVIZ.SHOW(1)
USE IN xtemp
*!* ENDIF
ENDPROC && lans_balanta_parteneri
*----------------------------------------------------------------------------------------------
*---------------------------------- Inceput lans_balanta_cumulata ----------------------------------
PROCEDURE lans_balanta_cumulata
pcselect = [select explicatie, id_coloana from ] + gcs + [.coloane where 2=2]
pcfiltru = [2=2]
pcschema = ['']
pcorder = [explicatie]
pccoloane = [explicatie]
pcTitlu = [Alegeti Balanta]
pcFiltruOriginal = [camp is null and tabel is null and id_prg_owner = 2 and configurabil = 1]
locauta = cauta_alfa(pcselect,pcfiltru,pcschema,pcorder,pccoloane,pcTitlu,pcTitlu,"",.f.,pcFiltruOriginal)
IF EMPTY(locauta.id_coloana) OR ISNULL(locauta.id_coloana)
RETURN
ENDIF
pnIdBal = locauta.id_coloana
pcTitluCol = []
pcNumeCol = []
lcSel = [{call pack_balante_cumulate.balante_cumulate(?@pcNumeCol,?@pcTitluCol,?gcS,?pnIdBal,?gnAn,?gnLuna)}]
lcSchema = []
lcCursor = 'crs_bal'
lnSucces = goExecutor.oExecute(lcSel,lcCursor)
IF lnSucces < 0
MESSAGEBOX(goExecutor.cEroare,0+16,"Eroare")
RETURN
ENDIF
pcNumeCol = [nume;cod_fiscal;acont;] + pcNumeCol
pcTitluCol = [Partener,Cod Fiscal,Analitic,] + pcTitluCol
SELECT (lcCursor)
SCATTER NAME loto BLANK
obalp = CREATEOBJECT('frm_bal_parteneri_cumulata')
obalp.ototal = loto
WITH obalp.ct_grid_order1
.cselect = lcSel
.cschema = lcSchema
.cTitlu_coloane = pcTitluCol
.cNume_coloane = pcNumeCol
.cFiltruOriginal = []
.cFiltru = []
.cOrder = []
.cTitlu = []
.cnumeCursor = lcCursor
.lmodparam = .T.
ENDWITH
obalp.ctitlu = locauta.explicatie
obalp.show()
IF USED(lcCursor)
USE IN (lcCursor)
ENDIF
ENDPROC && lans_balanta_cumulata
*---------------------------------- Sfarsit lans_balanta_cumulata ----------------------------------
*---------------------------------- Inceput configurare_balanta_cumulata ----------------------------------
PROCEDURE configurare_balanta_cumulata
PRIVATE pnIdBalanta, pnIdColoana
STORE 0 TO pnIdBalanta, pnIdColoana
pcselect1 = [select explicatie,explicatie2, id_coloana from ] + gcs + [.coloane ]
pcfiltru1 = [camp is null and tabel is null and id_prg_owner = 2 and configurabil = 1]
pcschema1 = ['']
pcorder1 = [explicatie]
pccoloane1 = [explicatie; explicatie2]
pcTitluCol1 = [Titlu Balanta,Conturi]
pcTitlu1 = [Lista Balante Configurate]
pcselect2 = [select f.id_calcul, f.id_op_col , f.ordine, f.id_coloana, c.camp, c.explicatie from ] + gcs + [.sal_calcul f left join ] + ;
gcs +[.coloane c on f.id_op_col = c.id_coloana and f.coloana = 1]
pcfiltru2 = [f.id_coloana =?pnIdBalanta]
pcschema2 = ['']
pcorder2 = [f.ordine]
pccoloane2 = [explicatie; ordine]
pcMask2 = '[1]=;[2]=REPLICATE("9",3)'
pcTitluCol2 = [Titlu coloana, Ordine]
pcTitlu2 = [Coloane Balanta]
pcselect3 = [select id_calcul, id_coloana, id_op_col, explicatie, camp, coloana, ordine from ] + gcs + [.cont_vformule_balante ]
pcfiltru3 = [id_coloana =?pnIdColoana]
pcschema3 = ['']
pcorder3 = [ordine]
pccoloane3 = [camp;explicatie;ordine]
pcMask3 = '[1]=;[2]=;[3]=REPLICATE("9",3)'
pcTitluCol3 = [Camp,Explicatie,Ordine]
pcTitlu3 = [Formula Coloane]
obalp = CREATEOBJECT('config_balante_parteneri')
WITH obalp.Ct_grid_search1
.cselect = pcselect1
.cschema = pcschema1
.cTitlu_coloane = pcTitluCol1
.cNume_coloane = pccoloane1
.cFiltruOriginal = pcfiltru1
.cFiltru = [2=2]
.cOrder = pcorder1
.cTitlu = pcTitlu1
.cnumeCursor = 'crs_NumeBal'
.lmodparam = .T.
ENDWITH
WITH obalp.Ct_grid_search2
.cselect = pcselect2
.cschema = pcschema2
.cTitlu_coloane = pcTitluCol2
.cNume_coloane = pccoloane2
.cFiltruOriginal = pcfiltru2
.cFiltru = [2=2]
.cOrder = pcorder2
.cTitlu = pcTitlu2
.cMask = pcMask2
.cnumeCursor = 'crs_ColoaneBal'
.lmodparam = .t.
ENDWITH
WITH obalp.Ct_grid_search3
.cselect = pcselect3
.cschema = pcschema3
.cTitlu_coloane = pcTitluCol3
.cNume_coloane = pccoloane3
.cFiltruOriginal = pcfiltru3
.cFiltru = [2=2]
.cOrder = pcorder3
.cTitlu = pcTitlu3
.cMask = pcMask3
.cnumeCursor = 'crs_FormulaBal'
.lmodparam = .t.
ENDWITH
obalp.show()
ENDPROC && configurare_balanta_cumulata
*---------------------------------- Sfarsit configurare_balanta_cumulata ----------------------------------

379
Programe/oparteneri_contracte.prg Normal file
View File

@@ -0,0 +1,379 @@
*!* APEL DE PROCEDURA
*!* DO lans_ireg_parteneri WITH tlTest,tcCont,tlActiv
*-----------------------------------------------------------
Procedure lans_ireg_parteneri
Parameters tlTest,tcCont,tlactiv,tlTitluTot,tcDenumire,tcDenDebit,tcDenCredit, tlContract
*!* tlTitluTot = daca denumirea titlului este totala i.e.: Nu trebuie sa mai adaug Balanta parteneri
*!* tcDenumire = titlul balantei
*!* tcDenDebit = peste tot pe unde apare debit se va inlocui cu aceasta denumire
*!* tcDenCredit = peste tot pe unde apare credit se va inlocui cu aceasta denumire
*!* 07.08.2008
*!* am copiat frm_ireg_parteneri din comun\clase\oparteneri.vcx
*!* am sters butoanele cmdModifica, cmdSterge, init - referinte la butoane, do_cauta - fara an si luna
*!* 07.08.2008 ^
Local lcCont, llActiv, llParametri,llTitluTot,lcDenumire,lcDenDebit,lcDenCredit
llParametri = .F.
If Empty(tlTitluTot)
llTitluTot = .F.
Else
llTitluTot = tlTitluTot
Endif
If Empty(tcDenumire)
lcDenumire = ""
Else
lcDenumire= tcDenumire
Endif
If Empty(tcDenDebit)
lcDenDebit = "Debit"
Else
lcDenDebit = tcDenDebit
Endif
If Empty(tcDenCredit)
lcDenCredit = "Credit"
Else
lcDenCredit = tcDenCredit
Endif
If !Empty(tcCont)
lcCont = Alltrim(tcCont)
Else
lcCont = ''
Endif
If !Empty(tlactiv)
llActiv = tlactiv
Else
llActiv = .F.
Endif
llParametri = .F.
If !Empty(tcCont)
llParametri = .T.
Endif
Local NOU, lnTdeb, lnTcred, lnSold, lcContPart, lclista
Store 0 To lnTdeb, lnTcred, lnSold
NOU=.T.
If glPrimaLuna
NOU = .F.
Endif
Private plActiv
Store .T. To plActiv
Private eActiv
Store .T. To eActiv
If llParametri
eActiv = llActiv
plActiv = llActiv
lcContPart = lcCont
If !llTitluTot And Empty(lcDenumire)
lcDenumire = "Inregistrari " + "( " + lcContPart + " )"
Else
If !Empty(lcDenumire) And !llTitluTot
lcDenumire = "Inregistrari " + lcDenumire + "( " + lcContPart + " )"
Endif
Endif
Endif
pcCont = lcContPart
Private poireg_parteneri,pcschema1,pcselect1
Store '' To poireg_parteneri
*!* lcschema1 = [id_ireg_part n(20), an n(4), luna n(2), ID_FACT N(20), rate_acoperite C(200), id_part n(20), cont c(4), acont c(4), ID_VALUTA N(5), ID_VENCHELT N(5), PROC_TVA N(8,2), ] + ;
*!* [PRECDEB N(20,4), PRECCRED N(20,4), PRECVALDEB N(20,4), PRECVALCRED N(20,4), ] + ;
*!* [debit n(20,4), credit n(20,4), valdebit n(20,4), valcredit n(20,4), ] + ;
*!* [NRACT N(14), DATAACT D, DATAIREG D, DATASCAD D, CURS N(10,4), ] + ;
*!* [COD N(20), EXPLICATIA C(100), EXPLICATIA4 C(100), EXPLICATIA5 C(100), ] + ;
*!* [ID_RESPONSABIL N(5), ID_FDOC N(5), ID_LUCRARE N(10), ID_CTR N(5), ID_SET N(20), ID_ACT N(20), ] + ;
*!* [NUME C(100), COD_FISCAL C(30), FDOC C(50), NRESP C(50), NRORD C(50), CONTRACT C(30), NUME_VAL C(10), VENCHELT C(50) ]
*!* modificare v 2.0.6 : am adaugat serie_act
lcschema1 = [ an n(4), luna n(2), ID_FACT N(20), rate_acoperite C(200), id_part n(20), cont c(4), acont c(4), ID_VALUTA N(5), ]+;
[ ID_VENCHELT N(5), PROC_TVA N(8,2), ] + ;
[PRECDEB N(20,4), PRECCRED N(20,4), PRECVALDEB N(20,4), PRECVALCRED N(20,4), ] + ;
[debit n(20,4), credit n(20,4), valdebit n(20,4), valcredit n(20,4), ] + ;
[NRACT N(14),serie_act c(50), DATAACT D, DATAIREG D, DATASCAD D, CURS N(10,gnPCurs2), ] + ;
[COD N(20), EXPLICATIA C(100), EXPLICATIA4 C(100), EXPLICATIA5 C(100), ] + ;
[ID_RESPONSABIL N(5), ID_FDOC N(5), ID_LUCRARE N(10), ID_CTR N(5), ID_SET N(20), ID_ACT N(20), ] + ;
[NUME C(100), COD_FISCAL C(30), FDOC C(50), NRESP C(50), NRORD C(50), CONTRACT C(30), NUME_VAL C(10), ]+;
[ VENCHELT C(50), ] + ;
[ID_SUCURSALA N(5), SUCURSALA C(100), NR N(10)]
lcPA = Alltrim(Str(gnPA))
*!* lcSelect1 = [ select i.an, i.luna, i.id_fact, ra.rate_acoperite, i.id_part, i.cont, i.acont, i.id_valuta, ]+;
*!* [ i.id_venchelt, i.proc_tva, ] + ;
*!* [ 000000000000000.0000 as PRECDEB, 000000000000000.0000 as PRECCRED, 000000000000000.0000 as PRECVALDEB, 000000000000000.0000 as PRECVALCRED, ]+;
*!* [ s2.debit, s2.credit, s2.valdebit, s2.valcredit, ]+;
*!* [ i.nract, i.dataact, i.dataireg, i.datascad, i.curs, ]+;
*!* [ i.cod, i.explicatia, i.explicatia4, i.explicatia5, ]+;
*!* [ i.id_responsabil, i.id_fdoc, i.id_lucrare, i.id_ctr, i.id_set, i.id_act, ]+;
*!* [ p.nume, p.cod_fiscal, f.FEL_DOCUMENT as fdoc, r.nume as nresp, l.nrord, ]+;
*!* [ (case when ctr.numar is not null then ctr.numar || '/' else '' end) || TO_CHAR(ctr.data, 'DD.MM.YYYY') as contract, ]+;
*!* [ v.nume_val, vc.explicatie as VENCHELT ]+;
*!* [ from (select an, luna, id_fact, id_part, cont, acont, id_valuta, ]+;
*!* [ id_venchelt, proc_tva, nract, dataact, dataireg, datascad, ]+;
*!* [ curs, cod, explicatia, explicatia4, explicatia5, id_responsabil, id_fdoc, id_lucrare, id_ctr, id_set, id_act ]+;
*!* [ from ireg_parteneri ]+;
*!* [ WHERE extract(year from dataireg) * 12 + extract(month from dataireg) = an * 12 + luna and id_part = ]+ ALLTRIM(STR(goContract.id_part))+[ and cont = '4111') i ]+;
*!* [ left join (select id_fact, cont,]+;
*!* [ sum(pack_sesiune.suma_ron(debit,an,luna,]+ lcPA + [)) as debit, ]+;
*!* [ sum(pack_sesiune.suma_ron(credit,an,luna,]+ lcPA + [)) as credit, ]+;
*!* [ sum(pack_sesiune.suma_ron(valdebit,an,luna,]+ lcPA + [)) as valdebit, ]+;
*!* [ sum(pack_sesiune.suma_ron(valcredit,an,luna,]+ lcPA + [)) as valcredit ]+;
*!* [ from ireg_parteneri where id_part = ]+ ALLTRIM(STR(goContract.id_part)) + [ and cont = '4111' group by id_fact,cont) s2 ]+;
*!* [ on i.id_fact = s2.id_fact ]+;
*!* [ left join (select s.id_ctr, ]+;
*!* [ rf.id_fact, stringAgg(s.den_rata) as rate_acoperite from vctr_rate_facturi rf ]+;
*!* [ left join (select * from vctr_scadentar order by id_ctr, den_rata) s on s.id_rata = rf.ID_RATA ]+;
*!* [ group by s.id_ctr, rf.id_fact) ra ]+;
*!* [ on i.id_fact = ra.id_fact ]+;
*!* [ LEFT JOIN CONTRACTE CTR ON i.ID_CTR = CTR.ID_CTR ]+;
*!* [ LEFT JOIN nom_venit_cheltuieli VC ON i.ID_VENCHELT = VC.ID_VENCHELT ]+;
*!* [ LEFT JOIN NOM_VALUTE V ON i.ID_VALUTA = V.ID_VALUTA ]+;
*!* [ LEFT JOIN VNOM_LUCRARI L ON i.ID_LUCRARE = L.ID_LUCRARE ]+;
*!* [ LEFT JOIN NOM_PARTENERI R ON i.ID_RESPONSABIL = R.ID_part ]+;
*!* [ LEFT JOIN NOM_FDOC F ON i.ID_FDOC = F.ID_FDOC ]+;
*!* [ LEFT JOIN NOM_PARTENERI P ON i.ID_PART = P.ID_PART ]
If tlContract
lcSelect1 = [ select i.* from (select ir.an, ir.luna, ir.id_fact, ra.rate_acoperite, ir.id_part, ir.cont, ir.acont, ir.id_valuta, ]+;
[ ir.id_venchelt, ir.proc_tva, ] + ;
[ 000000000000000.0000 as PRECDEB, 000000000000000.0000 as PRECCRED, 000000000000000.0000 as PRECVALDEB, 000000000000000.0000 as PRECVALCRED, ]+;
[ s2.debit, s2.credit, s2.valdebit, s2.valcredit, ]+;
[ ir.nract, ir.serie_act, ir.dataact, ir.dataireg, ir.datascad, ir.curs, ]+;
[ ir.cod, ir.explicatia, ir.explicatia4, ir.explicatia5, ]+;
[ ir.id_responsabil, ir.id_fdoc, ir.id_lucrare, ir.id_ctr, ir.id_set, ir.id_act, ]+;
[ p.nume, p.cod_fiscal, f.FEL_DOCUMENT as fdoc, r.nume as nresp, l.nrord, ]+;
[ (case when ctr.numar is not null then ctr.numar || '/' else '' end) || TO_CHAR(ctr.data, 'DD.MM.YYYY') as contract, ]+;
[ v.nume_val, vc.explicatie as VENCHELT, ir.id_sucursala, s.sucursala, atvanz.nr ]+;
[ from (select an, luna, serie_act, id_fact, id_part, cont, acont, id_valuta, ]+;
[ id_venchelt, proc_tva, nract, dataact, dataireg, datascad, ]+;
[ curs, cod, explicatia, explicatia4, explicatia5, id_responsabil, id_fdoc, id_lucrare, id_ctr, id_set, id_act, id_sucursala ]+;
[ from ireg_parteneri ]+;
[ WHERE extract(year from dataireg) * 12 + extract(month from dataireg) = an * 12 + luna and ]+;
[ id_part = ]+ Alltrim(Str(goContract.id_part))+;
[ and id_ctr = ] + Alltrim(Str(goContract.id_ctr)) +;
[ and cont = ] + tcCont + [) ir ]+;
[ left join (select id_fact, cont,acont,]+;
[ sum(pack_sesiune.suma_ron(debit,an,luna,]+ lcPA + [)) as debit, ]+;
[ sum(pack_sesiune.suma_ron(credit,an,luna,]+ lcPA + [)) as credit, ]+;
[ sum(pack_sesiune.suma_ron(valdebit,an,luna,]+ lcPA + [)) as valdebit, ]+;
[ sum(pack_sesiune.suma_ron(valcredit,an,luna,]+ lcPA + [)) as valcredit ]+;
[ from ireg_parteneri ]+;
[ where id_part = ]+ Alltrim(Str(goContract.id_part)) + ;
[ and id_ctr = ] + Alltrim(Str(goContract.id_ctr)) +;
[ and cont = ] + tcCont + [ group by id_fact,cont,acont) s2 ]+;
[ on ir.id_fact = s2.id_fact and ir.acont = s2.acont ]+;
[ left join (select s.id_ctr, ]+;
[ rf.id_fact, stringAgg(s.den_rata) as rate_acoperite from vctr_rate_facturi rf ]+;
[ left join (select * from vctr_scadentar order by id_ctr, den_rata) s on s.id_rata = rf.ID_RATA ]+;
[ group by s.id_ctr, rf.id_fact) ra ]+;
[ on ir.id_fact = ra.id_fact ]+;
[ LEFT JOIN CONTRACTE CTR ON ir.ID_CTR = CTR.ID_CTR ]+;
[ LEFT JOIN nom_venit_cheltuieli VC ON ir.ID_VENCHELT = VC.ID_VENCHELT ]+;
[ LEFT JOIN NOM_VALUTE V ON ir.ID_VALUTA = V.ID_VALUTA ]+;
[ LEFT JOIN VNOM_LUCRARI L ON ir.ID_LUCRARE = L.ID_LUCRARE ]+;
[ LEFT JOIN NOM_PARTENERI R ON ir.ID_RESPONSABIL = R.ID_part ]+;
[ LEFT JOIN NOM_FDOC F ON ir.ID_FDOC = F.ID_FDOC ]+;
[ LEFT JOIN vNOM_SUCURSALE S ON ir.ID_SUCURSALA = S.ID_SUCURSALA ]+;
[ LEFT JOIN NOM_PARTENERI P ON ir.ID_PART = P.ID_PART ] + ;
[left join (select count(*) as nr,cod from vatasamente_vanzari group by cod) atvanz on ir.cod = atvanz.cod) i ]
Else
lcSelect1 = [ select i.* from (select ir.an, ir.luna, ir.id_fact, ra.rate_acoperite, ir.id_part, ir.cont, ir.acont, ir.id_valuta, ]+;
[ ir.id_venchelt, ir.proc_tva, ] + ;
[ 000000000000000.0000 as PRECDEB, 000000000000000.0000 as PRECCRED, 000000000000000.0000 as PRECVALDEB, 000000000000000.0000 as PRECVALCRED, ]+;
[ s2.debit, s2.credit, s2.valdebit, s2.valcredit, ]+;
[ ir.nract, ir.serie_act, ir.dataact, ir.dataireg, ir.datascad, ir.curs, ]+;
[ ir.cod, ir.explicatia, ir.explicatia4, ir.explicatia5, ]+;
[ ir.id_responsabil, ir.id_fdoc, ir.id_lucrare, ir.id_ctr, ir.id_set, ir.id_act, ]+;
[ p.nume, p.cod_fiscal, f.FEL_DOCUMENT as fdoc, r.nume as nresp, l.nrord, ]+;
[ (case when ctr.numar is not null then ctr.numar || '/' else '' end) || TO_CHAR(ctr.data, 'DD.MM.YYYY') as contract, ]+;
[ v.nume_val, vc.explicatie as VENCHELT, ir.id_sucursala, s.sucursala, atvanz.nr ]+;
[ from (select an, luna, id_fact, id_part, cont, acont, id_valuta, ]+;
[ id_venchelt, proc_tva, nract, serie_act, dataact, dataireg, datascad, ]+;
[ curs, cod, explicatia, explicatia4, explicatia5, id_responsabil, id_fdoc, id_lucrare, id_ctr, id_set, id_act, id_sucursala ]+;
[ from ireg_parteneri ]+;
[ WHERE extract(year from dataireg) * 12 + extract(month from dataireg) = an * 12 + luna and id_part = ]+ Alltrim(Str(goContract.id_part))+[ and cont = ] + tcCont + [) ir ]+;
[ left join (select id_fact, cont,]+;
[ sum(pack_sesiune.suma_ron(debit,an,luna,]+ lcPA + [)) as debit, ]+;
[ sum(pack_sesiune.suma_ron(credit,an,luna,]+ lcPA + [)) as credit, ]+;
[ sum(pack_sesiune.suma_ron(valdebit,an,luna,]+ lcPA + [)) as valdebit, ]+;
[ sum(pack_sesiune.suma_ron(valcredit,an,luna,]+ lcPA + [)) as valcredit ]+;
[ from ireg_parteneri ]+;
[ where id_part = ]+ Alltrim(Str(goContract.id_part)) + ;
[ and cont = ] + tcCont + [ group by id_fact,cont) s2 ]+;
[ on ir.id_fact = s2.id_fact ]+;
[ left join (select s.id_ctr, ]+;
[ rf.id_fact, stringAgg(s.den_rata) as rate_acoperite from vctr_rate_facturi rf ]+;
[ left join (select * from vctr_scadentar order by id_ctr, den_rata) s on s.id_rata = rf.ID_RATA ]+;
[ group by s.id_ctr, rf.id_fact) ra ]+;
[ on ir.id_fact = ra.id_fact ]+;
[ LEFT JOIN CONTRACTE CTR ON ir.ID_CTR = CTR.ID_CTR ]+;
[ LEFT JOIN nom_venit_cheltuieli VC ON ir.ID_VENCHELT = VC.ID_VENCHELT ]+;
[ LEFT JOIN NOM_VALUTE V ON ir.ID_VALUTA = V.ID_VALUTA ]+;
[ LEFT JOIN VNOM_LUCRARI L ON ir.ID_LUCRARE = L.ID_LUCRARE ]+;
[ LEFT JOIN NOM_PARTENERI R ON ir.ID_RESPONSABIL = R.ID_part ]+;
[ LEFT JOIN NOM_FDOC F ON ir.ID_FDOC = F.ID_FDOC ]+;
[ LEFT JOIN vNOM_SUCURSALE S ON ir.ID_SUCURSALA = S.ID_SUCURSALA ]+;
[ LEFT JOIN NOM_PARTENERI P ON ir.ID_PART = P.ID_PART ] + ;
[left join (select count(*) as nr,cod from vatasamente_vanzari group by cod) atvanz on ir.cod = atvanz.cod) i ]
Endif
lcOrder1 = [i.dataact]
lcgroup = []
lcFiltru1 = []
lcFiltruOriginal = []
llModParam = .T.
llAfiseaza = .F.
&& DACA SUNT PE O SUCURSALA - SELECTEZ DOAR INREGISTRARILE DE PE SUCURSALA CURENTA
IF !ISNULL(gnIdSucursala)
lcFiltruOriginal = SUBSTR(gcCondSucursala,6)
ENDIF
gencursor('poireg_parteneri','actcv', lcSelect1, lcFiltru1, lcschema1, lcOrder1, llAfiseaza, lcgroup, llModParam, lcFiltruOriginal)
poireg_parteneri.ca_baza1.afisare()
********
tcFis2 = "ActCv"
tlVisible = .T.
Local c
c="nume+ALLTRIM(STR(YEAR(dataact)))+RIGHT('0'+ALLTRIM(STR(MONTH(dataact))),2)+RIGHT('0'+ALLTRIM(STR(DAY(dataact))),2)"
buton=1
If tlTest And .F.
Private pcCampVerif
pcCampVerif = ofis.camp_verif
Select (tcFis2)
Set Filter To
lcProc='inainte_'+Alltrim(tcFis2)
Do &lcProc In inaintede.prg
If buton=2
Return
Endif
Endif
lnsucces=update_jtva_coloane(,"jtva_temp")
Sele actcv
Private pcAnalitic,pcLucrare
Store '' To pcAnalitic,pcLucrare
Oreg=Createobject("FRM_IREG_PARTENERI")
With Oreg
.lActiv = plActiv
.cCont = lcContPart
*!* .LABEL10.Caption=Proper(tctitlu)&&& trebuie facut
.Lb_titlu_alb_b121.CAPTION = PROPER(lcDenumire)
.grid1.cTotCred.VISIBLE = .T.
.CONT = ALLT(pcCont)
.fisier = ALLTRIM(tcFis2)
*.Ck_valuta.VISIBLE = tlVisible
*.CK_explicatia.VISIBLE = tlVisible
*.ck_scadente.VISIBLE = tlVisible
* .CHECK9.VISIBLE = tlVisible
.grid1.cDataScad.VISIBLE = tlVisible
.grid1.cTotDebVal.VISIBLE = tlVisible
.grid1.cTotCredVal.VISIBLE = tlVisible
.grid1.cSoldVal.VISIBLE = tlVisible
.grid1.cNume_val.VISIBLE = tlVisible
.grid1.cCurs.VISIBLE = tlVisible
.grid1.cExplicatia.VISIBLE = tlVisible
IF !tlVisible
.CHECK3.CAPTION = 'Regularizate'
.CHECK4.CAPTION = 'Neregularizate'
.check10.CAPTION = 'Regularizat'
.grid1.cTotCred.header1.CAPTION = 'Regularizat'
.grid1.cDataScad.WIDTH = 0
ENDIF
IF !plActiv
.grid1.cSoldFinal.CONTROLSOURCE = "(Preccred+credit)-(precdeb+debit)"
.grid1.cSoldVal.CONTROLSOURCE ="(precvalcred+valcredit)-(precvaldeb+valdebit)"
*.ck_sold.camp_nume = "credit+preccred-precdeb-debit"
.grid1.cTotDeb.CONTROLSOURCE = "preccred+credit"
.grid1.cTotCred.CONTROLSOURCE = "precdeb+debit"
.grid1.cTotDebVal.CONTROLSOURCE = "precvalcred+valcredit"
.grid1.cTotCredVal.CONTROLSOURCE = "precvaldeb+valdebit"
.grid1.cDebit.CONTROLSOURCE = "credit"
.grid1.cCredit.CONTROLSOURCE = "debit"
.grid1.cValDebit.CONTROLSOURCE = "valcredit"
.grid1.cValCredit.CONTROLSOURCE = "valdebit"
.grid1.cPrecDeb.CONTROLSOURCE = "preccred"
.grid1.cPrecCred.CONTROLSOURCE = "precdeb"
.grid1.cTotDeb.header1.CAPTION = "Total " + lcDenCredit
.grid1.cTotCred.header1.CAPTION = "Total " + lcDenDebit
.grid1.cTotDebVal.header1.CAPTION = "Total " + lcDenCredit + " valuta"
.grid1.cTotCredVal.header1.CAPTION = "Total " + lcDenDebit + " valuta"
.grid1.cDebit.header1.CAPTION = lcDenCredit
.grid1.cCredit.header1.CAPTION = lcDenDebit
.grid1.cValDebit.header1.CAPTION = lcDenCredit + " valuta"
.grid1.cValCredit.header1.CAPTION = lcDenDebit + " valuta"
.grid1.cPrecDeb.header1.CAPTION = "Prec " + lcDenCredit
.grid1.cPrecCred.header1.CAPTION = "Prec " + lcDenDebit
.grid1.cPrecValDeb.header1.CAPTION = "Prec Valuta " + lcDenCredit
.grid1.cPrecValCred.header1.CAPTION = "Prec Valuta " + lcDenDebit
ELSE
.grid1.cSoldFinal.CONTROLSOURCE = "(precdeb+debit)-(preccred+credit)"
.grid1.cSoldVal.CONTROLSOURCE ="(precvaldeb+valdebit)-(precvalcred+valcredit)"
*.ck_sold.camp_nume = "precdeb+debit-credit-preccred"
.grid1.cTotDeb.header1.CAPTION = "Total " + lcDenDebit
.grid1.cTotCred.header1.CAPTION = "Total " + lcDenCredit
.grid1.cTotDebVal.header1.CAPTION = "Total " + lcDenDebit + " valuta"
.grid1.cTotCredVal.header1.CAPTION = "Total " + lcDenCredit + " valuta"
.grid1.cDebit.header1.CAPTION = lcDenDebit
.grid1.cCredit.header1.CAPTION = lcDenCredit
.grid1.cValDebit.header1.CAPTION = lcDenDebit + " valuta"
.grid1.cValCredit.header1.CAPTION = lcDenCredit + " valuta"
.grid1.cPrecDeb.header1.CAPTION = "Prec " + lcDenDebit
.grid1.cPrecCred.header1.CAPTION = "Prec " + lcDenCredit
.grid1.cPrecValDeb.header1.CAPTION = "Prec Valuta " + lcDenDebit
.grid1.cPrecValCred.header1.CAPTION = "Prec Valuta " + lcDenCredit
ENDIF
IF TYPE('pcTotctva')#'U' AND TYPE('pcAchitat')#'U'
.grid1.cTotCred.header1.CAPTION = pcAchitat
.grid1.cTotDeb.header1.CAPTION = pcTotctva
ENDIF
IF TYPE('pcSumaTotal')#'U' AND TYPE('pcSumaAchi')#'U'
.CHECK13.CAPTION = pcSumaTotal
.check10.CAPTION = pcSumaAchi
ENDIF
IF TYPE('actcv.nresp') # 'U'
.grid1.cNresp.VISIBLE= .T.
.grid1.cNresp.CONTROLSOURCE = 'nresp'
*.Ck_responsabil.VISIBLE = .T.
ENDIF
*!* IF plActiv
*!* .grid1.SETALL("DynamicForeColor", "IIF(ABS((preccred+credit)-(precdeb+debit))=0,RGB(0,0,0), iif(((precdeb+debit) < (preccred+credit)),RGB(255,0,0),RGB(0,0,255)))", "Column")
*!* ELSE
*!* .grid1.SETALL("DynamicForeColor", "IIF(ABS((preccred+credit)-(precdeb+debit))=0,RGB(0,0,0), iif(((precdeb+debit) > (preccred+credit)),RGB(255,0,0),RGB(0,0,255)))", "Column")
*!* ENDIF
IF plActiv
.grid1.SETALL("DynamicForeColor", "IIF(ABS((preccred+credit)-(precdeb+debit))=0,RGB(0,0,0), iif(((precdeb+debit) < (preccred+credit)), RGB(166,0,0), RGB(0,89,168)))", "Column")
ELSE
.grid1.SETALL("DynamicForeColor", "IIF(ABS((preccred+credit)-(precdeb+debit))=0,RGB(0,0,0), iif(((precdeb+debit) > (preccred+credit)), RGB(166,0,0), RGB(0,89,168)))", "Column")
ENDIF
Endwith
Oreg.do_cauta()
Oreg.Show(1)
Release Oreg
Use In actcv
Endproc && lans_ireg_parteneri
*---------------------------------------------------------------------------------

41
Programe/oproceduri_preluari.prg Normal file
View File

@@ -0,0 +1,41 @@
***-----------------------------------------------------
Procedure preluare_curs
PARAMETERS tcTabelCurs
LOCAL lcTabelCurs
lcTabelCurs = ALLTRIM(tcTabelCurs)
Select (lcTabelCurs)
SCAN
WAIT WINDOW ALLTRIM(STR(RECNO()))+"/"+ALLTRIM(STR(RECCOUNT())) NOWAIT
pnCurs = Curs
pdData1 = Data
pdData2 = data2
lnId_valuta = id_tipv
Do Case
Case lnId_valuta = 1
pnId_valuta = 41695
Case lnId_valuta = 2
pnId_valuta = 41692
Case lnId_valuta = 3
pnId_valuta = 41694
Case lnId_valuta = -1
pnId_valuta = 41697
OTHERWISE
pnId_valuta = 41696
Endcase
lcSql = [begin pack_crm.adauga_curs(?gcS, ?pnCurs, ?pdData1, ?pdData2, ?pnId_valuta); end;]
lnSucces = goExecutor.oExecute(lcSql)
If lnSucces < 0
Messagebox('pack_crm.adauga_curs'+goExecutor.cEroare,0+16,"Eroare")
Return
Endif
ENDSCAN
WAIT WINDOW "Preluarea s-a terminat!"
Endproc && preluare_curs
***-----------------------------------------------------

57
Programe/oproceduri_registretva.prg Normal file
View File

@@ -0,0 +1,57 @@
******************************************************************
PROCEDURE listare_registru_tva
LPARAMETERS tcRegistru
pcRegistru = UPPER(ALLTRIM(tcRegistru))
DO CASE
CASE 'VANZ'$pcRegistru
pcContTVA = [4427]
pcListaContTVA = [411,4111,4112,4113,4114,4115,4116,4117,461,635,5311,5121,428,4281,4282,4426,4428]
pcListaContBaza = [411,4111,4112,4113,4114,4115,4116,4117,461,428,4281,4282]
pcListaContExceptii = [667,419]
OTHERWISE
pcContTVA = [4426]
pcListaContTVA = [401,404,5121,5124,542,4427,4428]
pcListaContBaza = [401,404]
pcListaContExceptii = [767]
ENDCASE
lcSql = [{call PACK_REGISTRE_TVA.REGISTRUTVA(?gcS, ?gnAn, ?gnLuna, ] + ;
[?pcRegistru, ?pcContTVA, ?pcListaContTVA, ?pcListaContBaza, ?pcListaContExceptii )}]
lcCursor = 'crsRegistruTemp'
lnSucces = goExecutor.oExecute(lcSql,lcCursor)
IF lnSucces < 0
AMESSAGE(goExecutor.cEroare,0+16,"Eroare")
ELSE
SELECT nract, dataact, PART AS nume, cod_fiscal, fdoc, baza, proc_tva, tva, baza + tva as totctva, 00000000000.0000 as total ;
FROM crsRegistruTemp ;
INTO CURSOR crsRegistru ;
READWRITE ORDER BY nract, dataact, nume
USE IN crsRegistruTemp
SELECT nract, dataact, nume,sum(totctva) as total ;
from crsRegistru ;
INTO CURSOR tgrup ;
GROUP BY nract, dataact, nume
SELECT tgrup
SCAN
SCATTER NAME ot
SELECT crsRegistru
LOCATE FOR nume = ot.nume AND nract = ot.nract AND dataact = ot.dataact
IF FOUND()
REPLACE total WITH ot.total
ENDIF
SELECT tgrup
ENDSCAN
USE IN tgrup
SELECT crsRegistru
REPORT FORM registru_tva_simplu TO PRINTER PROMPT PREVIEW
USE IN crsRegistru
ENDIF
ENDPROC
******************************************************************

1814
Programe/oproceduri_roaclienti.prg Normal file
View File

File diff suppressed because it is too large Load Diff

1496
Programe/oproceduri_roacontracte.prg Normal file
View File

File diff suppressed because it is too large Load Diff

12
Programe/ovariabile_globale.prg Normal file
View File

@@ -0,0 +1,12 @@
PUBLIC gcCondLuna
*!* gcCondLuna = [((((extract(month from datafact) =]+Alltrim(Str(gnLuna))+;
*!* [ and extract(year from datafact) =]+Alltrim(Str(gnAn))+[) or (datafact is null ));
*!* and ]+;
*!* [ (extract (month from datai)<=]+Alltrim(Str(gnLuna)) + [ and extract(year from datai)<= ]+Alltrim(Str(gnAn))+[))]+;
*!* [ or ((extract (month from dataoravalid)>= ]+Alltrim(Str(gnLuna))+[ and extract(year from dataoravalid)>=]+Alltrim(Str(gnAn)) +[)]+;
*!* [ and id_tip > 1)]+ [)]
*!* lcDataFact= [ (a.facturat=1 and (extract(month from a.datafact) =]+Alltrim(Str(gnLuna))+[ and extract(year from a.datafact) =]+Alltrim(Str(gnAn))+[))]
*!* lcDataValid = [ (a.validat=1 and (extract (month from a.dataoravalid)>= ]+Alltrim(Str(gnLuna))+[ and extract(year from a.dataoravalid)>=]+Alltrim(Str(gnAn)) +[)) ]
*!* gcCondLuna = [ ((extract (month from a.datai)=]+Alltrim(Str(gnLuna)) + [ and extract(year from a.datai)= ]+Alltrim(Str(gnAn))+[) or ]+;
*!* [ (a.id_tip=1 and (a.facturat=0 or ] + lcDataFact + [) ) or (a.id_tip>1 and (a.validat=0 or ] + lcDataValid + [))) ]

4578
Programe/pmenu.prg Normal file
View File

File diff suppressed because it is too large Load Diff

935
Programe/proceduri.prg Normal file
View File

@@ -0,0 +1,935 @@
*-----------------------------------------------
Function existacamp
Param numef,numec
Sele &numef
For i=1 To Fcount()
If Upper(Allt(Field(i)))=Upper(Allt(numec))
Return .T.
Endif
Next
Return .F.
*-----------------------------------------------
Function existacimp
Param numef,numec
Sele &numef
For i=1 To Fcount()
If Upper(Allt(Field(i)))=Upper(Allt(numec))
Return .T.
Endif
Next
Return .F.
***-----------------------------------------------------------------------------------------------------------------
Procedure CAUT_ALF
Parameters NUMEBAZA,NUMECIMP,CAPTEXT,VARMEM
Local MC0,MC1,MC2
Set Safety Off
MC0='SELE '+NUMEBAZA
MC1='VARMEM=M.'+NUMECIMP
MC2='SET order TO TAG '+NUMECIMP
&MC0
Go Top
If Eof()
Appe Blank
Endif
&MC2
OCA=Createobject("CAUTALF")
OCA.Caption=CAPTEXT
OCA.GRID1.RecordSource=NUMEBAZA
OCA.GRID1.COLUMN1.ControlSource=NUMECIMP
OCA.Show(1)
Scatter Memvar
&MC1
Return
***-----------------------------------------------------------------------------------------------------------------
Procedure CAUT_ALFa
Parameters NUMEBAZA,NUMECIMP,CAPTEXT,VARMEM
Local MC0,MC1,MC2
Set Safety Off
MC0='SELE '+NUMEBAZA
MC1='VARMEM=M.'+NUMECIMP
MC2='SET order TO TAG '+NUMECIMP
&MC0
Go Top
If Eof()
Appe Blank
Endif
&MC2
OCA=Createobject("CAUTALFa")
OCA.Caption=CAPTEXT
OCA.GRID1.RecordSource=NUMEBAZA
OCA.GRID1.COLUMN1.ControlSource=NUMECIMP
OCA.cmdrenunt1.Visible=.T.
OCA.Show(1)
Scatter Memvar
&MC1
Return
***-----------------------------------------------------------------------------------------------------------------
Procedure mesaj
Parameters m1,m2
ot=Create('text')
ot.label2.Caption=m1
ot.label3.Caption=m2
ot.Show(1)
Return
***-----------------------------------------------------------------------------------------------------------------
Procedure mesajval
Parameters m1,m2
ot=Create('textval')
ot.label2.Caption=m1
ot.valoare=m2
ot.Show(1)
Return
***-----------------------------------------------------------------------------------------------------------------
Procedure mesajatent
Parameters m1,m2
ot=Create('atentie')
ot.label2.Caption=m1
ot.label3.Caption=m2
ot.Show(1)
Return
***-----------------------------------------------------------------------------------------------------------------
Procedure mesajrosu
Parameters m1,m2
ot=Create('atentierosu')
ot.label2.Caption=m1
ot.label3.Caption=m2
ot.Show(1)
Return
***-----------------------------------------------------------------------------------------------------------------
Procedure alfabeta
Parameters clasa,e5,b5,C5,e6,b6,C6,e7,b7,c7,expl
m.explicatia=expl
clasaact='actverif'
oc=Create(clasa)
With oc
.eti5=e5
.eti6=e6
.eti7=e7
.baza5=b5
.baza6=b6
.baza7=b7
.cimp5=C5
.cimp6=C6
.cimp7=c7
.num=C5
.num2=C6
.expl=c7
Endwith
If expl='do curs.spr'
oc.expl=expl
Endif
If txt2=.F.
m.FDOC="FACTURA"
oc.text2.Enabled=.F.
* oc.text2.controlsource="FACTURA"
Endif
oc.Show(1)
Return
***-----------------------------------------------------------------------------------------------------------------
Procedure alfabetaper
Parameters clasa,e5,b5,C5,e6,b6,C6,e7,b7,c7,expl,cumpvanz
m.explicatia=expl
clasaact='actverif'
oc=Create(clasa)
With oc
.eti5=e5
.eti6=e6
.eti7=e7
.baza5=b5
.baza6=b6
.baza7=b7
.cimp5=C5
.cimp6=C6
.cimp7=c7
.num=C5
.num2=C6
.expl=c7
.cv=cumpvanz
Endwith
oc.Show(1)
Return
***-----------------------------------------------------------------------------------------------------------------
*!* Procedure IESIRE
*!* *close tables
*!* *close database
*!* *set defa to &dirgen
*!* *erase actactan.*
*!* *erase ?temp.*
*!* Quit
*!* Return
***-----------------------------------------------------------------------------------------------------------------
Procedure mesajm
Param txt,i
Local T,p
p=Iif(i<10,Str(i,1),Str(i,2))
T='orm.label'+p+'.caption="'+txt+'"'
&T
If i<20
i=i+1
Endif
p=Iif(i<10,Str(i,1),Str(i,2))
T='orm.IMAGE'+p+'.VISIBLE=.T.'
&T
Return
***-----------------------------------------------------------------------------------------------------------------
Func ULTIMAZIL
Param LLL,AAA
Local N
Do Case
Case Inlist(LLL,1,3,5,7,8,10,12)
N=31
Case Inlist(LLL,4,6,9,11)
N=30
Case Inlist(LLL,2)
N=28
If Mod(AAA,2)=0
N=29
Endif
Endcase
Return N
***-----------------------------------------------------------------------------------------------------------------
Function SERIA_LUNARA_E_CORECTA
Local TIPAR,LOC,L
L=Val(M.NL)
LOC=L+Floor((L-1)/2)
TIPAR='VOICUIONEMIL'
Sele cul
Go Top
&&ESTE CORECTA ULTIMA SERIE?
If Substr(TIPAR,L,1)=Substr(GREEN,LOC,1);
AND Substr(red,1,1)=Substr(GREEN,3,1);
AND Substr(red,2,1)=Substr(GREEN,6,1);
AND Substr(red,3,1)=Substr(GREEN,9,1);
AND Substr(red,4,1)=Substr(GREEN,12,1);
AND Substr(red,5,1)=Substr(GREEN,15,1)
Return .T.
Else
Return .F.
Endif
***-----------------------------------------------------------------------------------------------------------------
Function e_ultima_luna
Sele calendar
Loca For m.NL=NL And m.an=an
Skip
If Eof()
ultima_luna=.T.
Return .T.
Else
ultima_luna=.F.
Return .F.
Endif
***-----------------------------------------------------------------------------------------------------------------
Procedure danu
Parameters m1
od=Create('danu')
od.label1.Caption=m1
od.Show(1)
Return
***-----------------------------------------------------------------------------------------------------------------
Procedure danuquit
Parameters m1
od=Create('danu')
od.label1.Caption=m1
od.Show(1)
If buton=2
Quit
Endif
Return
***-----------------------------------------------------------------------------------------------------------------
Proc pr
Param j
If j>M
OP.Release
OP=Crea('progresbar')
j=0
OP.Show()
Endif
OP.PRBAR.Value=j
OP.p=Round(100*OP.PRBAR.Value/OP.PRBAR.Max,2)
OP.Refresh
j=j+1
Return
***-----------------------------------------------------------------------------------------------------------------
Proc MESAJT
Param M.denumire
OTEXT.oleTreeview.NODES.Add(,,,M.denumire,)
STARE=STARE+1
Return
***-----------------------------------------------------------------------------------------------------------------
Procedure nrord
Parameters ALI
Sele &ALI
A=Reccount()
If A=0
Return
Endif
If A>65000
Return 0
Endif
Declare NROR(A)
K=0
Scan
K=K+1
NROR(K)=Recno()
Endscan
Return
Function NRCRT
NR=Ascan(NROR,Recno())
Return NR
***-----------------------------------------------------------------------------------------------------------------
Procedure inchidprog
Local CC,M.NUMESTATIE,UU
Return
UU=utilizator
If !Used('OPTIUNI')
Return
Endif
Sele OPTIUNI
Loca For OPTIUNE='RETEA'
If !Found() Or (Found() And !DA)
Sele OPTIUNI
Use
Return
Endif
Sele OPTIUNI
Use
If !File('C:\CONTAFIN\TEMP\RETEA.DBF')
Return
Endif
Sele 0
Use C:\CONTAFIN\TEMP\RETEA Shar Alias RETEA
m.NUMESTATIE=Allt(NUMESTATIE)
CC=DIRGEN
Use
If File('&DIRGEN\Dateretea\istoric.DBF')
Sele 0
Use &DIRGEN\Dateretea\istoric Share Alias istoric
Else
Sele 0
Use &CC\START2000\Data\istoric Share Alias istoric
Endif
Sele istoric
Set Order To DATAORAINT
Loca For Empty(dataoraies) And Allt(statie)=m.NUMESTATIE And Allt(utilizator)=Allt(UU)
If Found()
If Flock()
Repl dataoraies With Datetime()
Unlock
Endif
Endif
Sele istoric
Use
If File('&DIRGEN\Dateretea\activ.DBF')
Sele 0
Use &DIRGEN\Dateretea\Activ Share Alias Activ
Else
Sele 0
Use &CC\START2000\Data\Activ Share Alias Activ
Endif
Sele Activ
Loca For Allt(statie)=m.NUMESTATIE
If !Found()
Wait Wind 'Aceasta statie nu este inregistrata in server!'
Else
Sele Activ
If Flock()
Repl DEVIZE With .F.
Endif
Unlock
Endif
Sele Activ
Use
Return
***-----------------------------------------------------------------------------------------------------------------
Proc gendinante
Sele ORDante
Set Filter To
Sele CLIE
Set Filter To
Sele ORDante.*,CLIE.* From ORDante,CLIE Where ORDante.codc=CLIE.codc Into Cursor cliord Order By DATAI
ovs=Crea('selante')
ovs.Show(1)
Return
***-----------------------------------------------------------------------------------------------------------------
Procedure AFISNOTEPAD
Param NUMEFIS
Do Case
Case File('C:\WINDOWS\NOTEPAD.EXE')
Run /N C:\Windows\NOTEPAD.Exe &NUMEFIS
Case File('C:\WINnt\system32\NOTEPAD.EXE')
Run /N C:\WINnt\system32\NOTEPAD.Exe &NUMEFIS
Otherwise
Do mesajatent With 'Nu se poate vizualiza textul','pe acest sistem!'
Endcase
***-----------------------------------------------------------------------------------------------------------------
Procedure SCRIETEXT
Param NUMEFIS,TEXTUL
Set Textmerge To &NUMEFIS Additive Noshow
TEXT
<<TEXTUL>>
ENDTEXT
Return
Endproc && SCRIETEXT
***-----------------------------------------------------------------------------------------------------------------
Procedure INITTEXT
Param NUMEFIS
Set Textmerge To &NUMEFIS
Set Textmerge On Noshow
Return
***-----------------------------------------------------------------------------------------------------------------
Procedure SFTEXT
Set Textmerge To
Set Textmerge Off
Return
***-----------------------------------------------------------------------------------------------------------------
Procedure adaugtext
Param fisierul,TEXTUL
Wait Wind TEXTUL Nowait
Set Textmerge On
Set Textmerge Noshow
Set Textmerge To &fisierul Additive
\<<textul>>
Set Textmerge To
Return
***-----------------------------------------------------------------------------------------------------------------
Procedure errq
Do mesaj With 'Pentru moment accesul nu este posibil','Incercati mai tarziu.'
errq=.T.
Return
***-----------------------------------------------------------------------------------------------------------------
*!* Function SUMA_IN_VORBE
*!* Param suma
*!* Local i,lit,numar1
*!* Store 0 To i
*!* Store '' To lit,numar1
*!* numar1=Space(12)
*!* numar1=Str(suma,12)
*!* Dimension A(12)
*!* A(1)=Subs(numar1,12,1)
*!* A(2)=Subs(numar1,11,1)
*!* A(3)=Subs(numar1,10,1)
*!* A(4)=Subs(numar1,9,1)
*!* A(5)=Subs(numar1,8,1)
*!* A(6)=Subs(numar1,7,1)
*!* A(7)=Subs(numar1,6,1)
*!* A(8)=Subs(numar1,5,1)
*!* A(9)=Subs(numar1,4,1)
*!* A(10)=Subs(numar1,3,1)
*!* A(11)=Subs(numar1,2,1)
*!* A(12)=Subs(numar1,1,1)
*!* Sele mila1
*!* *********************
*!* Loca For NR=Val(A(12))
*!* lit=lit+Alltri(cr1)
*!* If Val(A(11))=1
*!* If Val(A(10))=0
*!* Loca For NR=Val(A(11))
*!* lit=lit+Alltri(cr5)
*!* Else
*!* Loca For NR=Val(A(10))
*!* lit=lit+Alltri(cr4)
*!* Endif
*!* Else
*!* If Val(A(10))=0
*!* Loca For NR=Val(A(11))
*!* lit=lit+Alltrim(cr5)
*!* Else
*!* Loca For NR=Val(A(11))
*!* lit=lit+Alltrim(cr2)
*!* Loca For NR=Val(A(10))
*!* lit=lit+Alltrim(cr3)
*!* Endif
*!* Endif
*!* Do Case
*!* Case Val(A(12)) # 0
*!* lit=lit+' miliarde'
*!* Case Val(A(11)) # 0
*!* lit=lit+' miliarde'
*!* Case Val(A(10)) # 0
*!* lit=lit+' miliarde'
*!* Endcase
*!* ***********************
*!* Loca For NR=Val(A(9))
*!* lit=lit+Alltri(cr1)
*!* If Val(A(8))=1
*!* If Val(A(7))=0
*!* Loca For NR=Val(A(8))
*!* lit=lit+Alltri(cr5)
*!* Else
*!* Loca For NR=Val(A(7))
*!* lit=lit+Alltri(cr4)
*!* Endif
*!* Else
*!* If Val(A(7))=0
*!* Loca For NR=Val(A(8))
*!* lit=lit+Alltrim(cr5)
*!* Else
*!* Loca For NR=Val(A(8))
*!* lit=lit+Alltrim(cr2)
*!* Loca For NR=Val(A(7))
*!* lit=lit+Alltrim(cr3)
*!* Endif
*!* Endif
*!* Do Case
*!* Case Val(A(9)) # 0
*!* lit=lit+' milioane'
*!* Case Val(A(8)) # 0
*!* lit=lit+' milioane'
*!* Case Val(A(7)) # 0
*!* lit=lit+' milioane'
*!* Endcase
*!* ***********************
*!* Loca For NR=Val(A(6))
*!* lit=lit+Alltri(cr1)
*!* If Val(A(5))=1
*!* If Val(A(4))=0
*!* Loca For NR=Val(A(5))
*!* lit=lit+Alltri(cr5)
*!* Else
*!* Loca For NR=Val(A(4))
*!* lit=lit+Alltri(cr4)
*!* Endif
*!* Else
*!* If Val(A(4))=0
*!* Loca For NR=Val(A(5))
*!* lit=lit+Alltrim(cr5)
*!* Else
*!* Loca For NR=Val(A(5))
*!* lit=lit+Alltrim(cr2)
*!* Loca For NR=Val(A(4))
*!* lit=lit+Alltrim(cr3)
*!* Endif
*!* Endif
*!* Do Case
*!* Case Val(A(6)) # 0
*!* lit=lit+' mii'
*!* Case Val(A(5)) # 0
*!* lit=lit+' mii'
*!* Case Val(A(4)) # 0
*!* lit=lit+' mii'
*!* Endcase
*!* *********************
*!* Loca For NR=Val(A(3))
*!* lit=lit+Alltri(cr1)
*!* If Val(A(2))=1
*!* If Val(A(1))=0
*!* Loca For NR=Val(A(2))
*!* lit=lit+Alltri(cr5)
*!* Else
*!* Loca For NR=Val(A(1))
*!* lit=lit+Alltri(cr4)
*!* Endif
*!* Else
*!* If Val(A(1))=0
*!* Loca For NR=Val(A(2))
*!* lit=lit+Alltrim(cr5)
*!* Else
*!* Loca For NR=Val(A(2))
*!* lit=lit+Alltrim(cr2)
*!* Loca For NR=Val(A(1))
*!* lit=lit+Alltrim(cr3)
*!* Endif
*!* Endif
*!* Do Case
*!* Case Val(A(3)) # 0
*!* lit=lit+' lei'
*!* Case Val(A(2)) # 0
*!* lit=lit+' lei'
*!* Case Val(A(1)) # 0
*!* lit=lit+' lei'
*!* Endcase
*!* Sele mila1
*!* *!* use
*!* lit=Strtran(lit,' ','')
*!* Return lit
***-----------------------------------------------------------------------------------------------------------------
Procedure LIST_EXCEL
Param TTABEL,TTITLU,TAHEADER
External Array TAHEADER
LCFIS=Allt(LOC)+"\"+Allt(NFSCURT)+"\TEMPO\LIST_"+Sys(2)+".XLS"
LCFIS=Strtran(LCFIS,'\\','\')
Set Textmerge On To (LCFIS) Noshow
LCANTET=Uppe(Allt(TTITLU))+crlf
\
\\<<LCANTET>>
\
If Parameters()<3
LCHEADER=""
Sele (TTABEL)
For i=1 To Fcount()
LCHEADER=LCHEADER+Upper(Allt(Field(i)))+Tab
Endfor
LCHEADER=LCHEADER+crlf
\\<<LCHEADER>>
Sele (TTABEL)
Scan
LDATE=""
For i=1 To Fcount()
F=Field(i)
T=&F
LDATE=LDATE+Transform(T,"")+Tab
Endfor
LDATE=LDATE+crlf
\\<<LDATE>>
Endscan
Set Textmerge To
Else
LCHEADER=""
NRCOL=Alen(TAHEADER,1)
Sele (TTABEL)
For i=1 To NRCOL
If Empty(TAHEADER[I,1])
LCHEADER=LCHEADER+Upper(Allt(TAHEADER[I,2]))+Tab
Else
LCHEADER=LCHEADER+Upper(Allt(TAHEADER[I,1]))+Tab
Endif
Endfor
LCHEADER=LCHEADER+crlf
\\<<LCHEADER>>
Sele (TTABEL)
Scan
LDATE=""
For i=1 To NRCOL
* F=Field(TAHEADER[I,2])
F=TAHEADER[I,2]
* IF EXISTACAMP(,F)
T=&F
LDATE=LDATE+Alltrim(Transform(T,""))+Tab
* ELSE
* LDATE=LDATE+" "+Tab
* ENDIF
Endfor
LDATE=LDATE+crlf
\\<<LDATE>>
Endscan
Set Textmerge To
Endif
* WAIT WINDOW "Se deschide Excel..." NOWAIT
OEXCEL = Createobject("Excel.Application")
OEXCEL.WorkBooks.Open(LCFIS)
OEXCEL.Visible=1
*!* IF TYPE(OEXCEL)='0'
*!* OEXCEL=""
*!* ENDIF
Endproc && list_excel
*__________________________________________________________
&& Folosesc un tabel <ids> (tabel,id) cu cate o linie pt fiecare tabel
&& aflu id-ul urmator si il scriu in tabela <ids>
&& returnez id-ul
&& EX1: LNEW_ID=NEW_ID("GRILA_SAL") --> urmatorul id din <grila_sal> fara cautare in tabela originala
&& EX2: LNEW_ID=NEW_ID("GRILA_SAL","ID") --> urmatorul id din <grila_sal> cu cautare in tabela originala dupa campul<id>
&& ex3: LNEW_ID=NEW_ID("GRILA_SAL","ID",.T.) --> .T. INSEAMNA CA TABELUL ORIGINAL ESTE INDEXAT DUPA <ID> FAC SEEK IN LOC DE LOCATE
Procedure NEW_ID
Parameters TALIAS,TFIELD,TTAG&&,tTipField
*WAIT WINDOW TALIAS
*ON error Errorh(ERROR(),PROGRAM(),LINENO())
LLLOOKUP=Iif(Type("tfield")="C",.T.,.F.)
LLChar = Iif(Type(TFIELD) = "C",.T.,.F.)
LLTAG=Iif(Type("TTAG")="C",.T.,.F.)
TALIAS=Upper(Alltrim(TALIAS))
*** Save Stats
LCOLDALIAS = Alias() && keep current work area
LNOLDRECNO = Iif(!Eof(),Recno(),0) && save record number
LCSETDEL=Set("deleted")
&& lnmaxval = (10^pcidsize)-1 && wrap around after this val
***
&& PUN ORDINEA PE ID
If LLLOOKUP And LLTAG
Sele (TALIAS)
Set Order To &TTAG
Endif
***
LCNEWID = 0 && our return result - NULL if failed
Select IDS
Locate For Upper(Alltrim(TABEL))=TALIAS
If !Found()
If Flock()
Append Blank
Replace TABEL With TALIAS
Unlock
Endif
Endif
Set Deleted Off
&& acum sunt pe inregistrarea corecta
*** lock counter table and update counter
Select IDS
If Rlock()
*** Avoid use of Macros - Convert to mem var & update it
LNCOUNTERVAL = NEW_ID
*** VERIFY ID NUMBER - search 'til no match
Do While .T.
*** increase the counter - update field and var
LNCOUNTERVAL = LNCOUNTERVAL+1
*!* *** check for wraparound
*!* IF lncounterval > lnmaxval
*!* lncounterval = 1
*!* ENDIF
Select (TALIAS)
If LLLOOKUP
If LLTAG
LCAUT="SEEK "+Allt(Str(LNCOUNTERVAL))
Else
If LLChar
LCAUT="LOCATE FOR "+Allt(TFIELD)+"='"+Allt(Str(LNCOUNTERVAL))+"'"
Else
LCAUT="LOCATE FOR "+Allt(TFIELD)+"="+Allt(Str(LNCOUNTERVAL))
Endif
*** now see if it exists
&LCAUT
* LOCATE FOR &TFIELD=LNCOUNTERVAL
If !Found()
*** No match - DONE
Exit
Endif && !found()
Endif && lltag
Else
Exit
Endif && lllokup
Enddo && done
Sele IDS
Replace NEW_ID With LNCOUNTERVAL
LCNEWID=LNCOUNTERVAL
Unlock In IDS
Endif && rlock()
*** Reset record number on original file
If !Empty(LCOLDALIAS)
Sele (LCOLDALIAS)
If LNOLDRECNO#0
Goto LNOLDRECNO
Endif
Endif
Set Deleted &LCSETDEL
Return LCNEWID
Endproc && NEW_ID
***-------------------------------------------------------------------------------------------------------
*-------------------------------------------------------------------------------------------
*** returneaza un obiect cu proprietatile an si nl (de fapt cu toate coloanele din calendar)
Function ret_luna
Parameters tcTitlu
Private loLuna
Select calendar
*!* USE DBF('calendar') IN 0 AGAIN ALIAS tsel_luna share
Select * From calendar Into Cursor tsel_luna Order By an Desc ,NL Desc
Select tsel_luna
loLuna=myscatter('blank')
Ol=Createobject("frm_sel_luna")
With Ol
.lblTitlu.Caption=tcTitlu
If Empty(.cboLuna.RowSource)
.cboLuna.RowSource="tsel_luna.nl,an"
Endif
.oLuna=loLuna
If Empty(.cAlias)
.cAlias=Left(.cboLuna.RowSource,At(".",.cboLuna.RowSource)-1)
Endif
Endwith
Ol.Show(1)
Use In tsel_luna
Return loLuna
Endfunc && ret_oluna
***-----------------------------------------------------------------------------------------------------------------
*!* SET CLASSLIB TO d:\contafin\contab\clase\caut.vcx ADDITIVE
*!* oo=ret_luna("Luna de inceput")
*** scattered = MYSCATTER() && This is instead of SCATTER NAME...
Procedure myscatter
Parameters tcBlank
Local llBlank, loScatter
llBlank=.F.
If Type('tcBlank')='C'
If 'BLANK'$Upper(tcBlank)
llBlank=.T.
Endif
Endif
myScatterObject = Createobject("myScatterObject")
If !Empty(Alias())
If llBlank
Scatter Name loScatter Memo Blank
Else
Scatter Name loScatter Memo
Endif
lnFields = Fcount(Alias())
For N =1 To lnFields
lcField=Field(N)
lcvalue=loScatter.&lcField
myScatterObject.AddProperty(lcField, lcvalue)
Endfor
Release loScatter
Endif
Return myScatterObject && Always return an object, so GATHER command could not choke.
Endproc
Define Class myScatterObject As Session
* You may use any VFP class directly like myScatterObject = CREATEOBJECT("Session")
* But you may optionally use this DEFINE CLASS
* and declare the native PEMs here as HIDDEN if you want, so they are not exposed
* in case you are using class other than Session or work with VFP version prior to VFP 7.0
Enddefine
***-----------------------------------------------------------------------------------------------------------------
Procedure caut_alfa_cursor
Parameters NUMEBAZA,NUMECIMP,CAPTEXT,VARMEM
Local MC0,MC1,MC2, llVizibil
Set Safety Off
llVizibil = .T.
MC0='SELE '+NUMEBAZA
MC1='VARMEM=M.'+NUMECIMP
*MC2='SET order TO TAG '+NUMECIMP
MC2 = [INDEX ON ] +NUMECIMP+ [ TAG nume OF &loc\&nfscurt\tempo\xindex.idx COMPACT ASCENDING ]
*!* &MC0
*!* &MC2
*!* GO TOP
Local lcNumeCol2
Store '' To lcNumeCol2
LcCol = Alltrim(NUMEBAZA) + '.cod_fiscal'
If Type(LcCol) # 'U'
lcNumeCol2 = 'cod_fiscal'
Endif
LcCol = Alltrim(NUMEBAZA) + '.gest'
If Type(LcCol) # 'U'
lcNumeCol2 = 'gest'
Endif
LcCol = Alltrim(NUMEBAZA) + '.id_sectie'
If Type(LcCol) # 'U'
lcNumeCol2 = 'id_sectie'
Endif
If Empty(lcNumeCol2)
lcNumeCol2 = 'space(4)'
llVizibil = .F.
Endif
LcCol = Alltrim(NUMEBAZA) + '.id'
If Type(LcCol) # 'U'
lcNumeCol3 = 'id'
Else
lcNumeCol3 = 'space(4)'
Endif
Select Distinct &NUMECIMP, &lcNumeCol2, &lcNumeCol3 From (NUMEBAZA) Into Cursor tnomenclator Readwrite Order By &NUMECIMP
OCA=Createobject("CAUTALFa")
OCA.Caption=CAPTEXT
OCA.GRID1.RecordSource='tnomenclator'
OCA.GRID1.COLUMN1.ControlSource = NUMECIMP
OCA.GRID1.COLUMN2.ControlSource = lcNumeCol2
OCA.GRID1.COLUMN2.Visible = llVizibil
OCA.cmdrenunt1.Visible=.T.
OCA.command1.Visible=.F.
OCA.command2.Visible=.F.
OCA.command3.Visible=.F.
OCA.Show(1)
*!* &MC0
*!* SCATTER MEMVAR
*!* SET FILTER TO
If buton=2
Use In tnomenclator
Return
Endif
lcFile = Addbs(gcTempPath) + 'xindex.idx'
If File(lcFile)
Set Index To
Delete File &lcFile
Endif
*!* &MC1
Select tnomenclator
Scatter Memvar
&MC1
Use In tnomenclator
Return
***-----------------------------------------------------------------------------------------------------------------

340
Programe/quitapp.prg Normal file
View File

@@ -0,0 +1,340 @@
* Program: QUITAPP.PRG
* Description: Client-side of remote termination of applications.
* Created: 07/11/2003
* Developer: Gregory L Reichert
* Copyright: Copyright (c) 2003 GLR software
*------------------------------------------------------------
* Id Date By Description
* 1 07/11/2003 Gregory L Reichert Initial Creation
*
*------------------------------------------------------------
*!* Overview
*!* The component is the client-side portion of a Remote Application Killer.
*!* With the use of a shared table, an network administrator can determine
*!* what workstation has what application running, and instruct that application
*!* to quit.
*!* An administrator can monitor which applications are running, and instruct them
*!* termination themselves.
*!* Instructions
*!* This component is based on a Timer class with a one minute interval. Each minute
*!* the application check to see if the administrator wishs the application to
*!* quit. If discovered so, the countdown begins (default 10 minutes). During the
*!* Countdown, a message is displayed notifing the user that the automatic termination of
*!* the application is underway. They can manual exit the application, or wait for the
*!* automatic. Either way, it is intended for the user to complete their current task.
*!* At the end of the countdown, the application issues a QUIT command.
*!* Call this routine, and a object reference is returned. This object should
*!* remain active throughout the life of the application.
*!* PRIVATE oQuitApp
*!* oQuitApp = QuitApp( "\\MyServer\MyDrive\CommonFiles\" )
*!*
*!* When the administrator wish to terminate one or more application, they place
*!* a True (.T.) in the "lQuit" field of the QuitApp.dbf table. As the Application continues
*!* countdown to automated termination, the "Remain" field indicates the number of minutes
*!* remaining. If the Admin changes the value of "Remain", the countdown continues from
*!* that new value. If a value less then zero (0) is entered, the application terminates
*!* the next time the QuitApp timer is fired.
*!* Two exposed method are provided to inform the routine that the application
*!* is performing critical operations and can not be interupted. These are called
*!* EnterCritical() and LeaveCritical(). The EnterCritical() should be called when the
*!* critical section begins, and the LeaveCritical() should be called when the section
*!* ends.
*!* The administrator can check to see a application is running, or if it crashed before hand,
*!* by set the "aLiveTest" field of the QuitApp.dbf to False (.F.). After a couple of minutes,
*!* if the application is still alive, the field will revert to True (.T.).
*!* The form called Admin_QuitApp.scx is used by the administrator to monitor and control the
*!* remote applications.
*!* =====================================================================================
LPARAMETERS tcPath, tcQuitName
RETURN CREATEOBJECT("QuitApp", tcPath, tcQuitName)
#DEFINE kQuitMax 10 && Wait 10 minutes before auto-quit
*------------------------------------------------------------
* Description: QuitApp class
*------------------------------------------------------------
* Id Date By Description
* 1 07/11/2003 Gregory L Reichert Initial Creation
*
*------------------------------------------------------------
DEFINE CLASS QuitApp AS TIMER
INTERVAL = (60*1000) && check once a minute.
ENABLE = .T.
cPath = tcPath
cQuitName ="QuitApp"
cQFile ="QuitApp"
cAlias = "QuitApp"
&& Full URN to QuitApp.dbf. Must be at a shared network location for all running application to gain access.
*------------------------------------------------------------
* Description: Error Trap
* Parameters: internal
* Return: n/a
* Use: internal
*------------------------------------------------------------
* Id Date By Description
* 1 07/11/2003 Gregory L Reichert Initial Creation
*
*------------------------------------------------------------
PROCEDURE ERROR( a,b,c )
*-- ignore all error from this class
RETURN
ENDPROC
*------------------------------------------------------------
* Description: Initializes the timer
* Parameters: cPath: path to the shared QuitApp.dbf - path only
* Return: N/A
* Use: ox = CreateObject( "QuitApp","\\myserver\shared\CommonFiles\" )
*------------------------------------------------------------
* Id Date By Description
* 1 07/11/2003 Gregory L Reichert Initial Creation
*
*------------------------------------------------------------
PROCEDURE INIT( cPath, cQuitName )
LOCAL lc
lc = SELECT()
cPath = ADDBS(IIF(EMPTY(cPath),"", cPath))
cQuitName = IIF(EMPTY(cQuitName),"QuitApp",JUSTSTEM(cQuitName))
cQFile = cPath+cQuitName+".dbf"
cAlias = "QuitApp"
this.cPath = cPath
this.cQuitName = cQuitName
this.cQFile = cQFile
this.cAlias = cAlias
*-------------------------------------
* create QuitApp table if missing.
*-------------------------------------
IF NOT FILE(this.cQFile)
SELECT 0
CREATE TABLE (this.cQFile) (ws c(40),ID N(10,0), cCaption c(100),lQuit L, remain N(3), Critical L, aLiveTest L)
USE
ENDIF
SELECT(lc)
ENDPROC
*------------------------------------------------------------
* Description: Timer routine
* Parameters: n/a
* Return: n/a
* Use: internal
*------------------------------------------------------------
* Id Date By Description
* 1 07/11/2003 Gregory L Reichert Initial Creation
*
*------------------------------------------------------------
PROCEDURE TIMER
LOCAL lc
lc = SELECT()
USE (this.cQFile) IN 0 SHARED ALIAS (this.cAlias)
SELECT (this.cAlias)
LOCATE FOR ID=_VFP.HWND AND cCaption=_VFP.CAPTION AND NOT DELETED()
IF NOT FOUND()
*-------------------------------------
* Add an instence for this workstation / application
INSERT INTO (this.cQFile) (ws,ID,cCaption,lQuit,remain, Critical, aLiveTest) ;
VALUES ( UPPER(SYS(0)),_VFP.HWND, _VFP.CAPTION, .F., kQuitMax, .F., .T.)
ENDIF
*- Each time, reset the aLiveTest field.
REPLACE aLiveTest WITH .T.
IF NOT Critical AND TXNLEVEL()=0
*- do only if not in Critical Section of the code,
* and not in a Transaction block
IF lQuit
*-------------------------------------
* if still timing out, display remaining time.
*-------------------------------------
IF remain>0
IF remain=kQuitMax
* - if first time displaying the warning, force application on top.
_SCREEN.ALWAYSONTOP=.T.
_SCREEN.ALWAYSONTOP=.F.
ENDIF
*- decrement the counter, and display warning.
REPLACE remain WITH remain -1
osh=CREATEOBJECT('shell.application')
osh.minimazeall
_screen.windowstate=2
WAIT WINDOW NOCLEAR NOWAIT "Programul se va inchide automat in " +ALLTRIM(STR(remain,10))+" minute."
?? CHR(7)
osh.undominimazeall
RELEASE osh
ELSE
*-------------------------------------
* otherwise, quit the application.
*-------------------------------------
USE IN (this.cAlias)
CLEAR EVENTS
glQuit = .T.
QUIT
ENDIF
ELSE
*-------------------------------------
* if nolonger quiing, reset counter.
*-------------------------------------
REPLACE remain WITH kQuitMax
WAIT CLEAR
ENDIF
ENDIF
USE IN (this.cAlias)
THIS.RESET
SELECT(lc)
ENDPROC
*------------------------------------------------------------
* Description: Called when entering a Critical Section of the code.
* Parameters: n/a
* Return: True
* Use: <object>.EnterCritical
*------------------------------------------------------------
* Id Date By Description
* 1 07/11/2003 Gregory L Reichert Initial Creation
*
*------------------------------------------------------------
PROCEDURE EnterCritical()
LOCAL lc
lc = SELECT()
USE (this.cQFile) IN 0 SHARED ALIAS (this.cAlias)
SELECT (this.cAlias)
UPDATE (this.cQFile) SET Critical=.T. WHERE ID=_VFP.HWND AND cCaption=_VFP.CAPTION
USE IN (this.cAlias)
SELECT(lc)
ENDPROC
*------------------------------------------------------------
* Description: Called when exitting a Critical Section of the code.
* Parameters: n/a
* Return: True
* Use: <object>.LeaveCritical
*------------------------------------------------------------
* Id Date By Description
* 1 07/11/2003 Gregory L Reichert Initial Creation
*
*------------------------------------------------------------
PROCEDURE LeaveCritical()
LOCAL lc
lc = SELECT()
USE (this.cQFile) IN 0 SHARED ALIAS (this.cAlias)
SELECT (this.cAlias)
UPDATE (this.cQFile) SET Critical=.F. WHERE ID=_VFP.HWND AND cCaption=_VFP.CAPTION
USE IN (this.cAlias)
SELECT(lc)
ENDPROC
*------------------------------------------------------------
* Description: Destroy this object
* Parameters: n/a
* Return: n/a
* Use: internal
*------------------------------------------------------------
* Id Date By Description
* 1 07/11/2003 Gregory L Reichert Initial Creation
*
*------------------------------------------------------------
PROCEDURE DESTROY
*-----------------------------------------------
* On destroy, remove the application reference from the QuitApp table.
*-----------------------------------------------
LOCAL lc
lc = SELECT()
USE (this.cQFile) IN 0 SHARED ALIAS (this.cAlias)
SELECT (this.cAlias)
DELETE FROM (this.cQFile) WHERE ID=_VFP.HWND AND cCaption=_VFP.CAPTION
USE IN (this.cAlias)
SELECT(lc)
ENDPROC
ENDDEFINE
&& ------------------------------INCEPUT: Quit_Automat ------------------------------
*!* Procedura: Quit_Automat
*!* Parametri: tlQuit
*!* Data/Ora generarii: 19/02/2004 12:48
*!* Autor: MARIUS.MUTU
PROCEDURE Quit_Automat
LPARAMETERS tlQuit
IF tlQuit
QUIT
ENDIF
ENDPROC
&& ------------------------------SFARSIT: Quit_Automat ------------------------------
* Eof QUITAPP.PRG
***************************
*!* FUNCTION AppInstance
*!* PARAMETERS WindowName
*!* #DEFINE GW_OWNER 4
*!* #DEFINE GW_HWNDFIRST 0
*!* #DEFINE GW_HWNDNEXT 2
*!* #DEFINE SW_MAXIMIZE 3
*!* #DEFINE SW_NORMAL 1
*!* DECLARE integer SetForegroundWindow in win32api long lnhWnd
*!* DECLARE integer GetWindowText in win32api integer, string, integer
*!* DECLARE integer GetWindow in win32api integer,INTEGER
*!* DECLARE integer IsWindowVisible in win32api integer
*!* DECLARE integer GetActiveWindow in win32api
*!* DECLARE integer ShowWindow in user32 INTEGER lnhWnd, INTEGER lnCmdShow
*!* IsWindEx = .F.
*!* if len(WindowName) < 1
*!* return .t.
*!* endif
*!* foxhwnd = GetActiveWindow()
*!* hwndNext = GetWindow(foxhwnd,GW_HWNDFIRST)
*!* DO WHILE hwndNext <> 0
*!* IF (hwndnext <> foxhwnd .AND. GetWindow(hwndnext,GW_OWNER) = 0)
*!* Stuffer = SPACE(64)
*!* x = GetWindowText(hwndnext,@Stuffer,64)
*!* IF WindowName $ Stuffer
*!* IsWindEx = .T.
*!* =SetForegroundWindow(hwndnext)
*!* =ShowWindow(hwndNext,SW_MAXIMIZE)
*!* EXIT
*!* ENDIF
*!* ENDIF
*!* hwndNext = GetWindow(hwndnext,GW_HWNDNEXT)
*!* ENDDO
*!* RETURN IsWindEx
*!* ENDFUNC

104
Programe/rapbal97.prg Normal file
View File

@@ -0,0 +1,104 @@
public wbal
dirfirm=loc+'\'+nfscurt
WBAL=0
sele bal
set filter to SUBS(CONT,1,1)='7'
TOTAL ON subs(cont,5,1) TO &dirfirm\tempo\TOTTOT7
SELE BAL
set filter to SUBS(CONT,1,1)='6'
TOTAL ON SUBS(CONT,5,1) TO &dirfirm\tempo\TOTTOT6
SELE 0
USE &dirfirm\tempo\TOTTOT7
REPL DENUMIRE WITH 'TOTAL VENITURI';
CONT WITH '7998'
SELE 0
USE &dirfirm\tempo\TOTTOT6
REPL DENUMIRE WITH 'TOTAL CHELTUIELI';
CONT WITH '6998'
SELE BAL
SET FILTER TO
SELE BAL
TOTAL ON SUBSTR(CONT,1,3) TO &dirfirm\tempo\TOTBAL
SELE 0
*USE DATEAN\TOTBAL
USE &dirfirm\tempo\totbal.dbf exclusive
SELE BAL
COPY TO &dirfirm\tempo\RAPBAL
SELE 0
USE &dirfirm\tempo\RAPBAL
TOTAL ON SUBS(CONT,5,1) TO &dirfirm\tempo\TOTTOT
SELE TOTBAL
REPL ALL DENUMIRE WITH 'TOTAL '+SUBSTR(CONT,1,3);
cont WITH substr(cont,1,3)+'A'
SELE 190
USE &dirfirm\tempo\TOTTOT
REPL DENUMIRE WITH 'TOTAL GENERAL';
CONT WITH '9999'
SELE TOTBAL
USE
SELE TOTTOT
USE
SELE TOTTOT7
USE
SELE TOTTOT6
USE
SELE RAPBAL
APPE FROM &dirfirm\tempo\TOTBAL
APPE FROM &dirfirm\tempo\TOTTOT
APPE FROM &dirfirm\tempo\TOTTOT7
APPE FROM &dirfirm\tempo\TOTTOT6
INDEX ON CONT TO &dirfirm\tempo\BALRAP.CDX
GO TOP
GCONT=CONT
kg=0
SCAN
SCATTER MEMVAR
if subs(m.cont,1,3)=subs(gcont,1,3)
kg=kg+1
else
kg=1
endif
IF SUBS(M.CONT,4,1)='A' and kg=2
DELETE
kg=0
ENDIF
GCONT=M.CONT
ENDSCAN
m.titlu=''
if a4
REPORT FORMAT RAPBALa4.FRX TO PRINTER PROMPT preview
else
REPORT FORMAT RAPBALa3.FRX TO PRINTER PROMPT preview
endif
SELE RAPBAL
USE
ERASE &dirfirm\tempo\RAPBAL.DBF
ERASE &dirfirm\tempo\BALrap.cdx
ERASE &dirfirm\tempo\TOTTOT.DBF
ERASE &dirfirm\tempo\TOTTOT7.DBF
ERASE &dirfirm\tempo\TOTTOT6.DBF
ERASE &dirfirm\tempo\totBAL.DBF
RETURN

7489
Programe/refverif.prg Normal file
View File

File diff suppressed because it is too large Load Diff

1064
Programe/roacontracte.prg Normal file
View File

File diff suppressed because it is too large Load Diff

3
Programe/shutdown.prg Normal file
View File

@@ -0,0 +1,3 @@
IF TYPE("goApp")=="O" AND NOT ISNULL(goApp)
RETURN goApp.OnShutDown()
ENDIF

65
Programe/update_nomenclator.prg Normal file
View File

@@ -0,0 +1,65 @@
**********************************************************
PROCEDURE update_nomenclator
*!* DO update_coresp_tip_part
*!* DO update_coresp_tip_cont
DO update_lunilean
*** tabele meniu deschise din proiect
LOCAL lcCaleDateMenu
lcCaleDateMenu=gcAppPath+[DATEMENU\]
*!* modificare v 2.0.35
*!* IF !USED('MILA1')
*!* USE &lcCaleDateMenu.MILA1 IN 0 ALIAS MILA1
*!* ENDIF
*!* IF !USED('XREQUEST')
*!* USE &lcCaleDateMenu.XREQUEST IN 0 ALIAS XREQUEST
*!* ENDIF
*!* IF !USED('xitems')
*!* USE &lcCaleDateMenu.xitems IN 0 ALIAS xitems
*!* ENDIF
*!* IF !USED('YACT')
*!* USE &lcCaleDateMenu.YACT IN 0 ALIAS YACT
*!* ENDIF
*!* IF !USED('XSETS')
*!* USE &lcCaleDateMenu.XSETS IN 0 ALIAS XSETS ORDER TAG ID_SET
*!* ENDIF
*!* IF !USED('xACT')
*!* USE &lcCaleDateMenu.xACT IN 0 ALIAS xACT
*!* ENDIF
*!* IF !USED('xnote')
*!* USE &lcCaleDateMenu.xnote IN 0 ALIAS xnote
*!* ENDIF
lnSucces = xdate()
*!* modificare v 2.0.35 ^
*!* IF !USED('menu1')
*!* USE &lcCaleDateMenu.menu1 IN 0 ALIAS menu1 EXCL
*!* ENDIF
IF !USED('INFISIERE')
USE &lcCaleDateMenu.INFISIERE IN 0 ALIAS INFISIERE
ENDIF
*!* modificare v 2.1.1
If !Used('mila1')
Use &lcCaleDateMenu.mila1 In 0 Alias mila1
endif
*!* modificare v 2.1.1 ^
*!* IF !USED('nom_meniu')
*!* USE &lcCaleDateMenu.nom_meniu IN 0 ALIAS nom_meniu
*!* ENDIF
*!* IF !USED('refaceri')
*!* USE &lcCaleDateMenu.refaceri IN 0 ALIAS refaceri
*!* ENDIF
*!* IF !USED('tabela_fisa_cont')
*!* USE &lcCaleDateMenu.tabela_fisa_cont IN 0 ALIAS tabela_fisa_cont
*!* ENDIF
ENDPROC && update_nomenclator

119
Programe/update_roadef_sal.prg Normal file
View File

@@ -0,0 +1,119 @@
*******************************************
* PROCEDURE update_responsabil( )
* Date : 05/23/05, 12:25:08
* author : liana.macinic
* description:
****** PARAMETER BLOCK **************
* Parameters : 0
*
*******************************************
PROCEDURE update_responsabil( )
If Used('v_resp')
Use In v_resp
Endif
lcSql = [select * from ] + gcS + [.sal_responsabil where ales = 1]
lcCursor = [v_resp]
lnSucces = goExecutor.oExecute(lcSql,lcCursor)
goExecutor.oReset()
ENDPROC
*----------------------------------sfarsit procedura update_responsabil----------------------------------
*******************************************
* PROCEDURE update_sectie( )
* Data/ora : 12/16/04, 14:26:22
* autor : liana.macinic
* descriere:
****** PARAMETER BLOCK **************
* Parametri : 0
*
*******************************************
Procedure update_sectie( )
If Used('v_sectie')
Use In v_sectie
Endif
lcSql = [select * from ] + gcS + [.nom_sectii order by sectie]&& where inactiv = 0]
lcCursor = [v_sectie]
lnSucces = goExecutor.oExecute(lcSql,lcCursor)
goExecutor.oReset()
Return lnSucces
Endproc
*******************************************
* PROCEDURE update_transe( )
* Date : 05/26/05, 16:25:42
* author : liana.macinic
* description:
****** PARAMETER BLOCK **************
* Parameters : 0
*
*******************************************
PROCEDURE update_transe( )
If Used('v_transe')
Use In v_sectie
Endif
lcSql = [select * from ] + gcS + [.SAL_NOM_TRANSE where inactiv = 0 and sters = 0]
lcCursor = [v_transe]
lnSucces = goExecutor.oExecute(lcSql,lcCursor)
goExecutor.oReset()
Return lnSucces
ENDPROC
*----------------------------------sfarsit procedura update_transa----------------------------------
*******************************************
* PROCEDURE update_ore( )
* Date : 05/26/05, 16:25:42
* author : liana.macinic
* description:
****** PARAMETER BLOCK **************
* Parameters : 0
*
*******************************************
PROCEDURE update_ore( )
If Used('v_nomore')
Use In v_nomore
Endif
lcSql = [select * from ] + gcS + [.SAL_NOMORE where inactiv = 0 and sters = 0]
lcCursor = [v_nomore]
lnSucces = goExecutor.oExecute(lcSql,lcCursor)
goExecutor.oReset()
Return lnSucces
ENDPROC
*----------------------------------sfarsit procedura update_ore----------------------------------
*******************************************
* PROCEDURE update_calcdin( )
* Date : 06/17/05, 12:52:29
* author : liana.macinic
* description:
****** PARAMETER BLOCK **************
* Parameters : 0
*
*******************************************
PROCEDURE update_calcdin( )
If Used('v_calcdin')
Use In v_calcdin
Endif
lcSql = [select id_calcdin,camp,denumire as nume_camp,tabel from ] + gcS + [.sal_nom_calcdin where 2=2]
lcCursor = [v_calcdin]
lnSucces = goExecutor.oExecute(lcSql,lcCursor)
goExecutor.oReset()
Return lnSucces
ENDPROC
*----------------------------------sfarsit procedura update_calcdin----------------------------------

1486
Programe/verifica.prg Normal file
View File

File diff suppressed because it is too large Load Diff