home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 15 / CDACTUAL15.iso / cdactual / program / basic / PGL.ZIP / PGLFS.ZIP / USERFILL.FOR < prev    next >
Encoding:
Text File  |  1992-01-20  |  2.4 KB  |  69 lines
  1. C*****************************************************************************
  2. C  USERFILL.FOR
  3. C
  4. C  This sample program demonstrates user defined fill patterns.
  5. C
  6. C  Warning:  Be sure the correct DATA statments are uncommented for
  7. C            use with your compiler, or else you will get fatal errors
  8. C            when you try to compile.  Lahey Fortran requires the data 
  9. C            to be in hex format when put in a DATA statement for character
  10. C            variables.  Microsoft Fortran allows either decimal or hex
  11. C            format data in the DATA statement.
  12. C****************************************************************************
  13.       include      "pgl.for"
  14.       integer*2    j, ierr, color, dx
  15.       character*20 fillstyle(12)
  16.       character    oldfill(8,3)
  17.       character    userfill(8,3)
  18.  
  19. C  Microsoft Fortran
  20.       data userfill/ 16#FF,16#80,16#80,16#80,16#FF,16#08,16#08,16#08,
  21.      +               16#FF,16#88,16#88,16#88,16#FF,16#08,16#08,16#08,
  22.      +               16#FF,16#08,16#08,16#08,16#FF,16#08,16#08,16#08/
  23.  
  24. C  Lahey Fortran
  25. C      data userfill/ Z'FF',Z'80',Z'80',Z'80',Z'FF',Z'08',Z'08',Z'08',
  26. C     +               Z'FF',Z'88',Z'88',Z'88',Z'FF',Z'08',Z'08',Z'08',
  27. C     +               Z'FF',Z'08',Z'08',Z'08',Z'FF',Z'08',Z'08',Z'08'/
  28.  
  29.       fillstyle(1) = "FILL 1"//CHAR(0)
  30.       fillstyle(2) = "FILL 2"//CHAR(0)
  31.       fillstyle(3) = "FILL 3"//CHAR(0)
  32. C    
  33. C    Open A Drawing File.
  34. C    
  35.     call pgInitDrw( "USERFILL.PLT"//CHAR(0), 4000, 3000, ierr) 
  36.       if( ierr .ne. 0)then
  37.          print *, 'Error opening drawing file!'
  38.          stop
  39.       endif
  40.  
  41.       call pgSetTextStyle( pgTRIPLEX ) 
  42.       call pgSetTextJustify( pgCENTER, pgTOP ) 
  43.       call pgSetCharSpacing( 3 )
  44.       call pgSetTextScaling( 2,1,2,1 ) 
  45.       call pgSetColor( 15 )
  46.  
  47.       do j=1,3
  48. C       Display user fill j
  49.         call pgSetFillPattern( userfill(1,j), 1 )
  50.         call pgRectangle( 100+(j-1)*1000,100,900+(j-1)*1000,
  51.      +        900,pgOFILL)
  52.         call pgDrawTextXY( 500+(j-1)*1000, 920, fillstyle(j) )
  53. C       Get old fill & color 
  54.         call pgGetFillPattern( oldfill(1,j), color )
  55.       enddo
  56.  
  57.       do j=1,3
  58.         call pgSetFillPattern( oldfill(1,j), color )
  59.         call pgRectangle( 100+(j-1)*1000, 1100, 900+(j-1)*1000,
  60.      +        1900,pgOFILL)
  61.         call pgDrawTextXY( 500+(j-1)*1000, 1920, fillstyle(j) )
  62.       enddo
  63. C
  64. C      Close The Drawing File.
  65. C    
  66.       call pgEndDrw() 
  67. C
  68.       END
  69.