*-------------------------------------------
* 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 ^ ********************************