Télécharger trgetc.eso

Retour à la liste

Numérotation des lignes :

  1. C TRGETC SOURCE GOUNAND 16/06/23 21:15:13 8982
  2. SUBROUTINE TRGETC ( NCOUL )
  3. c permet de choisir une couleur en cliquant
  4. c dessus dans la fenetre graphique
  5. c a l'appel ncoul contient le nombre de couleurs maxi
  6. c au retour ncoul contient la couleur choisie
  7.  
  8. IMPLICIT INTEGER(I-N)
  9.  
  10. -INC PPARAM
  11. -INC CCOPTIO
  12. -inc TMNTAB
  13. -INC CCTRACE
  14. REAL X ,Y ,Z
  15. integer ncoul
  16. integer imcoul
  17. INTEGER ISORT, IRESU
  18. real rxpos,rypos,hmin
  19. character*20 tmpcar
  20. *
  21. dimension X(2),Y(2),Z(2)
  22. imcoul = ncoul
  23. imcoul = max(imcoul,20)
  24. ISORT = 0
  25. IRESU = 0
  26. call ini(IRESU,ISORT,0,0,0,0.,0.,0.,0.)
  27. xz=0d0
  28. xd=10d0
  29. xv=20d0
  30. x(1)=4.
  31. X(2)=8.
  32. z(1)=0.
  33. z(2)=0.
  34. * write(6,*) ' ires iogra ' , ires , iogra
  35. call dfenet(xz,xd,xz,xv,xz,xd,xz,xd,xz,xv,.false.)
  36. call insegt(1,ires)
  37. * write(6,*) ' ires ' , ires
  38. tmpcar = 'Couleur No '
  39. if( icosc.eq.1) then
  40. ico1=7
  41. else
  42. ico1=8
  43. endif
  44. do 20 iy=1 , imcoul
  45. write (tmpcar(13:14),FMT='(I2)') iy
  46. rxpos = 2.
  47. rypos = 1. + iy
  48. call chcoul (ico1)
  49. call trlabl(rxpos,rypos,0.,tmpcar,15,hmin)
  50. call chcoul (iy)
  51. rxpos = 4.
  52. Y(1)=rypos
  53. y(2)=rypos
  54. call polrl(2,X,Y,Z)
  55. Y(1)=rypos+0.2
  56. y(2)=rypos+0.2
  57. call polrl(2,X,Y,Z)
  58. * call trlabl(rxpos,rypos,0.,
  59. * > 'ABCDEFGHIJKLMNOPQRSTUVWXYZ',26,hmin)
  60. 20 continue
  61. call chcoul(0)
  62. call majseg(1,0,0,0,0)
  63.  
  64. call trmess ('Clicker sur la couleur de votre choix.')
  65. call trdig (rxpos,rypos,inouse)
  66. ncoul = int (rypos - 1)
  67. if (ncoul.lt.0) ncoul=0
  68. if (ncoul.gt.imcoul) ncoul=imcoul
  69. *
  70. end
  71.  
  72.  
  73.  
  74.  
  75.  
  76.  
  77.  
  78.  
  79.  
  80.  
  81.  

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