Olá pessoal…

Hoje vou mostrar uma função que serve para criar uma nova aba em um cadastro (tabela SXA) utilizando uma função em AdvPL (sem precisar utilizar o Configurador).

AdvPL

Nessa função, existem apenas dois parâmetros, a Tabela e a Descrição da Aba que você deseja criar. No caso para criar uma Aba chamada “ESPECIFICOS” para a tabela SA1, bastaria utilizar:

u_zCriaPasta("SA1", "ESPECIFICOS")

A utilidade dessa rotina, é ser utilizada na criação de scripts para manutenção do dicionário de dados, por exemplo, imagine criar mais de 30 abas específicas na base de teste e ter que replicar uma a uma na de produção, para isso, cria um fonte que já faz todo esse processo.

Lembrando que após cadastrar a aba, é necessário atualizar os campos na SX3 (a coluna X3_FOLDER).

Abaixo o código completo da rotina.

//Bibliotecas
#Include "Protheus.ch"

/*/{Protheus.doc} zCriaPasta
Função que verifica se a pasta já existe, se não existir, cria a pasta
@type function
@author Atilio
@since 02/12/2015
@version 1.0
	@param cTabela, character, (Descrição do parâmetro)
	@param cDescPasta, character, (Descrição do parâmetro)
	@return cPasta, Código da pasta criada / existente
	@example
	u_zCriaPasta("SB1", "TESTE")
/*/

User Function zCriaPasta(cTabela, cDescPasta)
	Local aArea := GetArea()
	Local cPasta := ''

	//Abrindo a tabela de pastas
	DbSelectArea('SXA')
	SXA->(DbSetOrder(1)) //XA_ALIAS+XA_ORDEM
	SXA->(DbGoTop())
	
	//Se conseguir posicionar na tabela
	If (SXA->(DbSeek(cTabela)))
		cPasta := ''
		
		//Enquanto houver registros na tabela de pastas / abas e for a mesma tabela
		While !SXA->(EOF()) .And. (SXA->XA_ALIAS == cTabela)
			//Se for a mesma descrição de tabela, pega o código da pasta atual e sai do laço de repetição
			If Upper(AllTrim(SXA->XA_DESCRIC)) == Upper(AllTrim(cDescPasta))
				cPasta := SXA->XA_ORDEM
				Exit
			EndIf
			
			SXA->(DbSkip())
		EndDo
		
		//Se ele não encontrou a pasta
		If Empty(cPasta)
			//Enquanto houver registros na tabela de pastas / abas e for a mesma tabela
			SXA->(DbGoTop())
			SXA->(DbSeek(cTabela))
			While !SXA->(EOF()) .And. (SXA->XA_ALIAS == cTabela)
				cPasta := SXA->XA_ORDEM
				
				SXA->(DbSkip())
			EndDo
			
			//Somando a pasta
			cPasta := Soma1(cPasta)
		EndIf
	
	//Senão, será a primeira pasta
	Else
		cPasta := StrTran(Space(Len(SXA->XA_ORDEM)), ' ', '0')
		cPasta := Soma1(cPasta)
	EndIf

	//Se não conseguir posicionar na aba dessa tabela
	If !SXA->(DbSeek(cTabela + cPasta))
		RecLock('SXA',.T.)
			XA_ALIAS    := cTabela
			XA_ORDEM    := cPasta
			XA_DESCRIC  := cDescPasta
			XA_DESCSPA  := cDescPasta
			XA_DESCENG  := cDescPasta
			XA_PROPRI   := 'U'
		SXA->(MsUnlock())
	EndIf

	RestArea(aArea)
Return cPasta

Bom pessoal, por hoje é só.
Abraços e até a próxima.

Tags: AdvPL