Télécharger la plaquette Cast3M


fr en

Télécharger tbmain.eso

Retour à la liste

Numérotation des lignes : 

tbmain

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

© Cast3M 2003 - Tous droits réservés.
Mentions légales