293 lines
8.8 KiB
Plaintext
293 lines
8.8 KiB
Plaintext
*-------------------------------------------
|
|
* Function...: Xmenu
|
|
* Author.....: MARTIN
|
|
* Date.......: 04/06/1997
|
|
* Notes......: Based on an idea from Steve Zimmelman for FoxPro 2.x
|
|
* Parameters.: tcItems = Semicolon-separated String with the various options
|
|
* ...........: tnBar = Initially selected item (default=1)
|
|
* Returns....: Selected item number
|
|
* See Also...: PROMPT() [FoxPro Native]
|
|
* lnOption = xmenu('\<Listare1;L\<istare2;Li\<stare3')
|
|
Procedure XMENU
|
|
Lparameters TCITEMS, TNBAR
|
|
|
|
Local NITEMCOUNT, AITEMS, X, NROW, NCOL, CTITLE, NLASTPOS, CCOLOR, AITEMS
|
|
|
|
Private CPOPMENU, NSELECT && They flow into the GetChoice internal procedure
|
|
|
|
If Pcount() < 2
|
|
TNBAR = 1
|
|
Endif
|
|
|
|
Activate Screen
|
|
|
|
* Parse every item
|
|
m.NITEMCOUNT = Occurs( ';', TCITEMS ) + 1
|
|
Dimen AITEMS[ m.nItemCount ]
|
|
m.NLASTPOS = 1
|
|
|
|
For m.X = 1 To m.NITEMCOUNT
|
|
|
|
If m.X < m.NITEMCOUNT
|
|
|
|
AITEMS[ m.x ] = Subs( m.TCITEMS, m.NLASTPOS, ;
|
|
( At( ';', m.TCITEMS, m.X ) - 1 ) - m.NLASTPOS + 1 )
|
|
Else
|
|
AITEMS[ m.x ] = Subs( m.TCITEMS, m.NLASTPOS, ;
|
|
( Len( m.TCITEMS ) - m.NLASTPOS ) + 1 )
|
|
Endif
|
|
|
|
If AITEMS[ m.x ] # "\-"
|
|
|
|
AITEMS[ m.x ] = Allt( AITEMS[ m.x ] )
|
|
Endif
|
|
|
|
m.NLASTPOS=At( ';', m.TCITEMS, m.X ) + 1
|
|
Next
|
|
|
|
* Calculates the mouse pointer position
|
|
m.NROW = Iif( Mrow() + m.NITEMCOUNT < Srow(), Mrow() - 1, Srow() - m.NITEMCOUNT )
|
|
m.NCOL = Iif( Mcol() + 10 < Scol(), Mcol() - 3, Mcol() - 13 )
|
|
|
|
* Gets an unique name for the pop-up
|
|
m.CPOPMENU = 'M' + Sys(3) + "_"
|
|
|
|
Define Popup ( m.CPOPMENU ) SHORTCUT Relative From NROW, NCOL
|
|
|
|
For m.X = 1 To m.NITEMCOUNT
|
|
|
|
Define Bar m.X Of ( m.CPOPMENU ) Prompt AITEMS[ m.x ]
|
|
Next
|
|
|
|
m.CANS = ""
|
|
m.NSELECT = 0
|
|
Clear Type
|
|
|
|
On Selection Popup ( m.CPOPMENU ) Do GETCHOICE
|
|
|
|
Activate Popup ( m.CPOPMENU ) Bar TNBAR
|
|
|
|
Pop Key
|
|
Release Popup ( m.CPOPMENU )
|
|
|
|
Return Iif( Lastkey()=27, 0, m.NSELECT )
|
|
|
|
Endproc && XMENU
|
|
|
|
*--------------------
|
|
Procedure GETCHOICE
|
|
|
|
m.NSELECT = Bar()
|
|
|
|
Deactivate Popup ( m.CPOPMENU )
|
|
|
|
Endproc
|
|
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& MENIU &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Define Class Config As Relation
|
|
cSqlPlusFile = ""
|
|
cLogDirectory = ""
|
|
cActualizareDirectory = ""
|
|
*** ==========================================================
|
|
Procedure SetLogDirectory
|
|
Lparameters tcLogDirectory
|
|
Local lcLogDirectory
|
|
If Empty(tcLogDirectory)
|
|
lcLogDirectory = Getdir(Addbs(Justpath(Sys(16,0))), "Alegeti directorul in care se vor genera logurile","Director loguri")
|
|
Else
|
|
lcLogDirectory = tcLogDirectory
|
|
Endif
|
|
WriteINI(goApp.cIniFile, "folder", "log_folder", lcLogDirectory)
|
|
Return lcLogDirectory
|
|
Endproc && SetLogDirectory
|
|
|
|
*** ==========================================================
|
|
Procedure SetActualizareDirectory
|
|
Lparameters tcActualizareDirectory
|
|
Local lcActualizareDirectory
|
|
If Empty(tcActualizareDirectory)
|
|
lcActualizareDirectory = Getdir(Addbs(Justpath(Sys(16,0))), ;
|
|
"Alegeti directorul in care se vor genera actualizarile","Director actualizari")
|
|
Else
|
|
lcActualizareDirectory = tcActualizareDirectory
|
|
Endif
|
|
If !"actualizariaplicatii"$lcActualizareDirectory
|
|
lcActualizareDirectory = ADDBS(lcActualizareDirectory) + 'actualizariaplicatii\'
|
|
Endif
|
|
WriteINI(goApp.cIniFile, "folder", "actualizare", lcActualizareDirectory)
|
|
Return lcActualizareDirectory
|
|
Endproc && SetActualizareDirectory
|
|
*** ==========================================================
|
|
Procedure SetSqlPlus
|
|
Local lcSqlPlus
|
|
lcSqlPlus = Getfile("exe","SQLPLUS.EXE")
|
|
WriteINI(goApp.cIniFile, "folder", "sqlplus_exe", lcSqlPlus)
|
|
Return lcSqlPlus
|
|
Endproc && SetSqlPlus
|
|
*** ==========================================================
|
|
Function GetSqlPlus
|
|
Local lcSqlPlus
|
|
lcSqlPlus = ReadINI(goApp.cIniFile, "folder", "sqlplus_exe")
|
|
If Empty(lcSqlPlus) Or !File(lcSqlPlus)
|
|
lcSqlPlus = This.SetSqlPlus()
|
|
Endif
|
|
|
|
Return lcSqlPlus
|
|
Endfunc && GetSqlPlus
|
|
*** ==========================================================
|
|
Function GetLogDirectory
|
|
Local lcLogDirectory
|
|
lcLogDirectory = ReadINI(goApp.cIniFile, "folder", "log_folder")
|
|
If Empty(lcLogDirectory) Or !Directory(lcLogDirectory)
|
|
lcLogDirectory = This.SetLogDirectory()
|
|
Endif
|
|
lcLogDirectory = Addbs(lcLogDirectory)
|
|
Return lcLogDirectory
|
|
Endfunc && GetLogDirectory
|
|
*** ==========================================================
|
|
Function GetActualizareDirectory
|
|
Local lcActualizareDirectory
|
|
lcActualizareDirectory = ReadINI(goApp.cIniFile, "folder", "roa_output")
|
|
If !"actualizariaplicatii"$lcActualizareDirectory
|
|
lcActualizareDirectory = ADDBS(lcActualizareDirectory) + 'actualizariaplicatii\'
|
|
ENDIF
|
|
|
|
If Empty(lcActualizareDirectory) Or !Directory(lcActualizareDirectory)
|
|
lcActualizareDirectory = This.SetActualizareDirectory()
|
|
Endif
|
|
lcActualizareDirectory = Addbs(lcActualizareDirectory)
|
|
Return lcActualizareDirectory
|
|
Endfunc && GetActualizareDirectory
|
|
|
|
*** ==========================================================
|
|
|
|
Function GetDailyLogDirectory
|
|
lparameters tcHost, tcUserName
|
|
Local lcDailyLogDirectory, lcHost, lcUserName
|
|
lcHost = iif(!empty(m.tcHost), alltrim(m.tcHost), Alltrim(goApp.cUserName))
|
|
lcUserName = iif(!empty(m.tcUserName), alltrim(m.tcUserName), Alltrim(goApp.cUserName))
|
|
|
|
lcDailyLogDirectory = ""
|
|
lcLogDirectory = This.GetLogDirectory()
|
|
If !Empty(lcLogDirectory) And Directory(lcLogDirectory)
|
|
lcDailyLogDirectory = lcLogDirectory + m.lcHost + [\] + ;
|
|
m.lcUserName + [_] + Ttoc(Datetime(),1) + [\]
|
|
Endif
|
|
|
|
Return lcDailyLogDirectory
|
|
Endfunc && GetDailyLogDirectory
|
|
*** ==========================================================
|
|
Function getXMLDirectory
|
|
Lparameters tcCustomer_name
|
|
LOCAL lcXMLDirectory
|
|
lcXMLDirectory = This.GetActualizareDirectory()
|
|
If Pcount() > 0
|
|
lcXMLDirectory = lcXMLDirectory + Alltrim(tcCustomer_name) + '\'
|
|
Endif
|
|
|
|
Return lcXMLDirectory
|
|
|
|
Endfunc
|
|
Enddefine && Config
|
|
|
|
|
|
********************** inceput versiune *************************
|
|
Procedure versiune
|
|
Lparameters lcvers
|
|
|
|
External Array laVers
|
|
Local lcVersiune, lnNr
|
|
lcVersiune = []
|
|
|
|
lnNr = Alines(laVers,Nvl(lcvers,[]),.T.,".")
|
|
If lnNr > 1
|
|
For i =1 To lnNr
|
|
laVers(i) = Replicate("0",3 - Len(Alltrim(Nvl(laVers(i),[])))) + laVers(i)
|
|
lcVersiune = lcVersiune + laVers(i) + "."
|
|
Endfor
|
|
lcVersiune = Left(lcVersiune,Len(lcVersiune)-1)
|
|
Else
|
|
lcVersiune = lcvers
|
|
Endif
|
|
Return lcVersiune
|
|
|
|
Endproc
|
|
********************* versiune ^ ********************************
|
|
|
|
|
|
**************************** inceput cmdPagToate **************************
|
|
Define Class cmdPagToate As CommandButton && Create Command button
|
|
Left = 50 && Command button column
|
|
Top = 100 && Command button row
|
|
Height = 25 && Command button height
|
|
Visible = .T.
|
|
ToolTipText = "Toate inregistrarile"
|
|
Caption = "\<Toate"
|
|
|
|
Procedure Click
|
|
Local lcSql, lnSucces
|
|
|
|
If This.Parent.npag2 = 25
|
|
This.Caption = "\<Reset"
|
|
This.Parent.npag2 = 1000001
|
|
Else
|
|
This.Caption = "\<Toate"
|
|
This.Parent.npag1 = 0
|
|
This.Parent.npag2 = 25
|
|
Endif
|
|
lcSql = [select * from (] + This.Parent.cSelect + ;
|
|
[) where rownum < ] + Alltrim(Str(This.Parent.npag2))
|
|
This.Parent.save_grid(This.Parent.grid1)
|
|
executasql(lcSql,This.Parent.cCursor,.T.)
|
|
This.Parent.restore_grid(This.Parent.grid1)
|
|
Endproc
|
|
|
|
Enddefine
|
|
************************** sfarsit cmdPagToate ^ ******************************
|
|
|
|
************************** inceput cmdPagUrmatoare ****************************
|
|
Define Class cmdPagUrmatoare As CommandButton && Create Command button
|
|
Left = 50 && Command button column
|
|
Top = 100 && Command button row
|
|
Height = 25 && Command button height
|
|
Visible = .T. && implicit, butonul se adauga cu prop visible = .f.
|
|
ToolTipText = "Urmatoarele inregistrari"
|
|
Caption = "\<Urmatoarele"
|
|
|
|
Procedure Click
|
|
Local lcSql, lcSqlBackup, lnSucces, lcSel, lcp1, lcp2
|
|
|
|
This.Parent.npag1 = This.Parent.npag1 + 25
|
|
This.Parent.npag2 = This.Parent.npag2 + 25
|
|
|
|
lcSel = This.Parent.cSelect
|
|
lcp1 = Alltrim(Str(This.Parent.npag1))
|
|
lcp2 = Alltrim(Str(This.Parent.npag2))
|
|
|
|
lcSqlBackup = This.Parent.cSelect && daca nu mai sunt inregistrari pt paginare, se vor afisa toate inreg
|
|
lcSql = [select * from ] + ;
|
|
[ ( select a.*, rownum r from ] + ;
|
|
[ ( select * from ] + ;
|
|
[ ( ] + lcSel + [) t ) a ] + ;
|
|
[ where rownum <= ] + lcp2 + [) ] + ;
|
|
[ where r > ] + lcp1
|
|
|
|
This.Parent.save_grid(This.Parent.grid1)
|
|
executasql(lcSql,This.Parent.cCursor,.T.)
|
|
Select (This.Parent.cCursor)
|
|
If Reccount() = 0
|
|
executasql(lcSqlBackup,This.Parent.cCursor,.T.)
|
|
This.Parent.npag1 = 0
|
|
This.Parent.npag2 = 25
|
|
Endif
|
|
This.Parent.restore_grid(This.Parent.grid1)
|
|
Endproc
|
|
Enddefine
|
|
************************ sfarsit cmdPagUrmatoare ^ ******************************** |