Função para criar Pastas / Abas (SXA) em AdvPL

Função para criar Pastas / Abas (SXA) em AdvPL

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

Esses e outros códigos, estão disponíveis gratuitamente no nosso GitHub, acesse em github.com/dan-atilio/AdvPL.

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

About Dan_Atilio

Analista e desenvolvedor de sistemas. Técnico em Informática pelo CTI da Unesp. Graduado em Banco de Dados pela Fatec Bauru. Entusiasta de soluções Open Source e blogueiro nas horas vagas. Autor do projeto Terminal de Informação, onde são postados tutoriais e notícias envolvendo o mundo da tecnologia.

Deixe uma resposta

%d blogueiros gostam disto: