Download tbmain.eso
Back to the list
1 : C TBMAIN SOURCE CHAT 07/10/29 21:29:16 5940
2 : * PERMET D'AFFICHER SUR ECRAN OU IMPRIMANTE
3 : * UN TABLEAU.
4 : ***************************************************
5 : * ** LISTE DES FONCTIONS ET PROCEDURES:
6 : ***************************************************
7 : *
8 : * TABLEAU SUBROUTINE PRINCIPALE
9 : * EGALE (X,Y,P) FONCTION QUI RENVOIT .TRUE. SI LES
10 : * DEUX REAL*8 X ET Y SONT EGAUX A P PRES.
11 : * EFFACER PERMET D'EFFACER LA FENETRE GRAPHIQUE
12 : * EN REINITIALISANT LE SEGMENT POUR IMPRESSION.
13 : * NTAFFICHE AFFICHE LES ENTETES D'UN TABLEAU
14 : * NAFFICHE AFFICHE UNE CASE
15 : * AFFICHE AFFICHE UNE PAGE
16 : * TRINI ET SES FONCTIONS
17 : *
18 :
19 : SUBROUTINE TBMAIN
20 : IMPLICIT INTEGER(I-N)
21 : -INC CCOPTIO
22 : -INC SMEVOLL
23 : -INC CCGEOME
24 : -INC SMLENTI
25 : -INC TMNTAB
26 : ***************************************************
27 : * ** LISTE DES VARIABLES :
28 : ***************************************************
29 : * LPARAM LISTE DES PARAMETRES A LIRE
30 : * NPARAM NOMBRE DE PARAMETRES DANS LA LISTE
31 : * LEGEND TABLEAU DE CHAINE POUR LES MENUS
32 : * EV POINTEUR SUR UNE EVOLUTION
33 : * NBEVOL NOMBRE DE COURBES DANS L'OJET EVOLUTION
34 : * CURPX PAGE COURANTE EN X
35 : * CURPY PAGE COURANTE EN Y
36 : * ITABX NOMBRE DE COLONNES DE L'OBJET TABTR
37 : * ITABY NOMBRE DE LIGNES DE L'OBJET TABTR
38 : * NBPX NOMBRE DE PAGES EN X
39 : * NBPY NOMBRE DE PAGES EN Y
40 : * NBPAGE NOMBRE DE PAGES DE L'OBJET TABTR
41 : * TABTR SEGMENT POUR LE TABLEAU
42 :
43 : ***************************************************
44 : * ** DEFINITION DES VARIABLES:
45 : ***************************************************
46 : LOGICAL VALEUR,ZN,ZD
47 : CHARACTER*128 TMPCAR
48 : POINTEUR EV.MEVOLL
49 : POINTEUR LI.MLENTI
50 : REAL*8 EPSILN,RA,RB
51 : CHARACTER*10 LPARAM (17)
52 : INTEGER NPARAM
53 : CHARACTER*25 LEGEND (6)
54 : INTEGER CURPX,CURPY,FX,FY
55 : INTEGER ITABX,ITABY
56 : INTEGER PAGESX,PAGESY,NBPX,NBPY
57 : INTEGER NUM,NUM2
58 :
59 : ***************************************************
60 : * ** INITIALISATION DES VARIABLES:
61 : ***************************************************
62 : DATA LPARAM /'TITR','STITR','TCOL','TLIG','NOCENTER',
63 : # 'NOLIG','NODATE','TEXCOU','LIGCOU','COLCOU','TITCOU',
64 : # 'TRILIG','TRICOL','VERTICAL','PAGE','NOPAGE','LOGO'/
65 : NPARAM = 17
66 : EPSILN = DBLE (0)
67 : ITABX = 0
68 : ITABY = 0
69 : TABTR = 0
70 : LI = 0
71 :
72 : ***************************************************
73 : * ** LECTURE DES OBJETS
74 : ***************************************************
75 : *
76 : * EVOLUTION
77 : *
77 : CALL LIROBJ ('EVOLUTIO',IRET,0,IRETOU)
78 : IF (IRETOU.EQ.1) THEN
78 : CALL EVLIRE ( IRET, TABTR, EPSILN,ITABX, ITABY)
79 : IF (TABTR.EQ.0) GOTO 1000
80 : SEGACT TABTR*MOD
81 : GOTO 200
82 : ENDIF
83 : *
84 : * CHAMP PAR POINT
85 : *
85 : CALL LIROBJ ('CHPOINT',IRET,0,IRETOU)
86 : IF (IRETOU.EQ.1) THEN
86 : CALL CHLIRE ( IRET, TABTR, EPSILN,ITABX, ITABY)
87 : IF (TABTR.EQ.0) GOTO 1000
88 : SEGACT TABTR*MOD
89 : GOTO 200
90 : ENDIF
91 : *
92 : * CHAMP PAR ELEMENT
93 : *
93 : CALL LIROBJ ('MCHAML',IRET,0,IRETOU)
94 : IF (IRETOU.EQ.1) THEN
94 : CALL CELIRE ( IRET, TABTR, EPSILN,ITABX, ITABY)
95 : IF (TABTR.EQ.0) GOTO 1000
96 : SEGACT TABTR*MOD
97 : GOTO 200
98 : ENDIF
99 : *
100 : * PAS D'OBJET
101 : *
102 : GOTO 1000
103 :
104 : ***************************************************
105 : * ** INITIALISATION PAR DEFAUT DE TABTR
106 : ***************************************************
107 : 200 CONTINUE
108 : *
109 : * INITIALISE LA DEFINITION DES PAGES DU TABLEAU
110 : *
111 : IF (ZHORIZ) THEN
111 : CALL TBPAYS (NBPX, NBPY, TABTR, ITABX,ITABY)
112 : ELSE
112 : CALL TBPORT (NBPX, NBPY, TABTR, ITABX,ITABY)
113 : ENDIF
114 : * REGARDE S'IL FAUT METTRE LES NUMEROS DE PAGES
115 : IF (TABTR.PX*TABTR.PY.GT.1) THEN
116 : TABTR.ZPAGE = .TRUE.
117 : ELSE
118 : TABTR.ZPAGE = .FALSE.
119 : ENDIF
120 :
121 : ***************************************************
122 : * ** LECTURE DES MOTS CLE: POST TRAITEMENT DU TABLEAU
123 : ***************************************************
124 : 400 CONTINUE
124 : CALL LIRMOT (LPARAM,NPARAM,INDICE,0)
125 : IF (INDICE.NE.0) THEN
126 : GOTO (405,410,415,420,425,430,435,440,445,450,455,
127 : # 460,465,470,475,480,485),INDICE
128 : *
129 : * MODIFICATION DU TITRE
130 : *
131 : 405 CONTINUE
131 : CALL LIRCHA (TMPCAR,1,IRETOU)
132 : TABTR.TITGEN = TMPCAR
133 : GOTO 400
134 : *
135 : * MODIFICATION DU SOUS TITRE
136 : *
137 : 410 CONTINUE
137 : CALL LIRCHA (TMPCAR,1,IRETOU)
138 : TABTR.SSTITR = TMPCAR
139 : GOTO 400
140 : *
141 : * MODIFICATION DU TITRE D'UNE COLONNE
142 : *
143 : 415 CONTINUE
143 : CALL LIRENT ( NUM, 1,IRETOU)
143 : CALL LIRCHA ( TMPCAR,1,IRETOU)
144 : IF (TABTR.EQ.0) GOTO 400
145 : IF ( (NUM.LT.1).OR. (NUM.GT.ITABX)) GOTO 400
146 : TABTR.ELEM (NUM,1) = TMPCAR
147 : TABTR.TITCOL (NUM) = TMPCAR
148 : IF (ZHORIZ) THEN
148 : CALL TBPAYS ( NBPX, NBPY, TABTR, ITABX,ITABY)
149 : ELSE
149 : CALL TBPORT ( NBPX, NBPY, TABTR, ITABX,ITABY)
150 : ENDIF
151 : GOTO 400
152 : *
153 : * MODIFICATION DU TITRE D'UNE LIGNE
154 : *
155 : 420 CONTINUE
155 : CALL LIRENT ( NUM, 1, IRETOU)
155 : CALL LIRCHA ( TMPCAR,1,IRETOU)
156 : IF (TABTR.EQ.0) GOTO 400
157 : IF ( (NUM.LT.1).OR. (NUM.GT.ITABY)) GOTO 400
158 : TABTR.ELEM (1,NUM) = TMPCAR
159 : GOTO 400
160 : *
161 : * NE PAS CENTRER LES TABLEAUX
162 : *
163 : 425 CONTINUE
164 : TABTR.ZCTRER = .FALSE.
165 : GOTO 400
166 : *
167 : * NE PAS FAIRE L'ENCADREMENT AUTOMATIQUE
168 : *
169 : 430 CONTINUE
170 : TABTR.ZAULIG = .FALSE.
171 : GOTO 400
172 : *
173 : * ENLEVER LA DATE
174 : *
175 : 435 CONTINUE
176 : ZD = .FALSE.
177 : TABTR.ZDATE = .FALSE.
178 : GOTO 400
179 : *
180 : * CHANGER LA COULEUR DU TEXTE
181 : *
182 : 440 CONTINUE
182 : CALL LIRENT ( NUM, 1, IRETOU)
183 : TABTR.ITEXC = NUM
184 : GOTO 400
185 : *
186 : * CHANGER LA COULEUR DES ENCADREMENTS
187 : *
188 : 445 CONTINUE
188 : CALL LIRENT ( NUM, 1, IRETOU)
189 : TABTR.ILIGC = NUM
190 : GOTO 400
191 : *
192 : * CHANGER LA COULEUR DES TITRES DE COLONNES
193 : *
194 : 450 CONTINUE
194 : CALL LIRENT ( NUM, 1, IRETOU)
195 : TABTR.ICOLC = NUM
196 : GOTO 400
197 : *
198 : * CHANGER LA COULEUR DES TITRES
199 : *
200 : 455 CONTINUE
200 : CALL LIRENT ( NUM, 1, IRETOU)
201 : TABTR.ITITC = NUM
202 : GOTO 400
203 : *
204 : * TRIER LES LIGNES
205 : *
206 : 460 CONTINUE
206 : CALL LIRENT ( NUM, 1, IRETOU)
207 : IF ( (NUM.LT.1).OR. (NUM.GT.ITABX)) GOTO 400
207 : CALL TBTRLI ( NUM,3, TABTR, ITABX, ITABY)
208 : GOTO 400
209 : *
210 : * TRIER LES COLONNES
211 : *
212 : 465 CONTINUE
212 : CALL LIRENT ( NUM, 1, IRETOU)
213 : IF ( (NUM.LT.1).OR. (NUM.GT.ITABY)) GOTO 400
213 : CALL TBTRCO ( NUM,3, TABTR, ITABX, ITABY)
214 : GOTO 400
215 : *
216 : * PASSER EN MODE PORTRAIT
217 : *
218 : 470 CONTINUE
218 : if (ZINIPS) CALL TBPORT ( NBPX, NBPY, TABTR, ITABX,ITABY)
219 : GOTO 400
220 : *
221 : * FORCER L'AFFICHAGE DES NUMEROS DE PAGE
222 : *
223 : 475 CONTINUE
224 : TABTR.ZPAGE = .TRUE.
225 : GOTO 400
226 : *
227 : * FORCER LE NON AFFICHAGE DES NUMEROS DE PAGES
228 : *
229 : 480 CONTINUE
230 : TABTR.ZPAGE = .FALSE.
231 : GOTO 400
232 : *
233 : * INSERER LE LOGO
234 : *
235 : 485 CONTINUE
236 : TABTR.ZLOGO = .TRUE.
237 : GOTO 400
238 : *
239 : ENDIF
240 :
241 : ***************************************************
242 : * ** AFFICHAGE DE LA FENETRE
243 : ***************************************************
244 : IF (IOGRA.EQ.1) GOTO 900
245 : IF (IOGRA.EQ.7) GOTO 900
246 : IF (IOGRA.EQ.8) GOTO 900
247 : * INITIALISATION DU NOMBRE DE COULEURS
248 : if (ZHORIZ) then
248 : CALL TRINIT (24,29.7,21.,' ',1.,VALEUR,NBCOUL)
249 : else
249 : CALL TRINIT (24,21.,29.7,' ',1.,VALEUR,NBCOUL)
250 : endif
251 : CURPX = 1
252 : CURPY = 1
253 : *
254 :
255 : ***************************************************
256 : * ** CREATION DU MENU: ATTENTE DES ORDRES
257 : ***************************************************
258 : 600 CONTINUE
259 : *
260 : * AFFICHAGE MENU PRINCIPAL
261 : *
262 : 602 CONTINUE
262 : CALL TBAFF ( CURPX, CURPY, TABTR )
263 : LEGEND (1)='Fin dessin'
264 : LEGEND (2)=' Suivante '
265 : LEGEND (3)='Precedante'
266 : LEGEND (4)='Options >>'
267 : IF (ZHORIZ) THEN
268 : LEGEND (5)='Hor/Vert (H)'
269 : ELSE
270 : LEGEND (5)='Hor/Vert (V)'
271 : ENDIF
271 : CALL MENU (LEGEND,5,12)
271 : CALL TRAFF (ICLE)
272 : * FIN DESSIN
273 : IF (ICLE.EQ.0) GOTO 1000
274 : * AFFICHER LA PAGE SUIVANTE
275 : IF (ICLE.EQ.1) THEN
276 : CURPX = CURPX+1
277 : IF (CURPX.EQ. (NBPX+1)) THEN
278 : CURPX=1
279 : CURPY=CURPY+1
280 : IF (CURPY.EQ. (NBPY+1)) THEN
281 : CURPY=1
282 : ENDIF
283 : ENDIF
284 : ENDIF
285 : * AFFICHER LA PAGE PRECEDANTE
286 : IF (ICLE.EQ.2) THEN
287 : CURPX = CURPX - 1
288 : IF (CURPX.EQ.0) THEN
289 : CURPX = NBPX
290 : CURPY = CURPY -1
291 : IF (CURPY.EQ.0) THEN
292 : CURPY = NBPY
293 : ENDIF
294 : ENDIF
295 : ENDIF
296 : * OPTIONS
297 : IF (ICLE.EQ.3) GOTO 610
298 : * BASCULER
299 : IF (ICLE.EQ.4) THEN
300 : IF (ZINIPS) THEN
301 : NBPX = 0
302 : NBPY = 0
303 : IF (ZHORIZ) THEN
303 : CALL TBPORT ( NBPX, NBPY, TABTR ,ITABX,ITABY)
304 : ELSE
304 : CALL TBPAYS ( NBPX, NBPY, TABTR, ITABX,ITABY)
305 : ENDIF
306 : CURPX = 1
307 : CURPY = 1
308 : ENDIF
309 : ENDIF
310 : * RETOUR
311 : GOTO 602
312 : *
313 : * SOUS MENU OPTIONS
314 : *
315 : 610 CONTINUE
315 : CALL TBAFF ( CURPX, CURPY, TABTR )
316 : LEGEND (1)=' << options'
317 : LEGEND (2)=' Arranger >>'
318 : LEGEND (3)='Encadrement >>'
319 : LEGEND (4)=' Titres >>'
320 : LEGEND (5)=' Couleurs >>'
321 : LEGEND (6)=' Divers >>'
321 : CALL MENU (LEGEND,6,16)
321 : CALL TRAFF (ICLE)
322 : * REVENIR
323 : IF (ICLE.EQ.0) THEN
323 : CALL TBAFF ( CURPX, CURPY, TABTR )
324 : GOTO 602
325 : ENDIF
326 : * TRIER
327 : IF (ICLE.EQ.1) GOTO 620
328 : * ENCADREMENT
329 : IF (ICLE.EQ.2) GOTO 630
330 : * TITRES
331 : IF (ICLE.EQ.3) GOTO 640
332 : * COULEURS
333 : IF (ICLE.EQ.4) GOTO 650
334 : * DIVERS
335 : IF (ICLE.EQ.5) GOTO 710
336 : * RETOUR
337 : GOTO 610
338 : *
339 : * SOUS MENU ARANGER
340 : *
341 : 620 CONTINUE
341 : CALL TBAFF ( CURPX, CURPY, TABTR )
342 : LEGEND (1)=' << Aranger'
343 : LEGEND (2)='Trier Colonnes >>'
344 : LEGEND (3)=' Trier Lignes >>'
345 : LEGEND (4)=' Modifier >>'
345 : CALL MENU (LEGEND,4,17)
345 : CALL TRAFF (ICLE)
346 : * REVENIR
347 : IF (ICLE.EQ.0) GOTO 610
348 : * TRIER LES COLONNES
349 : IF (ICLE.EQ.1) GOTO 700
350 : * TRIER LES LIGNES
351 : IF (ICLE.EQ.2) GOTO 690
352 : * MODIFIER
353 : IF (ICLE.EQ.3) GOTO 730
354 : * RETOUR
355 : GOTO 620
356 : *
357 : * SOUS MENU ENCADREMENT
358 : *
359 : 630 CONTINUE
359 : CALL TBAFF ( CURPX, CURPY, TABTR )
360 : LEGEND (1)='<< encadrement'
361 : LEGEND (2)='inter Colonnes >>'
362 : LEGEND (3)='inter Lignes >> '
363 : LEGEND (4)=' Cellule >> '
363 : CALL MENU (LEGEND,4,18)
363 : CALL TRAFF (ICLE)
364 : * REVENIR
365 : IF (ICLE.EQ.0) GOTO 610
366 : * INTER COLONNE
367 : IF (ICLE.EQ.1) THEN
368 : GOTO 680
369 : ENDIF
370 : * INTER LIGNE
371 : IF (ICLE.EQ.2) THEN
372 : GOTO 660
373 : ENDIF
374 : * CELLULE
375 : IF (ICLE.EQ.3) THEN
376 : GOTO 670
377 : ENDIF
378 : * RETOUR
379 : GOTO 630
380 : *
381 : * SOUS MENU TITRES
382 : *
383 : 640 CONTINUE
383 : CALL TBAFF ( CURPX, CURPY, TABTR )
384 : LEGEND (1)=' << titres'
385 : LEGEND (2)=' General '
386 : LEGEND (3)='Sous titre'
387 : LEGEND (4)=' Colonne '
388 : LEGEND (5)=' Ligne '
388 : CALL MENU (LEGEND,5,10)
388 : CALL TRAFF (ICLE)
389 : * REVENIR
390 : IF (ICLE.EQ.0) GOTO 610
391 : * CHANGER LE TITRE DU TABLEAU
392 : IF (ICLE.EQ.1) THEN
392 : CALL TRGET ('Entrer le nouveau titre:',TMPCAR)
393 : TABTR.TITGEN=TMPCAR
393 : CALL TBAFF ( CURPX, CURPY, TABTR)
394 : ENDIF
395 : * CHANGER LE SOUS TITRE
396 : IF (ICLE.EQ.2) THEN
396 : CALL TRGET ('Entrer le nouveau sous-titre:',TMPCAR)
397 : TABTR.SSTITR=TMPCAR
397 : CALL TBAFF ( CURPX, CURPY, TABTR)
398 : ENDIF
399 : * CHANGER LE TITRE D'UNE COLONNE
400 : IF (ICLE.EQ.3) THEN
400 : CALL TRMESS ('Cliquer sur la colonne.')
400 : CALL TBGTXY (CURPX,CURPY,TABTR,IX,IY,FX,FY)
401 : IF ( (IX.LT.1).OR. (IX.GT.ITABX)) THEN
401 : CALL TRMESS ('Emplacement invalide')
402 : GOTO 640
403 : ENDIF
403 : CALL TRGET ('Entrer le nouveau titre de colonne:',TMPCAR)
404 : TABTR.ELEM (IX,1) = TMPCAR
405 : TABTR.TITCOL (IX) = TMPCAR
405 : CALL TBTRHT (TABTR,ITABX)
406 : IF (ZHORIZ) THEN
406 : CALL TBPAYS ( NBPX, NBPY, TABTR, ITABX,ITABY)
407 : ELSE
407 : CALL TBPORT ( NBPX, NBPY, TABTR, ITABX,ITABY)
408 : ENDIF
408 : CALL TBAFF ( CURPX, CURPY, TABTR)
409 : ENDIF
410 : * CHANGER LE TITRE D'UNE LIGNE
411 : IF (ICLE.EQ.4) THEN
411 : CALL TRMESS ('Cliquer sur la ligne.')
411 : CALL TBGTXY (CURPX,CURPY,TABTR,IX,IY,FX,FY)
412 : IF ( (IY.LT.1).OR. (IY.GT.ITABY)) THEN
412 : CALL TRMESS ('Emplacement invalide')
413 : GOTO 640
414 : ENDIF
414 : CALL TRGET ('Entrer le nouveau titre de ligne:',TMPCAR)
415 : TABTR.ELEM (1,IY) = TMPCAR
415 : CALL TBAFF ( CURPX, CURPY, TABTR)
416 : ENDIF
417 : * RETOUR
418 : GOTO 640
419 : *
420 : * SOUS MENU COULEURS
421 : *
422 : 650 CONTINUE
422 : CALL TBAFF ( CURPX, CURPY, TABTR )
423 : LEGEND (1)=' << couleurs'
424 : LEGEND (2)=' Texte '
425 : LEGEND (3)='Encadrement '
426 : LEGEND (4)=' Colonnes '
427 : LEGEND (5)=' Titres '
428 : LEGEND (6)=' Logo '
428 : CALL MENU (LEGEND,6,12)
428 : CALL TRAFF (ICLE)
429 : * REVENIR
430 : IF (ICLE.EQ.0) GOTO 610
431 : * TEXTE
432 : IF (ICLE.EQ.1) THEN
433 : NUM=NBCOUL
433 : CALL TRGETC (NUM)
434 : TABTR.ITEXC = NUM
434 : CALL TBAFF ( CURPX, CURPY, TABTR)
435 : ENDIF
436 : * ENCADREMENT
437 : IF (ICLE.EQ.2) THEN
438 : NUM=NBCOUL
438 : CALL TRGETC (NUM)
439 : TABTR.ILIGC = NUM
440 : ENDIF
441 : * COLONNES
442 : IF (ICLE.EQ.3) THEN
443 : NUM=NBCOUL
443 : CALL TRGETC (NUM)
444 : TABTR.ICOLC = NUM
445 : ENDIF
446 : * TITRES
447 : IF (ICLE.EQ.4) THEN
448 : NUM=NBCOUL
448 : CALL TRGETC (NUM)
449 : TABTR.ITITC = NUM
450 : ENDIF
451 : * LOGO
452 : IF (ICLE.EQ.5) THEN
453 : NUM=NBCOUL
453 : CALL TRGETC (NUM)
454 : TABTR.ILOGC = NUM
455 : ENDIF
456 : * RETOUR
457 : GOTO 650
458 : *
459 : * SOUS MENU ENCADREMENT INTER LIGNE
460 : *
461 : 660 CONTINUE
461 : CALL TBAFF ( CURPX, CURPY, TABTR )
462 : LEGEND (1)='<< encadrement-lignes'
463 : LEGEND (2)=' Normal '
464 : LEGEND (3)=' Gras '
465 : LEGEND (4)=' Enlever '
465 : CALL MENU (LEGEND,4,22)
465 : CALL TRAFF (ICLE)
466 : * REVENIR
467 : IF (ICLE.EQ.0) GOTO 630
468 : * NORMAL
469 : IF (ICLE.EQ.1) THEN
469 : CALL TRMESS ('Cliquer sur la ligne.')
469 : CALL TBGTXY (CURPX,CURPY,TABTR,IX,IY,FX,FY)
470 : IF (IY.EQ.0) IY=TABTR.CIDY (CURPX,CURPY)+1
471 : DO 662 IX=1 , ITABX
472 : TABTR.ZHSEP (IX,IY) = .TRUE.
473 : TABTR.ZGHSEP (IX,IY) = .FALSE.
474 : 662 CONTINUE
475 : ENDIF
476 : * GRAS
477 : IF (ICLE.EQ.2) THEN
477 : CALL TRMESS ('Cliquer sur la ligne.')
477 : CALL TBGTXY (CURPX,CURPY,TABTR,IX,IY,FX,FY)
478 : IF (IY.EQ.0) IY=TABTR.CIDY (CURPX,CURPY)+1
479 : DO 664 IX=1 , ITABX
480 : TABTR.ZHSEP (IX,IY) = .TRUE.
481 : TABTR.ZGHSEP (IX,IY) = .TRUE.
482 : 664 CONTINUE
483 : ENDIF
484 : * ENLEVER
485 : IF (ICLE.EQ.3) THEN
485 : CALL TRMESS ('Cliquer sur la ligne.')
485 : CALL TBGTXY (CURPX,CURPY,TABTR,IX,IY,FX,FY)
486 : IF (IY.EQ.0) IY=TABTR.CIDY (CURPX,CURPY)+1
487 : DO 666 IX=1 , ITABX
488 : TABTR.ZGHSEP (IX,IY) = .FALSE.
489 : TABTR.ZHSEP (IX,IY) = .FALSE.
490 : 666 CONTINUE
491 : ENDIF
492 : * RETOUR
493 : GOTO 660
494 : *
495 : * SOUS MENU ENCADREMENT CELLULE
496 : *
497 : 670 CONTINUE
497 : CALL TBAFF ( CURPX, CURPY, TABTR )
498 : LEGEND (1)='<MENU (LEGEND,4,23)
501 : CALL TRAFF (ICLE)
502 : * REVENIR
503 : IF (ICLE.EQ.0) GOTO 630
504 : * NORMAL
505 : IF (ICLE.EQ.1) THEN
505 : CALL TRMESS ('Cliquer sur la cellule.')
505 : CALL TBGTXY (CURPX,CURPY,TABTR,NUM,NUM2,FX,FY)
506 : IF (NUM.EQ.0) THEN
507 : IDEBX=1
508 : IFINX=ITABX
509 : ELSE
510 : IDEBX=NUM
511 : IFINX=NUM
512 : ENDIF
513 : IF (NUM2.EQ.0) THEN
514 : IDEBY=1
515 : IFINY=ITABY
516 : ELSE
517 : IDEBY=NUM2
518 : IFINY=NUM2
519 : ENDIF
520 : DO 671 IX=IDEBX , IFINX
521 : TABTR.ZHSEP (IX,IDEBY ) = .TRUE.
522 : TABTR.ZGHSEP (IX,IDEBY ) = .FALSE.
523 : TABTR.ZHSEP (IX,IFINY+1) = .TRUE.
524 : TABTR.ZGHSEP (IX,IFINY+1) = .FALSE.
525 : 671 CONTINUE
526 : DO 672 IY=IDEBY , IFINY
527 : TABTR.ZVSEP (IDEBX ,IY) = .TRUE.
528 : TABTR.ZGVSEP (IDEBX ,IY) = .FALSE.
529 : TABTR.ZVSEP (IFINX+1,IY) = .TRUE.
530 : TABTR.ZGVSEP (IFINX+1,IY) = .FALSE.
531 : 672 CONTINUE
532 : ENDIF
533 : * GRAS
534 : IF (ICLE.EQ.2) THEN
534 : CALL TRMESS ('Cliquer sur la cellule.')
534 : CALL TBGTXY (CURPX,CURPY,TABTR,NUM,NUM2,FX,FY)
535 : IF (NUM.EQ.0) THEN
536 : IDEBX=1
537 : IFINX=ITABX
538 : ELSE
539 : IDEBX=NUM
540 : IFINX=NUM
541 : ENDIF
542 : IF (NUM2.EQ.0) THEN
543 : IDEBY=1
544 : IFINY=ITABY
545 : ELSE
546 : IDEBY=NUM2
547 : IFINY=NUM2
548 : ENDIF
549 : DO 673 IX=IDEBX , IFINX
550 : TABTR.ZHSEP (IX,IDEBY ) = .TRUE.
551 : TABTR.ZGHSEP (IX,IDEBY ) = .TRUE.
552 : TABTR.ZHSEP (IX,IFINY+1) = .TRUE.
553 : TABTR.ZGHSEP (IX,IFINY+1) = .TRUE.
554 : 673 CONTINUE
555 : DO 674 IY=IDEBY , IFINY
556 : TABTR.ZVSEP (IDEBX ,IY) = .TRUE.
557 : TABTR.ZGVSEP (IDEBX ,IY) = .TRUE.
558 : TABTR.ZVSEP (IFINX+1,IY) = .TRUE.
559 : TABTR.ZGVSEP (IFINX+1,IY) = .TRUE.
560 : 674 CONTINUE
561 : ENDIF
562 : * ENLEVER
563 : IF (ICLE.EQ.3) THEN
563 : CALL TRMESS ('Cliquer sur la cellule.')
563 : CALL TBGTXY (CURPX,CURPY,TABTR,NUM,NUM2,FX,FY)
564 : IF (NUM.EQ.0) THEN
565 : IDEBX=1
566 : IFINX=ITABX
567 : ELSE
568 : IDEBX=NUM
569 : IFINX=NUM
570 : ENDIF
571 : IF (NUM2.EQ.0) THEN
572 : IDEBY=1
573 : IFINY=ITABY
574 : ELSE
575 : IDEBY=NUM2
576 : IFINY=NUM2
577 : ENDIF
578 : DO 675 IX=IDEBX , IFINX
579 : TABTR.ZHSEP (IX,IDEBY ) = .FALSE.
580 : TABTR.ZGHSEP (IX,IDEBY ) = .FALSE.
581 : TABTR.ZHSEP (IX,IFINY+1) = .FALSE.
582 : TABTR.ZGHSEP (IX,IFINY+1) = .FALSE.
583 : 675 CONTINUE
584 : DO 676 IY=IDEBY , IFINY
585 : TABTR.ZVSEP (IDEBX ,IY) = .FALSE.
586 : TABTR.ZGVSEP (IDEBX ,IY) = .FALSE.
587 : TABTR.ZVSEP (IFINX+1,IY) = .FALSE.
588 : TABTR.ZGVSEP (IFINX+1,IY) = .FALSE.
589 : 676 CONTINUE
590 : ENDIF
591 : * RETOUR
592 : GOTO 670
593 : *
594 : * SOUS MENU ENCADREMENT INTER COLONNE
595 : *
596 : 680 CONTINUE
596 : CALL TBAFF ( CURPX, CURPY, TABTR )
597 : LEGEND (1)='R '
598 : LEGEND (2)=' Normal '
599 : LEGEND (3)=' Gras '
600 : LEGEND (4)=' Enlever '
600 : CALL MENU (LEGEND,4,23)
600 : CALL TRAFF (ICLE)
601 : * REVENIR
602 : IF (ICLE.EQ.0) GOTO 630
603 : * NORMAL
604 : IF (ICLE.EQ.1) THEN
604 : CALL TRMESS ('Cliquer sur la colonne.')
604 : CALL TBGTXY (CURPX,CURPY,TABTR,IX,IY,FX,FY)
605 : IF (IX.EQ.0) IX=TABTR.CIDX (CURPX,CURPY)+1
606 : DO 682 IY=1 , ITABY
607 : TABTR.ZVSEP (IX,IY) = .TRUE.
608 : TABTR.ZGVSEP (IX,IY) = .FALSE.
609 : 682 CONTINUE
610 : ENDIF
611 : * GRAS
612 : IF (ICLE.EQ.2) THEN
612 : CALL TRMESS ('Cliquer sur la colonne.')
612 : CALL TBGTXY (CURPX,CURPY,TABTR,IX,IY,FX,FY)
613 : IF (IX.EQ.0) IX=TABTR.CIDX (CURPX,CURPY)+1
614 : DO 684 IY=1 , ITABY
615 : TABTR.ZVSEP (IX,IY) = .TRUE.
616 : TABTR.ZGVSEP (IX,IY) = .TRUE.
617 : 684 CONTINUE
618 : ENDIF
619 : * ENLEVER
620 : IF (ICLE.EQ.3) THEN
620 : CALL TRMESS ('Cliquer sur la colonne.')
620 : CALL TBGTXY (CURPX,CURPY,TABTR,IX,IY,FX,FY)
621 : IF (IX.EQ.0) IX=TABTR.CIDX (CURPX,CURPY)+1
622 : DO 686 IY=1 , ITABY
623 : TABTR.ZGVSEP (IX,IY) = .FALSE.
624 : TABTR.ZVSEP (IX,IY) = .FALSE.
625 : 686 CONTINUE
626 : ENDIF
627 : * RETOUR
628 : GOTO 680
629 : *
630 : * SOUS MENU TRIER LIGNES
631 : *
632 : 690 CONTINUE
632 : CALL TBAFF ( CURPX, CURPY, TABTR )
633 : LEGEND (1)='<< trier-lignes'
634 : LEGEND (2)=' Croissant '
635 : LEGEND (3)=' Decroissant '
635 : CALL MENU (LEGEND,3,15)
635 : CALL TRAFF (ICLE)
636 : * REVENIR
637 : IF (ICLE.EQ.0) GOTO 620
638 : * CROISSANT
639 : IF (ICLE.EQ.1) THEN
639 : CALL TRMESS ('Cliquer sur la colonne de reference.')
639 : CALL TBGTXY (CURPX,CURPY,TABTR,IX,IY,FX,FY)
640 : IF ( (IX.LT.1).OR. (IX.GT.ITABX)) THEN
640 : CALL TRMESS ('Emplacement invalide')
641 : GOTO 690
642 : ENDIF
643 : NUM2 = 3
644 : IF (TABTR.YTYPE (IX).EQ.'LISTENTI') NUM2=5
645 : IF (TABTR.YTYPE (IX).EQ.'LISTREEL') NUM2=1
645 : CALL TBTRLI ( IX, NUM2, TABTR, ITABX, ITABY)
645 : CALL TBAFF ( CURPX, CURPY, TABTR )
646 : GOTO 610
647 : ENDIF
648 : * DECROISSANT
649 : IF (ICLE.EQ.2) THEN
649 : CALL TRMESS ('Cliquer sur la colonne de reference.')
649 : CALL TBGTXY (CURPX,CURPY,TABTR,IX,IY,FX,FY)
650 : IF ( (IX.LT.1).OR. (IX.GT.ITABX)) THEN
650 : CALL TRMESS ('Emplacement invalide')
651 : GOTO 690
652 : ENDIF
653 : NUM2 = 4
654 : IF (TABTR.YTYPE (IX).EQ.'LISTENTI') NUM2=6
655 : IF (TABTR.YTYPE (IX).EQ.'LISTREEL') NUM2=2
655 : CALL TBTRLI ( IX, NUM2, TABTR, ITABX, ITABY)
655 : CALL TBAFF ( CURPX, CURPY, TABTR )
656 : GOTO 610
657 : ENDIF
658 : * RETOUR
659 : GOTO 690
660 : *
661 : * SOUS MENU TRIER COLONNES
662 : *
663 : 700 CONTINUE
663 : CALL TBAFF ( CURPX, CURPY, TABTR )
664 : LEGEND (1)='<< trier-colonnes'
665 : LEGEND (2)=' Croissant '
666 : LEGEND (3)=' Decroissant '
666 : CALL MENU (LEGEND,3,18)
666 : CALL TRAFF (ICLE)
667 : * REVENIR
668 : IF (ICLE.EQ.0) GOTO 620
669 : * CROISSANT
670 : IF (ICLE.EQ.1) THEN
670 : CALL TRMESS ('Cliquer sur la ligne de reference.')
670 : CALL TBGTXY (CURPX,CURPY,TABTR,IX,IY,FX,FY)
671 : IF ( (IY.LT.1).OR. (IY.GT.ITABY)) THEN
671 : CALL TRMESS ('Emplacement invalide')
672 : GOTO 620
673 : ENDIF
673 : CALL TBTRCO ( IY, 3, TABTR, ITABX, ITABY)
673 : CALL TBAFF ( CURPX, CURPY, TABTR )
674 : GOTO 610
675 : ENDIF
676 : * DECROISSANT
677 : IF (ICLE.EQ.2) THEN
677 : CALL TRMESS ('Cliquer sur la ligne de reference.')
677 : CALL TBGTXY (CURPX,CURPY,TABTR,IX,IY,FX,FY)
678 : IF ( (IY.LT.1).OR. (IY.GT.ITABY)) THEN
678 : CALL TRMESS ('Emplacement invalide')
679 : GOTO 620
680 : ENDIF
680 : CALL TBTRCO ( IY, 4, TABTR, ITABX, ITABY)
680 : CALL TBAFF ( CURPX, CURPY, TABTR )
681 : GOTO 610
682 : ENDIF
683 : * RETOUR
684 : GOTO 700
685 : *
686 : * SOUS MENU DIVERS
687 : *
688 : 710 CONTINUE
688 : CALL TBAFF ( CURPX, CURPY, TABTR )
689 : LEGEND (1)='<< options-divers'
690 : IF (TABTR.ZDATE) THEN
691 : LEGEND (2)=' (X) date'
692 : ELSE
693 : LEGEND (2)=' ( ) date'
694 : ENDIF
695 : IF (TABTR.ZCTRER) THEN
696 : LEGEND (3)=' (X) centrer'
697 : ELSE
698 : LEGEND (3)=' ( ) centrer'
699 : ENDIF
700 : IF (TABTR.ZAULIG) THEN
701 : LEGEND (4)=' (X) lignes'
702 : ELSE
703 : LEGEND (4)=' ( ) lignes'
704 : ENDIF
705 : IF (TABTR.ZPAGE) THEN
706 : LEGEND (5)=' (X) No page'
707 : ELSE
708 : LEGEND (5)=' ( ) No page'
709 : ENDIF
710 : LEGEND (6)=' Logo >> '
710 : CALL MENU (LEGEND,6,17)
710 : CALL TRAFF (ICLE)
711 : * REVENIR
712 : IF (ICLE.EQ.0) GOTO 610
713 : * DATE
714 : IF (ICLE.EQ.1) THEN
715 : TABTR.ZDATE = .NOT.TABTR.ZDATE
716 : GOTO 710
717 : ENDIF
718 : * CENTRER
719 : IF (ICLE.EQ.2) THEN
720 : TABTR.ZCTRER = .NOT.TABTR.ZCTRER
720 : CALL TBTRXY (TABTR,NBPX,NBPY)
721 : GOTO 710
722 : ENDIF
723 : * AUTOLIGNES
724 : IF (ICLE.EQ.3) THEN
725 : TABTR.ZAULIG = .NOT.TABTR.ZAULIG
726 : GOTO 710
727 : ENDIF
728 : * PAGES
729 : IF (ICLE.EQ.4) THEN
730 : TABTR.ZPAGE = .NOT.TABTR.ZPAGE
731 : GOTO 710
732 : ENDIF
733 : * LOGO
734 : IF (ICLE.EQ.5) THEN
735 : GOTO 720
736 : ENDIF
737 : * RETOUR
738 : GOTO 710
739 : *
740 : * SOUS MENU LOGO
741 : *
742 : 720 CONTINUE
742 : CALL TBAFF ( CURPX, CURPY, TABTR )
743 : LEGEND (1)=' << logo'
744 : LEGEND (2)='Position'
745 : LEGEND (3)='Couleur'
746 : LEGEND (4)='Taille'
747 : IF (TABTR.ZLOGO) THEN
748 : LEGEND (5)=' (X) Logo'
749 : ELSE
750 : LEGEND (5)=' ( ) Logo'
751 : ENDIF
751 : CALL MENU (LEGEND,5,9)
751 : CALL TRAFF (ICLE)
752 : * REVENIR
753 : IF (ICLE.EQ.0) GOTO 710
754 : * POSITION
755 : IF (ICLE.EQ.1) THEN
755 : CALL TRMESS ('Cliquer sur la nouvelle position.')
755 : CALL TRDIG (TABTR.XLPOS,TABTR.YLPOS,inouse)
756 : ENDIF
757 : * COULEUR
758 : IF (ICLE.EQ.2) THEN
759 : NUM=NBCOUL
759 : CALL TRGETC (NUM)
760 : TABTR.ILOGC = NUM
761 : ENDIF
762 : * TAILLE
763 : IF (ICLE.EQ.3) THEN
763 : CALL TRGET ('Entrer la nouvelle taille du logo:',TMPCAR)
764 : RA = F_ATOL (TMPCAR)
765 : NUM = F_ATOI (TMPCAR)
766 : IF ( (RA.LT.0.5).OR. (RA.GT.15.0)) RA=DBLE (NUM)
767 : IF ( (RA.LT.0.5).OR. (RA.GT.15.0)) THEN
767 : CALL TRMESS ('Taille invalide')
768 : ELSE
769 : TABTR.TLOGO = REAL (RA)
770 : ENDIF
771 : ENDIF
772 : * ON/OFF
773 : IF (ICLE.EQ.4) THEN
774 : TABTR.ZLOGO = .NOT.TABTR.ZLOGO
775 : ENDIF
776 : * RETOUR
777 : GOTO 720
778 : *
779 : * SOUS MENU MODIFIER
780 : *
781 : 730 CONTINUE
781 : CALL TBAFF ( CURPX, CURPY, TABTR )
782 : LEGEND (1)=' << modifier'
783 : LEGEND (2)='Sup. Colonne'
784 : LEGEND (3)=' Sup. Ligne '
785 : LEGEND (4)='Modif. Cell.'
785 : CALL MENU (LEGEND,4,12)
785 : CALL TRAFF (ICLE)
786 : * REVENIR
787 : IF (ICLE.EQ.0) GOTO 620
788 : * SUPPRIMER COLONNE
789 : IF (ICLE.EQ.1) THEN
789 : CALL TRMESS ('Cliquer sur la colonne à suprimer.')
789 : CALL TBGTXY (CURPX,CURPY,TABTR,IX,IY,FX,FY)
790 : IF ( (IX.LT.1).OR. (IX.GT.ITABX)) THEN
790 : CALL TRMESS ('Emplacement invalide')
791 : ELSE
791 : CALL TBDELC (IX,NBPX,NBPY,TABTR,ITABX,ITABY)
792 : ENDIF
793 : ENDIF
794 : * SUPPRIMER LIGNE
795 : IF (ICLE.EQ.2) THEN
795 : CALL TRMESS ('Cliquer sur la ligne à suprimer.')
795 : CALL TBGTXY (CURPX,CURPY,TABTR,IX,IY,FX,FY)
796 : IF ( (IY.LT.1).OR. (IY.GT.ITABY)) THEN
796 : CALL TRMESS ('Emplacement invalide')
797 : ELSE
797 : CALL TBDELL (IY,NBPX,NBPY,TABTR,ITABX,ITABY)
798 : ENDIF
799 : ENDIF
800 : * MODIFIER CELLULE
801 : IF (ICLE.EQ.3) THEN
802 : ENDIF
803 : * RETOUR
804 : GOTO 730
805 : *
806 :
807 : ***************************************************
808 : * ** TRAITEMENT DES BATCHS
809 : ***************************************************
810 : 900 CONTINUE
811 : C print *,'On rentre dans la partie Traitement des batchs'
812 :
813 : DO 920 IY=1 , NBPY
814 : DO 910 IX=1 , NBPX
815 :
815 : CALL TBAFF (IX, IY, TABTR)
815 : CALL TRAFF (ICLE)
816 :
817 : 910 CONTINUE
818 : 920 CONTINUE
819 :
820 : ***************************************************
821 : * ** SORTIR ET LIBERER LA MEMOIRE
822 : ***************************************************
823 : 1000 CONTINUE
824 : IF (TABTR.NE.0) SEGSUP TABTR
825 : IF (LI.NE.0) SEGSUP LI
826 : ZHORIZ = .TRUE.
827 : END
828 :
829 :
830 :
831 :
832 :
833 :
834 :
835 :
836 :
837 :
838 :
839 :