home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 15 / CDACTUAL15.iso / cdactual / program / basic / PGL.ZIP / PGLBS.ZIP / GEOM.BAS < prev    next >
Encoding:
BASIC Source File  |  1992-01-20  |  2.7 KB  |  97 lines
  1. '****************************************************************************
  2. '  GEOM.BAS
  3. '
  4. '  This sample program demonstrates the supported PGL geometries.
  5. '****************************************************************************
  6. '$INCLUDE: 'PGL.BAS'
  7.  
  8.    dfile$="GEOM.PLT"
  9.    DIM polydata(11) AS INTEGER
  10.    DIM pdata(11) AS INTEGER
  11.        polydata(0)= 500:polydata(1)= 200 :polydata(2)=100: polydata(3)=400
  12.        polydata(4)= 300:polydata(5)= 800 :polydata(6)=600: polydata(7)=600
  13.        polydata(8)= 900:polydata(9)= 700 :polydata(10)=750: polydata(11)=300
  14.  
  15. ' ****   FillPat main procedure   ****  
  16. '    
  17. '    Open A Drawing File.
  18. '    
  19.    call pgInitDrw( dfile$, 3001, 3001, ierr% ) 
  20.    if ierr% <> 0 then
  21.       print "Error Opening Drawing File: " + dfile$ + " !"
  22.       goto exitpgm
  23.    endif
  24.    
  25.    call pgSetTextStyle( pgTRIPLEX ) 
  26.    call pgSetTextJustify( pgCENTER, pgBOTTOM ) 
  27.    call pgSetCharSpacing( 3 ) 
  28.    call pgSetTextScaling( 2, 1, 2, 1 ) 
  29.    call pgSetColor( 15 ) 
  30.  
  31.    call pgRectangle( 0, 0, 3000, 3000, pgOUTLINE ) 
  32.    call pgLine( 0, 1000, 3000, 1000 ) 
  33.    call pgLine( 0, 2000, 3000, 2000 ) 
  34.    call pgLine( 1000, 0, 1000, 3000 ) 
  35.    call pgLine( 2000, 0, 2000, 3000 ) 
  36.  
  37. ' 1 
  38.    call pgArc( 500, 500, 300, 0, 210 ) 
  39.    call pgDrawTextXY( 500, 990, "ARC" ) 
  40.  
  41. ' 2 
  42.    call pgSetFillStyle( 2, 1 ) 
  43.    call pgCircle( 1500, 500, 300, pgOFILL ) 
  44.    call pgDrawTextXY( 1500, 990, "CIRCLE" ) 
  45.  
  46. '  3 
  47.    call pgEllArc( 2500, 500, 400, 300, 0, 210 ) 
  48.    call pgDrawTextXY( 2500, 990, "ELLARC" ) 
  49.  
  50. ' 4 
  51.    call pgSetFillStyle( 3, 1 ) 
  52.    call pgEllipse( 500, 1500, 400, 300, pgOFILL ) 
  53.    call pgDrawTextXY( 500, 1990, "ELLIPSE" ) 
  54.  
  55. '  5 
  56.    call pgSetFillStyle( 4, 1 ) 
  57.    call pgPie( 1500, 1500, 300, 0, 240, pgOFILL ) 
  58.    call pgDrawTextXY( 1500, 1990, "PIE" ) 
  59.  
  60. ' 6 
  61.    j%=0 
  62.    DO  While j% < 11 
  63.       pdata(j%)   = polydata(j%)   + 2000 
  64.       pdata(j%+1) = polydata(j%+1) + 1000 
  65.       j%=j%+2 
  66.    LOOP 
  67.    call pgSetFillStyle( 5, 1 ) 
  68.    call pgPolyLine( pdata(0), 6 ) 
  69.    call pgDrawTextXY( 2500, 1990, "POLYLINE" ) 
  70.  
  71. ' 7 
  72.    j%=0 
  73.    DO While j% < 11
  74.       pdata(j%)   = polydata(j%)   + 0 
  75.       pdata(j%+1) = polydata(j%+1) + 2000 
  76.       j%=j%+2 
  77.    LOOP 
  78.    call pgSetFillStyle( 6, 1 ) 
  79.    call pgPolygon( pdata(0), 6, pgOFILL ) 
  80.    call pgDrawTextXY( 500, 2990, "POLYGON" ) 
  81.  
  82. ' 8 
  83.    call pgSetFillStyle( 7, 1 ) 
  84.    call pgRectangle( 1500-400, 2500-300, 1500+400, 2500+300, pgOFILL ) 
  85.    call pgDrawTextXY( 1500, 2990, "RECTANGLE" ) 
  86.  
  87. ' 9 
  88.    call pgSetFillStyle( 8, 1 ) 
  89.    call pgSector( 2500, 2500, 400, 300, 0, 300, pgOFILL ) 
  90.    call pgDrawTextXY( 2500, 2990, "SECTOR" ) 
  91.  
  92. ' Close The Drawing File. 
  93.    call pgEndDrw 
  94.  
  95. exitpgm:
  96. end
  97.