home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 15 / CDACTUAL15.iso / cdactual / program / basic / PGL.ZIP / PGLPS.ZIP / USERFILL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-01-20  |  2.4 KB  |  89 lines
  1. { USERFILL.PAS }
  2. { PGL - Turbo Pascal Test Program }
  3. { User Fill pattern display test program }
  4.  
  5. program geom;
  6. {$R-,S-}
  7. uses Crt, PGL;
  8.  
  9. label
  10. ExitPgm;
  11.  
  12. type
  13.   fill = string[20];
  14.   userpat = array [0..7] of byte;
  15.  
  16. const
  17.    fillstyle : array [0..2] of fill =(' USER FILL 1',
  18.                                       ' USER FILL 2',
  19.                                       ' USER FILL 3' );
  20.    userfill  : array [0..2] of userpat = ( ($FF,$80,$80,$80,$FF,$08,$08,$08),
  21.                                            ($FF,$88,$88,$88,$FF,$08,$08,$08),
  22.                                            ($FF,$08,$08,$08,$FF,$08,$08,$08) );
  23.  
  24. var
  25.    j, ierr, dx, color : integer;
  26.    oldfill  : array [0..2] of userpat;
  27.  
  28. { ****   FillPat main procedure   ****  }
  29. begin
  30.     pgInitDrw( 'UserFill.plt', 4000, 3000, ierr );
  31.     if ierr <> 0 then
  32.      begin
  33.         Writeln('Error in pgInitDrw' ); 
  34.         goto ExitPgm;
  35.      end;
  36.  
  37.    { Set up text style,color,size, & justicfication }
  38.     pgSetTextStyle( pgTRIPLEX );
  39.     pgSetTextJustify( pgCENTER, pgTOP );
  40.     pgSetCharSpacing( 3 );
  41.     pgSetTextScaling( 2, 1, 2, 1 );
  42.     pgSetColor( 15 );
  43.  
  44.    { Display user fill 1 }
  45.     pgSetFillPattern( userfill[0], 1 );
  46.     pgRectangle( 100, 100, 900, 900, pgOFILL );
  47.     pgDrawTextXY( 500, 920, fillstyle[0] );
  48.  
  49.    { Get old fill & color }
  50.     pgGetFillPattern( oldfill[0], color );
  51.  
  52.    { Display user fill 2 }
  53.     pgSetFillPattern( userfill[1], 1 );
  54.     pgRectangle( 1100, 100, 1900, 900, pgOFILL );
  55.     pgDrawTextXY( 1500, 920, fillstyle[1] );
  56.  
  57.    { Get old fill & color }
  58.     pgGetFillPattern( oldfill[1], color );
  59.  
  60.    { Display user fill 3 }
  61.     pgSetFillPattern( userfill[2], 1 );
  62.     pgRectangle( 2100, 100, 2900, 900, pgOFILL );
  63.     pgDrawTextXY( 2500, 920, fillstyle[2] );
  64.  
  65.    { Get old fill & color }
  66.     pgGetFillPattern( oldfill[2], color );
  67.  
  68.    { Display old fill 1 }
  69.     pgSetFillPattern( oldfill[0], color );
  70.     pgRectangle( 100, 1100, 900, 1900, pgOFILL );
  71.     pgDrawTextXY( 500, 1920, fillstyle[0] );
  72.  
  73.    { Display old fill 2 }
  74.     pgSetFillPattern( oldfill[1], color );
  75.     pgRectangle( 1100, 1100, 1900, 1900, pgOFILL );
  76.     pgDrawTextXY( 1500, 1920, fillstyle[1] );
  77.  
  78.    { Display old fill 3 }
  79.     pgSetFillPattern( oldfill[2], color );
  80.     pgRectangle( 2100, 1100, 2900, 1900, pgOFILL );
  81.     pgDrawTextXY( 2500, 1920, fillstyle[2] );
  82.  
  83.  
  84.  
  85.    { Close The Drawing File. }
  86.     pgEndDrw ;
  87. ExitPgm:
  88. end.
  89.