Initial: flux text FoxBin2Prg (git urmareste .??2 in-arbore, binarele VFP git-ignored)
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:
935
Programe/proceduri.prg
Normal file
935
Programe/proceduri.prg
Normal 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
|
||||
***-----------------------------------------------------------------------------------------------------------------
|
||||
Reference in New Issue
Block a user