FiveTech Software tech support forums

Code: Select all  Expand view

 Version 2.0b( 27/07/05 )
        + Primera implementacion de CANCELAMENTO

Code: Select all  Expand view

#include "hbclass.ch"
#include "harupdf.ch"
#include "common.ch"
#include "tutilpdf.ch"
******************************************************************************
******************************************************************************
CLASS TUtilPdf

      DATA oPrinter  // Objeto Hairu en el que trabajar
      DATA oBrush    // Brocha a usar la clase por defecto
      DATA oPen      // Lapiz a usar  la clase por defecto
      DATA nColor INIT 0   // Color de la fuente a usar por defecto

      HIDDEN:
      DATA nAnchoFont, nAltoFont,nAnchoPage
      DATA cLongText   // Texto mas largo dentro de un array o Texto pasado. Uso interno
      DATA aAltoFonts  // Alto de las Fuentes del bi-array, para el salto de linea
      DATA nPos        // Posicion de la fuente dentro del array bi que es la mas ancha
      DATA aFonts      // Array con las fuentes a usar desde un fichero externo

      EXPORT:
      METHOD New( oPrinter ) CONSTRUCTOR
      METHOD Text()
      METHOD Box( nArriba, nIzq, nAbajo, nDerecha )
      METHOD SayImage( cFileImage, x, y, nWidth, nHeight , ljpg ,lPage )
      METHOD Linea( nArriba, nIzq, nAbajo, nDerecha )
      METHOD BoxMsg( )

END CLASS

METHOD New( oPrinter ) CLASS TUtilPDF
     ::oPrinter := oPrinter
RETURN Self


******************************************************************************
******************************************************************************
METHOD Text( cText,nRow,nCol, cFont, nSize, nRed,nGreen,nBlue,  nAngle ) CLASS TUtilPDF
  local nPad := 0, nAl, aDev, unDefined := 0

  ::oPrinter:CMSAY( nRow, nCol, cText, cFont, nSize, nRed, nGreen, nBlue, nAngle )

Return Nil

******************************************************************************
******************************************************************************
METHOD Box( nArriba, nIzq, nAbajo, nDerecha, nWitdh, lStroke, nRed, nGreen, nBlue, lFill, nRed2, nGreen2, nBlue2 ) CLASS TUtilPDF

   DEFAULT nRed  TO 0 , nGreen  TO 0 , nBlue  TO 0,;
           nRed2 TO 1 , nGreen2 TO 1 , nBlue2 TO 1


   ::oPrinter:GSave()
   if !empty( nWitdh )
      ::oPrinter:SetLineWidth( nWitdh )
   endif

   ::oPrinter:SetRGBStroke( nRed, nGreen, nBlue )
   ::oPrinter:SetRgbFill( nRed2 , nGreen2, nBlue2  )

   ::oPrinter:Rectangle( nArriba, nIzq, nAbajo, nDerecha )

   ::oPrinter:PageFillStroke( ) // Pinta borde y contenido

   ::oPrinter:GRestore()

Return nil


******************************************************************************
******************************************************************************
METHOD SayImage( x, y, nWidth, nHeight, cFileImage, ljpg ,lPage ) CLASS TUtilPDF
   Local pImage

    lJpg := iif( (".jpeg" $ cFileImage .or. ".jpg" $ cFileImage ), .T., .F. )

    if lJpg
      pImage := ::oPrinter:LoadImageJpg( cFileImage )
    else
      pImage := ::oPrinter:LoadImagePng( cFileImage )
    endif

    if (lPage)
       nWidth  := ::oPrinter:POINTS2CMS( ::oPrinter:GetPageWidth()  )- 0.5
       nHeight := ::oPrinter:POINTS2CMS( ::oPrinter:GetPageHeight() )- 0.5
       x := 0.25
       y := 0.25
    endif

   if !empty( pImage )
       ::oPrinter:DrawImage( pImage, x, y, nWidth, nHeight )
   endif

RETURN NIL

******************************************************************************
/* Dibujando Lineas con el Pen que tenemos o el pasado */
******************************************************************************
METHOD Linea( nArriba, nIzq, nAbajo, nDerecha, nWidth, nRed, nGreen, nBlue ) CLASS TUtilPDF
   DEFAULT nRed  TO 0 , nGreen  TO 0 , nBlue  TO 0
 
   ::oPrinter:GSave()

   if !empty( nWidth )
      ::oPrinter:SetLineWidth( nWidth )
   endif
   ::oPrinter:SetRGBStroke( nRed, nGreen, nBlue )
   ::oPrinter:Line( nArriba, nIzq, nAbajo, nDerecha, nWidth, nRed, nGreen, nBlue )

   ::oPrinter:GRestore()

return NIL


******************************************************************************
* Caja de Textos.
* beta:
*   nMode pasa a lTitle para titulo centrado en la hoja.
*   nMode se convierte para align sobre el Box
* Debemos de escoger la fuente que tenemos y dejarla como estaba
* ya que GetTextWidth() la deja selecciona atraves de SetFont, y
* nos interesa que el comando SELEC siga con la fuente que le dijimos
******************************************************************************

METHOD BoxMsg( nArriba, nIzq, nAbajo, nDerecha ,oBrush, oPen,lRound,nZ,nZ2,;
               cText, nRow,nCol,oFont, nClrText,nBkMode ,;
               nAlto, nAncho ,lShadow,nShadow, oBrushShadow,;
               oPenShadow ,lTitle,cPad,lNoBox, nSize ) CLASS TUtilPdf

  Local lEndBrush := .F.
  Local lEndPen   := .F.
  Local aDev,nMode
  Local nLinesArray := 1

  ::cLongText := cText    // Cadena de texto mas grande dentro del array. Por defecto el texto pasado
                          // Si es un array dimensional , ya se recalculara de nuevo
  ::aAltoFonts := {}
  ::nAnchoFont := 0
  ::nAltoFont  := 0
  ::nPos := 0

  DEFAULT nShadow TO 0.25,; // Cantidad de Sombra cms
          nCol TO 0      ,;
          nRow TO 0      ,;
          nAncho TO .5   ,;
          nAlto  TO .5   ,;
          lTitle TO .F. ,;
          oFont  TO ::oPrinter:Font_Active,; // Fuente Activa
          lShadow TO .F.,;
          lNoBox TO .F.

 IF cPad == "LEFT"          ; nMode := HPDF_TALIGN_LEFT
    ELSEIF cPad == "RIGHT"  ; nMode := HPDF_TALIGN_RIGHT
    ELSEIF cPad == "CENTER" .OR. cPad == "CENTERED" ; nMode := HPDF_TALIGN_CENTER
    ELSE
       nMode := HPDF_TALIGN_CENTER
 ENDIF

  ::nAnchoPage :=  ::oPrinter:Points2Cms( ::oPrinter:GetPageWidth() ) / 10 //Dimensiones fisicas en Cms

  ::nAnchoFont := ::oPrinter:GetFontSize() / 10               // Esta en m/m , pasamos a cms
  ::nAltoFont  := ::oPrinter:GetFontSize() / 10

  if lTitle // Centro.Calculamos la nueva posicion de la columna
       nCol := ( ::nAnchoPage / 2 ) - ( ::nAnchoFont / 2 ) // La mitad de todo ;)
  endif

  if lShadow


//METHOD Box( nArriba, nIzq, nAbajo, nDerecha, nWitdh, lStroke, nRed, nGreen, nBlue, lFill, nRed2, nGreen2, nBlue2 ) CLASS TUtilPDF

     if ( Empty( cText ) ) .OR. nArriba # NIL   //Solamente una Caja
        ::Box( nArriba+nShadow-nAlto,;
               nIzq+nShadow-nAncho,;
               nAbajo+nShadow+nAlto,;
               nDerecha+nShadow+nAncho  )
     else
        ::Box( nRow+nShadow-nAlto,;
               nCol+nShadow-nAncho,;
               nRow+::nAltoFont+nShadow+nAlto,;
               nCol+::nAnchoFont+nShadow+nAncho  )
     endif

  endif

  if ( Empty( cText ) ) .OR. nArriba # NIL  // Solamente una caja
     ::Box( nArriba - nAlto,;
            nIzq - nAncho,;
            nAbajo + nAlto,;
            nDerecha+ nAncho )
  else

      if !lNoBox
       ::Box( nRow - nAlto,;
            nCol - nAncho,;
            nRow+::nAltoFont+nAlto,;
            nCol+::nAnchoFont+nAncho  )
      endif

      IF VALTYPE( cText ) == "A"
         ::TextLines( cText,nRow,nCol,oFont,nClrText,;
                      nBkMode,nLinesArray, nMode, nAncho, lTitle )
      ELSE
         // Alineacion dentro de la Caja de Mensaje
         DO CASE
            CASE nMode == 0  // Left
                 nCol -=  nAncho - 0.1
            CASE nMode == 1 // Right
                 nCol +=  nAncho - 0.1
         END CASE
         //TODO: Falta pasar tamaño fuente y color

            DEFAULT nArriba to nRow - nAlto
            DEFAULT nIzq    to nCol - nAncho
            DEFAULT nAbajo  to nRow+::nAltoFont+nAlto
            DEFAULT nDerecha to nCol+::nAnchoFont+nAncho
           ::oPrinter:CMSAYRECT( nRow, nCol, cText, oFont, 15, 0,0, 0, 0, nArriba, nIzq, nAbajo, nDerecha, nMode )

      ENDIF

  endif

RETURN NIL

 

Code: Select all  Expand view

// ------------------------------------------------------------------------------------
// (c) 2011-2012 Rafa Carmona
// ------------------------------------------------------------------------------------
   #define rLEFT   1
   #define rTOP    2
   #define rRIGHT  3
   #define rBOTTOM 4

#xcommand DEFINE UTILPDF  <oUtil>  ;
          [ < of: PRINTER,OF> <oPrinter> ]  ;
          [ BRUSH <oBrush> ] ;
          [ PEN   <oPen>   ] ;
         =>;
         [ <oUtil> := ] TUtilPdf():New( <oPrinter>,<oBrush>,<oPen> )

#xcommand UTILPDF <oUtil> ;
          [ <nRow>,<nCol> SAY <cText> ];
          [ FONT <cFont> ] [SIZE <nSize> ];
          [ COLOR RGB <nRed>,<nGreen>,<nBlue> ];
          [ ROTATE <nAngle>];
         =>;
           <oUtil>:Text( <cText>,<nRow>,<nCol>,<cFont>,<nSize>, <nRed>,<nGreen>,<nBlue>, <nAngle>)

#xcommand ISEPARATOR [ <nSpace> ] [<lBody: BODY>];
         =>;
           ::Separator( <nSpace> , <.lBody.>)

#xcommand UTILPDF <oUtil> ;
          BOX <nX>,<nY> TO <nX2>,<nY2> ;
          [  <lStroke: STROKE> [ SIZE <nWitdh>] [ COLOR <nRed>,<nGreen>,<nBlue> ] ];
          [  <lFill: FILLRGB> <nRed2>,<nGreen2>,<nBlue2>  ];
         =>;
           <oUtil>:Box( <nX>,<nY>,<nX2>,<nY2>,<nWitdh>,<.lStroke.>,<nRed>,<nGreen>,<nBlue>,<.lFill.>,<nRed2>,<nGreen2>,<nBlue2> )

#xcommand UTILPDF <oUtil> ;
          LINEA <nX>,<nY> TO <nX2>,<nY2> ;
          [ WITDH <nWitdh>];
          [ COLOR <nRed>,<nGreen>,<nBlue> ] ;
         =>;
           <oUtil>:Linea( <nX>,<nY>,<nX2>,<nY2>,<nWitdh>,<nRed>,<nGreen>,<nBlue> )

#xcommand UTILPDF <oUtil> ;
          [<nX>,<nY>] IMAGE <cFile> [ SIZE <nX2>,<nY2> ] ;
          [ <lImage: JPG > ];
          [ <lPage: PAGE > ];
         =>;
           <oUtil>:SayImage( <nX>,<nY>,<nX2>,<nY2>,<cFile>,<.lImage.>,<.lPage.> )

#xcommand UTILPDF <oUtil> ;
          MSG [ <cText>  [ AT <nRow>,<nCol> ] [TEXTFONT <oFont> ] [TEXTCOLOR <nClrText>] ];
          [<nX>,<nY> TO <nX2>,<nY2>] ;
          [ BRUSH <oBrush>];
          [ PEN <oPen> ] ;
          [ <lRound: ROUND >  [ <nZ>,<nZ2>  ] ];
          [ <lShadow: SHADOW> [ WIDTH <nShadow> ] ];
          [SHADOWBRUSH <oBrushShadow>];
          [SHADOWPEN <oPenShadow>];
          [ EXPANDBOX <nAlto>,<nAncho> ] ;
          [ ALIGN <nMode> ] ;
         =>;
           <oUtil>:BoxMsg( <nX>,<nY>,<nX2>,<nY2>,<oBrush>,<oPen>,<.lRound.>,<nZ>,<nZ2>,;
                        <cText>,<nRow>,<nCol>,<oFont>, <nClrText>,,;
                        <nAlto>, <nAncho> ,<.lShadow.>,<nShadow>, <oBrushShadow>, <oPenShadow> ,;
                        <nMode>)

 

Code: Select all  Expand view

#include "hbclass.ch"
#include "harupdf.ch"
#include "common.ch"
#include "tutilpdf.ch"
/*
 ******************************************************************************
  Clase TIMPRIMEPDF
  Nos permite generar ficheros pdf a traves de la libreria Hairu.
  Esta clase nos provee la facilidad de trabajar con cms.
 ******************************************************************************
 */
CLASS TIMPRIMEPDF
    DATA pPdf                  // Pointer
    DATA aPages                // Array Pages creates
    DATA Page_Active           // Page active
    DATA PointToInch INIT 72
    DATA Font_Active           // Font Active
    DATA nSpace_Separator   INIT 0.5
    DATA nEndLine              // Fin de la ultima linea
    DATA nLinea INIT 1
    DATA nFila  INIT 1
    DATA oUtil
    DATA cFontDefault INIT "Courier"
    DATA cFileName    INIT "tgtk.pdf"
    DATA aFonts
    DATA aEncodings
    DATA cEncoding   INIT "ISO8859-15"
    DATA lUTF8toISO  INIT .T.     // Esta versión de HARU no tiene soporte de UTF8, hacemos conversion automaticamente del texto a imprimir
    DATA def_font
   
    METHOD New( cFile ) CONSTRUCTOR
    METHOD Init( cFile ) INLINE ::New( cFile )

    MESSAGE Date      METHOD _DateTime( nLinea, nFila )
    MESSAGE MesFecha  METHOD _MesFecha_( dDate )

    METHOD SaveAs( cFileToSave )  INLINE HPDF_SaveToFile( ::pPdf, cFileToSave )
    METHOD SetCompresion( cMode ) INLINE HPDF_SetCompressionMode( ::pPdf, cMode )

    METHOD AddPage()
    METHOD PageSetSize( nSize, nDirection ) INLINE HPDF_Page_SetSize( ::Page_Active, nSize, nDirection )
    METHOD GetPageHeight() INLINE HPDF_Page_GetHeight( ::Page_Active )
    METHOD GetPageWidth()  INLINE HPDF_Page_GetWidth( ::Page_Active )
    METHOD GetFontSize()   INLINE HPDF_PAGE_GETCURRENTFONTSIZE( ::Page_Active )
    METHOD GetFontName()   INLINE HPDF_Font_GetFontName( ::Font_Active )
   
    METHOD SetFontSize( nSize )
    METHOD SetFont( cFontName, nSize, cEncoding  )

    METHOD CMSAY( nRowCms, nColCms, cText, nSize )
    METHOD CMS2POINTS( nCms )
    METHOD POINTS2CMS( nPoints )
    METHOD Rectangle( nTop, nLeft, nRight, nBottom )
    METHOD SetRgbStroke( nRed, nGreen, nBlue ) INLINE HPDF_Page_SetRGBStroke( ::page_active, nRed, nGreen, nBlue)
    METHOD SetRgbFill( nRed, nGreen, nBlue  )  INLINE HPDF_Page_SetRGBFill( ::Page_Active, nRed, nGreen, nBlue) // 0 ... 1
    METHOD PageFill()                          INLINE HPDF_Page_Fill( ::Page_Active )
    METHOD PageFillStroke()                    INLINE HPDF_Page_FillStroke( ::Page_Active )
    METHOD PageStroke()                        INLINE HPDF_Page_Stroke( ::Page_Active )


    METHOD Separator( nJump )
    METHOD CompLinea( nSuma )
    METHOD SetPortrait()  INLINE ( ::PageSetSize( HPDF_PAGE_SIZE_A4, HPDF_PAGE_PORTRAIT ),;
                                   ::nEndLine := ::POINTS2CMS( ::GetPageHeight() ) )
    METHOD SetLandScape()  INLINE ( ::PageSetSize( HPDF_PAGE_SIZE_A4, HPDF_PAGE_LANDSCAPE ),;
                                   ::nEndLine := ::POINTS2CMS( ::GetPageHeight() ) )


    //Methods Destructores
    METHOD End( lPageCount )

    METHOD PageCount()
    MESSAGE Eject     METHOD __Eject()
    METHOD SetLineWidth( nWidth ) INLINE HPDF_Page_SetLineWidth( ::Page_Active, nWidth )

    METHOD GSave()    INLINE  HPDF_Page_GSave( ::Page_Active )      // Save the current graphic state
    METHOD GRestore() INLINE  HPDF_Page_GRestore( ::Page_Active )   // Restore graphic state
/*
    METHOD GSave()    VIRTUAL
    METHOD GRestore() VIRTUAL
*/
    METHOD LoadImagePng( cFileImage ) INLINE HPDF_LoadPngImageFromFile( ::pPdf, cFileImage )
    METHOD LoadImageJpg( cFileImage ) INLINE HPDF_LoadJpegImageFromFile( ::pPdf, cFileImage )
    METHOD ImageGetWidth( pImage )  INLINE HPDF_Image_GetWidth( pImage )
    METHOD ImageGetHeight( pImage ) INLINE HPDF_Image_GetHeight( pImage )
    METHOD DrawImage( pImage, x, y, nWidth, nHeight )
    METHOD UseUTF() INLINE HPDF_UseUTFEncodings( ::pPdf )
    METHOD Line( nTop, nLeft, nBottom, nRight, nWitdh, nRed, nGreen, nBlue )
    METHOD SetEncoder( cEncoding ) INLINE HPDF_SetCurrentEncoder  ( ::pPdf, cEncoding )
    Method LoadTTF( cFont )  INLINE HPDF_LoadTTFontFromFile ( ::pPdf, "/home/rafa/pol/fonts/"+cFont +".ttf", HPDF_TRUE)
    METHOD CMSAYRECT(nRowCms, nColCms, cText, cFont, nSize, nRed, nGreen, nBlue, nAngle, nTop, nLeft, nBottom, nRight, nJustify)
    METHOD CreateFonts()

END CLASS

METHOD New( cFile ) CLASS TIMPRIMEPDF
   ::CreateFonts()
   
   ::pPdf := HPDF_New()
   ::aPages := {}
   ::AddPage()         // Crea pagina para imprimir

   DEFINE UTILPDF ::oUtil OF Self
   ::cFileName := cFile

RETURN Self

METHOD CreateFonts() CLASS TIMPRIMEPDF
   ::aFonts  := { ;
                    "Courier",                  ; // 1
                    "Courier-Bold",             ; // 2
                    "Courier-Oblique",          ; // 3
                    "Courier-BoldOblique",      ; // 4
                    "Helvetica",                ; // 5
                    "Helvetica-Bold",           ; // 6
                    "Helvetica-Oblique",        ; // 7
                    "Helvetica-BoldOblique",    ; // 8
                    "Times-Roman",              ; // 9
                    "Times-Bold",               ; // 10
                    "Times-Italic",             ; // 11
                    "Times-BoldItalic",         ; // 12
                    "Symbol",                   ; // 13
                    "ZapfDingbats"              ; // 14
                  }

  ::aEncodings := { ;
            "StandardEncoding",;
            "MacRomanEncoding",;
            "WinAnsiEncoding", ;
            "ISO8859-2",       ;
            "ISO8859-3",       ;
            "ISO8859-4",       ;
            "ISO8859-5",       ;
            "ISO8859-9",       ;
            "ISO8859-10",      ;
            "ISO8859-13",      ;
            "ISO8859-14",      ;
            "ISO8859-15",      ;
            "ISO8859-16",      ;
            "CP1250",          ;
            "CP1251",          ;
            "CP1252",          ;
            "CP1254",          ;
            "CP1257",          ;
            "KOI8-R",          ;
            "Symbol-Set",      ;
            "ZapfDingbats-Set" }

RETURN NIL

*******************************************************************************
METHOD End( lPageCount ) CLASS TIMPRIMEPDF

  DEFAULT lPageCount TO .F.

  if lPageCount
     ::PageCount(  )
  endif

  ::SaveAs( ::cFileName ) // Save File

  HPDF_Free( ::pPdf )
RETURN NIL

*******************************************************************************
METHOD AddPage() CLASS TIMPRIMEPDF

   ::Page_Active := HPDF_AddPage( ::pPdf )
   ::SetFont( ::cFontDefault, 10)  // Important, definir font
   AADD( ::aPages, ::Page_Active )
   ::nEndLine := ::POINTS2CMS( ::GetPageHeight() )

RETURN ::Page_Active

*******************************************************************************
METHOD CMSAY( nRowCms, nColCms, cText, cFont, nSize, nRed, nGreen, nBlue, nAngle ) CLASS TIMPRIMEPDF
   Local uFont := ::GetFontName()
   Local uSize := ::GetFontSize()
   Local nRad1

   DEFAULT nRed TO 0 , nGreen TO 0 , nBlue TO 0

   if ::lUTF8toISO
      cText := _UTF_8 ( cText )
   endif

   ::GSave()
   if !empty( cFont  ) .OR. !empty( nSize )
      ::SetFont( cFont, nSize )
   endif

   HPDF_Page_BeginText( ::Page_Active )

    if !empty( nAngle  )
       nRad1 := nAngle / 180 * 3.141592
       HPDF_Page_SetTextMatrix( ::Page_Active, cos(nRad1), sin(nRad1), -sin(nRad1), cos(nRad1), ::CMS2POINTS( nColCms ), ::GetPageHeight() - ::CMS2POINTS( nRowCms ) )
    else
       HPDF_Page_MoveTextPos(::Page_Active , ::CMS2POINTS( nColCms ), ::GetPageHeight() - ::CMS2POINTS( nRowCms ))
    endif

    HPDF_Page_SetRGBFill( ::Page_Active, nRed, nGreen, nBlue) // 0 ... 1
    HPDF_Page_ShowText(::Page_Active, cText )

   //HPDF_Page_TextOut( ::Page_Active, ::CMS2POINTS( nColCms ), ::GetPageHeight() - ::CMS2POINTS( nRowCms ), cText )

   HPDF_Page_EndText( ::Page_Active )
   ::GRestore()

RETURN NIL

*******************************************************************************
METHOD CMSAYRECT(nRowCms, nColCms, cText, cFont, nSize, nRed, nGreen, nBlue, nAngle, nTop, nLeft, nBottom, nRight, nJustify) CLASS TIMPRIMEPDF
   Local uFont := ::GetFontName()
   Local uSize := ::GetFontSize()
   Local nRad1
   Local rect := Array( 4 )

   rect[ rLEFT   ] := ::CMS2POINTS( nLeft )

   rect[ rTOP    ] := ::GetPageHeight() - ::CMS2POINTS( nTop )
   rect[ rRIGHT  ] := ::CMS2POINTS( nRight )
   rect[ rBOTTOM ] := ::GetPageHeight() - ::CMS2POINTS( nBottom )

   DEFAULT nRed TO 0 , nGreen TO 0 , nBlue TO 0

   if ::lUTF8toISO
      cText := _UTF_8 ( cText )
   endif

   ::GSave()
   if !empty( cFont  ) .OR. !empty( nSize )
      ::SetFont( cFont, nSize )
   endif

   HPDF_Page_BeginText( ::Page_Active )

    if !empty( nAngle  )
       nRad1 := nAngle / 180 * 3.141592
       HPDF_Page_SetTextMatrix( ::Page_Active, cos(nRad1), sin(nRad1), -sin(nRad1), cos(nRad1), ::CMS2POINTS( nColCms ), ::GetPageHeight() - ::CMS2POINTS( nRowCms ) )
    else
       HPDF_Page_MoveTextPos(::Page_Active , ::CMS2POINTS( nColCms ), ::GetPageHeight() - ::CMS2POINTS( nRowCms ))
    endif

    HPDF_Page_SetRGBFill( ::Page_Active, nRed, nGreen, nBlue) // 0 ... 1
    HPDF_Page_TextRect( ::Page_Active, rect[ rLEFT ], rect[ rTOP ], rect[ rRIGHT ], rect[ rBOTTOM ],;
               cText, HPDF_TALIGN_CENTER, NIL)

   HPDF_Page_EndText( ::Page_Active )
   ::GRestore()

RETURN NIL

*******************************************************************************
METHOD Rectangle( nTop, nLeft, nBottom, nRight ) CLASS TIMPRIMEPDF
   Local rect := Array( 4 )

   rect[ rLEFT   ] := ::CMS2POINTS( nLeft )
   rect[ rTOP    ] := ::GetPageHeight() - ::CMS2POINTS( nTop )
   rect[ rRIGHT  ] := ::CMS2POINTS( nRight )
   rect[ rBOTTOM ] := ::GetPageHeight() - ::CMS2POINTS( nBottom )

   HPDF_Page_SetLineCap( ::Page_Active, HPDF_ROUND_END)
   HPDF_Page_Rectangle( ::Page_Active, rect[ rLEFT ], rect[ rBOTTOM ], rect[ rRIGHT ] - rect[ rLEFT ], ;
                                       rect[ rTOP ] - rect[ rBOTTOM ] )

RETURN NIL

*******************************************************************************
METHOD Line( nTop, nLeft, nBottom, nRight, nWitdh, nRed, nGreen, nBlue ) CLASS TIMPRIMEPDF
   Local rect := Array( 4 )

   rect[ rLEFT   ] := ::CMS2POINTS( nLeft )
   rect[ rTOP    ] := ::GetPageHeight() - ::CMS2POINTS( nTop )
   rect[ rRIGHT  ] := ::CMS2POINTS( nRight )
   rect[ rBOTTOM ] := ::GetPageHeight() - ::CMS2POINTS( nBottom )

   HPDF_Page_MoveTo( ::Page_Active, rect[ rLEFT   ] , rect[ rTOP ] )
   HPDF_Page_LineTo( ::Page_Active, rect[ rRIGHT  ],  rect[ rBOTTOM ])
   ::PageStroke()

RETURN NIL

*******************************************************************************
METHOD DrawImage( pImage, x, y, nWidth, nHeight )  CLASS TIMPRIMEPDF

   x := ::GetPageHeight() - ::CMS2POINTS( x )
   y := ::CMS2POINTS( y )

   if empty( nWidth )
      nWidth := ::ImageGetWidth( pImage )
   else
      nWidth := ::CMS2POINTS( nWidth )
   endif

   if empty( nHeight )
      nHeight := ::ImageGetHeight( pImage )
   else
      nHeight := ::CMS2POINTS( nHeight  )
   endif

   //Nota: Restamos la mitad del alto para obtener la posicion real de X
   x -= nHeight

   HPDF_Page_DrawImage( ::Page_Active, pImage, y, x, nWidth, nHeight )

RETURN NIL

*******************************************************************************
METHOD SetFont( cFontName, nSize, cEncoding  ) CLASS TIMPRIMEPDF
   
   DEFAULT cEncoding  TO ::cEncoding , nSize TO 10

   ::Font_Active := HPDF_GetFont( ::pPdf, cFontName, cEncoding  )
   
   if !empty( nSize )
      ::SetFontSize( nSize )
   endif

RETURN NIL

*******************************************************************************
METHOD SetFontSize( nSize ) CLASS TIMPRIMEPDF
   HPDF_Page_SetFontAndSize( ::Page_Active, ::Font_Active, nSize )
RETURN NIL

*******************************************************************************
METHOD CMS2POINTS( nCms ) CLASS TIMPRIMEPDF
RETURN ( nCms/2.54*::PointToInch )

*******************************************************************************
METHOD POINTS2CMS( nPoints ) CLASS TIMPRIMEPDF
RETURN ( nPoints / ::PointToInch * 2.54 )

*******************************************************************************
/* Funcion que nos comprueba si tenemos que realizar una pagina nueva
  El salto de pagina se produce cuando la Linea sobrepasa la dimension
  fisica de la hoja en vertical.
  Esto nos da como resultado usar cualquier tipo de papel sin complicaciones.
  Si salta pagina devuelve .T. , sino .F.
  */
*******************************************************************************
METHOD CompLinea( nSuma ) CLASS TIMPRIMEPDF
       Static nPage := 1

       DEFAULT nSuma TO 0

       IF ::nLinea > ( ::nEndLine + nSuma  )
          ::Addpage()  // Add page to document
          ::nLinea := 1
          Return .T.
       ENDIF

Return .F.

*******************************************************************************
METHOD Separator( nSpace , nSuma ) CLASS TIMPRIMEPDF
     Local lRet

   if Empty( nSpace ) /* Si no paso espacio, por defecto */
      nSpace := ::nSpace_Separator
   endif

   ::nLinea += nSpace
   lRet := ::CompLinea( nSuma )  // Retorna si se ha producido salto de pagina

Return lRet

*******************************************************************************
*******************************************************************************
METHOD PageCount( )  CLASS TIMPRIMEPDF
   Local x
   Local nFilesLong := Len( ::aPages )
   Local nHojas := nFilesLong
   Local nEndCol
   Local nEndLine
   Local cInfo_Page

   if nFilesLong <= 1  // Solamente una pagina, Si hay copia son X Copias
      Return Nil
   endif

   FOR x := 1 TO  nFilesLong
      ::Page_Active := ::aPages[ x ]
      nEndCol   := ::Points2Cms( ::GetPageWidth() )  - 3
      nEndLine  := ::POINTS2CMS( ::GetPageHeight() ) - 1
      cInfo_Page := "Hoja " + Alltrim( Str( x ) ) +" de " + Alltrim( Str( nFilesLong ) )
      ::CMSAY( nEndLine +.5, nEndCol, cInfo_Page, "Courier" )
   NEXT

Return NIl

******************************************************************************
******************************************************************************
METHOD __Eject() CLASS TIMPRIMEPDF
     ::AddPage()
RETURN NIL

METHOD _DateTime( nLinea, nFila ) CLASS TIMPRIMEPDF

  DEFAULT nLinea TO 0.5
  DEFAULT nFila  TO 15

  UTILPDF Self:oUtil nLinea,nFila SAY "Fecha: " + DTOC( Date() )+" Hora: "+ Time() FONT ::aFonts[2] SIZE 8

Return Self

******************************************************************************
******************************************************************************
METHOD _MesFecha_( dDate ) CLASS TIMPRIMEPDF

  Local cMes

  DO CASE
     CASE Month(dDate) == 1 ; cMes := "Enero"
     CASE Month(dDate) == 2 ; cMes := "Febrero"
     CASE Month(dDate) == 3 ; cMes := "Marzo"
     CASE Month(dDate) == 4 ; cMes := "Abril"
     CASE Month(dDate) == 5 ; cMes := "Mayo"
     CASE Month(dDate) == 6 ; cMes := "Junio"
     CASE Month(dDate) == 7 ; cMes := "Julio"
     CASE Month(dDate) == 8 ; cMes := "Agosto"
     CASE Month(dDate) == 9 ; cMes := "Septiembre"
     CASE Month(dDate) == 10; cMes := "Octubre"
     CASE Month(dDate) == 11; cMes := "Noviembre"
     CASE Month(dDate) == 12; cMes := "Diciembre"
     OTHERWISE
       cMes := "Incorrecto"
  ENDCASE

Return  cMes

 

Code: Select all  Expand view

#include "gclass.ch"
#include "hbclass.ch"
#include "tdolphin.ch"
#include "gmante.ch"
#include "pol.ch"
#include "harupdf.ch"
#include "tutilpdf.ch"

MEMVAR oServer, oEmpresa, p_LectorPDF

Function FacturaPdf( lAlbaran, nId, lSeleccion ,lCopia, lProforma, lCompras, lOfertas )
   Local oFact
   DEFAULT lCompras := .f.
   DEFAULT lOfertas := .f.

   with object oFact := TFacturaPDF():Create()
       :lAlbaran := lAlbaran
       :lCompras := lCompras
       :lOfertas := lOfertas
       :lSeleccion := lSeleccion
       :lProforma := lProforma
       :New( nId, NIL, lCopia )
       :Print()
       :End( .T. )

       if !empty( p_LectorPDF )
          hb_ProcessRun( p_LectorPDF + " "+ :Directory + :cFile + ".pdf" )
       else
         if "WINDOWS" $  Upper( Os()  )
               hb_ProcessRun( getEnv( "COMSPEC" ) + " /c " + " start " + :Directory + :cFile + ".pdf" )
         else
            winexec( "evince " + " " + :Directory + :cFile + ".pdf"  )
         endif
       endif
   end

return nil

/*********************************************************************
 Ejemplo de impresion de una factura.
 *********************************************************************/
CLASS TFacturaPDF FROM TIMPRIMEPDF

      DATA nEndBody INIT 23           // Limite donde tiene que llegar las lineas de la factura
      DATA lAlbaran INIT .F.           // Albaran  , si es .F., se tratará de una factura
      DATA lCompras INIT .F.           // Albaran de Compra
      DATA lOfertas INIT .F.           // Oferta de Compra
      DATA lProforma INIT .F.          // Si es una factura proforma

      DATA lCabecera INIT .T.          // Cabecera en todas las paginas
      DATA lCopia,nVeces               // Si queremos copias
      DATA nCopies INIT 1              // y cuantas copias quiero del original
      DATA nID                         // ID que identifica a un albaran, factura, o compra
      DATA lSeleccion INIT .F.         // False := Serie A  , True = Serie B
      DATA Directory   INIT "./pdfs/"       // "./pdfs/"
      DATA cFile
      DATA nTotal INIT 0

      DATA oData
      DATA oSlave
      DATA oCliente

      METHOD Create( ) INLINE Self
      METHOD New( cFile )
      METHOD Reset()
      METHOD Print()
      METHOD Body()
      METHOD Plantilla( nLinea )

      METHOD Separator( nSpace, lBody )
      METHOD Headers()
      METHOD Footers() VIRTUAL
      METHOD CompLinea( nSuma )
      METHOD Lineas( nIdAlbaran )
      METHOD LineasFac()          VIRTUAL
      METHOD Copia()
      METHOD MEMO()
      METHOD CajaTotal()

ENDCLASS

*********************************************************************
METHOD New( nID, cFile, lCopia ) CLASS TFacturaPDF

    DEFAULT lCopia := .F.
    ::lCopia := lCopia

    // Si quiero copias , las que quiero mas el original.
    if ::lCopia
       ::nCopies += 1  // ::nCopies + 1 := El + 1 es por el original + nCopies
    endif

    if empty( cFile )
       if ::lAlbaran
          if ::lCompras
              if ::lOfertas
                 cFile := "Oferta_"+alltrim( CStr( nID  )) // Es una oferta
              else
                 cFile := "Pedido_Compra_"+alltrim( CStr( nID  )) // Es una compra
              endif  
          else
             cFile := "Albaran_"+alltrim( cStr( nID  ))
          endif
       else
          if ::lProforma
             cFile := "Factura_PROFORMA_"+alltrim( CStr(nID ) )
          else
             cFile := "Factura_"+alltrim( CStr(nID ) )
          endif
       endif
    endif

    ::cFile := cFile + "_" + cValtoChar( oEmpresa:Ejercicio )+ iif( ::lCopia, "_copia", "" ) + iif( ::lSeleccion, "B","")
    ::nID := nID
   
    Super:New( ::Directory + ::cFile + ".pdf" )

RETURN Self

*********************************************************************
METHOD Print() CLASS TFacturaPDF
    Local cQry, cQryCliente, oError
    Local lResult := .T.

    cQryCliente := [ select  cli.nombre as nombre , val.texto as valoracion, pago.descripcion as fpago, pago.idpago as idpago, cli.dias, cli.proveedor, codproveedor,  ]+;
                  [          cli.nif, cli.direccion, cli.direccion2, cli.direccion3, cli.direccion4, textopago, iban, entidad, oficina, dc, cuenta ]+;
                  [ from cliente cli ] +;
                  [ left join valoracion val on val.idvalor  = cli.idvalor   ] +;
                  [ left join fpago pago     on pago.idpago  = cli.fk_idpago ] +;
                  [ where cli.idcliente= ]

    if ::lAlbaran         // Empezamos por si es un albaran
        if ::lCompras
           if ::lOfertas
              cQry := [ select a.id_oferta as idoferta , a.total as total, a.fecha as fecha, fk_idempresa , fk_idcliente , plazo] +;
                      [ from oferta a  ] +;
                      [ where  fk_idempresa=]  + CStr( oEmpresa:IdEmpresa  ) + [ and  id_oferta = ]
           else
              cQry := [ select a.id_compra as idcompra , a.total as total, a.fecha as fecha, fk_idempresa , fk_idcliente , plazo] +;
                      [ from compra a  ] +;
                      [ where  fk_idempresa=]  + CStr( oEmpresa:IdEmpresa  ) + [ and  id_compra = ]
           endif        

        else
           cQry := [ select a.id_albaran as idalbaran , a.total as total, a.fecha as fecha,  a.fk_factura as factura ,fk_idempresa , fk_idcliente ] +;
                   [ from albaran a  ] +;
                   [ where  fk_idempresa=]  + CStr( oEmpresa:IdEmpresa  ) + [ and  id_albaran = ]
        endif
        try
          if ::lCompras
             ::oData    := oServer:Query( cQry + CStr( ::nId )  ) // Datos de Compra
          else
             ::oData    := oServer:Query( cQry + CStr( ::nId ) + " and seleccion=" +ClipValue2SQL( ::lSeleccion ) ) // Datos del Albaran
          endif  
          ::oCliente := oServer:Query( cQryCliente + CStr( ::oData:fk_idcliente ) )     // Datos del Cliente
        catch oError
          lResult := .F.
          MsgAlert( oError:Description + hb_osnewline() + cQry, "Alerta" )
        end
    else
        cQry := [ select a.id_factura as idfactura , base, iva, total, fecha, vto, descripcion_pago as fpago, ]+;
                [   fk_idempresa , fk_idcliente ] +;
                [ from factura a  ] +;
                [ where  fk_idempresa=]  + CStr( oEmpresa:IdEmpresa  ) + [ and  id_factura = ]
        try
          ::oData    := oServer:Query( cQry + CStr( ::nId ) + " and seleccion=" +ClipValue2SQL( ::lSeleccion ) )                           // Datos del Albaran
          ::oCliente := oServer:Query( cQryCliente + CStr( ::oData:fk_idcliente ) )     // Datos del Cliente
          ::oCliente:FPago  := ::oData:fPago                                              // La de la factura.
        catch oError
          lResult := .F.
          MsgAlert( oError:Description + hb_osnewline() + cQry,  "Alerta" )
        end

    endif

    if lResult
      ::Reset()
      ::Headers()
      ::Body()
      ::Footers()

      if ::lCopia
         ::Copia()
      endif

    endif

RETURN NIL

*********************************************************************
METHOD Headers() CLASS TFacturaPDF
*********************************************************************
 Local ctexto
 ::Plantilla( 9 )

 if ::lAlbaran
    UTILPDF ::oUtil 1,1.5 IMAGE "./gui/logotipo.jpg" SIZE 8,5 JPG
 else
    UTILPDF ::oUtil 1,1.5 IMAGE "./gui/logotipo.jpg" SIZE 8,5 JPG
 endif

 UTILPDF ::oUtil 1.5,6.5 IMAGE "./gui/imageiso.png" SIZE 4,2.5         // IMAGEISO


 UTILPDF ::oUtil LINEA 4.064,10.54 TO 4.064,11.00

 UTILPDF ::oUtil LINEA 4.064,10.54 TO 4.464,10.54

 UTILPDF ::oUtil LINEA 4.064,19.04 TO 4.064,19.50  // up der hor
 UTILPDF ::oUtil LINEA 4.064,19.50 TO 4.464,19.50  // up der vert

 UTILPDF ::oUtil LINEA 8.428,10.54 TO 8.428,11.00
 UTILPDF ::oUtil LINEA 8.028,10.54 TO 8.428,10.54

 UTILPDF ::oUtil LINEA 8.428,19.04 TO 8.428,19.50
 UTILPDF ::oUtil LINEA 8.028,19.50 TO 8.428,19.50

 IF ::lAlbaran        //2.2
    if ::lCompras
       if ::lOfertas
           UTILPDF ::oUtil 7.0,1.5   SAY "OFERTA" FONT ::aFonts[10] SIZE 15
       else    
           UTILPDF ::oUtil 7.0,1.5   SAY "PEDIDO" FONT ::aFonts[10] SIZE 15
       endif    
    else
        UTILPDF ::oUtil 7.0,1.5   SAY "ALBARAN" FONT ::aFonts[10] SIZE 15
    endif    
 ELSE
    IF ::lProforma
       UTILPDF ::oUtil 7.0,1.5   SAY "FACTURA PROFORMA" FONT ::aFonts[10] SIZE 15
    ELSE
       UTILPDF ::oUtil 7.0,1.5   SAY "FACTURA" FONT ::aFonts[10] SIZE 15
    ENDIF
 ENDIF

IF ::lProforma
   UTILPDF ::oUtil 7.5,1.5 SAY "NUMERO: P/"+ CStr( ::nID ) FONT ::aFonts[10] SIZE 13
ELSE
   UTILPDF ::oUtil 7.5,1.5 SAY "NUMERO:"+ CStr( ::nID )    FONT ::aFonts[10] SIZE 13
ENDIF

   UTILPDF ::oUtil 8.0,1.5 SAY "Fecha:"+ Fecha( ::oData:Fecha ) FONT ::aFonts[10] SIZE 13

    if  !Empty( ::oCliente:CodProveedor )
        UTILPDF ::oUtil 8.5,1.5 SAY "Proveedor N: " + CStr( ::oCliente:codproveedor ) FONT ::aFonts[10]
    endif
    UTILPDF ::oUtil 5.0,11  SAY ::oCliente:Nombre      FONT ::aFonts[10] SIZE 10
    UTILPDF ::oUtil 5.5,11  SAY ::oCliente:Direccion   FONT ::aFonts[10] SIZE 10
    UTILPDF ::oUtil 6.0,11  SAY ::oCliente:Direccion2  FONT ::aFonts[10] SIZE 10
    UTILPDF ::oUtil 6.5,11  SAY ::oCliente:Direccion3  FONT ::aFonts[10] SIZE 10
    UTILPDF ::oUtil 7.0,11  SAY ::oCliente:Direccion4  FONT ::aFonts[10] SIZE 10

    UTILPDF ::oUtil 7.8,15  SAY "N.I.F/D.N.I: " + ::oCliente:NIF  FONT ::aFonts[10] SIZE 10

 if !::lAlbaran  // Si no es un albaran
    if empty( ::oCliente:TextoPago )
       UTILPDF ::oUtil 25.5,1.75   SAY ::oCliente:FPago  FONT ::aFonts[10] SIZE 12         //oDbf:Fpago
    else
       UTILPDF ::oUtil 24.70,4.75  SAY alltrim( ::oCliente:TextoPago ) FONT ::aFonts[2] SIZE 9
       UTILPDF ::oUtil 26,1.6  SAY ::oCliente:Iban     FONT ::aFonts[10] SIZE 10
       UTILPDF ::oUtil 26,3.2  SAY ::oCliente:Entidad  FONT ::aFonts[10] SIZE 10
       UTILPDF ::oUtil 26,4.8  SAY ::oCliente:Oficina  FONT ::aFonts[10] SIZE 10
       UTILPDF ::oUtil 26,6.3  SAY ::oCliente:DC       FONT ::aFonts[10] SIZE 10
       UTILPDF ::oUtil 26,7.4  SAY ::oCliente:Cuenta   FONT ::aFonts[10] SIZE 10
    endif

    UTILPDF ::oUtil 26,10.75  SAY cValtoChar( ::oData:Vto )   FONT ::aFonts[10] SIZE 12  //oDbf:Vto
    UTILPDF ::oUtil 26,13.60  SAY cValtoChar( ::oData:Base )  FONT ::aFonts[10] SIZE 12  //oDbf:Base
    UTILPDF ::oUtil 26,15.60  SAY cValtoChar( ::oData:Iva  )  FONT ::aFonts[10] SIZE 12  //oDbf:Iva
    UTILPDF ::oUtil 26,17.80  SAY cValtoChar( ::oData:Total ) FONT ::aFonts[10] SIZE 12  //oDbf:Total
 endif

  if ::lAlbaran
     cTexto := "Tu Empresa a piñon....."
     UTILPDF ::oUtil 22, 0.5  SAY cTexto FONT ::aFonts[10] SIZE 7 ROTATE 90
     UTILPDF ::oUtil 27.5,1.5  SAY "A estos precios se ha de sumar el I.V.A" FONT ::aFonts[1] SIZE 10
  else
     cTexto := "Sociedad Inscrita en el Registro Mercantil de Barcelona."+;
               " Tomo XXXX, Inscripcion 1."
     UTILPDF ::oUtil 22,0.5  SAY  cTexto  FONT ::aFonts[10] SIZE 7 ROTATE 90  
  endif

RETURN NIL

*********************************************************************
METHOD Body() CLASS TFacturaPDF
*********************************************************************
      Local oAlbaran, oError, cQry

      ::nLinea := 10.5    // Comenzamos de nuevo lineas de albaran

      if ::lAlbaran
         ::Lineas( ::nId )
      else
         // Lineas de albaranes
        cQry := [ select id_albaran as idalbaran  from albaran  ] +;
                [ where  fk_idempresa=]  + CStr( oEmpresa:IdEmpresa  ) + [ and  fk_factura = ]

        try
          oAlbaran    := oServer:Query( cQry + CStr( ::nId ) +  " and seleccion=" +ClipValue2SQL( ::lSeleccion ) + " order by id_albaran" ) // Datos del Albaran
        catch oError
          MsgAlert( oError:Description + hb_osnewline() + cQry, "Alerta" )
        end
        while !oAlbaran:Eof()
              ::Lineas( oAlbaran:idalbaran )
              oAlbaran:Skip()
        end while

      endif


RETURN Nil

*********************************************************************
METHOD Plantilla( nLinea ) CLASS TFacturaPDF
*********************************************************************
  Local nFila := 1
  Local cTexto


  if ::lAlbaran
   UTILPDF ::oUtil BOX nLinea,1.5 TO nLinea + 1,13.25 STROKE SIZE 0.1 FILLRGB (171/255),(218/255),(248/255)   // Primera caja descripcion
  else
   UTILPDF ::oUtil BOX nLinea,1.5 TO nLinea + 1,3     STROKE SIZE 0.1 FILLRGB (171/255),(218/255),(248/255)
   UTILPDF ::oUtil BOX nLinea,3   TO nLinea + 1,13.25 STROKE SIZE 0.1 FILLRGB (171/255),(218/255),(248/255)
  endif

  UTILPDF ::oUtil BOX nLinea,13.25 TO nLinea + 1,14.8 STROKE SIZE 0.1 FILLRGB (171/255),(218/255),(248/255)// FILLRGB (171/255),205/255,244/255
  UTILPDF ::oUtil BOX nLinea,14.8  TO nLinea + 1,17   STROKE SIZE 0.1 FILLRGB (171/255),(218/255),(248/255)
  UTILPDF ::oUtil BOX nLinea,17    TO nLinea + 1,19.5 STROKE SIZE 0.1 FILLRGB (171/255),(218/255),(248/255)

  if ::lAlbaran
   UTILPDF ::oUtil BOX nLinea+1,1.5 TO 24.0,19.5 STROKE SIZE 0.1
  else
   UTILPDF ::oUtil BOX nLinea+1,1.5 TO 24.0,19.5 STROKE SIZE 0.1
   UTILPDF ::oUtil LINEA nLinea+1,3 TO if(::lAlbaran,26.5,24),3 WITDH 0.5
  endif

  UTILPDF ::oUtil LINEA nLinea+1,13.25 TO 24,13.25 WITDH 0.1
  UTILPDF ::oUtil LINEA nLinea+1,14.8  TO 24,14.8  WITDH 0.1
  UTILPDF ::oUtil LINEA nLinea+1,17.0  TO 24,17    WITDH 0.1

  nLinea += .25

  if ::lAlbaran
    *UTILPRN ::oUtil nLinea + 0.25,1.65  SAY "Pedido"   FONT oFnt
  else
   UTILPDF ::oUtil nLinea + 0.25,1.65  SAY "Albaran"  FONT ::aFonts[2] SIZE 9
  endif


  UTILPDF ::oUtil nLinea + 0.25,5    SAY "Descripcion / Operaciones " FONT ::aFonts[5] SIZE 10
  UTILPDF ::oUtil nLinea + 0.25,13.3 SAY "Cantidad"   FONT ::aFonts[5] SIZE 9
  UTILPDF ::oUtil nLinea + 0.25,15   SAY "Precio U."  FONT ::aFonts[5] SIZE 9
  UTILPDF ::oUtil nLinea + 0.25,17.5 SAY "Totales"    FONT ::aFonts[5] SIZE 10



 IF !::lAlbaran

    UTILPDF ::oUtil BOX 24.2,1.5  TO 26.5,19.5 STROKE SIZE 0.1
    UTILPDF ::oUtil BOX 24.2,1.5  TO 25.0,19.5 STROKE SIZE 0.1 FILLRGB (171/255),(218/255),(248/255)

    UTILPDF ::oUtil LINEA 24.2,13.25 TO 26.5,13.25 WITDH 0.1
    UTILPDF ::oUtil LINEA 24.2,17    TO 26.5,17    WITDH 0.1

    UTILPDF ::oUtil 24.70,1.75   SAY "Forma de Pago:" FONT ::aFonts[2] SIZE 10
    if !empty( ::oCliente:textopago )
       //TODO: Dibujar cajas de entidad bancaria
      UTILPDF ::oUtil LINEA 25,2.8 TO 26.5,2.8 WITDH 0.1
      UTILPDF ::oUtil LINEA 25,4.5 TO 26.5,4.5 WITDH 0.1
      UTILPDF ::oUtil LINEA 25,6.0 TO 26.5,6.0 WITDH 0.1
      UTILPDF ::oUtil LINEA 25,7.0 TO 26.5,7.0 WITDH 0.1
      UTILPDF ::oUtil LINEA 24.2,10.5 TO 26.5,10.5 WITDH 0.1
      UTILPDF ::oUtil LINEA 25.55,1.5 TO 25.55,10.5 WITDH 0.1
      // AQUI
      UTILPDF ::oUtil 25.5,1.6  SAY "IBAN"     FONT ::aFonts[2] SIZE 9
      UTILPDF ::oUtil 25.5,3.0  SAY "Entidad"  FONT ::aFonts[2] SIZE 9
      UTILPDF ::oUtil 25.5,4.6  SAY "Oficina"  FONT ::aFonts[2] SIZE 9
      UTILPDF ::oUtil 25.5,6.3  SAY "DC"       FONT ::aFonts[2] SIZE 9
      UTILPDF ::oUtil 25.5,7.4  SAY "N.Cuenta" FONT ::aFonts[2] SIZE 9
    else
       UTILPDF ::oUtil 24.70,1.75   SAY "Forma de Pago:" FONT ::aFonts[2] SIZE 10
    endif



    UTILPDF ::oUtil 24.70,10.75  SAY "Vencimiento"    FONT ::aFonts[2] SIZE 10
    UTILPDF ::oUtil 24.70,13.75  SAY "Base"           FONT ::aFonts[2] SIZE 10
    UTILPDF ::oUtil 24.70,15.75  SAY "I.V.A"          FONT ::aFonts[2] SIZE 10
    UTILPDF ::oUtil 24.70,17.75  SAY "TOTAL"          FONT ::aFonts[2] SIZE 12

 ENDIF

 IF ::lAlbaran
    UTILPDF ::oUtil BOX 24.2,1.5  TO 25.8,10.5
    if ::lCompras
       if ::lOfertas
       else
          UTILPDF ::oUtil 25,2.0  SAY _UTF_8( "- PLAZO DE ENTREGA : " + Str( ::oData:Plazo, 3 ) + " dias" )
       endif  
    else  
       UTILPDF ::oUtil 25,2.0  SAY  "- PLAZO DE ENTREGA : " + Str( 30, 3 ) + " dias"
    endif  
    UTILPDF ::oUtil 25.5,2.0  SAY "- DEVOLVER COPIA COMO ACUSE DE RECIBO"
 ENDIF


Return nil


**********************************************************************************
**********************************************************************************
METHOD Separator( nSpace, lBody ) CLASS TFacturaPDF

   IF ::nLinea >= ::nEndBody
      ::Eject()
      ::nLinea := 10.5
      ::Headers()
      ::Footers()
   ELSEIF Super:Separator( nSpace )
      ::Headers()
      ::Footers()
   ENDIF

  Return NIL

  *******************************************************************************
/* Funcion que nos comprueba si tenemos que realizar una pagina nueva
  nLinea > 26 Si es mayor de 26 cms ( A4 )
  nSuma  := La caja de total tiene el final de linea en la linea 27*/
*******************************************************************************
METHOD CompLinea( nSuma ) CLASS TFACTURAPDF

 DEFAULT nSuma := 0


 IF If( ::lAlbaran,::nLinea >= ( 23.5 + nSuma  ), ::nLinea >=( 23.5 +nSuma ) ) .OR. ::nLinea < 5 // nLinea < 4 para la caja del total
    ::nLinea := 10.5
    ::AddPage() // Nueva Pagina
    if ::lCabecera   // Si queremos cabecera en todas las paginas
       ::nLinea := 10.5
       ::Headers( )
       ::Footers()
    endif
   return .t.
 ENDIF

Return .F.

*******************************************************************************
/* Reseteamos valores */
*******************************************************************************
METHOD Reset() CLASS TFACTURAPDF

  ::nLinea := 10.5 // Comenzamos de nuevo lineas de albaran
  ::nTotal := 0  // Empezamos a totalizar

Return Nil

*******************************************************************************
/* Cuando es una copia Rev2 */
*******************************************************************************
METHOD Copia()  CLASS TFACTURAPDF


  Local oFont
  Local cCopia := "ALBARAN ES COPIA"

  if ::lCopia  //.AND. ::nVeces >= 2
       if ::lAlbaran
          if ::lCompras
             if ::lOfertas
                cCopia := "OFERTA ES COPIA"
             else  
                cCopia := "PEDIDO ES COPIA"
             endif
          endif
       else
           cCopia := "FACTURA ES COPIA"
       endif

       UTILPDF ::oUtil if(::lAlbaran,27.3,28.5),;   //25,22
                       if(::lAlbaran,1.5,1.5) ;    //.5,1
                       SAY cCopia FONT ::aFonts[10] SIZE 52  COLOR RGB (200/255),(200/255),(200/255)
  endif

return NIL
*******************************************************************************
// Lineas de Albaran Cliente
*******************************************************************************
METHOD Lineas( nIdAlbaran ) CLASS TFACTURAPDF
     Local cQry
     static nAlbaran := 0

     if ::lCompras
        if ::lOfertas
           cQry   := [ SELECT descripcion,cantidad,precio_u,precio_t FROM lineas_oferta where fk_idoferta = ] + CStr( nIdAlbaran ) +;
                     [ and fk_idempresa=]  + CStr( oEmpresa:IdEmpresa  )  +[ order by idlinea ]
        else
           cQry   := [ SELECT descripcion,cantidad,precio_u,precio_t FROM lineas_compra where fk_idcompra = ] + CStr( nIdAlbaran ) +;
                     [ and fk_idempresa=]  + CStr( oEmpresa:IdEmpresa  )  +[ order by idlinea ]
        endif          
     else
         cQry   := [ SELECT descripcion,cantidad,precio_u,precio_t FROM lineas_albaran where fk_idalbaran = ] + CStr( nIdAlbaran ) +;
                   [ and fk_idempresa=]  + CStr( oEmpresa:IdEmpresa  )  + [ and seleccion=] + ClipValue2SQL( ::lSeleccion ) + [ order by idlinea ]
     endif              



     ::oSlave  := oServer:Query( cQry  )

      while !::oSlave:Eof()
             if ::lAlbaran
                ::nFila := 4.1
             else
                 if !Empty( nIdAlbaran ) .AND. nAlbaran != nIdAlbaran
                    UTILPDF Self:oUtil Self:nLinea,1.65 SAY StrZero( nIdAlbaran,6 ) FONT ::aFonts[1] SIZE 9
                    nAlbaran := nIdAlbaran
               endif
               ::nFila := 4.1
             endif


             if ::lAlbaran
                UTILPDF ::oUtil Self:nLinea,1.6 SAY ::oSlave:Descripcion FONT ::aFonts[1] SIZE 9
             else
                UTILPDF ::oUtil Self:nLinea,3.1 SAY ::oSlave:Descripcion FONT ::aFonts[1] SIZE 9
             endif

             if !Empty( ::oSlave:Cantidad )
                 UTILPDF ::oUtil Self:nLinea,::nFila+9.4 SAY Str( ::oSlave:Cantidad,5 ) FONT ::aFonts[1] SIZE 9
             endif

             if !Empty( ::oSlave:Precio_U )
                UTILPDF ::oUtil Self:nLinea,Self:nFila+10.65 SAY Str( ::oSlave:Precio_U,10,2 ) FONT ::aFonts[1] SIZE 9
             endif

             if !Empty( ::oSlave:Precio_T )
                 UTILPDF ::oUtil Self:nLinea,::nFila+12.9 SAY Str( ::oSlave:Precio_T,11,2 ) FONT ::aFonts[1] SIZE 9
                ::nTotal += ::oSlave:Precio_T
              endif

        ::nLinea += .5 ; ::CompLinea()

        ::oSlave:Skip()

      end while

      // La ultima linea no debe de ser visualizada.!!! Para factura( albaranes) Mirar
      // METHOD LineasFac()
      //17/06/2002
      IF ::lAlbaran
         IF !::oSlave:Eof()
            ::nLinea += .5 ; ::CompLinea()
            UTILPDF ::oUtil LINEA ::nLinea,1.5 TO ::nLinea, 19.5 //PEN ::oPen
            ::nLinea += .5 ; ::CompLinea()
         ENDIF

      ENDIF


   ::nLinea += 0.25 ; ::CompLinea( )

   IF ::lAlbaran
      ::nLinea += 0.75 ; ::CompLinea( )
      ::CajaTotal()
   ENDIF

   nAlbaran := 0 //11-07-02 Reinicializamos para el siguiente albaran.

RETURN NIL

*******************************************************************************
 // Dibujamos caja del Total
*******************************************************************************
METHOD CajaTotal() CLASS TFACTURAPDF

 IF ::lAlbaran .AND. ::nTotal > 0
    ::nLinea -=  0.75  // Volvemos para atras para dibujar caja total
    IF ::oSlave:LastRec() > 0
         ::CompLinea( 1 )
        UTILPDF ::oUtil BOX ::nLinea,13.25 TO ::nLinea + 1,14.8
        UTILPDF ::oUtil BOX ::nLinea,14.8  TO ::nLinea + 1,19.5
        UTILPDF ::oUtil Self:nLinea+.6,13.4  SAY "Total"              FONT ::aFonts[2] SIZE 12
        UTILPDF ::oUtil Self:nLinea+.6,15.62 SAY Str( ::nTotal,11,2 ) FONT ::aFonts[2] SIZE 14
    ENDIF
 ENDIF

Return Nil

*******************************************************************************
* Impresion del MEMO de las descripciones ALbaran/ Factura
*******************************************************************************
METHOD MEMO( cText ) CLASS TFACTURAPDF

    Local cLinea,nLineas,oFont

    FOR nLineas := 1 TO  MLCOUNT( cText, 56 )  //53
        cLinea := MEMOLINE( cText, 56, nLineas )
        if ::lAlbaran
            UTILPDF ::oUtil Self:nLinea,2 SAY cLinea FONT ::aFonts[1]
        else
            UTILPDF ::oUtil Self:nLinea,3.2 SAY cLinea FONT ::aFonts[1]
        endif

        ::nLinea += .5 ; ::CompLinea( .5 )
    NEXT

Return NIL


/* Fecha en Spanish para clipper 5.3 English */
Static Func Fecha( dDate )
Local cMes
DO CASE
   CASE Month(dDate) == 1 ; cMes := "Enero"
   CASE Month(dDate) == 2 ; cMes := "Febrero"
   CASE Month(dDate) == 3 ; cMes := "Marzo"
   CASE Month(dDate) == 4 ; cMes := "Abril"
   CASE Month(dDate) == 5 ; cMes := "Mayo"
   CASE Month(dDate) == 6 ; cMes := "Junio"
   CASE Month(dDate) == 7 ; cMes := "Julio"
   CASE Month(dDate) == 8 ; cMes := "Agosto"
   CASE Month(dDate) == 9 ; cMes := "Septiembre"
   CASE Month(dDate) == 10; cMes := "Octubre"
   CASE Month(dDate) == 11; cMes := "Noviembre"
   CASE Month(dDate) == 12; cMes := "Diciembre"
ENDCASE
Return ( Str(Day(dDate),2)+" "+ cMes +" del "+Str(Year(dDate),4) )
 

Code: Select all  Expand view

#include "fivewin.ch"
#include "utilprn.ch"

function main()
    imprime init "spot de prueba"
        page
            imprime datetime
        endpage
    imprime end
   
    return (nil)
 

Error description: Error BASE/1003 Variable does not exist: SELF
Args:

Stack Calls
===========
Called from: Z:\32_bits\testtimprime\source\test.PRG => MAIN( 5 )

Code: Select all  Expand view

#include "fivewin.ch"
#include "utilprn.ch"

class TApp from TImprime
    method  new() constructor
end class

//--------------(  ) ---------------------

method new()
    imprime init  "hola"
    imprime end

    return (self)

//--------------(  ) ---------------------

function main()
    local a:= TApp():new()

   
    return (nil)

karinha wrote:Yo no puedo decir, pero esto es muy interesante:

http://fivewin-contributions.googlecode.com/files/Bucaneros.pdf

Salu2

Code: Select all  Expand view

::aFonts  := { ;
                    "Courier",                  ; // 1
                    "Courier-Bold",             ; // 2
                    "Courier-Oblique",          ; // 3
                    "Courier-BoldOblique",      ; // 4
                    "Helvetica",                ; // 5
                    "Helvetica-Bold",           ; // 6
                    "Helvetica-Oblique",        ; // 7
                    "Helvetica-BoldOblique",    ; // 8
                    "Times-Roman",              ; // 9
                    "Times-Bold",               ; // 10
                    "Times-Italic",             ; // 11
                    "Times-BoldItalic",         ; // 12
                    "Symbol",                   ; // 13
                    "ZapfDingbats",             ; // 14
                    "Courier New";
                  }

Code: Select all  Expand view

HPDF_LoadTTFontFromFile ( tPdf:pPdf, "c:\windows\fonts\arial.ttf", HPDF_TRUE)

Code: Select all  Expand view

Function CargaFuentesPdf (tPdf, aFuentes)
/* =================================================================
    tPdf - Objeto harupdf
    aFuentes - Array de fuentes a incrustar en el PDF (Ej. {"Arial","Courier New","Verdana"}
   ==================================================================
*/
Local cDirFonts:=GetWinDir(), nC:=0, aFicheros:={}, cTemporal, aFuentesCreadas:={}, nFuentes:=Len(aFuentes)

  /* Obtengo el directorio de windows y comprueba si existe una fuente por defecto
    Esto lo hago porque en sesión de Terminal Server GetWinDir() devuelve una carpeta temporal del usuario en
    lugar del de la instalación de Windows */
 
  If !File (cDirFonts+"\fonts\arial.ttf") // Compruebo si existe arial.ttf que aparece en todas las instalaciones de windows que he probado.
    cDirFonts:="c:\windows"
  Endif
  cDirFonts:=cDirFonts+"\fonts\"
 
  For nC:=1 To nFuentes
    cTemporal:=cDirFonts+GetProfString( "Fonts", aFuentes[nC]+" (TrueType)" )
   
    If File (cTemporal)
      aAdd (aFicheros,cTemporal)
    Else
      MsgInfo ("El tipo de letra "+aFuentes[nC]+" utilizado en el formato no se encuentra en el sistema. Se reemplazará por el tipo Arial","Atención")
      aAdd (aFicheros,cDirFonts+"arial.ttf")
    Endif
  Next
 
  // Cargo los ficheros en el formato DPF
  For nC:=1 To nFuentes
    cTemporal:=HPDF_LoadTTFontFromFile ( tPdf:pPdf, aFicheros[nC], HPDF_TRUE)
    If Len(Alltrim(cTemporal))<>0
      aAdd (aFuentesCreadas,cTemporal)
    Else
      MsgInfo ("No se ha podido incrustar el tipo de letra "+aFuentes[nC]+" en el archivo PDF. Será sustituida por el tipo Arial","Atención")
      aAdd (aFuentesCreadas,"ArialMT")
    Endif
  Next
Return (aFuentesCreadas)

horacio wrote:Angel, pudiste compilarlo para FWH y Borland ?. Con la versión de Harbour 3.1 y compilandolo con hbmk2.exe funciona pero al compilarlo con Fwh1412 y Bcc587 no se queja pero no me crea el .pdf. Muchas gracias

Saludos