ATOUTFOX
COMMUNAUTÉ FRANCOPHONE DES PROFESSIONNELS FOXPRO
Visual FoxPro : le développement durable

Classe foxpro permettant de générer des fichiers pdf texte   


L'auteur

lcarrere
France France
Membre Simple
# 0000000104
enregistré le 03/11/2004

http://www.asi-concept.fr
42 ans
Carrère Loïc
31700 Blagnac
Fiche personnelle

Note des membres
17/20
1 vote

Contributions > 01 - PRG : Programmation

Classe foxpro permettant de générer des fichiers pdf texte
# 0000000224
ajouté le 25/07/2005 16:29:36 et modifié le 25/07/2005
consulté 12713 fois
Niveau initié

Version(s) Foxpro :
VFP 9.0
Description

Salut!

Voici une classe permettant de générer des fichiers pdf contenant de texte.

Le code est 100% foxpro, vous n'avez pas besoin de composants tiers.

Si j'ai un peu de temps j'ajouterai l'insertion des images et des formes géométriques.

Loïc

Code source :
**********************************************************
*!* Classe FoxPDFText                                  *!*
*!* Version 1.0  25/07/2005                            *!*
*!* Auteur: Loïc Carrère - carrere.loic@neuf.com       *!*
**********************************************************

&&Types de police
#define pdfRegular    1
#define pdfItalic     2
#define pdfBold       3
#define pdfBoldItalic 4


&&Formats de document
#define pdfA3         1
#define pdfA4         2
#define pdfA5         3
#define pdfTABLOID    4
#define pdfLEDGER     5
#define pdfLEGAL      6
#define pdfSTATEMENT  7
#define pdfEXECUTIVE  8
#define pdfCUSTOMSIZE 9

#define LF  CHR(10)
#define CR  CHR(13)


DEFINE CLASS FoxPDFText as Custom

   sProducer = ""          &&Tag Producer du fichier PDF
   sTitle = ""             &&Tag Title du fichier PDF
   sSubject = ""           &&Tag Subject du fichier PDF
   sAuthor = ""            &&Tag Author du fichier PDF
   nPaperSize = pdfA4      &&Format du document
   bLandScape = .F.        &&Mode portrait
   nTopMargin = 50         &&Marge supérieur
   nLeftMargin = 50        &&Marge gauche
   nFontSize = 10          &&Taille de la police
   nFontType = pdfRegular  &&Type de police
   nVertSpace = 12         &&Hauteur de l'interligne
   nDegree = 0             &&Degrès de rotation
   nCustomHeight = 0       &&Hauteur personnalisée du document
   nCustomWidth = 0        &&lageur personnalisée du document

   protected nStartStream,;
             nObject,;               && Nombre d'objets
             tbPages(1),;            && Tableau de pages
             tbObjectsRefs(1),;      && Tableau de références d'objets (contient la position relative de chaque objet du fichier PDF)
             nPaperWidth,;           && Largeure du papier
             nPaperHeight,;          && Hauteur du papier
           nPDfHandle,;            && Handle du fichier PDF
             nPages,;                && Compteur de pages
             sObj,;                  && Chaîne de caractère contenant la définition de l'objet courant
             sFilePath               &&Path du fichier PDF


   &&Création d'un nouveau fichier PDF
   FUNCTION NewPDF(sPath) as long
      PRIVATE nLen,;
              nBuffer

      this.sFilePath = spath
      DO CASE
         CASE this.nPaperSize = pdfA3
              this.nPaperWidth = 842
              this.nPaperHeight = 1190
         CASE this.nPaperSize = pdfA4
              this.nPaperWidth = 595
              this.nPaperHeight = 842
         CASE this.nPaperSize = pdfA5
              this.nPaperWidth = 421
              this.nPaperHeight = 595
         CASE this.nPaperSize = pdfTABLOID
              this.nPaperWidth = 792
              this.nPaperHeight = 1224
         CASE this.nPaperSize = pdfLEDGER
              this.nPaperWidth = 1224
              this.nPaperHeight = 792
         CASE this.nPaperSize = pdfLETTER
              this.nPaperWidth = 612
              this.nPaperHeight = 1008
         CASE this.nPaperSize = pdfSTATEMENT
              this.nPaperWidth = 396
              this.nPaperHeight = 612
         CASE this.nPaperSize = pdfEXECUTIVE
              this.nPaperWidth = 540
              this.nPaperHeight = 720
         CASE this.nPaperSize = pdfCUSTOMSIZE
              this.nPaperWidth = nCustomHeight
              this.nPaperHeight = nCustomWidth
      ENDCASE

    IF this.bLandScape
       nBuffer = this.nPaperWidth
       this.nPaperWidth = this.nPaperHeight
       this.nPaperHeight = nBuffer
    ENDIF

      this.nPDfHandle = FCREATE(this.sFilePath)
      IF this.nPDfHandle > 0
         FPUTS(this.nPDfHandle, "%PDF-1.2" + LF + "%âãÏÓ" + LF)
         this.nObject = 1
         this.sObj = "/CreationDate (D:" + ALLTRIM(STR(YEAR(DATE()))) +;
                                      PADL(ALLTRIM(STR(MONTH(DATE()))), 2, '0') +;
                                      PADL(ALLTRIM(STR(DAY(DATE()))), 2, '0') +;
                                      PADL(ALLTRIM(STR(HOUR(DATETIME()))), 2, '0') +;
                                      PADL(ALLTRIM(STR(MINUTE(DATETIME()))), 2, '0') +;
                                      PADL(ALLTRIM(STR(SEC(DATETIME()))), 2, '0') + ")"

         this.sObj = this.sObj + LF + "/Creator (FoxPDF 1.0)"
         this.sObj = this.sObj + LF + "/Producer (" + this.sProducer + ")"
         this.sObj = this.sObj + LF + "/Title ("    + this.sTitle    + ")"
         this.sObj = this.sObj + LF + "/Subject ("  + this.sSubject  + ")"
         this.sObj = this.sObj + LF + "/Author ("   + this.sAuthor   + ")"

         &&Ecriture de l'entête
         this.WriteObject()

        &&Font REGULAR
         this.nObject = 4
         this.sObj = "/Type /Font"
         this.sObj = this.sObj + LF + "/Subtype /Type1"
         this.sObj = this.sObj + LF + "/Name /F1"
         this.sObj = this.sObj + LF + "/Encoding 8 0 R"
         this.sObj = this.sObj + LF + "/BaseFont /Courier"
        this.WriteObject()

       &&Font ITALIC
       this.nObject = this.nObject + 1
       this.sObj = "/Type /Font"
       this.sObj = this.sObj + LF + "/Subtype /Type1"
       this.sObj = this.sObj + LF + "/Name /F2"
       this.sObj = this.sObj + LF + "/Encoding 8 0 R"
       this.sObj = this.sObj + LF + "/BaseFont /Courier-Oblique"
       this.WriteObject()

       &&Font BOLD
       this.nObject = this.nObject + 1
       this.sObj = "/Type /Font"
       this.sObj = this.sObj + LF + "/Subtype /Type1"
       this.sObj = this.sObj + LF + "/Name /F3"
       this.sObj = this.sObj + LF + "/Encoding 8 0 R"
       this.sObj = this.sObj + LF + "/BaseFont /Courier-Bold"
       this.WriteObject()

       &&Font BOLD Italic
       this.nObject = this.nObject + 1
       this.sObj = "/Type /Font"
       this.sObj = this.sObj + LF + "/Subtype /Type1"
       this.sObj = this.sObj + LF + "/Name /F4"
       this.sObj = this.sObj + LF + "/Encoding 8 0 R"
       this.sObj = this.sObj + LF + "/BaseFont /Courier-BoldOblique"
       this.WriteObject()

      &&Font Encoding
      this.nObject = this.nObject + 1
      this.sObj = "/Type /Encoding"
      this.sObj = this.sObj + LF + "/BaseEncoding /WinAnsiEncoding"
      this.WriteObject()

      &&Fonts object
      this.nObject = this.nObject + 1
      this.sObj = " /Font << /F1 4 0 R /F2 5 0 R /F3 6 0 R /F4 7 0 R >>"
      this.sObj = this.sObj + LF + " /ProcSet [ /PDF /Text ]"
      this.WriteObject()
      ENDIF

      RETURN this.nPDfHandle
   ENDFUNC


   &&Fermeture et enregistrement du fichier PDF natif
   PROCEDURE ClosePDF()
      PRIVATE nCpt,;
              nOffset

      IF this.nPDfHandle > 0
         this.EndPage()

         &&Ectiture du Catalogue
        this.sObj = "2 0 obj"
        this.sObj = this.sObj + LF + "<<"
        this.sObj = this.sObj + LF + "/Type /Catalog"
        this.sObj = this.sObj + LF + "/Pages 3 0 R"
        this.sObj = this.sObj + LF + "/PageLayout /OneColumn"
        this.sObj = this.sObj + LF + ">>"
        this.sObj = this.sObj + LF + "endobj"
         nOffset = this.WriteTextObjet()
         this.tbObjectsRefs(2) = ALLTRIM(STR(nOffset))

         &&Gestion des pages
        this.sObj = "3 0 obj"
        this.sObj = this.sObj + LF + "<<"
        this.sObj = this.sObj + LF + "/Type /Pages"
        this.sObj = this.sObj + LF + "/Count " + ALLTRIM(STR(this.nPages))
        this.sObj = this.sObj + LF + "/MediaBox [ 0 0 " + ALLTRIM(str(this.nPaperWidth)) + " " + ALLTRIM(str(this.nPaperHeight)) + " ]"
        this.sObj = this.sObj + LF + "/Kids [ "

       FOR nCpt = 1 To this.nPages
            this.sObj = this.sObj + ALLTRIM(str(this.tbPages(nCpt))) + " 0 R "
         ENDFOR
        this.sObj = this.sObj + "]"
        this.sObj = this.sObj + LF + ">>"
        this.sObj = this.sObj + LF + "endobj"
        nOffset = this.WriteTextObjet()
         this.tbObjectsRefs(3) = ALLTRIM(STR(nOffset))

         && Références croisées
        this.nObject = this.nObject + 1
        this.sObj = "xref"
        this.sObj = this.sObj + LF + "0 " + ALLTRIM(str(this.nObject))
        this.sObj = this.sObj + LF + "0000000000 65535 f "

         FOR nCpt = 1 To this.nObject - 1
           this.sObj = this.sObj + CR + padl(this.tbObjectsRefs(nCpt), 10, '0') + " 00000 n "
        ENDFOR
        this.sObj = this.sObj + CR + "trailer"
        nOffset = this.WriteTextObjet()

       && Trailer
       this.sObj = "<<"
       this.sObj = this.sObj + LF + "/Size " + ALLTRIM(str(this.nObject))
       this.sObj = this.sObj + LF + "/Root 2 0 R"
       this.sObj = this.sObj + LF + "/Info 1 0 R"
       this.sObj = this.sObj + LF + ">>"
       this.sObj = this.sObj + LF + "startxref"
       this.sObj = this.sObj + LF + ALLTRIM(str(nOffset))
       this.sObj = this.sObj + LF + "%%EOF"
       this.WriteTextObjet()
       FCLOSE(this.nPDfHandle)
       this.nPDfHandle = -1
      ENDIF
   ENDPROC

   &&Ajout d'une nouvelle page
   PROCEDURE NewPage()
      private nLen,;
              nOffset

    && Fermeture de la page précédente
     If this.nPages > 0
       this.EndPage()
    ENDIF

      && Page resources
    this.nObject = this.nObject + 1
    this.sObj = "/Type /Page"
    this.sObj = this.sObj + LF + "/Parent 3 0 R"
     this.sObj = this.sObj + LF + "/Resources 9 0 R"
     this.sObj = this.sObj + LF + "/Contents " + ALLTRIM(str(this.nObject + 1)) + " 0 R"
     this.WriteObject()

    && Référence l'objet en tant que page
    this.nPages = this.nPages + 1
    DIMENSION this.tbPages(this.nPages)
    this.tbPages(this.nPages) = this.nObject

    && Défini un objet contenant la longueur de la page
     this.nObject = this.nObject + 1
     this.sObj = ALLTRIM(str(this.nObject)) + " 0 obj"
     this.sObj = this.sObj + LF + "<<"
     this.sObj = this.sObj + LF + "/Length " + ALLTRIM(str(this.nObject + 1)) + " 0 R"
     this.sObj = this.sObj + LF + ">>"
     this.sObj = this.sObj + LF + "stream"
     this.sObj = this.sObj + LF + "BT"
     nOffset = this.WriteTextObjet()
     DIMENSION this.tbObjectsRefs(this.nObject)
      this.tbObjectsRefs(this.nObject) = ALLTRIM(STR(nOffset))


     && Récupère la position du flux de données
     this.nStartStream = nOffset + Len(this.sObj) - 5

    this.sObj = "/F" + ALLTRIM(str(this.nFontType)) + " " + ALLTRIM(str(this.nFontSize)) + " Tf"
     this.WriteTextObjet()

    this.SetOrigin(this.nLeftMargin, this.nPaperHeight - this.nTopMargin, this.nDegree)
   ENDPROC


   &&Ecriture du texte sText dans le fichier PDF
   PROCEDURE WriteText(sText As String, bNewRow As Boolean)
      PRIVATE sRestoreFont

      this.sObj = "/F" + ALLTRIM(str(this.nFontType)) + " " + ALLTRIM(str(this.nFontSize)) + " Tf" + LF
      sRestoreFont = LF + "/F" + ALLTRIM(str(this.nFontType)) + " " + ALLTRIM(str(this.nFontSize)) + " Tf"

    IF bNewRow Then
       this.sObj = this.sObj + "T* "
    ENDIF

      this.sObj = this.sObj + "(" + sText + ") Tj"
      this.sObj = this.sObj + sRestoreFont
      this.WriteTextObjet()

   ENDPROC


   &&Ecriture du texte multi-lignes sText dans le fichier PDF
   PROCEDURE WriteMultiLineText(sText As String, bNewRow As Boolean)
      PRIVATE sStartObj,;
              sRestoreFont,;
              nCpt,;
              sLine,;
              nBegin,;
              nlen

      nLineCount = OCCURS(CR + LF, sText)
      sStartObj =  "/F" + ALLTRIM(str(this.nFontType)) + " " + ALLTRIM(str(this.nFontSize)) + " Tf" + LF
      sRestoreFont = LF + "/F" + ALLTRIM(str(this.nFontType)) + " " + ALLTRIM(str(this.nFontSize)) + " Tf"
    IF bNewRow Then
       sStartObj = sStartObj + "T* "
    ENDIF
      FOR nCpt = 1 TO nLineCount
          DO CASE
             CASE nCpt = 1
                  nBegin = 1
                  nLen = AT(CR + LF, sText, nCpt)
           CASE nCpt = nLineCount
                nBegin = AT(CR + LF, sText, nCpt) + 2
                nLen = LEN(sText) - nBegin + 2
           OTHERWISE
                nBegin = AT(CR + LF, sText, nCpt - 1) + 2
                nLen = AT(CR + LF, sText, nCpt) - nBegin
        ENDCASE
        sLine = SUBSTR(sText, nBegin, nLen)
          this.sObj = sStartObj + "(" + sLine + ") Tj"
          this.sObj = this.sObj + sRestoreFont
          this.WriteTextObjet()
      ENDFOR
   ENDPROC


   &&Défini l'origine du document ainsi que l'angle de rotation utilisé
   PROTECTED PROCEDURE SetOrigin(nStartX As Long, nStartY As Long, nDegree As Long)
      PRIVATE a, b, c, d,;
              nPi

      nPi = 3.141592654
      a = Cos(nPI * nDegree / 180)
      b = Sin(nPI * nDegree / 180)
      c = -b
      d = a

      this.sObj = ALLTRIM(str(a, 3))    + " " + ;
                    ALLTRIM(str(b, 3))    + " " + ;
                    ALLTRIM(str(c, 3))    + " " + ;
                    ALLTRIM(str(d, 3))    + " " + ;
                    ALLTRIM(Str(nStartX)) + " " + ;
                    ALLTRIM(Str(nStartY)) + " Tm"

      this.WriteTextObjet()
     this.sObj = ALLTRIM(str(this.nVertSpace)) + " TL"

      this.WriteTextObjet()
   ENDPROC


   &&Ajoute un objet dans le fichier PDF
   PROTECTED PROCEDURE WriteObject()
      PRIVATE nOffset,;
               sObjectBuf

      sObjectBuf = this.sObj
      this.sObj = ALLTRIM(str(this.nObject)) + " 0 obj"
      this.sObj = this.sObj + LF + "<<"
      this.sObj = this.sObj + LF + sObjectBuf
      this.sObj = this.sObj + LF + ">>"
      this.sObj = this.sObj + LF + "endobj"
      nOffset = this.WriteTextObjet()
      DIMENSION this.tbObjectsRefs(this.nObject)
      this.tbObjectsRefs(this.nObject) = ALLTRIM(STR(nOffset))
   ENDPROC


   && Ecrit un objet donné sous forme de texte dans le fichier pdf et retourne sa position
   PROTECTED FUNCTION WriteTextObjet() As Long
        PRIVATE nSeek

       nSeek = FSEEK(this.nPDfHandle, 0, 2)
        FWRITE(this.nPDfHandle, this.sObj + LF)
        RETURN nSeek
   ENDFUNC


   &&Finalisation de la dernière page
   PROTECTED PROCEDURE EndPage()
    PRIVATE nLen,;
              nOffset

     this.sObj = "ET"
     this.sObj = this.sObj + LF + "endstream"
     this.sObj = this.sObj + LF + "endobj"

    && Calcul de la longueur de la page
      nLen = this.WriteTextObjet() - this.nStartStream
      this.nObject = this.nObject + 1
      this.sObj = ALLTRIM(str(this.nObject)) + " 0 obj"
      this.sObj = this.sObj + LF + ALLTRIM(str(nLen))
      this.sObj = this.sObj + LF + "endobj"
      nOffset = this.WriteTextObjet()
      DIMENSION this.tbObjectsRefs(this.nObject)
      this.tbObjectsRefs(this.nObject) = ALLTRIM(STR(nOffset))
   ENDPROC


  &&Ca c'est la méthode init
  PROTECTED procedure init()
      this.nObject = 0
      this.nPages = 0
      this.nStartStream = 0
      this.nPaperWidth = 595
      this.nPaperHeight = 842
   ENDPROC

ENDDEFINE
Commentaires
le 07/09/2009, Ludo186 a écrit :
Super MERCI
As tu les morceaux pour Ajouter des image et des formes géometriques ?
Publicité

Les pubs en cours :
www.atoutfox.org - Site de la Communauté Francophone des Professionnels FoxPro - v3.4.0 - © 2004-2024.
Cette page est générée par un composant COM+ développé en Visual FoxPro 9.0-SP2-HF3