Marius Mutu
63f3828d5e
Co-Authored-By: Claude Fable 5 <noreply@anthropic.com> Claude-Session: https://claude.ai/code/session_012P75yL9Fc9EcT33tMbuxcF
936 lines
20 KiB
Plaintext
936 lines
20 KiB
Plaintext
*-----------------------------------------------
|
|
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
|
|
***-----------------------------------------------------------------------------------------------------------------
|