home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 15 / CDACTUAL15.iso / cdactual / program / basic / PGL.ZIP / PGLBS.ZIP / USERFILL.BAS < prev    next >
Encoding:
BASIC Source File  |  1992-01-20  |  1.9 KB  |  66 lines
  1. '****************************************************************************
  2. '  USERFILL.BAS
  3. '
  4. '  This sample program demonstrates the user defined fill patterns.
  5. '****************************************************************************
  6. '$INCLUDE: 'PGL.BAS'
  7.  
  8.    dfile$="USERFILL.PLT"
  9.    DIM fillstyle(3) AS STRING*25
  10.    DIM userfill%(3,2) 
  11.    DIM oldfill%(3,2) 
  12.  
  13.    fillstyle(0) = "FILL 1" 
  14.    fillstyle(1) = "FILL 2" 
  15.    fillstyle(2) = "FILL 3" 
  16.  
  17. ' Set up user fill patterns in Column Major order
  18.    userfill%(0,0)=&H80FF : userfill%(1,0)=&H8080
  19.    userfill%(2,0)=&H08FF : userfill%(3,0)=&H0808
  20.  
  21.    userfill%(0,1)=&H88FF : userfill%(1,1)=&H8888 
  22.    userfill%(2,1)=&H08FF : userfill%(3,1)=&H0808
  23.  
  24.    userfill%(0,2)=&H08FF : userfill%(1,2)=&H0808
  25.    userfill%(2,2)=&H08FF : userfill%(3,2)=&H0808
  26.  
  27.  
  28. ' ****   UserFill main procedure   ****  
  29. '    
  30. '    Open A Drawing File.
  31. '    
  32.    call pgInitDrw( dfile$, 4000, 3000, ierr% ) 
  33.    if ierr% <> 0 then
  34.       print "Error Opening Drawing File: " + dfile$ + " !"
  35.       goto exitpgm
  36.    endif
  37.    
  38.    call pgSetTextStyle( pgTRIPLEX ) 
  39.    call pgSetTextJustify( pgCENTER, pgTOP ) 
  40.    call pgSetCharSpacing( 3 ) 
  41.    call pgSetTextScaling( 2, 1, 2, 1 ) 
  42.    call pgSetColor( 15 ) 
  43.  
  44. ' Set fill patterns using userfill patterns
  45.    FOR j% = 0 TO 2
  46.       dx% = j% * 1000 
  47.       call pgSetFillPattern( userfill%(0,j%), 1 ) 
  48.       call pgRectangle( 100+dx%, 100, 900+dx%, 900, pgOFILL ) 
  49.       call pgDrawTextXY( 500+dx%, 920, fillstyle$(j%) ) 
  50.       call pgGetFillPattern( oldfill%(0,j%), 1 ) 
  51.    NEXT
  52.  
  53. ' Set fill patterns using oldfill patterns
  54.    FOR j% = 0 TO 2
  55.       dx% = j% * 1000 
  56.       call pgSetFillPattern( oldfill%(0,j%), 1 ) 
  57.       call pgRectangle( 100+dx%, 1100, 900+dx%, 1900, pgOFILL ) 
  58.       call pgDrawTextXY( 500+dx%, 1920, fillstyle$(j%) ) 
  59.    NEXT
  60.  
  61. ' Close The Drawing File. 
  62.    call pgEndDrw 
  63.  
  64. exitpgm:
  65. end
  66.