home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / TPPCX.ZIP / PCX.INT < prev    next >
Encoding:
Text File  |  1991-01-28  |  6.3 KB  |  180 lines
  1.  {══════════════════════════════════════════════════════════════════════════╗
  2.  ║ MDRUtils/Mark D.Rafn  [71530,2307]                                       ║
  3.  ║ Rt1 Box138A                                                              ║
  4.  ║ Two Harbors, MN 55616                                                    ║
  5.  ║ 218-834-5154                                                             ║
  6.  ║                                                                          ║
  7.  ║ Unit for displaying/creating ZSoft PCX format picture files              ║
  8.  ║ Must be in graphics mode.                                                ║
  9.  ╚══════════════════════════════════════════════════════════════════════════}
  10.  { See EOF for Revision Record }
  11.  
  12. {$F+,O+,D-,R-,S-}
  13. unit PCX;
  14. interface
  15. uses Graph, EGA;
  16.  
  17. type
  18.   FStr = string[ 50 ];
  19.   TripletArray = array[ 0..15,0..2] of byte;
  20.  
  21.   BufferType = array[ 1..128 ] of byte;
  22.   OffsetType = array[ 0..479 ] of longint;
  23.  
  24.   PBuf = ^BufferType;
  25.   POffset = ^OffsetType;
  26.  
  27.   Header = record
  28.     Maker, Version, Encoding, bpp: byte;
  29.     xmn, ymn, xmx, ymx, HRes, VRes: integer;
  30.     CMap: TripletArray;
  31.     Reserved, NPlanes: byte;
  32.     NBpl, Palett: integer;
  33.     end;
  34.  
  35.   DisplayRec = record
  36.     SegBase: word;
  37.     Page0, Page1: word;
  38.     HorizRes, VertRes, BytesPerLine, NoColors: integer;
  39.     end;
  40.  
  41.   { abstract objext type }
  42.   BasePcxPtr = ^BasePcx;
  43.   BasePCX = object
  44.     PCXError: byte;
  45.     Loaded: boolean;
  46.     constructor Init;
  47.     destructor Done; virtual;
  48.     procedure Show( Filename: FStr; PageNo: byte; UsePal: boolean );
  49.     procedure GetPicVp( var PicVp: viewporttype );
  50.     procedure Save( x1, y1, x2, y2: integer; Filename: FStr );
  51.     function GetPCXError: byte;
  52.     function GetXmx: integer;
  53.     function GetXmn: integer;
  54.     function GetYmx: integer;
  55.     function GetYmn: integer;
  56.     function IsMultiPlane: boolean;
  57.     function PCXLoaded: boolean;
  58.     PRIVATE
  59.       Hdr: Header;
  60.       Page: word;
  61.       PFile: pointer;
  62.       SizeF: longint;
  63.       Buf: PBuf;
  64.       Offset: POffset;
  65.       Display: DisplayRec;
  66.       f: file;
  67.       procedure OpenFile( Filename: FStr; NewFile: boolean; var OK: boolean );
  68.       procedure GetHeader;
  69.       procedure SetPal; virtual;
  70.       procedure Decode; virtual;
  71.       procedure DecodeRow( var Index: integer );
  72.       procedure WriteRow( row: integer );
  73.       procedure ReadRow( row, sbyt: integer; var inBuf: PBuf );
  74.       procedure WriteHeader;
  75.       function FillOffsets: boolean; virtual;
  76.       function Encode( Srow, Erow: integer; sbyt: byte ): integer; virtual;
  77.       function EncPut( byt, cnt: byte ): integer;
  78.       function EncodeLine( inBuf: PBuf; inLen: integer ): boolean;
  79.       function GetByte( n: integer ): byte;
  80.       function GetInteger( n1, n2: integer ): integer;
  81.     end; { object }
  82.  
  83.   HercPCXPtr = ^HercPCX;
  84.   HercPCX = object( BasePCX )
  85.     constructor Init;
  86.     destructor Done; virtual;
  87.     PRIVATE
  88.       procedure Decode; virtual;
  89.       procedure GetRow( r, sbyt: integer; var inBuf: PBuf );
  90.       function Encode( Srow, Erow: integer; sbyt: byte ): integer; virtual;
  91.       function FillOffsets: boolean; virtual;
  92.     end; { object }
  93.  
  94.   EgaPCXPtr = ^EgaPCX;
  95.   EgaPCX = object( BasePCX )
  96.     constructor Init;
  97.     destructor Done; virtual;
  98.     PRIVATE
  99.       procedure SetPal; virtual;
  100.       procedure GetRow( Plane, r, sbyt: integer; var inBuf: PBuf );
  101.       procedure Decode; virtual;
  102.       function FillOffsets: boolean; virtual;
  103.       function Encode( Srow, Erow: integer; sbyt: byte ): integer; virtual;
  104.     end; { object }
  105.  
  106.   VgaPCXPtr = ^VgaPcx;
  107.   VgaPCX = object( EgaPCX );
  108.     constructor Init;
  109.     destructor Done; virtual;
  110.     end;
  111.  
  112. const
  113.   HERC_Attr: DisplayRec = ( SegBase: $B000; Page0: $0000; Page1: $8000;
  114.                             HorizRes: 720; VertRes: 348; BytesPerLine: 90;
  115.                             NoColors: 2 );
  116.   EGA_Attr:  DisplayRec = ( SegBase: $A000; Page0: $0000; Page1: $8000;
  117.                             HorizRes: 640; VertRes: 350; BytesPerLine: 80;
  118.                             NoColors: 16 );
  119.  
  120.   PCXError0:  byte = 0;  { no error }
  121.   PCXError1:  byte = 1;  { File not found }
  122.   PCXError2:  byte = 2;  { Not enough memory for picture buffer }
  123.   PCXError3:  byte = 3;  { Error reading PCX file into RAM }
  124.   PCXError4:  byte = 4;  { Multi-plane image encountered,display adapter for single plane only }
  125.   PCXError5:  byte = 5;  { Not a valid PCX file }
  126.   PCXError6:  byte = 6;  { Incorrect PCX version. Must be v3.0 or greater }
  127.   PCXError7:  byte = 7;  { Not enough memory for Offset Buffer }
  128.   PCXError8:  byte = 8;  { unable to open new file }
  129.   PCXError9:  byte = 9;  { Encoding error }
  130.   PCXError10: byte = 10; { Image exceeds 64k limit }
  131.   PCXError11: byte = 11; { Image exceeds display capabilities }
  132.  
  133.   Zero: byte         = 0;
  134.   dMaker: byte       = 10;
  135.   dVersion: byte     = 5;
  136.   dEncoding: byte    = 1;
  137.   dbpp: byte         = 1;
  138.   dPallet: integer   = 1;
  139.   dFillSize          = 58;
  140.  
  141.   EGATriplet: TripletArray = ( { 48byte default EGA/VGA palette}
  142.     ($00, $00, $00),  {  black        }
  143.     ($00, $00, $AA),  {  blue         }
  144.     ($00, $AA, $00),  {  green        }
  145.     ($00, $AA, $AA),  {  cyan         }
  146.     ($AA, $00, $00),  {  red          }
  147.     ($AA, $00, $AA),  {  magenta      }
  148.     ($AA, $55, $00),  {  brown        }
  149.     ($AA, $AA, $AA),  {  lightgray    }
  150.     ($55, $55, $55),  {  darkgray     }
  151.     ($00, $00, $FF),  {  lightblue    }
  152.     ($00, $FF, $00),  {  lightgreen   }
  153.     ($00, $FF, $FF),  {  lightcyan    }
  154.     ($FF, $00, $00),  {  lightred     }
  155.     ($FF, $00, $FF),  {  lightmagenta }
  156.     ($FF, $FF, $00),  {  yellow       }
  157.     ($FF, $FF, $FF) );{  white        }
  158.  
  159.   MDATriplet: TripletArray = ( {48 byte default MDA palette entry for header }
  160.     ($00, $00, $00),   { black  }
  161.     ($FF, $FF, $FF),   { white  }
  162.     ($00, $00, $00),   { remaining = filler }
  163.     ($00, $00, $00),
  164.     ($00, $00, $00),
  165.     ($00, $00, $00),
  166.     ($00, $00, $00),
  167.     ($00, $00, $00),
  168.     ($00, $00, $00),
  169.     ($00, $00, $00),
  170.     ($00, $00, $00),
  171.     ($00, $00, $00),
  172.     ($00, $00, $00),
  173.     ($00, $00, $00),
  174.     ($00, $00, $00),
  175.     ($00, $00, $00));
  176.  
  177. {══════════════════════════════════════════════════════════════════════════╗
  178. ╚══════════════════════════════════════════════════════════════════════════}
  179. implementation
  180.