Olá pessoal…

Devido a necessidade de imprimir um campo MEMO em várias linhas, desenvolvi uma rotina que quebra um campo MEMO (ou uma string) em Array para impressão.

A rotina desenvolvida, se parece com a MemoLine, porém ela já retorna um Array pronto para impressão, e é possível enviar um caracter para quebrar a string além do -Enter- (como por exemplo, ponto e vírgula).

Abaixo um exemplo de como imprimir.

User Function zTstMemo()
	Local cExemplo := ""
	Local oPrint
	Local nMaximo  := 100
	Local nAtual   := 1
	Local nLin     := 050
	Local nEsp     := 060
	Local cLinha   := ""
	Local aDados   := {}
	Local oFont    := TFont():New('Arial',,-10,.T.)
	
	//Exemplo de Lorem Ipsum
	cExemplo := "Lorem ipsum dolor sit amet, consectetur adipiscing elit. Aenean non condimentum turpis, at ultrices sapien. Ut ac nibh nec lorem sodales rhoncus at non mauris. Pellentesque ex nulla, placerat non aliquam sed, egestas eget ex. Duis hendrerit tellus sit amet dui feugiat cursus. Proin luctus ipsum vel arcu tempor, et malesuada urna scelerisque. In ex nunc, euismod ut est vel, euismod sagittis nisi. Sed ac ipsum eu quam posuere dictum. Integer vitae pretium turpis. Nunc eu sodales leo, sed consectetur orci. Mauris malesuada varius neque, at consectetur augue faucibus ut. Etiam sit amet est lorem. Nulla iaculis nunc ex, nec eleifend orci viverra non." + Chr(13)+Chr(10)
	cExemplo += "Cras efficitur pharetra massa, et posuere sem mollis eu. Vivamus vulputate quis est in efficitur. Mauris eleifend semper pharetra. Nullam laoreet nunc vel massa maximus, non condimentum augue ullamcorper. Nunc in neque in purus sagittis egestas. Etiam placerat, urna nec iaculis iaculis, dui diam sollicitudin enim, pharetra tristique libero quam et augue. Nam eget ligula sodales velit pellentesque congue. Sed consectetur fermentum justo vel porta. Cras metus justo, rhoncus vestibulum pharetra id, iaculis sit amet est." + Chr(13)+Chr(10)
	cExemplo += "Cum sociis natoque penatibus et magnis dis parturient montes, nascetur ridiculus mus. Mauris dapibus ut enim in commodo. Pellentesque blandit molestie convallis. Cras urna odio, fringilla ut sem a, blandit pellentesque enim. Morbi tristique, erat ut dictum lacinia, elit tellus lacinia leo, et bibendum mauris orci vitae libero. In massa mi, rhoncus sed ultrices ac, lobortis eu ipsum. Ut rutrum non mauris egestas tincidunt. Nulla fringilla nibh non elit tincidunt lobortis. Pellentesque dictum orci eget mi pharetra pellentesque. Aliquam aliquam non nisl non efficitur. Sed quis leo in urna interdum tincidunt vitae non nunc. Maecenas aliquam, mi efficitur rutrum faucibus, ligula ex tempor ex, at eleifend dui nisi ac tellus. Etiam vitae nunc in lorem tincidunt volutpat. Maecenas tincidunt purus vitae ipsum dignissim dapibus." + Chr(13)+Chr(10)
	cExemplo += "Quisque ac mi imperdiet, pretium nunc ac, dapibus tortor. Aenean quis tincidunt dui, rhoncus ultrices dui. Quisque sed luctus lectus. Integer vel volutpat nisi. Aliquam varius sem turpis, at dictum mauris hendrerit volutpat. Morbi pellentesque pharetra nunc, quis vestibulum metus pharetra sed. Aliquam pulvinar et dui ut tempus. Ut rutrum libero ac arcu tempor consequat. Phasellus tempus mollis venenatis. Quisque vehicula placerat malesuada. Cras ut nibh id leo congue tempor. Proin consectetur pretium arcu quis dignissim. Vestibulum neque nibh, consequat ac lacus eu, dapibus posuere quam. Integer a nisl in turpis vulputate venenatis eu ut dui." + Chr(13)+Chr(10)
	cExemplo += "Sed vulputate volutpat mauris, nec aliquet erat gravida ac. Quisque pretium purus vulputate risus finibus dignissim. Nam molestie dui vitae nibh semper finibus. Quisque id mollis urna. Duis euismod justo vitae nisi scelerisque, at mattis odio consectetur. Ut quam risus, ultrices vel congue ut, lacinia ac risus. Proin volutpat finibus ligula, non ultricies lectus rhoncus blandit. Vestibulum egestas, risus in pharetra dignissim, urna lorem condimentum odio, eget cursus erat ex eu leo."  + Chr(13)+Chr(10)
	
	//Monta o TMSPrinter
	oPrint := TMSPrinter():New()
	oPrint:Setup()
	oPrint:SetPortrait()
	oPrint:SetPaperSize(9)
	
	//Agora será utilizado nossa zMemoToA, que quebra além dos -Enters-, qualquer expressão procurada, como por exemplo ';' (o que difere ela da função padrão MemoLine)
	aDados := u_zMemoToA(cExemplo, nMaximo, , .T.)
	oPrint:Say(nLin, 100, "zMemoToA:", oFont)
	nLin += nEsp
	
	//Percorrendo as linhas geradas
	For nAtual := 1 To Len(aDados)
		oPrint:Say(nLin, 100, aDados[nAtual], oFont)
		nLin += nEsp
	Next
	
	oPrint:Preview()
Return

Abaixo o print da impressão gerada.

Exemplo de impressão

E abaixo a função desenvolvida.

//Bibliotecas
#Include "Protheus.ch"

/*/{Protheus.doc} zMemoToA
Função Memo To Array, que quebra um texto em um array conforme número de colunas
@author Atilio
@since 15/08/2014
@version 1.0
	@param cTexto, Caracter, Texto que será quebrado (campo MEMO)
	@param nMaxCol, Numérico, Coluna máxima permitida de caracteres por linha
	@param cQuebra, Caracter, Quebra adicional, forçando a quebra de linha além do enter (por exemplo '<br>')
	@param lTiraBra, Lógico, Define se em toda linha será retirado os espaços em branco (Alltrim)
	@return nMaxLin, Número de linhas do array
	@example
	cCampoMemo := SB1->B1_X_TST
	nCol        := 200
	aDados      := u_zMemoToA(cCampoMemo, nCol)
	@obs Difere da MemoLine(), pois já retorna um Array pronto para impressão
/*/

User Function zMemoToA(cTexto, nMaxCol, cQuebra, lTiraBra)
	Local aArea     := GetArea()
	Local aTexto    := {}
	Local aAux      := {}
	Local nAtu      := 0
	Default cTexto  := ''
	Default nMaxCol := 80
	Default cQuebra := ';'
	Default lTiraBra:= .T.

	//Quebrando o Array, conforme -Enter-
	aAux:= StrTokArr(cTexto,Chr(13))
	
	//Correndo o Array e retirando o tabulamento
	For nAtu:=1 TO Len(aAux)
		aAux[nAtu]:=StrTran(aAux[nAtu],Chr(10),'')
	Next
	
	//Correndo as linhas quebradas
	For nAtu:=1 To Len(aAux)
	
		//Se o tamanho de Texto, for maior que o número de colunas
		If (Len(aAux[nAtu]) > nMaxCol)
		
			//Enquanto o Tamanho for Maior
			While (Len(aAux[nAtu]) > nMaxCol)
				//Pegando a quebra conforme texto por parâmetro
				nUltPos:=RAt(cQuebra,SubStr(aAux[nAtu],1,nMaxCol))
				
				//Caso não tenha, a última posição será o último espaço em branco encontrado
				If nUltPos == 0
					nUltPos:=Rat(' ',SubStr(aAux[nAtu],1,nMaxCol))
				EndIf
				
				//Se não encontrar espaço em branco, a última posição será a coluna máxima
				If(nUltPos==0)
					nUltPos:=nMaxCol
				EndIf
				
				//Adicionando Parte da Sring (de 1 até a Úlima posição válida)
				aAdd(aTexto,SubStr(aAux[nAtu],1,nUltPos))
				
				//Quebrando o resto da String
				aAux[nAtu] := SubStr(aAux[nAtu], nUltPos+1, Len(aAux[nAtu]))
			EndDo
			
			//Adicionando o que sobrou
			aAdd(aTexto,aAux[nAtu])
		Else
			//Se for menor que o Máximo de colunas, adiciona o texto
			aAdd(aTexto,aAux[nAtu])
		EndIf
	Next
	
	//Se for para tirar os brancos
	If lTiraBra
		//Percorrendo as linhas do texto e aplica o AllTrim
		For nAtu:=1 To Len(aTexto)
			aTexto[nAtu] := Alltrim(aTexto[nAtu])
		Next
	EndIf
	
	RestArea(aArea)
Return aTexto

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

Tags: AdvPL