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. -inc CCOPTIO
  10. -inc TMNTAB
  11. -INC CCTRACE
  12. REAL X ,Y ,Z
  13. integer ncoul
  14. integer imcoul
  15. INTEGER ISORT, IRESU
  16. real rxpos,rypos,hmin
  17. character*20 tmpcar
  18. *
  19. dimension X(2),Y(2),Z(2)
  20. imcoul = ncoul
  21. imcoul = max(imcoul,20)
  22. ISORT = 0
  23. IRESU = 0
  24. call ini(IRESU,ISORT,0,0,0,0.,0.,0.,0.)
  25. xz=0d0
  26. xd=10d0
  27. xv=20d0
  28. x(1)=4.
  29. X(2)=8.
  30. z(1)=0.
  31. z(2)=0.
  32. * write(6,*) ' ires iogra ' , ires , iogra
  33. call dfenet(xz,xd,xz,xv,xz,xd,xz,xd,xz,xv,.false.)
  34. call insegt(1,ires)
  35. * write(6,*) ' ires ' , ires
  36. tmpcar = 'Couleur No '
  37. if( icosc.eq.1) then
  38. ico1=7
  39. else
  40. ico1=8
  41. endif
  42. do 20 iy=1 , imcoul
  43. write (tmpcar(13:14),FMT='(I2)') iy
  44. rxpos = 2.
  45. rypos = 1. + iy
  46. call chcoul (ico1)
  47. call trlabl(rxpos,rypos,0.,tmpcar,15,hmin)
  48. call chcoul (iy)
  49. rxpos = 4.
  50. Y(1)=rypos
  51. y(2)=rypos
  52. call polrl(2,X,Y,Z)
  53. Y(1)=rypos+0.2
  54. y(2)=rypos+0.2
  55. call polrl(2,X,Y,Z)
  56. * call trlabl(rxpos,rypos,0.,
  57. * > 'ABCDEFGHIJKLMNOPQRSTUVWXYZ',26,hmin)
  58. 20 continue
  59. call chcoul(0)
  60. call majseg(1,0,0,0,0)
  61.  
  62. call trmess ('Clicker sur la couleur de votre choix.')
  63. call trdig (rxpos,rypos,inouse)
  64. ncoul = int (rypos - 1)
  65. if (ncoul.lt.0) ncoul=0
  66. if (ncoul.gt.imcoul) ncoul=imcoul
  67. *
  68. end
  69.  
  70.  
  71.  
  72.  
  73.  
  74.  
  75.  
  76.  
  77.  
  78.  
  79.  

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