Retrouver la position d'un champ

[mutsum1]

Bonjour,

Sur un écran, le mot-clé DSPATR( &var ) permet de s'affranchir de l'utilisation d'indicateurs. Cette fonctionnalité permet en effet de gérer les couleurs et autres attributs de la zone via la variable.
Sur les écrans complexes, on obtient ainsi un code plus clair en évitant de multiplier les indicateurs nécessaires.

Malheureusement, cette fonctionnalité permet de gérer tous les attributs sauf le positionnement du curseur ( PC ), et les deux fonctions sont incompatibles.

Si on veut utiliser DSPATR( &var ), il faut donc soit se passer de positionner le curseur, soit le faire par un autre moyen.
La fonction CSRLOC serait une possibilité, mais elle n'accepte en paramètres que la position (ligne/colonne).

Je vous propose donc un petit programme qui permet de retrouver la position d'un champ en fonction de son nom. Elle permet donc l'utilisation de la fonction CSRLOC, et par là-même le DSPATR( &var ).

Ce programme est basé sur l'API QDFRTVFD, qui permet de lire un fichier écran.
Il a été traduit du C à partir du programme d'IBM situé ici.

Il attend en paramètres le nom du fichier écran, le nom du format, et le nom de la zone. Il retourne la position du champ s'il existe, 0 sinon.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
     H DFTACTGRP(*NO)

     D RtvDspFD        PR                  extpgm('QDFRTVFD')
     D  RcvVar                        1    options(*varsize)
     D  LenRcvVar                    10i 0 const
     D  Format                        8    const
     D  QualDspF                     20    const
     D  ErrCde                             LIKEDS(QUSEC)

     D CvtHex          PR             3  0
     D                                1    const

     D QualDspF        DS
     D  DspFName                     10
     D  DspFLib                      10    inz('*LIBL')

     D I               S             10i 0
     D J               S             10i 0
     D K               S             10i 0
     D L               S             10i 0

     D BasePtr         S               *
     D BaseInfo        DS                  LIKEDS(QDFFBASE) BASED(BasePtr)

     D InfoPtr         S               *
     D InfoInfo        DS                  LIKEDS(QDFFINFO) BASED(InfoPtr)

     D RftePtr         S               *
     D RfteInfo        DS                  LIKEDS(QDFARFTE) BASED(RftePtr)

     D RinfPtr         S               *
     D RinfInfo        DS                  LIKEDS(QDFFRINF) BASED(RinfPtr)

     D RdpdPtr         S               *
     D RdpdInfo        DS                  LIKEDS(QDFFRDPD) BASED(RdpdPtr)

     D RctbPtr         S               *
     D RctbInfo        DS                  LIKEDS(QDFFRCTB) BASED(RctbPtr)

     D FleiPtr         S               *
     D FleiInfo        DS                  LIKEDS(QDFWFLEI) BASED(FleiPtr)

     D NtblPtr         S               *
     D NtblInfo        DS                  LIKEDS(QDFFNTBL) BASED(NtblPtr)

     D RcdiPtr         S               *
     D RcdiInfo        DS                  LIKEDS(QDFWRCDI) BASED(RcdiPtr)

     D FldiPtr         S               *
     D FldiInfo        DS                  LIKEDS(QDFWFLDI) BASED(FldiPtr)

     D RctePtr         S               *
     D RcteInfo        DS                  LIKEDS(QDFFRCTE) BASED(RctePtr)

     D NamePtr         S               *
     D NameInfo        S             10    BASED(NamePtr)

     D InlRcvVar       DS                  QUALIFIED
     D  BytRtn                       10i 0
     D  BytAvl                       10i 0

      /copy QSYSINC/QRPGLESRC,QDFRTVFD
      /copy QSYSINC/QRPGLESRC,QUSEC

     C     *ENTRY        PLIST
     C                   PARM                    DspFile          10
     C                   PARM                    DspFrmt          10
     C                   PARM                    DspField         10
     C                   PARM                    Row               3 0
     C                   PARM                    Col               3 0

      /free

       DspFName = DspFile;
       Row = 0;
       Col = 0;

       // Lit la structure du fichier

       RtvDspFD( InlRcvVar : %size(InlRcvVar) : 'DSPF0100' : QualDspF : QUSEC );
       BasePtr = %alloc( InlRcvVar.BytAvl );

       RtvDspFD( BaseInfo  : InlRcvVar.BytAvl : 'DSPF0100' : QualDspF : QUSEC );

       InfoPtr = BasePtr + BaseInfo.QDFFINOF;              // File Header Section
       RftePtr = InfoPtr + InfoInfo.QDFFDFLO;              // Record Format Table

       // Recherche l'index du format demandé

       FOR I = 1 TO BaseInfo.QDFFFRCS;

         IF RfteInfo.QDFARFNM <> DspFrmt;
           RftePtr += %size( RfteInfo );                   // Format suivant
         ELSE;

           RinfPtr = InfoPtr + RfteInfo.QDFARFOF;          // Record Header Section
           RdpdPtr = RinfPtr + RinfInfo.QDFFRAOF;          // Display-Record-Level Device Section
           RctbPtr = RinfPtr + RdpdInfo.QDFFDRCO;          // Row-Column Table

           FleiPtr = InfoPtr + InfoInfo.QDFFWUOF;          // Where Used File Information
           NtblPtr = FleiPtr + FleiInfo.QDFWNTBO;          // Field Name table pointer
           NamePtr = NtblPtr + %size( NtblInfo.QDFFFNMS );

           // Recherche l'index du champ demandé

           FOR J = 1 TO NtblInfo.QDFFFNMS;

             IF NameInfo <> DspField ;
               NamePtr += 10;                              // Champ suivant
             ELSE;

               // Accède aux données du format et du champ

               RcdiPtr = FleiPtr + FleiInfo.QDFWXLEN;      // Where-Used Record Information Struct.
               FOR K = 1 TO BaseInfo.QDFFFRCS;

                 IF K <> I;
                   RcdiPtr += RcdiInfo.QDFWNXTR;
                 ELSE;

                   FldiPtr = RcdiPtr + RcdiInfo.QDFWRLEN;  // Where-Used Field Information Structure
                   FOR L = 1 TO RinfInfo.QDFFFFLD;

                     IF FldiInfo.QDFWNMEI <> J;
                       FldiPtr += FldiInfo.QDFWFLDL;
                     ELSE;

                       RctePtr = RctbPtr + %size( RctbInfo );
                       RctePtr = RctePtr + (( FldiInfo.QDFWRRDX - 1 ) * 2 );

                       Row = CvtHex( RcteInfo.QDFFSROW );
                       Col = CvtHex( RcteInfo.QDFFSCOL ) + 1;

                       IF Row = 255;
                         Row = 0;
                       ENDIF;
                       IF Col = 256;
                         Col = 0;
                       ENDIF;

                       LEAVE;
                     ENDIF;
                   ENDFOR;

                   LEAVE;
                 ENDIF;
               ENDFOR;

               LEAVE;
             ENDIF;
           ENDFOR;

           LEAVE;
         ENDIF;

       ENDFOR;

       DEALLOC BasePtr;

       *INLR = *ON;
       RETURN;

      /end-free

     P CvtHex          B
     D CvtHex          PI             3  0
     D   Character                    1A   CONST
     D                 DS
     D DSNum                          5I 0 INZ( 0 )
     D DSChar                         1A   OVERLAY( DSNum : 2 )
     C                   EVAL      DSChar = Character
     C                   RETURN    DSNum
     P CvtHex          E

Travaillez-bien

[m4k-Hurrican]

Sympa çà.
Il faudra que je teste ce que çà donne avec des fenêtres.

[tonino77]

bjr ou se trouve

/copy QSYSINC/QRPGLESRC,QDFRTVFD
/copy QSYSINC/QRPGLESRC,QUSEC

[FORMULARY]

Les /copy font référence à des sources pour include situés dans la bibliothèque QSYSINC
Elle ne se trouve sur ton système que si tu as installé l'option 13 de l'OS. (System openness includes)
Je ne sais plus si elle figure toujours sur les CD d'installation ou seulement si on a acheté les outils de développement avec.

[mutsum1]

Je t'ai fait un zip des /copy.
Tu pourras compiler.

[tonino77]

Envoyé par mutsum1

Je t'ai fait un zip des /copy.
Tu pourras compiler.

merci