PC Toledo

Nos tempos do clipper adaptei de uma rotina pra VB6 que encontrei na NET pra gerar PDF.
Deixando a disposição aqui.
No Harbour transformei pra classes e acrescentei algumas facilidades, mas não equivale a harupdf.
Por enquanto ainda atende, mas já que uso harupdf pra outras coisas, melhor usar pra isso também.
De qualquer jeito, é interessante pra ver a estrutura de um PDF.
Como o PDF é feito com objetos, a estrutura básica acaba continuando a mesma, só aparecendo novos objetos.
Peguei o fonte mais recente que eu tinha, antes de virar código Harbour.

Código: Selecionar todos


// Procedure Main()

// Txt2Pdf("d:\temp\*.lst","teste.pdf")
// Return NIL


Function Txt2Pdf(cFileInput, cFileOutput)

Position := PageNo := LineNo := PageHeight := PageWidth := 0
Lines := Obj := TPages := Encoding := Resources := 0
PointSize := VertSpace := Rotate := Info := Root := 0
nPagex := nPagey := LIneLen := Rotation := 0
Author := Creator := KeyWords := Subject := Title := ""
BaseFont := cmdLine := ""
nHandle := 0
Declare Location[4000]
Afill(Location,0)
Declare PageObj[4000]
Afill(PageObj,0)
Pages := "" // Variant
aFileList := {}

cPath := ""
If "\" $ cFileInput
   cPath      := Substr(cFileInput,1,Rat("\",cFileInput))
Endif

mDirList := Directory(cFileInput)
For nCont = 1 To Len(mDirList)
   Aadd(aFileList,cPath+mDirList[nCont,1])
Next
   
AppName := "JPA-Preview"

Author = "JPA-Preview"
Creator = "JPA-Preview"
Keywords = "None"
Subject = "Listagem JPA-Preview"
Title = "Listagem JPA-Preview"
nHandle := fCreate(cFileOutput)   
PdfSetup()
PdfStart()
PdfHead()
WritePages(aFileList)
PdfEnd()
fClose(nHandle)
Return NIL


Function PdfSetup()

FontSize := PaperWidth := PaperHeight := Rotation := 0
FontName := ""
  FontName = "Courier"
  FontSize = 6
  PaperWidth = 8.3 // 'A4=8.3
  PaperHeight = 11.7 // 'A4=11.7
  Rotation = 0
  
  pageHeight = Round(72 * PaperHeight, 0)
  pageWidth = Round(72 * PaperWidth, 0)
  BaseFont = FontName // ' Courier, Times-Roman, Arial
  pointSize = FontSize // ' Font Size; não altere
  vertSpace = Round(FontSize * 1.7, 0) // ' Round(FontSize * 1.2, 0) ' Vertical spacing
  rotate = Rotation // ' degrees to rotate; try setting 90,180,etc
  lines = (pageHeight - 72) / vertSpace // ' no of lines on one page
  
//  'Select Case LCase(FontName)
//   'Case "courier":
//   linelen = 1.5 * pageWidth / pointSize
//   'Case "arial": linelen = 2 * pageWidth / pointSize
//  'Case "Times-Roman": linelen = 2.2 * pageWidth / pointSize
//   'Case Else: linelen = 2.2 * pageWidth / pointSize
//  'End Select

  obj = 0
  npagex = pageWidth / 2
  npagey = 25
  pageNo = 0
  Position = 0
Return NIL

Static Function PdfWrite(Stre)

Position := Position + Len(Stre)
fWrite(nHandle,Stre+Chr(13))
Return NIL
  
Static Function PdfStart()
  PdfWrite("%PDF-1.2")
  PdfWrite( Chr(37) + Chr(226) + Chr(227) + Chr(207) + Chr(211) ) // Confirmar porque isso e no VB
Return NIL

Static Function PdfHead()
  CreationDate = ""
  CreationDate = "D:" + Dtos(Date()) + Substr(Time(),1,2)+Substr(Time(),4,2)+Substr(Time(),7,2)
  obj = obj + 1
  location[obj] = Position
  info = obj
    
    PdfWrite(Ltrim(Str(obj)) + " 0 obj")
    PdfWrite("<<")
    PdfWrite("/Author (" + author + ")")
    PdfWrite("/CreationDate (" + CreationDate + ")")
    PdfWrite("/Creator (" + creator + ")")
    PdfWrite("/Producer (" + AppName + ")")
    PdfWrite("/Title (" + Title + ")")
    PdfWrite("/Subject (" + subject + ")")
    PdfWrite("/Keywords (" + keywords + ")")
    PdfWrite(">>")
    PdfWrite("endobj")
    
    obj = obj + 1
    root = obj
    obj = obj + 1
    Tpages = obj
    encoding = obj + 2
    resources = obj + 3
    
    obj = obj + 1
    location[obj] = Position
    PdfWrite (Ltrim(Str(obj)) + " 0 obj")
    PdfWrite("<<")
    PdfWrite("/Type /Font")
    PdfWrite("/Subtype /Type1")
    PdfWrite("/Name /F1")
    PdfWrite("/Encoding " + Ltrim(Str(encoding)) + " 0 R")
    PdfWrite("/BaseFont /" + BaseFont)
    PdfWrite(">>")
    PdfWrite("endobj")
    
    obj = obj + 1
    location[obj] = Position
    PdfWrite(Ltrim(Str(obj)) + " 0 obj")
    PdfWrite("<<")
    PdfWrite("/Type /Encoding")
    PdfWrite("/BaseEncoding /WinAnsiEncoding")
    PdfWrite(">>")
    PdfWrite("endobj")
    
    obj = obj + 1
    location[obj] = Position
    PdfWrite(Ltrim(Str(obj)) + " 0 obj")
    PdfWrite("<<")
    PdfWrite("  /Font << /F1 " + Ltrim(Str(obj - 2)) +  " 0 R >>")
    PdfWrite("  /ProcSet [ /PDF /Text ]")
    PdfWrite(">>")
    PdfWrite("endobj")
Return NIL
  
Static Function WritePages(aFileList)

I := 0
Line := TmpLine := BeginStream := ""
//'      beginstream = PdfPageStart()
//'      lineNo = -1
nCont := 0
For nCont = 1 To Len(aFileList)
    cTexto := MemoRead(aFileList[nCont])
      beginstream = PdfPageStart()
      lineNo = -1
      For nCont2 = 1 To MLCount(cTexto,255)
        Line = MemoLine(cTexto,255,nCont2)
        
        // 'quebra de página
        // 'If lineNo >= lines Or InStr(line, Chr(12)) > 0 Then
        // '  PdfWrite ("1 0 0 1 " & npagex & " " & npagey & " Tm")
        // '  PdfWrite ("(" & pageNo & ") Tj")
        // '  PdfWrite ("/F1 " & pointSize & " Tf")
        // '  PdfPageEnd (beginstream)
        // '  beginstream = PdfPageStart()
        // 'End If
        
        line = StrTran(line, "\", "\\")
        line = StrTran(line, "(", "\(")
        line = StrTran(line, ")", "\)")
//'        line = Trim(line)
//'  Acrescentado aqui ref PDF eliminar espaços em branco, mas não deu certo
//        'If Mid(line, 1, 1) = " " Then
//        '   line = "\." & Mid(line, 2)
//        'End If
        
          PdfWrite("T* (" + line + Chr(13) + Chr(10) + ") Tj")
        lineNo = lineNo + 1
//'        End If
      Next
    
//' Acrescentado aqui
          PdfWrite("1 0 0 1 " + Ltrim(Str(npagex)) + " " + Ltrim(Str(npagey)) + " Tm")
          PdfWrite("(" + Ltrim(Str(pageNo)) + ") Tj")
          PdfWrite("/F1 " + Ltrim(Str(pointSize)) + " Tf")
          PdfPageEnd(beginstream)
Next
//'    PdfWrite ("1 0 0 1 " & npagex & " " & npagey & " Tm")
//'    PdfWrite ("(" & pageNo & ") Tj")
//'    PdfWrite ("/F1 " & pointSize & " Tf")
//'    PdfPageEnd (beginstream)
Return NIL

Static Function PdfPageStart() 
  Local StrmPos := 0
  obj = obj + 1
  location[obj] = Position
  pageNo = pageNo + 1
  pageObj[pageNo] = obj
  
  PdfWrite(Ltrim(Str(obj)) + " 0 obj")
  PdfWrite("<<")
  PdfWrite("/Type /Page")
  PdfWrite("/Parent " + Ltrim(Str(Tpages)) + " 0 R")
  PdfWrite("/Resources " + Ltrim(Str(resources)) + " 0 R")
  obj = obj + 1
  PdfWrite("/Contents " + Ltrim(Str(obj)) + " 0 R")
  PdfWrite("/Rotate " + Ltrim(Str(rotate)))
  PdfWrite(">>")
  PdfWrite("endobj")
  
  location[obj] = Position
  PdfWrite(Ltrim(Str(obj)) + " 0 obj")
  PdfWrite("<<")
  PdfWrite("/Length " + Ltrim(Str(obj + 1)) + " 0 R")
  PdfWrite(">>")
  PdfWrite("stream")
  strmpos = Position
  PdfWrite("BT")
  PdfWrite("/F1 " + Ltrim(Str(pointSize)) + " Tf")
  PdfWrite("1 0 0 1 50 " + Ltrim(Str(pageHeight - 40)) + " Tm")
  PdfWrite(Ltrim(Str(vertSpace)) + " TL")
  
Return StrmPos

Static Function PdfPageEnd(streamstart)
StreamEnd := 0
    PdfWrite ("ET")
    streamEnd = Position
    PdfWrite ("endstream")
    PdfWrite ("endobj")
    obj = obj + 1
    location[obj] = Position
    PdfWrite(Ltrim(Str(obj)) + " 0 obj")
    PdfWrite(Ltrim(Str(streamEnd - streamstart)))
    PdfWrite( "endobj")
    lineNo = 0
Return NIL

Static Function PdfEnd()
Ty := ""
I := 0
xRef := ""
    location[root] = Position
    PdfWrite(Ltrim(Str(root)) + " 0 obj")
    PdfWrite("<<")
    PdfWrite("/Type /Catalog")
    PdfWrite("/Pages " + Ltrim(Str(Tpages)) + " 0 R")
    PdfWrite(">>")
    PdfWrite("endobj")
    location[Tpages] = Position
    PdfWrite(Ltrim(Str(Tpages)) + " 0 obj")
    PdfWrite("<<")
    PdfWrite("/Type /Pages")
    PdfWrite("/Count " + Ltrim(Str(pageNo)))
    PdfWrite("/MediaBox [ 0 0 " + Ltrim(Str(pageWidth)) + " " + Ltrim(Str(pageHeight)) + " ]")
    ty = ("/Kids [ ")
    For i = 1 To pageNo
      ty = ty + Ltrim(Str(pageObj[i])) + " 0 R "
    Next i
    ty = ty + "]"
    PdfWrite(ty)
    PdfWrite(">>")
    PdfWrite("endobj")
    xreF = Position
    PdfWrite("0 " + Ltrim(Str(obj + 1)))
    PdfWrite("0000000000 65535 f ")
    For i = 1 To obj
      PdfWrite(StrZero(location[i], 10) + " 00000 n ")
    Next i
    PdfWrite("trailer")
    PdfWrite("<<")
    PdfWrite("/Size " + Ltrim(Str(obj + 1)))
    PdfWrite("/Root " + Ltrim(Str(root)) + " 0 R")
    PdfWrite("/Info " + Ltrim(Str(info)) + " 0 R")
    PdfWrite(">>")
    PdfWrite("startxref")
    PdfWrite(Ltrim(Str(xreF)))
    PdfWrite("%%EOF")
Return NIL

Não tenho certeza, mas acho que o fonte VB6 que usei de base foi este:

http://www.vb6.us/tutorials/visual-basic-tutorial-pdf

Fui eliminando a parte que não dava pra fazer no Clipper, como gráficos, e converti o que sobrou.

Como ainda uso, acabo de fazer uma mudança na versão em Harbour, que também dá pra fazer nessa.
Ao invés de definir os arrays com tamanho de 4.000, defini como tamanho ZERO.
E adicionei um método, que no caso do Clipper seria uma função.

Código: Selecionar todos

SetArray( aArray, nElement, xValue )
   LOCAL nCont, nSize
   nSize := Len( aArray )
   FOR nCont = nSize To nElement
      Aadd( aArray, 0 )
   NEXT
   aArray[ nElement ] := xValue
   RETURN NIL

Vantagem:
- Definindo o array com tamanho zero {} ao invés de Array(50000), ele fica só do tamanho que precisar, economiza memória.
- No caso do Harbour, acabou eliminando qualquer limite, pelo menos do fonte.

Fiz um teste agora gerando um PDF de 10.000 páginas, e ficou com quase 70MB.
Imagino que usando a harupdf ele ficaria somente com 2MB, por permitir compactação.
Mas só vou descobrir quando fizer.
Obs.
Na minha máquina sem problemas abrir esse PDF, é instantâneo do mesmo jeito.
O array acima contém somente números, com a posição de cada coisa.
No caso do Clipper convém acrescentar uma checagem nessa rotina pra não estourar o limite de tamanho de array.
Lógico, substituir os array[ nElement ] := value por AddToArray( Array, nElement, value )
Minha máquina é 64 bits há tempos, deixei de usar o Clipper, portanto fica a cargo de quem quiser usar fazer alguma alteração e testar.

Fiz outro teste, pra ver limite.
O array PageObj tem 1 elemento a mais do que a quantidade de páginas. Em 2895 páginas ficou com 2896 elementos.
O array Location ficou com 8.692 elementos.

Significa que em Clipper vai ter um limite de umas 1.500 páginas, se o array puder ter 4.000 elementos.

Mas pode criar um módulo separado em Harbour, e eliminar limites.

Oi, José Quintas

Eu peguei o seu fonte e não modiquei nada, além do diretório onde coloco meus .LST, produto de relatórios emitidos.

Compilei e linkei, pelo Clipper 5.2E, e tudo OK.

Executei o programa, mas se eu quiser visualizar o .PDF gerado nada aparece, mas tem conteúdo gravado, o que verifiquei com o DEBUG do DOS.

O visualizador informa que tem, num caso, 7 páginas gravadas, todas em branco.

O que está errado ?

1) Lembro de ter diferença no limite de array entre compilado com Blinker ou não.
Mas ao que parece o problema não foi esse.

2) No tempo do clipper meu sistema gerava um arquivo pra cada página, pelo que pude reparar, essa rotina é daquela época.
Se não dividir as páginas, o PDF se perde. Teria que fazer a checagem do Chr(12) na rotina Txt2Pdf.
Ou dividir em arquivos antes de chamar a rotina, assim não precisa se preocupar com limite do clipper pra ler o texto.
O nome de entrada é usado pra pegar a lista como exemplo: Directory( "rel*.lst" ), e as páginas seriam rel001.lst, rel002.lst, rel003.lst

No programa em clipper, eu usava uma rotina de cabeçalho que fazia isso.

algo como:

Código: Selecionar todos

IF nLin > 66
   Cabecalho()
endif
...

function cabecalho()
   nPag += 1
   SET ALTERNATE TO ( "rel" + StrZero( nPag, 3 ) + ".lst" )
   RETURN NIL

A sugestão é testar com um relatório de uma única página, antes de qualquer mexida.
Depois teste com um de duas páginas, e já vai tirar a dúvida.

Aproveitando...
A observação no fonte:

PdfWrite( Chr(37) + Chr(226) + Chr(227) + Chr(207) + Chr(211) ) // Confirmar porque isso e no VB

Agora que mexo com codepage descobri o porque:
A letra resultado do Chr() é diferente em cada codepage, e por isso é diferente no Clipper e no VB (em outra codepage).
traduzindo: a tabela ASCII é diferente em cada codepage.

A rotina WritePages( aFileList ) gera página pra cada arquivo.
For nCont = 1 To Len(aFileList)

é nessa parte que vai mexer, depois do teste pra confirmar.
Só pegar um lst, e apagar o que ultrapassar uma página pra esse teste.

depois pode substituir o for/next por algo como isto:

Código: Selecionar todos

DO WHILE Len( cTxt ) > 0
   cTxtPage := substr( ctxt, 1, at( Chr(12), ctxt + Chr(12) )
   cTxt := Substr( cTxt, Len( cTxtPage ) + 1 )
   ... imprimir página
ENDDO

Vou fazer como o indicado, pois achei a rotina interessante pois hoje eu gero arquivos .PDF usando o PDF995, que agrega uma
impressora às existentes, mas temos de informar o nome do arquivo gerado.

Amanhã vou fazer os testes propostos e informo o resultado.

O fonte parece ter problemas no trecho abaixo:

Código: Selecionar todos

For nCont = 1 To Len(aFileList)
    cTexto := MemoRead(aFileList[nCont])
      beginstream = PdfPageStart()
      lineNo = -1
      For nCont2 = 1 To MLCount(cTexto,255)
        Line = MemoLine(cTexto,255,nCont2)

Compilei o sistema com a opção /b e através do CLD percorri as rotinas.

Nesse ponto, a variável nCont2 assume valor 0 (zero) , ou seja, a função MLCount não consegue separar o CTexto que foi lido na função MemoRead.

Fiz o teste com somente um arquivo de 825 bytes e foi gerado um .PDF de 611 bytes que não contém nenhum texto proveniente
do .LST informado.

Junto o TESTE.PDF em questão.

TESTE.PDF: (611 Bytes) Baixado 814 vezes

Enviado: **26 Nov 2013 10:30**

Bom dia. Utilizo um sistema em clipper e gostaria de implantar o pdf nele também. Você poderia fazer pra mim? meu e-mail é thiago@rusithy.com.br Obrigado

Enviado: **26 Jun 2018 09:21**

Eu já tinha uma solução que importava txt para dbf, mas essa sua é mais simples. Mas agora surgiu uma necessidade : eu preciso que o PDF seja acentuado. Estou usando o padrão UTF-8 e o meu arquivo txt é UTF-8 também. Ocorre que o PDF gerado não reconhece os acentos ? Tem como incluir acentos no PDF gerado pela função

Eu acrescentei as linhas abaixo no prg antes de chamar e também não deu certo :

REQUEST HB_CODEPAGE_UTF8EX
hb_cdpSelect( "UTF8EX" )

Enviado: **26 Jun 2018 13:33**

Essa rotina era pra Clipper.
No Harbour basta usar a HaruPDF, e selecionar codepage.

Enviado: **27 Jun 2018 09:29**

Deu certo com Haru mas tive que fazer algumas modificações. É impressionante como a impressão de UTF-8 em PDF ainda gera bastante dúvidas e becos sem saída. O Google está cheio de gente com o mesmo problema.

Mas enfim, segue um código de exemplo para quem tiver que gerar um PDF com UTF-8
Nota: Estou usando o Harbour 3.4 no Ubuntu 16

Código: Selecionar todos

#require "hbhpdf"

PROCEDURE Main()
LOCAL cFileToSave

Set( _SET_DATEFORMAT, "yyyy-mm-dd" )
REQUEST HB_CODEPAGE_UTF8EX
hb_cdpSelect( "UTF8EX" )

   cFileToSave := "myharu.pdf"


   IF DesignHaruPDF( cFileToSave )
      ? hb_StrFormat( "PDF File '%1$s' is created!", cFileToSave )
   ELSE
      ? "Some problems in creating the PDF!"
   ENDIF

   RETURN

FUNCTION DesignHaruPDF( cFileToSave )

   LOCAL page, height, width, def_font, tw, name
   LOCAL page_title :=  "hbhpdf demo áéãoção" //HB_TRANSLATE( "hbhpdf demo áéãoção" , 'UTF8EX' , 'PTISO' )
   LOCAL pdf := HPDF_New()

   hb_vfErase( cFileToSave )

   IF pdf == NIL
      ? "PDF could not be created!"
      RETURN .F.
   ENDIF

   /* set compression mode */
   HPDF_SetCompressionMode( pdf, HPDF_COMP_ALL )

   HPDF_UseUTFEncodings( pdf )
   //HPDF_SetCurrentEncoder( pdf, "UTF-8" )

   page := HPDF_AddPage( pdf )
   height := HPDF_Page_GetHeight( page )
   width  := HPDF_Page_GetWidth( page )

   /* Print the title of the page(with positioning center). */
   name=HPDF_LoadTTFontFromFile(pdf, "Courier_New.ttf", HPDF_TRUE)
   def_font=HPDF_GetFont(pdf, name, "UTF-8")

   HPDF_Page_SetFontAndSize( page, def_font, 24 )
   tw := HPDF_Page_TextWidth( page, page_title )
   HPDF_Page_BeginText( page )
   HPDF_Page_TextOut( page, ( width - tw ) / 2, height - 50, page_title )
   HPDF_Page_EndText( page )

   IF HPDF_SaveToStream( pdf ) == HPDF_OK
      ? "Size:", hb_ntos( HPDF_GetStreamSize( pdf ) )
      ? "Saved:", hb_MemoWrit( cFileToSave, HPDF_ReadFromStream( pdf ) )
   ELSE
      ? "0x" + hb_NumToHex( HPDF_GetError( pdf ), 4 ), hb_HPDF_GetErrorString( HPDF_GetError( pdf ) ), HPDF_GetErrorDetail( pdf )
   ENDIF

   HPDF_Free( pdf )

   RETURN hb_vfExists( cFileToSave )

O segredo é usar fontes externas. Quando eu estava usando as fontes que estão embutidas na biblioteca eu não estava conseguindo.

name=HPDF_LoadTTFontFromFile(pdf, "Courier_New.ttf", HPDF_TRUE)
def_font=HPDF_GetFont(pdf, name, "UTF-8")

Tentei anexar a fonte mas o sistema de upload não permitiu.

Enviado: **27 Jun 2018 11:57**

JoséQuintas escreveu:Tentei anexar a fonte mas o sistema de upload não permitiu.

Manda o anexo zipado com a fonte

PC Toledo

PDF em Clipper

PDF em Clipper

PDF em Clipper

PDF em Clipper

PDF em Clipper

PDF em Clipper

PDF em Clipper

PDF em Clipper

PDF em Clipper

PDF em Clipper

PDF em Clipper

PDF em Clipper

PDF em Clipper

PDF em Clipper

PDF em Clipper

PDF em Clipper