1 : C TBAFNT SOURCE PV 05/09/22 21:27:03 5181 2 : c subroutine utilisee dans tableau 3 : *************************************************** 4 : * 5 : * AFFICHE LE TITRE SOUS TITRE ET DATE 6 : * A LA BONNE POSITION 7 : * 8 : *************************************************** 9 : SUBROUTINE TBAFNT ( IPX, IPY, TABTR ) 10 : * 11 : * DEFINITION DES VARIABLES 12 : * 13 : IMPLICIT INTEGER(I-N) 14 : -INC TMNTAB 15 : -INC SMLENTI 16 : -INC CCOPTIO 17 : INTEGER IPX,IPY 18 : INTEGER IEX,IX,IDEBX,IFINX,IXD 19 : INTEGER IEY,IY,IDEBY,IFINY,IYD 20 : INTEGER NBC,ICOUL 21 : CHARACTER*128 TMPCAR 22 : REAL*4 RXPOS,RYPOS,HMIN 23 : POINTEUR LI.MLENTI 24 : LOGICAL ZH,ZB,ZG,ZD,ZGH,ZGB,ZGG,ZGD 25 : LOGICAL ZZH,ZZB,ZZGH,ZZGB 26 : INTEGER N,NBMCX,A,B 27 : * 28 : LI = 0 29 : * 30 : * AFFICHAGE DU TITRE 31 : * 32 : ICOUL = TABTR.ITITC 32 : CALL CHCOUL (ICOUL) 33 : TMPCAR = TABTR.TITGEN 33 : CALL CFORMA (TMPCAR,66,NBMCX,LI) 34 : IF (LI.EQ.0) GOTO 1202 35 : RXPOS = 1. 36 : IF (ZHORIZ) THEN 37 : RYPOS = 20.5 38 : ELSE 39 : RYPOS = 29.2 40 : ENDIF 41 : SEGACT LI 42 : DO 1201 N=1 , NBMCX 43 : A = LI.LECT (2*N-1) 44 : B = LI.LECT (2*N) 45 : NBC = B-A+1 45 : CALL TRLABL (RXPOS,RYPOS,0.,TMPCAR (A:B),NBC,HMIN) 46 : RYPOS = RYPOS - 0.5 47 : 1201 CONTINUE 48 : SEGSUP LI 49 : 1202 CONTINUE 50 : * 51 : * AFFICHAGE DU SOUS TITRE 52 : * 53 : TMPCAR = TABTR.SSTITR 53 : CALL CFORMA (TMPCAR,66,NBMCX,LI) 54 : IF (LI.EQ.0) GOTO 1204 55 : RXPOS = 1. 56 : IF (ZHORIZ) THEN 57 : RYPOS = 19.5 58 : ELSE 59 : RYPOS = 28.2 60 : ENDIF 61 : SEGACT LI 62 : DO 1203 N=1 , NBMCX 63 : A = LI.LECT (2*N-1) 64 : B = LI.LECT (2*N) 65 : NBC = B-A+1 65 : CALL TRLABL (RXPOS,RYPOS,0.,TMPCAR (A:B),NBC,HMIN) 66 : RYPOS = RYPOS - 0.5 67 : 1203 CONTINUE 68 : SEGSUP LI 69 : 1204 CONTINUE 70 : * 71 : * AFFICHAGE DE LA DATE 72 : * 73 : IF ( TABTR.ZDATE ) THEN 73 : CALL GIBDAT (JOUR,MOIS,IANNEE) 74 : iannee=mod(iannee,100) 75 : TMPCAR (1:14)='Le 00/00/ ' 76 : WRITE (TMPCAR (4:5),FMT=' (I2)') JOUR 77 : WRITE (TMPCAR (7:8),FMT=' (I2)') MOIS 78 : WRITE (TMPCAR (10:11),FMT=' (I2)') IANNEE 79 : IF (ZHORIZ) THEN 80 : RXPOS = 20. 81 : RYPOS = 19.5 82 : ELSE 83 : RXPOS = 15. 84 : RYPOS = 28.2 85 : ENDIF 85 : CALL TRLABL (RXPOS,RYPOS,0.,TMPCAR (1:14),14,HMIN) 86 : ENDIF 87 : * 88 : * AFFICHAGE DES TIRES DE COLONNES 89 : * 90 : IXD = TABTR.IHDEC (IPX,IPY) 91 : IYD = TABTR.IVDEC (IPX,IPY) 92 : IDEBX = TABTR.CSGX (IPX,IPY) 93 : IFINX = TABTR.CIDX (IPX,IPY) 94 : IX=2+IXD 95 : DO 1210 IEX=IDEBX , IFINX 96 : LI = 0 97 : IF (TABTR.ZAULIG) THEN 98 : ZG = .TRUE. 99 : ZH = .TRUE. 100 : ZD = .TRUE. 101 : ZB = .TRUE. 102 : ZGG = TABTR.ZGVSEP (IEX ,1 ) 103 : ZGH = TABTR.ZGHSEP (IEX ,1 ) 104 : ZGD = TABTR.ZGVSEP (IEX+1,1 ) 105 : ZGB = .TRUE. 106 : ELSE 107 : ZG = TABTR.ZVSEP (IEX ,1 ) 108 : ZH = TABTR.ZHSEP (IEX ,1 ) 109 : ZD = TABTR.ZVSEP (IEX+1,1 ) 110 : ZB = TABTR.ZHSEP (IEX ,2 ) 111 : ZGG = TABTR.ZGVSEP (IEX ,1 ) 112 : ZGH = TABTR.ZGHSEP (IEX ,1 ) 113 : ZGD = TABTR.ZGVSEP (IEX+1,1 ) 114 : ZGB = TABTR.ZGHSEP (IEX ,2 ) 115 : ENDIF 116 : TMPCAR = TABTR.TITCOL (IEX) 117 : IF (TABTR.IHTCOL.EQ.1) THEN 118 : ICOUL = TABTR.ICOLC 118 : CALL TBAFNC (TMPCAR,ICOUL,IX,5+IYD,ZH,ZB,ZG,ZD 119 : > ,ZGH,ZGB,ZGG,ZGD,TABTR) 120 : ELSE 120 : CALL CFORMA (TMPCAR,12,NBMCX,LI) 121 : IF (LI.EQ.0) GOTO 1210 122 : SEGACT LI 123 : DO 1240 N=1 , TABTR.IHTCOL 124 : IF (N.EQ.1) THEN 125 : ZZH = ZH 126 : ZZGH = ZGH 127 : ELSE 128 : ZZH = .FALSE. 129 : ZZGH = .FALSE. 130 : ENDIF 131 : IF (N.EQ.TABTR.IHTCOL) THEN 132 : ZZB = ZB 133 : ZZGB = ZGB 134 : ELSE 135 : ZZB = .FALSE. 136 : ZZGB = .FALSE. 137 : ENDIF 138 : IF (N.LE.NBMCX) THEN 139 : A = LI.LECT (2*N-1) 140 : B = LI.LECT (2*N) 141 : ICOUL = TABTR.ICOLC 141 : CALL TBAFNC (TMPCAR (A:B),ICOUL,IX,4+N+IYD,ZZH,ZZB,ZG,ZD 142 : > ,ZZGH,ZZGB,ZGG,ZGD,TABTR) 143 : ELSE 144 : TMPCAR = ' ' 145 : ICOUL = TABTR.ICOLC 145 : CALL TBAFNC (TMPCAR,ICOUL,IX,4+N+IYD,ZZH,ZZB,ZG,ZD 146 : > ,ZZGH,ZZGB,ZGG,ZGD,TABTR) 147 : ENDIF 148 : 1240 CONTINUE 149 : SEGSUP LI 150 : ENDIF 151 : IX = IX + 1 152 : 1210 CONTINUE 153 : * 154 : * AFFICHAGE DU TITRE DE LA COLONNE 1 155 : * 156 : IEX = 1 157 : LI = 0 158 : IF (TABTR.ZAULIG) THEN 159 : ZG = .TRUE. 160 : ZH = .TRUE. 161 : ZD = .TRUE. 162 : ZB = .TRUE. 163 : ZGG = .TRUE. 164 : ZGH = TABTR.ZGHSEP (IEX ,1 ) 165 : ZGD = TABTR.ZGVSEP (IEX+1,1 ) 166 : ZGB = .TRUE. 167 : ELSE 168 : ZG = TABTR.ZVSEP (IEX ,1 ) 169 : ZH = TABTR.ZHSEP (IEX ,1 ) 170 : ZD = TABTR.ZVSEP (IEX+1,1 ) 171 : ZB = TABTR.ZHSEP (IEX ,2 ) 172 : ZGG = TABTR.ZGVSEP (IEX ,1 ) 173 : ZGH = TABTR.ZGHSEP (IEX ,1 ) 174 : ZGD = TABTR.ZGVSEP (IEX+1,1 ) 175 : ZGB = TABTR.ZGHSEP (IEX ,2 ) 176 : ENDIF 177 : TMPCAR = TABTR.TITCOL (IEX) 178 : IF (TABTR.IHTCOL.EQ.1) THEN 179 : ICOUL = TABTR.ICOLC 179 : CALL TBAFNC (TMPCAR,ICOUL,1+IXD,5+IYD,ZH,ZB,ZG,ZD 180 : > ,ZGH,ZGB,ZGG,ZGD,TABTR) 181 : ELSE 181 : CALL CFORMA (TMPCAR,12,NBMCX,LI) 182 : IF (LI.EQ.0) GOTO 1260 183 : SEGACT LI 184 : DO 1250 N=1 , TABTR.IHTCOL 185 : IF (N.EQ.1) THEN 186 : ZZH = ZH 187 : ZZGH = ZGH 188 : ELSE 189 : ZZH = .FALSE. 190 : ZZGH = .FALSE. 191 : ENDIF 192 : IF (N.EQ.TABTR.IHTCOL) THEN 193 : ZZB = ZB 194 : ZZGB = ZGB 195 : ELSE 196 : ZZB = .FALSE. 197 : ZZGB = .FALSE. 198 : ENDIF 199 : IF (N.LE.NBMCX) THEN 200 : A = LI.LECT (2*N-1) 201 : B = LI.LECT (2*N) 202 : ICOUL = TABTR.ICOLC 202 : CALL TBAFNC (TMPCAR (A:B),ICOUL,1+IXD,4+N+IYD,ZZH,ZZB,ZG,ZD 203 : > ,ZZGH,ZZGB,ZGG,ZGD,TABTR) 204 : ELSE 205 : TMPCAR = ' ' 206 : ICOUL = TABTR.ICOLC 206 : CALL TBAFNC (TMPCAR,ICOUL,1+IXD,4+N+IYD,ZZH,ZZB,ZG,ZD 207 : > ,ZZGH,ZZGB,ZGG,ZGD,TABTR) 208 : ENDIF 209 : 1250 CONTINUE 210 : SEGSUP LI 211 : ENDIF 212 : 1260 CONTINUE 213 : * 214 : * AFFICHAGE DES TIRES DE LIGNES 215 : * 216 : ICOUL = TABTR.ITEXC 217 : IDEBY = TABTR.CSGY (IPX,IPY) 218 : IFINY = TABTR.CIDY (IPX,IPY) 219 : IY=5+TABTR.IHTCOL+IYD 220 : DO 1220 IEY=IDEBY , IFINY 221 : ZB = TABTR.ZHSEP (1,IEY+1) 222 : ZH = TABTR.ZHSEP (1,IEY ) 223 : ZGG= TABTR.ZGVSEP (1,IEY ) 224 : IF ( (IEY.EQ.IFINY).AND.TABTR.ZAULIG) THEN 225 : TABTR.ZHSEP (1,IEY+1)=.TRUE. 226 : ENDIF 227 : IF ( (IEY.EQ.IDEBY).AND.TABTR.ZAULIG) THEN 228 : TABTR.ZHSEP (1,IEY)=.TRUE. 229 : ENDIF 230 : IF (TABTR.ZAULIG) THEN 231 : TABTR.ZGVSEP (1,IEY ) = .TRUE. 232 : ENDIF 232 : CALL TBAFN ( 1, IEY, 1+IXD, IY, TABTR ) 233 : TABTR.ZHSEP (1,IEY+1) = ZB 234 : TABTR.ZHSEP (1,IEY ) = ZH 235 : TABTR.ZGVSEP (2,IEY ) = ZGG 236 : IY = IY + 1 237 : 1220 CONTINUE 238 : * 239 : * AFFICHAGE DU NUMERO DE PAGE 240 : * 241 : ICOUL = TABTR.ITEXC 241 : CALL CHCOUL (ICOUL) 242 : IF (TABTR.ZPAGE) THEN 243 : TMPCAR = 'page 000/000' 244 : WRITE (TMPCAR (6:8) ,FMT=' (I3)') (TABTR.PX* (IPY-1)+IPX) 245 : WRITE (TMPCAR (10:12),FMT=' (I3)') (TABTR.PX*TABTR.PY) 246 : IF (ZHORIZ) THEN 247 : RXPOS = 12. 248 : RYPOS = 0. 249 : ELSE 250 : RXPOS = 8.5 251 : RYPOS = 0. 252 : ENDIF 252 : CALL TRLABL (RXPOS,RYPOS,0.,TMPCAR (1:12),12,HMIN) 253 : ENDIF 254 : * 255 : END 256 : 257 : 258 : 259 : 260 : 261 :
© Cast3M 2003 - All rights reserved.
Disclaimer