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

Comment imprimer automatiquement un état à partir d'un grid   


L'auteur

Jean-Fançois Sant
France France
Membre Simple
# 0000000037
enregistré le 18/10/2004

http://www.convisav.com
Sant Jean-François
de la société ECOR informatique
Fiche personnelle

Note des membres
19/20
1 vote

Contributions > 03 - FRX : Etat, impression, Report

Comment imprimer automatiquement un état à partir d'un grid
# 0000000226
ajouté le 01/08/2005 16:04:46 et modifié le 05/08/2005
consulté 11633 fois
Niveau débutant

Version(s) Foxpro :
VFP 9.0
VFP 8.0
VFP 7.0
VFP 6.0
Zoomer sur l'image
Description

La procédure ci-dessous est à créer dans une méthode du grid - gridtoprint par exemple -

Cette méthode déclenchée par du code ou un bouton du formulaire ou d'une barre d'outil permet d'imprimer le contenu d'un grid quelconque d'un formulaire
Voir fonctionnement à partir d'une barre d'outil dans l'appli de démo ConviSAV sur www.convisav.com

Caractéristiques :
- imprime les colonnes du grid avec les dimensions du grid
- imprime les entêtes de colonnes sur une ou plusieurs lignes
- permet de rajouter un titre au rapport (passé en paramètre)
- identifie l'état en pied de page - date et n° de page
- imprime en mode paysage si une barre de scroll horizontale est détectée dans le grid
- utilise les mêmes polices que celle du grid
- imprime dans l'ordre de tri du grid

Devrait fonctionner en VFP9 mais non testé. Si quelqu'un le teste sous VFP9 qu'il m'en informe ....
OK pour VFP9. Merçi Thierry

05/08/2005 : code modifié pour la portabilité VFP6 à VFP9.

Code source :
Lparameters ctitre
* cette méthode est à intégrer dans un grid car elle fait référence à celui-ci
*
* le titre de l'état est passé en paramètre
* mais il pourrait également être traité à partir d'une propriété du grid

DECLARE integer GetDC IN WIN32API integer
DECLARE integer GetDeviceCaps IN WIN32API integer, integer

#Define LOGPIXELSX    88    && Logical pixels/inch in X
#Define LOGPIXELSY    90    && Logical pixels/inch in Y

Local i, j, calias, cnomfrx, cnomfrt, cfield, nhDCmain, ndpiscreen, nheaderheight, cnomch
calias=Alias()

* paramètres affichage
nhDCmain = GetDC(0)
ndpiscreen=GetDeviceCaps(nhDCmain,LOGPIXELSY)

if version(5) >= "700"
    cnomfrx=Home(7)+Sys(3)
else
    cnomfrx=sys(5)+curdir()+sys(3)
endif
cnomfrt=cnomfrx+".frt"
cnomfrx=cnomfrx+".frx"

cfield=""
With This
    Local Array atabchamp(.ColumnCount,11), acursor(.ColumnCount,4)
    nheaderheight=This.HeaderHeight
    For i = 1 To .ColumnCount
        acursor(i,1)="champ"+Ltrim(Str(i,3))
        acursor(i,2)="C"
        acursor(i,3)=1
        acursor(i,4)=0
        cnomch=.Columns(i).ControlSource
        atabchamp(i,1)=Iif(Not Empty(cnomch),cnomch,'" "')
        atabchamp(i,2)=.Columns(i).Width
        atabchamp(i,3)=.Columns(i).ColumnOrder
        atabchamp(i,4)=.Columns(i).FontName
        atabchamp(i,5)=.Columns(i).FontSize
        if version(5) >= "700"
           atabchamp(i,7)=.columns(i).header1.wordwrap
        else
           atabchamp(i,7)=.F.
        endif
        atabchamp(i,6)=.Columns(i).header1.Caption
        atabchamp(i,7)=.Columns(i).header1.WordWrap
        atabchamp(i,8)=.Columns(i).header1.FontName
        atabchamp(i,9)=.Columns(i).header1.FontSize
        atabchamp(i,10)=""+Iif(.Columns(i).FontBold,"B","")+Iif(.Columns(i).FontItalic,"I","")++Iif(.Columns(i).FontUnderline,"U","")
        atabchamp(i,11)=""+Iif(.Columns(i).header1.FontBold,"B","")+Iif(.Columns(i).header1.FontItalic,"I","")++Iif(.Columns(i).header1.FontUnderline,"U","")
    Endfor
    =Asort(atabchamp,3)   && tri par ordre de colonnes
    Create Cursor prepfrx From Array acursor
Endwith
Create Report (cnomfrx) From prepfrx
Select prepfrx
Use
Use (cnomfrx) In 0 Exclus Alias gridfrx
Select gridfrx
* Mettre en mode paysage si barre de défilement horizontale
If This.ScrollBars= 1 Or This.ScrollBars= 3
    Replace Expr With Strtran(Expr,"ORIENTATION=0","ORIENTATION=1") For objtype=1
Endif
* identifier les champs du pied de page et ligne détail
Replace All User With "PIED" For objtype=5 And Expr='"Page "'
Replace All User With "PIED" For objtype=8 And Upper(Expr)="DATE()"
Replace All User With "PIED" For objtype=8 And Upper(Expr)="_PAGENO"
Replace All User With "DETAIL" For objtype=8 And !User=="PIED"

* mémoriser le 1er champ de l'entete pour le mettre en titre
Local oenrtitre, nhpos, oenrentete
Locate For objtype=5 And objcode = 0
Scatter Name oenrtitre Memo
* dimensionner entete
Locate For objtype=9 And objcode=1
If Found()
    noldheight=Height
    Replace Height With Height+2*noldheight && rajouter une ligne titre + 1 ligne blanche
    Replace All User With "ENTETE" For objtype=5 And !User=="PIED"
    Replace All vpos With vpos+(noldheight * 2) For objtype=5 And User=="ENTETE" && et repositionner les champs entetes
* tenir compte de la hauteur entete grid
    Locate For objtype=9 And objcode=1
    Replace Height With (Height-noldheight) + This.HeaderHeight*10000/ndpiscreen
    nnewheight=Height
* repositionner les champs
    If Height > noldheight
        Replace All vpos With vpos+(nnewheight-noldheight) For objtype=8 Or User == "PIED"
    Endif
Endif
* ajuster les largeurs des champs du FRX à celles du grid
* pour l'entête
i=1
nhpos=500
Scan For objtype = 5 And i <= Alen(atabchamp,1)
** convertir à la résolution de l imprimante
    Replace Width With (atabchamp(i,2)*10000/ndpiscreen), ;
        expr With '"'+Alltrim(atabchamp(i,6))+'"', ;
        fontface With atabchamp(i,8), ;
        fontsize With atabchamp(i,9), ;
        fontstyle With Iif(At("B",atabchamp(i,10)) # 0,1,0) ;
        +Iif(At("I",atabchamp(i,10)) # 0,2,0) ;
        +Iif(At("U",atabchamp(i,10)) # 0,4,0), ;
        hpos With nhpos
    If atabchamp(i,7) && entete sur plusieurs lignes
        If (Txtwidth(Expr,fontface,FontSize,atabchamp(i,11)) * Fontmetric(6,fontface,FontSize,atabchamp(i,11))) > atabchamp(i,2)
            Local cexpr,centet
            cexpr=Chrtran(Expr,'"','')
            centet='"'
            j=1
            Do While .T.
                If (Txtwidth(Left(cexpr,j),fontface,FontSize,atabchamp(i,11)) * Fontmetric(6,fontface,FontSize,atabchamp(i,11))) > atabchamp(i,2)
                    centet=centet+Iif(Len(centet) > 1,Chr(13),"")+Alltrim(Left(cexpr,j-1))
                    cexpr=Substr(cexpr,j)
                    j=1
                    Loop
                Endif
                j=j+1
                If j > Len(cexpr)
                    centet=centet+Chr(13)+Alltrim(cexpr)+'"'
                    Exit
                Endif
            Enddo
            Replace Expr With centet
        Endif
    Endif
    i=i+1
    nhpos = nhpos+Width+500
Endscan
* pour le détail
i=1
nhpos=500
Scan For objtype = 8 And i <= Alen(atabchamp,1)
    cnomch=atabchamp(i,1)
    Replace Width With (atabchamp(i,2)*10000/ndpiscreen), ;
        expr With Iif(Type(cnomch)="L","iif("+cnomch+",'X',' ')",cnomch), ;
        fontface With atabchamp(i,4), ;
        fontsize With atabchamp(i,5), ;
        picture With "", ;
        hpos With nhpos, Stretch With .F.
    i=i+1
    nhpos = nhpos+Width+500
Endscan
* mettre un cadre autour de l'entete des colonnes
Select Max(hpos+Width) From (cnomfrx) Into Array amaxwidth Where Inlist(objtype,5,8) And User="DETAIL"
Locate For objtype=5 And User ="ENTETE"
Scatter Name oenrentete Memo
Insert Blank Before
Gather Name oenrentete Memo
Replace objtype With 7, objcode With 4, Expr With "", hpos With 0.000, vpos With vpos - 200, ;
    height With This.HeaderHeight*10000/ndpiscreen, Width With amaxwidth(1), pensize With 1, penpat With 8, fillpat With 0, User With "CADRE"
* rajouter la ligne de titre
Locate For objtype=5 And objcode = 0
Insert Blank Before
Gather Name oenrtitre Memo
Replace Expr With "'"+ctitre+"'", hpos With 0.000, fontface With "Arial", FontSize With 11,fontstyle With 1, User With "TITRE"
Replace Width With Txtwidth(Expr,fontface,FontSize+2,"B") * Fontmetric(6,fontface,FontSize+2,"B") * 10000/ndpiscreen
* centrer le titre
Replace hpos With (amaxwidth(1) - Width ) / 2
Use
* exécuter le report
Select (This.RecordSource)
* en impresssion
*report form (cnomfrx) all noconsole to printer nodialog
* ou en previsu
Report Form (cnomfrx) All Preview Noconsole
Delete File (cnomfrx)
Delete File (cnomfrt)

Select &calias
Commentaires
le 01/08/2005, Thierry a écrit :
Il manque les déclarations suivantes :

DECLARE integer GetDC IN WIN32API integer
DECLARE integer GetDeviceCaps IN WIN32API integer, integer

Sinon, tout fonctionne bien en VFP9. Bravo !
le 02/08/2005, Jean-Fançois Sant a écrit :
Merçi Thierry pour le test en VFP9.

J'avais effectivement oublié d'intégrer les déclarations ...
le 03/08/2005, FoxInCloud (Th. Nivelet) a écrit :
Tu peux gérer les variantes selon les versions de VFP avec :
#IF Version(5) >= 700
&& code version 7+
#ELSE
&& code version 6-
#ENDIF
le 06/01/2006, FG82 a écrit :
Euh, je suis fort intéressé, mais comment je rajoute une méthode à un grid ??? à un formulaire je sais faire, mais pas à un grid :(
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