home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 15 / CDACTUAL15.iso / cdactual / program / basic / PGL.ZIP / PGLPS.ZIP / GEOM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-01-20  |  2.5 KB  |  108 lines
  1. { GEOM.PAS }
  2. { PGL - Turbo Pascal Test Program }
  3. { Geometry display test program }
  4.  
  5. program geom;
  6. {$R-,S-}
  7. uses Crt, PGL;
  8.  
  9. label
  10. ExitPgm;
  11.  
  12. type
  13.   linestyle = string[20];
  14.  
  15. const
  16.     polydata : array [0..11] of integer = ( 500, 200,
  17.                                              100, 400,
  18.                                              300, 800,
  19.                                              600, 600,
  20.                                              900, 700,
  21.                                              750, 300  );
  22. var
  23.    j, ierr : integer;
  24.    pdata   : array [0..11] of integer;
  25.  
  26. { ****   Geom main procedure   ****  }
  27. begin
  28.   pgInitDrw( 'Geom.plt', 3001, 3001, ierr );
  29.   if  ierr <> 0 then
  30.     begin
  31.        Writeln('Error in pgInitDrw' ); 
  32.        goto ExitPgm;
  33.     end;
  34.  
  35.    pgSetTextStyle( pgTRIPLEX );
  36.    pgSetTextJustify( pgCENTER, pgBOTTOM );
  37.    pgSetCharSpacing( 3 );
  38.    pgSetTextScaling( 2, 1, 2, 1 );
  39.    pgSetColor( 15 );
  40.  
  41.    pgRectangle( 0, 0, 3000, 3000, pgOUTLINE );
  42.    pgLine( 0, 1000, 3000, 1000 );
  43.    pgLine( 0, 2000, 3000, 2000 );
  44.    pgLine( 1000, 0, 1000, 3000 );
  45.    pgLine( 2000, 0, 2000, 3000 );
  46.  
  47. { 1 }
  48.    pgArc( 500, 500, 300, 0, 210 );
  49.    pgDrawTextXY( 500, 990, 'ARC' );
  50.  
  51. { 2 }
  52.    pgSetFillStyle( 2, 1 );
  53.    pgCircle( 1500, 500, 300, pgOFILL );
  54.    pgDrawTextXY( 1500, 990, 'CIRCLE' );
  55.  
  56. { 3 }
  57.    pgEllArc( 2500, 500, 400, 300, 0, 210 );
  58.    pgDrawTextXY( 2500, 990, 'ELLARC' );
  59.  
  60. { 4 }
  61.    pgSetFillStyle( 3, 1 );
  62.    pgEllipse( 500, 1500, 400, 300, pgOFILL );
  63.    pgDrawTextXY( 500, 1990, 'ELLIPSE' );
  64.  
  65. { 5 }
  66.    pgSetFillStyle( 4, 1 );
  67.    pgPie( 1500, 1500, 300, 0, 240, pgOFILL );
  68.    pgDrawTextXY( 1500, 1990, 'PIE' );
  69.  
  70. { 6 }
  71.    j:=0;
  72.    While j <= 11 DO
  73.      BEGIN
  74.       pdata[j]   := polydata[j]   + 2000;
  75.       pdata[j+1] := polydata[j+1] + 1000;
  76.       j:=j+2;
  77.     END;
  78.    pgSetFillStyle( 5, 1 );
  79.    pgPolyLine( pdata, 6 );
  80.    pgDrawTextXY( 2500, 1990, 'POLYLINE' );
  81.  
  82. { 7 }
  83.    j:=0;
  84.    While j <= 11 DO
  85.      BEGIN
  86.       pdata[j]   := polydata[j]   + 0;
  87.       pdata[j+1] := polydata[j+1] + 2000;
  88.       j:=j+2;
  89.     END;
  90.    pgSetFillStyle( 6, 1 );
  91.    pgPolygon( pdata, 6, pgOFILL );
  92.    pgDrawTextXY( 500, 2990, 'POLYGON' );
  93.  
  94. { 8 }
  95.    pgSetFillStyle( 7, 1 );
  96.    pgRectangle( 1500-400, 2500-300, 1500+400, 2500+300, pgOFILL );
  97.    pgDrawTextXY( 1500, 2990, 'RECTANGLE' );
  98.  
  99. { 9 }
  100.    pgSetFillStyle( 8, 1 );
  101.    pgSector( 2500, 2500, 400, 300, 0, 300, pgOFILL );
  102.    pgDrawTextXY( 2500, 2990, 'SECTOR' );
  103.  
  104.    { Close The Drawing File. }
  105.    pgEndDrw ;
  106. ExitPgm:
  107. end.
  108.