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.
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.
Parabéns Atílio mais uma vez… uma funcionalidade que vai ajudar muita gente do mundo ADVPL…
Acabei de usar essa funcionalidade, parabéns jovem!
Opa, obrigado pelo comentário jovem.
Grande abraço.
Valeu mesmo Daniel! proporcionando ganho de tempo. Show!!! Gratidão!!!
Eu que agradeço pelo comentário e feedback Fabiola.
Grande abraço.