Cabec

Função que imprime o cabeçalho dos antigos relatórios gerados com SetPrint.

Exemplo da Rotina:

Cabec - Exemplo 1
Cabec – Exemplo 1
Cabec("Titulo", "Cabec1", "Cabec2", "NomePrograma", "Tamanho", nTipo)

Exemplo 1- Relatório exemplo de Contas a Pagar:

//Bibliotecas
#Include "Protheus.ch"
#Include "TopConn.ch"

/*/{Protheus.doc} zTeste
Função de Teste
@type function
@author Terminal de Informação
@since 13/11/2016
@version 1.0
    @example
    u_zTeste()
/*/
 
User Function zTeste()
	Local cDesc1     := "Este relatório irá imprimir informações do contas a pagar conforme"
	Local cDesc2     := "parâmetro informado. Será gerado um arquivo no diretório "
	Local cDesc3     := "Spool - zTeste_????.XLS, onde ???? e o nome do usuário."
	Private cString  := "SE2"
	Private Tamanho  := "M"
	Private aReturn  := { "Zebrado",2,"Administração",2,2,1,"",1 }
	Private wnrel    := "zTeste"
	Private NomeProg := "zTeste"
	Private nLastKey := 0
	Private Limite   := 132
	Private Titulo   := "Título a Pagar - Ordem de "
	Private cPerg    := "X_zTeste"
	Private nTipo    := 0
	Private cbCont   := 0
	Private cbTxt    := "registro(s) lido(s)"
	Private Li       := 80
	Private m_pag    := 1
	Private aOrd     := {}
	Private Cabec1   := "    PREFIXO TITULO      PARC.  TIP  EMISSAO   VENCTO      VENCTO REAL VLR. ORIGINAL       PAGO                SALDO "
	Private Cabec2   := ""

	/*
	Parâmetros do aReturn
	aReturn - Preenchido pelo SetPrint()
	aReturn[1] - Reservado para formulário
	aReturn[2] - Reservado para numero de vias
	aReturn[3] - Destinatário
	aReturn[4] - Formato 1=Paisagem 2=Retrato
	aReturn[5] - Mídia 1-Disco 2=Impressora
	aReturn[6] – Porta ou arquivo 1-Lpt1... 4-Com1...
	aReturn[7] - Expressão do filtro
	aReturn[8] - Ordem a ser selecionada
	aReturn[9] [10] [n] - Campos a processar se houver
	*/

	//Ordens do relatório
	aAdd( aOrd, "Fornecedor" )
	aAdd( aOrd, "Titulo" )
	aAdd( aOrd, "Emissão" )
	aAdd( aOrd, "Vencimento" )
	aAdd( aOrd, "Vencto. Real" )

	//Cria as perguntas do relatório e chama para a memória
	fCriaSX1()
	Pergunte(cPerg,.F.)

	//Mostra a tela de configuração do relatório
	wnrel := SetPrint(cString, wnrel, cPerg, @Titulo, cDesc1, cDesc2, cDesc3, .F., aOrd, .F., Tamanho, .F., .F.)

	//Se pressionar -ESC- encerra o programa
	If nLastKey == 27
		Return
	Endif

	//Estabelece os padrões para impressão, conforme escolha do usuário
	SetDefault(aReturn,cString)

	//Verificar se será reduzido ou normal
	nTipo := IIF(aReturn[4] == 1, 15, 18)

	//Se pressionar -ESC- encerra o programa
	If nLastKey == 27
		Return
	Endif

	//Chama função que processa os dados
	RptStatus({|lEnd| fImpRel(@lEnd) }, Titulo, "Processando e imprimindo dados, aguarde...", .T. )
Return

/*---------------------------------------------------------------------*
| Func:  fImpRel                                                      |
| Desc:  Função para impressão do relatório                           |
*---------------------------------------------------------------------*/

Static Function fImpRel(lEnd)
	Local nIndice   := 0
	Local cArq      := ""
	Local cIndice   := ""
	Local cFiltro   := ""
	Local aCol      := {}
	Local cFornec   := ""
	Local nValor    := 0
	Local nPago     := 0
	Local nSaldo    := 0
	Local nT_Valor  := 0
	Local nT_Pago   := 0
	Local nT_Saldo  := 0
	Local cArqExcel := ""
	Local cAliasImp
	Local oExcelApp
	Titulo += aOrd[aReturn[8]]

	//Se não utilizar banco top connect, executa filtro manualmente na tabela
	#IFNDEF TOP
	cAliasImp := "SE2"
	cFiltro := "E2_FILIAL == '"+xFilial("SE2")+"' "
	cFiltro += ".And. E2_FORNECE >= '"+mv_par01+"' "
	cFiltro += ".And. E2_FORNECE <= '"+mv_par02+"' "
	cFiltro += ".And. E2_TIPO >= '"+mv_par03+"' "
	cFiltro += ".And. E2_TIPO <= '"+mv_par04+"' "
	cFiltro += ".And. Dtos(E2_VENCTO) >= '"+Dtos(mv_par05)+"' "
	cFiltro += ".And. Dtos(E2_VENCTO) <= '"+Dtos(mv_par06)+"' "

	//Ordenação por Fornecedor
	If aReturn[8] == 1
		cIndice := "E2_FORNECE+E2_LOJA+E2_NUM"

		//Ordenação por Título
	Elseif aReturn[8] == 2
		cIndice := "E2_NUM+E2_FORNECE+E2_LOJA"

		//Ordenação por Emissão
	Elseif aReturn[8] == 3
		cIndice := "Dtos(E2_EMISSAO)+E2_FORNECE+E2_LOJA"

		//Ordenação por Vencimento
	Elseif aReturn[8] == 4
		cIndice := "Dtos(E2_VENCTO)+E2_FORNECE+E2_LOJA"

		//Ordenação por Vencimento Real
	Elseif aReturn[8] == 5
		cIndice := "Dtos(E2_VENCREA)+E2_FORNECE+E2_LOJA"
	Endif

	//Cria arquivo temporário filtrando via AdvPL
	cArq := CriaTrab(NIL,.F.)
	dbSelectArea(cAliasImp)
	IndRegua(cAliasImp,cArq,cIndice,,cFiltro)
	nIndice := RetIndex()
	nIndice := nIndice + 1
	dbSetIndex(cArq+OrdBagExt())
	dbSetOrder(nIndice)

	//Senão, monta consulta SQL
	#ELSE
	cAliasImp := "QRY_IMP"
	cQuery := "SELECT "
	cQuery += "E2_PREFIXO, E2_NUM, E2_PARCELA, E2_TIPO, E2_FORNECE, E2_LOJA, E2_NOMFOR, "
	cQuery += "E2_EMISSAO, E2_VENCTO, E2_VENCREA, E2_VALOR, E2_SALDO "
	cQuery += "FROM "+RetSqlName("SE2")+" "
	cQuery += "WHERE E2_FILIAL = '"+xFilial("SE2")+"' "
	cQuery += "AND E2_FORNECE >= '"+mv_par01+"' "
	cQuery += "AND E2_FORNECE <= '"+mv_par02+"' "
	cQuery += "AND E2_TIPO    >= '"+mv_par03+"' "
	cQuery += "AND E2_TIPO    <= '"+mv_par04+"' "
	cQuery += "AND E2_VENCTO  >= '"+Dtos(mv_par05)+"' "
	cQuery += "AND E2_VENCTO  <= '"+Dtos(mv_par06)+"' "
	cQuery += "AND D_E_L_E_T_  = ' ' "
	cQuery += "ORDER BY "

	//Ordenação por Fornecedor
	If aReturn[8] == 1
		cQuery += "E2_FORNECE,E2_LOJA,E2_NUM"

		//Ordenação por Título
	Elseif aReturn[8] == 2
		cQuery += "E2_NUM,E2_FORNECE,E2_LOJA"

		//Ordenação por Emissão
	Elseif aReturn[8] == 3
		cQuery += "E2_EMISSAO,E2_FORNECE,E2_LOJA"

		//Ordenação por Vencimento
	Elseif aReturn[8] == 4
		cQuery += "E2_VENCTO,E2_FORNECE,E2_LOJA"

		//Ordenação por Vencimento Real
	Elseif aReturn[8] == 5
		cQuery += "E2_VENCREA,E2_FORNECE,E2_LOJA"
	Endif
	TCQuery cQuery New Alias "QRY_IMP"

	#ENDIF
	dbGoTop()
	SetRegua(0)

	//Colunas de impressão
	aAdd( aCol, 004 ) //Prefixo
	aAdd( aCol, 012 ) //Titulo
	aAdd( aCol, 024 ) //Parcela
	aAdd( aCol, 031 ) //Tipo
	aAdd( aCol, 036 ) //Emissao
	aAdd( aCol, 046 ) //Vencimento
	aAdd( aCol, 058 ) //Vencimento Real
	aAdd( aCol, 070 ) //Valor Original
	aAdd( aCol, 090 ) //Pago
	aAdd( aCol, 110 ) //Saldo
	cFornec := (cAliasImp)->E2_FORNECE+(cAliasImp)->E2_LOJA

	//Enquanto houver dados
	While !Eof() .And. !lEnd
		//Se atingir 55 linhas, imprime cabeçalho
		If Li > 55
			Cabec(Titulo,Cabec1,Cabec2,NomeProg,Tamanho,nTipo)
		Endif

		//Imprime dados do Fornecedor
		@ Li, aCol[1] PSay "Cod/Loj/Nome: "+(cAliasImp)->E2_FORNECE+"-"+(cAliasImp)->E2_LOJA+" "+(cAliasImp)->E2_NOMFOR
		Li ++

		//Enquanto for o fornecedor atual
		While !Eof() .And. !lEnd .And. (cAliasImp)->E2_FORNECE+(cAliasImp)->E2_LOJA == cFornec
			IncRegua()
			//Testa para quebra de linha
			If Li > 55
				Cabec(Titulo,Cabec1,Cabec2,NomeProg,Tamanho,nTipo)
			Endif

			//Se for analítico, imprime os dados do título
			If mv_par07 == 2
				@ Li, aCol[1] PSay (cAliasImp)->E2_PREFIXO
				@ Li, aCol[2] PSay (cAliasImp)->E2_NUM
				@ Li, aCol[3] PSay (cAliasImp)->E2_PARCELA
				@ Li, aCol[4] PSay (cAliasImp)->E2_TIPO
				@ Li, aCol[5] PSay (cAliasImp)->E2_EMISSAO
				@ Li, aCol[6] PSay (cAliasImp)->E2_VENCTO
				@ Li, aCol[7] PSay (cAliasImp)->E2_VENCREA
				@ Li, aCol[8] PSay (cAliasImp)->E2_VALOR PICTURE "@E 99,999,999,999.99"
				@ Li, aCol[9] PSay (cAliasImp)->E2_VALOR - (cAliasImp)->E2_SALDO PICTURE "@E 99,999,999,999.99"
				@ Li, aCol[10] PSay (cAliasImp)->E2_SALDO PICTURE "@E 99,999,999,999.99"
				Li ++
			Endif

			//Atualiza os totais
			nValor   += (cAliasImp)->E2_VALOR
			nPago    += ((cAliasImp)->E2_VALOR-(cAliasImp)->E2_SALDO)
			nSaldo   += (cAliasImp)->E2_SALDO
			nT_Valor += (cAliasImp)->E2_VALOR
			nT_Pago  += ((cAliasImp)->E2_VALOR-(cAliasImp)->E2_SALDO)
			nT_Saldo += (cAliasImp)->E2_SALDO
			dbSkip()
		EndDo

		//Imprime os totais
		@ Li, 000 PSay Replicate("-",Limite)
		Li ++
		@ Li, aCol[1] PSay "TOTAL....."
		@ Li, aCol[8] PSay nValor PICTURE "@E 99,999,999,999.99"
		@ Li, aCol[9] PSay nPago PICTURE "@E 99,999,999,999.99"
		@ Li, aCol[10] PSay nSaldo PICTURE "@E 99,999,999,999.99"
		Li +=2
		cFornec := (cAliasImp)->E2_FORNECE+(cAliasImp)->E2_LOJA
		nValor := 0
		nPago := 0
		nSaldo := 0
	EndDo

	//Se o usuário cancelou, finaliza
	If lEnd
		@ Li, aCol[1] PSay cCancel
		Return
	Endif

	//Imprime o total geral
	@ Li, 000 PSay Replicate("=",Limite)
	Li ++
	@ Li, aCol[1] PSay "TOTAL GERAL....."
	@ Li, aCol[8] PSay nT_Valor PICTURE "@E 99,999,999,999.99"
	@ Li, aCol[9] PSay nT_Pago PICTURE "@E 99,999,999,999.99"
	@ Li, aCol[10] PSay nT_Saldo PICTURE "@E 99,999,999,999.99"

	//Se não atingiu o limite, imprime o rodapé
	If Li <> 80
		Roda(cbCont,cbTxt,Tamanho)
	Endif

	//Gera arquivo do tipo .DBF com extensão .XLS p/ usuário abrir no Excel
	cArqExcel := __RELDIR+NomeProg+"_"+Substr(cUsuario,7,4)+".XLS"
	Copy To &cArqExcel
	#IFNDEF TOP
	dbSelectArea(cAliasImp)
	RetIndex(cAliasImp)
	Set Filter To
	#ELSE
	dbSelectArea(cAliasImp)
	(cAliasImp)->(dbCloseArea())
	#ENDIF
	DbSelectArea('SE2')
	SE2->(DbSetOrder(1))
	SE2->(DbGoTop())

	//Mostra o relatório
	If aReturn[5] == 1
		Set Printer TO
		dbCommitAll()
		OurSpool(wnrel)
	EndIf

	//Abrindo planilha MS-Excel
	If mv_par08 == 1
		__CopyFile(cArqExcel,GetTempPath()+NomeProg+"_"+Substr(cUsuario,7,4)+".XLS")
		If ! ApOleClient("MsExcel")
			MsgAlert("MsExcel não instalado", "Atenção")
			Return
		Endif
		oExcelApp := MsExcel():New()
		oExcelApp:WorkBooks:Open( GetTempPath()+NomeProg+"_"+Substr(cUsuario,7,4)+".XLS" )
		oExcelApp:SetVisible(.T.)
		oExcel:Destroy()
	Endif
	Ms_Flush()
Return

/*---------------------------------------------------------------------*
| Func:  fCriaSX1                                                     |
| Desc:  Função para criar o grupo de perguntas                       |
*---------------------------------------------------------------------*/

Static Function fCriaSx1()
	Local aP := {}
	Local i := 0
	Local cSeq
	Local cMvCh
	Local cMvPar
	Local aHelp := {}
	
	//Adiciona os parâmetros
	aAdd(aP,{"Fornecedor de","C",6,0,"G","","SA2","" ,"" ,"","",""})
	aAdd(aP,{"Fornecedor ate","C",6,0,"G","(mv_par02>=mv_par01)","SA2","" ,"" ,"","",""})
	aAdd(aP,{"Tipo de","C",3,0,"G","","05" ,"" ,"" ,"","",""})
	aAdd(aP,{"Tipo ate","C",3,0,"G","(mv_par04>=mv_par03)","05" ,"" ,"" ,"","",""})
	aAdd(aP,{"Vencimento de","D",8,0,"G","","" ,"" ,"" ,"","",""})
	aAdd(aP,{"Vencimento ate","D",8,0,"G","(mv_par06>=mv_par05)","" ,"" ,"" ,"","",""})
	aAdd(aP,{"Aglutinar pagto.de fornec.","N",1,0,"C","","","Sim","Não","","",""})
	aAdd(aP,{"Abrir planilha MS-Excel" ,"N",1,0,"C","","","Sim","Não","","",""})
	aAdd(aHelp,{"Informe o código do fornecedor.","inicial."})
	aAdd(aHelp,{"Informe o código do fornecedor.","final."})
	aAdd(aHelp,{"Tipo de título inicial."})
	aAdd(aHelp,{"Tipo de título final."})
	aAdd(aHelp,{"Digite a data do vencimento inicial."})
	aAdd(aHelp,{"Digite a data do vencimento final."})
	aAdd(aHelp,{"Aglutinar os títulos do mesmo forne-","cedor totalizando seus valores."})
	aAdd(aHelp,{"Será gerada uma planilha para ","MS-Excel, abrir esta planilha?"})
	
	//Percorre, recriando
	For i:=1 To Len(aP)
		cSeq := StrZero(i,2,0)
		cMvPar := "mv_par"+cSeq
		cMvCh := "mv_ch"+IIF(i<=9,Chr(i+48),Chr(i+87))
		PutSx1(cPerg,;
		cSeq,;
		aP[i,1],aP[i,1],aP[i,1],;
		cMvCh,;
		aP[i,2],;
		aP[i,3],;
		aP[i,4],;
		0,;
		aP[i,5],;
		aP[i,6],;
		aP[i,7],;
		"",;
		"",;
		cMvPar,;
		aP[i,8],aP[i,8],aP[i,8],;
		"",;
		aP[i,9],aP[i,9],aP[i,9],;
		aP[i,10],aP[i,10],aP[i,10],;
		aP[i,11],aP[i,11],aP[i,11],;
		aP[i,12],aP[i,12],aP[i,12],;
		aHelp[i],;
		{},;
		{},;
		"")
	Next i
Return

Observações:

– Caso tenha dúvidas ou problemas com os exemplos, entre em contato;
– Se tiver sugestões de rotinas, pode entrar em contato;

Referências:

TDN