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

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