Código: Seleccionar todo
//----------------------------------------------------------------------//
// HaruPdf.prg
// Pritpal Bedi <pritpal@vouchcac.com>
//----------------------------------------------------------------------//
#include 'harupdf.ch'
********************************************************************************
function GERA_PDF(cArqPDF, lAbrePDF, cNomePDF)
********************************************************************************
local cText := MEMOREAD( cArqPDF ),;
nLines := MLCOUNT( cText, 255 ),;
vAUTOR := '', ;
nA,;
nFileHandle,;
cLinha,;
nLINE_TEMP:=0 ,;
nLargura := VeLargLinArq( cArqPDF ),; && Pega a Largura maxima do arq contida nas primeiras 100 linhas
cNomeRel :='RELATORIO ' + TRANSF(DATE(), '@E 99/99/99') + ' as ' + STRTRAN(TIME(), ':', '_')
private i, oPage, height, tw, samp_text, lLandScape, lCondensa :=.F., vCont:=0
if ISNIL(cNomePDF)
cNomePDF := 'PDF_' + STRTRAN(TRANSF(DATE(),'@E 99/99/99'), '/', '') + '_' + STRTRAN(TIME(), ':', '') + '.PDF'
else
cNomePDF := substr(cNomePDF, 1, len(cNomePDF) - 4) +;
'_' + STRTRAN(Dt2Dig(Date()), '/', '') + STRTRAN(TIME(), ':', '') + '.PDF'
endif
DEFAULT lAbrePDF TO .F.
DEFAULT lLandScape TO nLargura > 136
cNomePDF := 'PDF\' + cNomePDF
PRIVATE oPDF := HPDF_New(), FontNormal, FontBold, FontItalic, FontBoldItalic
if ISNIL(oPDF)
MsgAlert( 'Erro ao tentar gerar o Arquivo PDF, Favor Tentar novamente')
return nil
endif
FontNormal := HPDF_GetFont( oPDF, 'Courier', NIL )
FontBold := HPDF_GetFont( oPDF, 'Courier-Bold', NIL )
FontItalic := HPDF_GetFont( oPDF, 'Courier-Oblique', NIL )
FontBoldItalic := HPDF_GetFont( oPDF, 'Courier-BoldOblique', NIL )
//- HPDF_SetPassword(pdf, 'senha','minhasenha' ) // colocar senha no PDF
HPDF_SetCompressionMode( oPDF, HPDF_COMP_ALL )
PDF_NovaPagina()
FOR nA :=1 TO nLines
cLinha := MEMOLINE( cText, 255, nA, 1, .F. )
cChar := SUBSTR( cLinha, 1, 1)
nTamLinha := LEN( cLinha )
nTamBlk := IF( nA>1, nTamBlk, IF( cChar=CHR(15), 7, IF( cChar=CHR(14), 14, 10)) ) // 7=Condesado, 10=Normal, 14=Grande
nTamAtu := IF( nA>1, nTamAtu, nTamBlk) // 7=Condesado, 10=Normal, 14=Grande
lBold := IF( nA>1, lBold, .F.)
lItalic := IF( nA>1, lItalic, .F.)
lMudou := .F.
HPDF_Page_SetFontAndSize( oPage, IF( lBold, FontBold, FontNormal), nTamAtu )
FOR i:=1 TO nTamLinha
cChar := SUBSTR( cLinha, I, 1)
cChar2 := SUBSTR( cLinha, I, 2)
PDF_DefTameBold()
HPDF_Page_ShowText( oPage, HB_OEMTOANSI( TiraCaracESCPOS(cChar) ))
NEXT
HPDF_Page_MoveTextPos( oPage, 0, -10 )
vCONT++
if vCONT == IF( lLandScape, 58, 80) //-- Nova P gina
PDF_NovaPagina()
endif
NEXT
HPDF_Page_EndText( oPage )
HPDF_SaveToFile( oPDF, cNomePDF )
HPDF_Free( oPDF )
if lAbrePDF
Executa( CurDirSys()+cNomePDF )
endif
return nil
********************************************************************************
static procedure PDF_DefTAMeBold()
lMudou := .T.
if cChar = CHR(12)
PDF_NovaPagina()
i++
elseif cChar = CHR(14) && Abre Bloco Letra Grande
nTamAtu := 14
elseif cChar = CHR(15) && Abre Bloco Condensado
nTamAtu := 7
elseif cChar = CHR(18) && Fecha Bloco Letra Grande
nTamAtu := nTamBlk
elseif cChar = CHR(20) && Fecha Bloco Letra Grande
nTamAtu := 10
elseif cChar2 = CHR(27)+'M' && Grande
nTamAtu := 12
i++
elseif cChar2 = CHR(27)+'P' && Normal
nTamAtu := 10
i++
elseif cChar2 = CHR(27)+'4' && Italico Ini
lItalic := .T.
i++
elseif cChar2 = CHR(27)+'5' && Italico Fim
lItalic := .F.
i++
elseif cChar2 = CHR(27)+'E' && Negrito Ini
lBold := .T.
i++
elseif cChar2 = CHR(27)+'F' && Negrito Fim
lBold := .F.
i++
else
lMudou := .F.
endif
if lMudou
HPDF_Page_SetFontAndSize( oPage, IF( lBold, IF( lItalic, FontBoldItalic, FontBold), IF(lItalic, FontItalic, FontNormal)), nTamAtu )
endif
return
********************************************************************************
static procedure PDF_NovaPagina()
oPage := HPDF_AddPage(oPDF)
if lLandScape
HPDF_Page_SetSize(oPage, HPDF_PAGE_SIZE_A4, HPDF_PAGE_LANDSCAPE)
endif
//--> Cabe‡alho com LogoMarca
height := HPDF_Page_GetHeight(oPage)
* width := HPDF_Page_GetWidth(oPage)
if LogoCabecalho()
image := HPDF_LoadJpegImageFromFile(oPdf, 'cabecalho.jpg') // image := HPDF_LoadPngImageFromFile( oPdf, cImage)
iw := HPDF_Image_GetWidth( image )
ih := HPDF_Image_GetHeight( image )
HPDF_Page_DrawImage(oPage, image, 010, 735, 475, 080) // aki fica pela metade. // HPDF_Page_DrawImage(oPage, image, x, y, width, height)
else
iw := 0
ih := 0
endif
HPDF_Page_SetLineWidth( oPage, 1) //--> Essa Linha aki nÆo tinha qdo pagina inicial mas vou manter e ver o efeito
HPDF_Page_BeginText( oPage )
HPDF_Page_MoveTextPos( oPage, 10, height - IF( LogoCabecalho(), 110, 10 ) ) // Come‡a a imprimir depois da imagem caso ela exista
vCONT := 0
return
//--------------------------- RETORNA SE EXISTE ARQUIVO DE LOGO DE CABECALHO
function LogoCabecalho()
return ( file( 'cabecalho.bmp') .or. file( 'cabecalho.jpg' ) )
*********************************************************************************
function VeLargLinArq( cArq )
local cText := MemoRead( cArq ),;
cLine, nA, nLargMax, nLines
nLines := mlcount( cText, 255 )
nLargMax := 0
for nA := 1 to 100 //nLines
cLine := memoline( cText, 255, nA, 1, .F. )
cLine := TiraCaracESCPOS(cLine)
nLargMax := IF( Len(alltrim(cLine)) > nLargMax, Len(Alltrim(cLine)), nLargMax)
next
return nLargMax
//-------------------------------- Tira caracteres ESC/POS das Strings
function TiraCaracESCPOS( cLine )
cLine := STRTRAN( cLine, chr(27)+'E', '')
cLine := STRTRAN( cLine, chr(27)+'F', '')
cLine := STRTRAN( cLine, chr(27)+'4', '')
cLine := STRTRAN( cLine, chr(27)+'5', '')
cLine := STRTRAN( cLine, chr(27)+chr(18), '')
cLine := STRTRAN( cLine, chr(27)+chr(15), '')
cLine := STRTRAN( cLine, chr(27)+chr(14), '')
cLine := STRTRAN( cLine, chr(27)+chr(20), '')
*-- Esta parte estava a mais
cLine := STRTRAN( cLine, chr(14), '')
cLine := STRTRAN( cLine, chr(20), '')
cLine := STRTRAN( cLine, chr(18), '')
cLine := STRTRAN( cLine, chr(15), '')
cLine := STRTRAN( cLine, chr(27)+'O', '')
return cLine
