home *** CD-ROM | disk | FTP | other *** search
/ PC Pro 2005 June (DVD) / DPPRO0605DVD.iso / Install / program files / Borland / BDS / 3.0 / Demos / Delphi.Net / CLR / PCXViewer / PcxClass.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2004-10-22  |  23.8 KB  |  778 lines

  1. unit PcxClass;
  2. {*=====================================================================
  3.   Classes:   PCX_Reader
  4.  
  5.   File:      PCXClass.pas
  6.  
  7.   Summary:
  8.        PCXClass.pas contain a moreless useful PCX-viewer class, and some
  9.              others to make it working. BitWise also needed (BitWiseClass.pas).
  10.              It will work with the most widely distributed 256 or 24bit color
  11.              pictures and the older 16 bit ones.
  12.  
  13.              Known issues are the possibly problems with true CGA pictures
  14.              and the packed 16 bit ones (with 4 planes).
  15.              Some coding solution surely will be like a stone-age way
  16.              for professionals, but probably not for starter ones in the C#-world.
  17.  
  18.              This .NET-class was implemented by Endre I Simay according to
  19.  
  20. ---------------------------------------------------------------------
  21.   This file is submitted by:
  22.  
  23.      endresy@axelero.hu
  24.      Endre I. Simay,
  25.      Hungary
  26.  
  27. THIS CODE AND INFORMATION ARE PROVIDED "AS IS" WITHOUT WARRANTY OF ANY
  28. KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE
  29. IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A
  30. PARTICULAR PURPOSE.
  31. =====================================================================*}
  32.  
  33. interface
  34. uses
  35.   System.IO,
  36.   bitwiseclass;
  37.  
  38. type
  39.   VideoModes = class //  video modes
  40.   public
  41.     CGA4,
  42.       CGA2,
  43.       EGA,
  44.       VGA,
  45.       MCGA,
  46.       MCGA2: byte;
  47.     constructor Create;
  48.   end;
  49.  
  50.   dword = UInt32;
  51.  
  52.   BITMAPFILEHEADER = record
  53.     bfType: word;
  54.     bfSize: dword;
  55.     bfReserved1,
  56.       bfReserved2: word;
  57.     bfOffBits: dword;
  58.   end; // Size=14
  59.  
  60.   BITMAPINFOHEADER = record
  61.     biSize: dword;
  62.     biWidth,
  63.       biHeight: Int32;
  64.     biPlanes,
  65.       biBitCount: word;
  66.     biCompression,
  67.       biSizeImage: dword;
  68.     biXPelsPerMeter,
  69.       biYPelsPerMeter: Int32;
  70.     biClrUsed,
  71.       biClrImportant: dword;
  72.   end; // Size=40
  73.  
  74.   PCX_Header = class
  75.   public
  76.     Manufacturer: byte; // Always 10 for PCX file
  77.     Version: byte;
  78.       {* 2 - old PCX - no palette (NOT used anymore),
  79.          3 - no palette,
  80.          4 - Microsoft Windows - no palette (only in
  81.          old files, New Windows version USES 3),
  82.          5 - WITH palette *}
  83.     Encoding: byte;
  84.       {* 1 is PCX, it is possible that we may add
  85.          additional encoding methods IN the future *}
  86.     Bits_per_pixel: byte;
  87.       {* Number of bits to represent a pixel
  88.          (per plane) - 1, 2, 4, or 8 *}
  89.     Xmin: Int16; // Image window dimensions (inclusive)
  90.     Ymin: Int16; // Xmin, Ymin are usually zero (not always)
  91.     Xmax: Int16;
  92.     Ymax: Int16;
  93.     Hdpi: Int16; // Resolution of image (dots per inch)
  94.     Vdpi: Int16; // Set to scanner resolution - 300 is default
  95.     ColorMap: array[0..15, 0..2] of byte;
  96.       {* RGB palette data (16 colors or less)
  97.          256 color palette is appended to END OF FILE *}
  98.     Reserved: byte;
  99.       {* (used to contain video mode)
  100.          now it is ignored - just set to zero *}
  101.     Nplanes: byte; // Number of planes
  102.     Bytes_per_line_per_plane,
  103.       {* Number of bytes to allocate
  104.          for a scanline plane.
  105.          MUST be an an EVEN number!
  106.          DO NOT calculate from Xmax-Xmin! *}
  107.     PaletteInfo: word;
  108.       {* 1 = black & white or color image,
  109.          2 = grayscale image - ignored IN PB4, PB4+
  110.          palette must also be set to shades of gray! *}
  111.     HscreenSize: Int16; // added for PC Paintbrush IV Plus ver 1.0,
  112.     VscreenSize: Int16; // PC Paintbrush IV ver 1.02 (and later)
  113.     Filler: array[0..53] of byte; // Set to zeros but mainly indifferent paddings to 128 byte
  114.  
  115.     constructor Create;
  116.   end;
  117.  
  118.   PCX_Reader = class
  119.   private
  120.     PictureMode: Int16;
  121.     RealWidth,
  122.       RealHeight,
  123.       Error,
  124.       Index: integer;
  125.     data: byte;
  126.     bytes_per_line: word;
  127.     video: VideoModes;
  128.     PCXheader: PCX_Header;
  129.     PCXStream: System.IO.StreamReader;
  130.     breader: System.IO.BinaryReader;
  131.     bwrite: System.IO.BinaryWriter;
  132.     ms: MemoryStream;
  133.     Fbitmapfileheader: BITMAPFILEHEADER;
  134.     Fbitmapinfoheader: BITMAPINFOHEADER;
  135.     errors: array[0..6] of string;
  136.     procedure PCX_Reader_Init;
  137.     procedure FromFileToStream(FilePath: string; IStream: Stream);
  138.     procedure FromStreamToStream(IStream: Stream);
  139.     procedure FillBitmapStructs;
  140.     procedure ReadPalettes(IStream: Stream);
  141.     procedure Read256palette(IStream: Stream); // Read in a 256 color palette at end of PCX file
  142.     procedure ReadMCGA2palette(IStream: Stream); // Read in a 24b color PCX file
  143.     procedure ReadVGA16palette(IStream: Stream); // Read in a 16 color PCX file
  144.  
  145.   strict protected
  146.       procedure Dispose(Disposing: Boolean);
  147.  
  148.   public
  149.     constructor Create;
  150.     function PCX_ErrorString: string;
  151.     function PCX_ErrorNumber: integer;
  152.     function FromStream(Source: Stream): Stream;
  153.     function FromFile(FilePath: string): Stream;
  154.   end;
  155.  
  156. implementation
  157. const
  158.   PCX_errors: array[0..6] of string = (
  159.     'No problems.',
  160.     'Problem with opening the sourcefile.',
  161.     'Problem to read the PCX-header.',
  162.     'Problem with initializing the BinaryReader.',
  163.     'Not a valid PCX-file for this decoder.',
  164.     'Problem with reading the palette.',
  165.     'Any problem with reading from or writing to a stream of the image.')
  166.   ;
  167.  
  168. constructor VideoModes.Create; //  video modes
  169. begin
  170.   inherited;
  171.   CGA4 := $04;
  172.   CGA2 := $06;
  173.   EGA := $10;
  174.   VGA := $12;
  175.   MCGA := $13;
  176.   MCGA2 := $15;
  177. end;
  178.  
  179. constructor PCX_Header.Create;
  180. begin
  181.   inherited;
  182. end;
  183.  
  184. constructor PCX_Reader.Create;
  185. begin
  186.   inherited;
  187.   PCX_Reader_Init;
  188. end;
  189.  
  190. procedure PCX_Reader.Dispose(Disposing: Boolean);
  191. begin
  192.   if (disposing) then
  193.   begin
  194.     if (bwrite <> nil) then
  195.     begin
  196.       bwrite.Close();
  197.     end;
  198.   end;
  199. end;
  200.  
  201. procedure PCX_Reader.PCX_Reader_Init;
  202. begin
  203.   video := VideoModes.Create;
  204.   PCXheader := PCX_Header.Create;
  205.   PictureMode := 0;
  206.   Error := 0;
  207.   Index := 0;
  208.   data := 0;
  209.   bytes_per_line := 0;
  210.   RealWidth := 0;
  211.   RealHeight := 0;
  212.   ms := MemoryStream.Create;
  213.   bwrite := BinaryWriter.Create(ms);
  214.   errors[0] := 'No problems.';
  215.   errors[1] := 'Problem with opening the sourcefile.';
  216.   errors[2] := 'Problem to read the PCX-header.';
  217.   errors[3] := 'Problem with initializing the BinaryReader.';
  218.   errors[4] := 'Not a valid PCX-file for this decoder.';
  219.   errors[5] := 'Problem with reading the palette.';
  220.   errors[6] := 'Any problem with reading from or writing to a stream of the image.';
  221. end;
  222.  
  223. function PCX_Reader.PCX_ErrorString: string;
  224. begin
  225.   Result := errors[Error];
  226. end;
  227.  
  228. function PCX_Reader.PCX_ErrorNumber: integer;
  229. begin
  230.   Result := Error;
  231. end;
  232.  
  233.  
  234. function PCX_Reader.FromStream(Source: Stream): Stream;
  235. var
  236.   IStream: MemoryStream;
  237. begin
  238.   IStream := MemoryStream.Create;
  239.   PCXStream := StreamReader.Create(Source);
  240.   FromStreamToStream(IStream);
  241.   if (Error = 0) then
  242.   begin
  243.     Result := IStream;
  244.   end
  245.   else
  246.   begin
  247.     Result := nil;
  248.   end;
  249. end;
  250.  
  251. function PCX_Reader.FromFile(FilePath: string): Stream;
  252. var
  253.   IStream: MemoryStream;
  254. begin
  255.   IStream := MemoryStream.Create;
  256.   PCXStream := StreamReader.Create(FilePath);
  257.   FromStreamToStream(IStream);
  258.   if (Error = 0) then
  259.   begin
  260.     Result := IStream;
  261.   end
  262.   else
  263.   begin
  264.     Result := nil;
  265.   end;
  266. end;
  267.  
  268. procedure PCX_Reader.FromFileToStream(FilePath: string; IStream: Stream);
  269.  
  270. begin
  271.   try
  272.     PCXStream := StreamReader.Create(FilePath);
  273.     FromStreamToStream(IStream);
  274.   except
  275.     Error := 1; //Problem with opening the sourcefile
  276.   end;
  277. end;
  278.  
  279. procedure PCX_Reader.FromStreamToStream(IStream: Stream);
  280. var
  281.   i, j: integer;
  282. begin
  283.   PCX_Reader_Init();
  284.   try
  285.     breader := BinaryReader.Create(PCXStream.BaseStream);
  286.     try
  287.       PCXheader.Manufacturer := breader.ReadByte();
  288.       PCXheader.Version := breader.ReadByte();
  289.       PCXheader.Encoding := breader.ReadByte();
  290.       PCXheader.Bits_per_pixel := breader.ReadByte();
  291.       PCXheader.Xmin := breader.ReadInt16();
  292.       PCXheader.Ymin := breader.ReadInt16();
  293.       PCXheader.Xmax := breader.ReadInt16();
  294.       PCXheader.Ymax := breader.ReadInt16();
  295.       PCXheader.Hdpi := breader.ReadInt16();
  296.       PCXheader.Vdpi := breader.ReadInt16();
  297.       for j := 0 to 15 do
  298.       begin
  299.         for i := 0 to 2 do
  300.         begin
  301.           PCXheader.ColorMap[j, i] := breader.ReadByte;
  302.         end;
  303.       end;
  304.       PCXheader.Reserved := breader.ReadByte();
  305.       PCXheader.Nplanes := breader.ReadByte();
  306.       PCXheader.Bytes_per_line_per_plane := breader.ReadUInt16();
  307.       PCXheader.PaletteInfo := breader.ReadUInt16();
  308.       PCXheader.HscreenSize := breader.ReadInt16();
  309.       PCXheader.VscreenSize := breader.ReadInt16();
  310.       PCXheader.Filler := breader.ReadBytes(55);
  311.     except
  312.       Error := 2; //Problem to read the PCX-header
  313.     end;
  314.   except
  315.     Error := 3; //Problem with initializing the BinaryReader
  316.   end;
  317.   if (Error = 0) then
  318.   begin
  319.     if ((PCXheader.Manufacturer <> 10) or (PCXheader.Encoding <> 1)) then
  320.     begin
  321.       Error := 4; //Not a valid PCX-file
  322.     end;
  323.     if ((PCXheader.Nplanes = 3) and (PCXheader.Bits_per_pixel = 8)) then
  324.     begin
  325.       PictureMode := video.MCGA2;
  326.     end;
  327.     if ((PCXheader.Nplanes = 4) and (PCXheader.Bits_per_pixel = 1)) then
  328.     begin
  329.       PictureMode := video.VGA;
  330.     end;
  331.  
  332.     if ((PCXheader.Nplanes = 1) and (PCXheader.Bits_per_pixel = 4)) then
  333.     begin
  334.       Error := 4; //Not a valid PCX-file for this class
  335.                  {* Not implemented yet *}
  336.     end;
  337.  
  338.     if (PCXheader.Nplanes = 1) then
  339.     begin
  340.       if (PCXheader.Bits_per_pixel = 1) then
  341.       begin
  342.         PictureMode := video.VGA;
  343.                     {* b/w PCX saved on Windows (e.g. from Paint Shop Pro)
  344.                        working with VGA-decoding, while true CGA2
  345.                        images may cause problem
  346.                     *}
  347.                     //   Error := 4; //Not a valid PCX-file for this class
  348.       end
  349.       else
  350.       begin
  351.         if (PCXheader.Bits_per_pixel = 2) then
  352.         begin
  353.           PictureMode := video.CGA4;
  354.           Error := 4; //Not a valid PCX-file for this class
  355.         end
  356.         else begin
  357.           if (PCXheader.Bits_per_pixel = 8) then
  358.           begin
  359.             PictureMode := video.MCGA;
  360.             if (PCXheader.Version <> 5) then
  361.             begin
  362.               Error := 4; //Not a valid PCX-file
  363.             end;
  364.           end;
  365.         end;
  366.       end;
  367.     end;
  368.   end;
  369.   if (Error = 0) then
  370.   begin
  371.     bytes_per_line := word(PCXheader.Bytes_per_line_per_plane * PCXheader.Nplanes);
  372.     RealWidth := PCXheader.Xmax - PCXheader.Xmin + 1;
  373.     RealHeight := PCXheader.Ymax - PCXheader.Ymin + 1;
  374.     FillBitmapStructs();
  375.     ReadPalettes(PCXStream.BaseStream);
  376.   end;
  377.   if (breader <> nil) then
  378.   begin
  379.     breader.Close();
  380.   end;
  381.   if (PCXStream <> nil) then
  382.   begin
  383.     PCXStream.Close();
  384.   end;
  385.   if (Error = 0) then
  386.   begin
  387.     (MemoryStream(bwrite.BaseStream)).WriteTo(IStream);
  388.   end
  389.   else
  390.   begin
  391.     IStream.Close;
  392.   end;
  393. end;
  394.  
  395. procedure PCX_Reader.FillBitmapStructs;
  396. begin
  397.   Fbitmapfileheader.bfType := word($4D42);
  398.   Fbitmapfileheader.bfSize := UInt32((3 * 255) + 14 {*Sizeof(BitmapFileHeader)*}
  399.     + 40 {* Sizeof(TBitmapInfoHeader) *}
  400.     + ((RealHeight) * (RealWidth)));
  401.   Fbitmapfileheader.bfReserved1 := 0;
  402.   Fbitmapfileheader.bfReserved2 := 0;
  403.   Fbitmapfileheader.bfOffBits := (4 * 256) + 14 {*Sizeof(BitmapFileHeader)*}
  404.     + 40 {* Sizeof(TBitmapInfoHeader) *};
  405.   Fbitmapinfoheader.biSize := UInt32(40);
  406.   Fbitmapinfoheader.biWidth := Int32(RealWidth);
  407.   Fbitmapinfoheader.biHeight := Int32(RealHeight);
  408.   Fbitmapinfoheader.biPlanes := word(1); // biPlanes  :=  1; Arcane and rarely used
  409.   Fbitmapinfoheader.biBitCount := word(8); //biBitCount  :=  8; Most widely occurring for PCX format
  410.   Fbitmapinfoheader.biCompression := UInt32(0); // biCompression  :=  BI_RGB; Not needed compressing for the laters
  411.   Fbitmapinfoheader.biSizeImage := UInt32(0); //biSizeImage  :=  0; Valid since we are not compressing the image
  412.   Fbitmapinfoheader.biXPelsPerMeter := Int32(143); //biXPelsPerMeter  :=  143; Rarely used (Windows not use) very arcane field
  413.   Fbitmapinfoheader.biYPelsPerMeter := Int32(143); //biYPelsPerMeter  :=  143; Ditto
  414.   Fbitmapinfoheader.biClrUsed := UInt32(0); //biClrUsed  :=  0; all colors are used
  415.   Fbitmapinfoheader.biClrImportant := UInt32(0); //biClrImportant  :=  0; all colors are important
  416. end;
  417.  
  418. procedure PCX_Reader.ReadPalettes(IStream: Stream);
  419. begin
  420.   Error := 0;
  421.   if ((PictureMode = video.MCGA) and (PCXheader.Version = 5)) then
  422.   begin
  423.     Read256palette(IStream);
  424.   end;
  425.   if (PictureMode = video.MCGA2) then
  426.   begin
  427.     ReadMCGA2palette(IStream);
  428.   end;
  429.   if (PictureMode = video.VGA) then
  430.   begin
  431.     ReadVGA16palette(IStream);
  432.   end;
  433. end;
  434.  
  435. procedure PCX_Reader.Read256palette(IStream: Stream); // Read in a 256 color palette at end of PCX file
  436. var
  437.   bytes_in_line, dY, i, j, k: integer;
  438.   count: word;
  439.   Palette256: array[0..255, 0..2] of byte;
  440.   lines: array of array of byte;
  441.  
  442. begin
  443.   IStream.Seek((IStream.Length) - 769, SeekOrigin(0));
  444.   try
  445.     if (IStream.ReadByte() = 12) then // read indicator byte
  446.     begin
  447.       for j := 0 to 255 do // read palette if there is one
  448.       begin
  449.         for i := 0 to 2 do
  450.         begin
  451.           Palette256[j, i] := byte(IStream.ReadByte());
  452.         end;
  453.       end;
  454.       IStream.Seek(128, SeekOrigin(0)); /// go back to start of PCX data
  455.       Error := 0;
  456.     end
  457.     else
  458.     begin
  459.       Error := 5; // no palette here...
  460.     end;
  461.   except
  462.     Error := 5; //Problem with reading the palette
  463.   end;
  464.  
  465.   if (Error = 0) then
  466.   begin
  467.     try
  468.       bwrite.Write(Fbitmapfileheader.bfType);
  469.       bwrite.Write(Fbitmapfileheader.bfSize);
  470.       bwrite.Write(Fbitmapfileheader.bfReserved1);
  471.       bwrite.Write(Fbitmapfileheader.bfReserved2);
  472.       bwrite.Write(Fbitmapfileheader.bfOffBits);
  473.       bwrite.Write(Fbitmapinfoheader.biSize);
  474.       bwrite.Write(Fbitmapinfoheader.biWidth);
  475.       bwrite.Write(Fbitmapinfoheader.biHeight);
  476.       bwrite.Write(Fbitmapinfoheader.biPlanes);
  477.       bwrite.Write(Fbitmapinfoheader.biBitCount);
  478.       bwrite.Write(Fbitmapinfoheader.biCompression);
  479.       bwrite.Write(Fbitmapinfoheader.biSizeImage);
  480.       bwrite.Write(Fbitmapinfoheader.biXPelsPerMeter);
  481.       bwrite.Write(Fbitmapinfoheader.biYPelsPerMeter);
  482.       bwrite.Write(Fbitmapinfoheader.biClrUsed);
  483.       bwrite.Write(Fbitmapinfoheader.biClrImportant);
  484.       for i := 0 to 255 do
  485.       begin // R, G, and B must be 0..63
  486.         bwrite.Write(byte(Palette256[i, 2]));
  487.         bwrite.Write(byte(Palette256[i, 1]));
  488.         bwrite.Write(byte(Palette256[i, 0]));
  489.         bwrite.Write(byte(0));
  490.       end;
  491.       Index := 0;
  492.       bytes_in_line := RealWidth;
  493.       dY := 4 - (bytes_in_line - (bytes_in_line div 4) * 4);
  494.       if (dY = 4) then
  495.       begin
  496.         dY := 0;
  497.       end;
  498.       bytes_in_line := bytes_in_line + dY;
  499.       SetLength(lines, RealHeight, bytes_in_line);
  500.       for i := 0 to RealHeight - 1 do
  501.       begin
  502.         if (Index <> 0) then
  503.         begin
  504.           for j := 0 to Index - 1 do
  505.           begin
  506.             lines[i, j] := data; // fills a contiguous block
  507.           end;
  508.         end;
  509.         while (Index < bytes_per_line) do // read 1 line of data (all planes)
  510.         begin
  511.           data := byte(IStream.ReadByte);
  512.           if (byte(data and byte($C0)) = byte($C0)) then
  513.           begin
  514.             count := word(byte(data and byte($3F)));
  515.             data := byte(IStream.ReadByte);
  516.             for j := 0 to count - 1 do
  517.             begin
  518.               lines[i, Index + j] := data; // fills a contiguous block
  519.             end;
  520.             Inc(Index, count);
  521.           end
  522.           else
  523.           begin
  524.             lines[i, Index] := data;
  525.             Inc(Index);
  526.           end;
  527.         end;
  528.         Index := Index - bytes_per_line;
  529.       end;
  530.       for k := RealHeight - 1 downto 0 do
  531.       begin
  532.         for i := 0 to bytes_in_line - 1 do
  533.         begin
  534.           bwrite.Write(byte(lines[k, i]));
  535.         end;
  536.       end;
  537.     except
  538.       Error := 6; // Any problem with reading from or writing to a stream of the image
  539.     end;
  540.  
  541.   end;
  542. end;
  543.  
  544. procedure PCX_Reader.ReadMCGA2palette(IStream: Stream); // Read in a 24b color PCX file
  545. var
  546.   bytes_in_line, dY, i, j, k, L, x: integer;
  547.   count: word;
  548.   lines: array of array of byte;
  549.   line: array of byte;
  550. begin
  551.   IStream.Seek(128, SeekOrigin(0)); ///  guaranted go to start of PCX data
  552.   bytes_in_line := 3 * (RealWidth);
  553.   dY := 4 - (bytes_in_line - (bytes_in_line div 4) * 4);
  554.  
  555.   if (dY = 4) then
  556.   begin
  557.     dY := 0;
  558.   end;
  559.   bytes_in_line := bytes_in_line + dY;
  560.  
  561.   if (Error = 0) then
  562.   begin
  563.     try
  564.       Fbitmapfileheader.bfSize := UInt32((3 * 15) + 14 {*Sizeof(BitmapFileHeader)*}
  565.         + 40 {* Sizeof(TBitmapInfoHeader) *}
  566.         + ((RealHeight) * (RealWidth) * 3));
  567.       Fbitmapfileheader.bfOffBits := 14 {*Sizeof(BitmapFileHeader)*}
  568.         + 40 {* Sizeof(TBitmapInfoHeader) *};
  569.       Fbitmapinfoheader.biBitCount := word(24);
  570.       bwrite.Write(Fbitmapfileheader.bfType);
  571.       bwrite.Write(Fbitmapfileheader.bfSize);
  572.       bwrite.Write(Fbitmapfileheader.bfReserved1);
  573.       bwrite.Write(Fbitmapfileheader.bfReserved2);
  574.       bwrite.Write(Fbitmapfileheader.bfOffBits);
  575.       bwrite.Write(Fbitmapinfoheader.biSize);
  576.       bwrite.Write(Fbitmapinfoheader.biWidth);
  577.       bwrite.Write(Fbitmapinfoheader.biHeight);
  578.       bwrite.Write(Fbitmapinfoheader.biPlanes);
  579.       bwrite.Write(Fbitmapinfoheader.biBitCount);
  580.       bwrite.Write(Fbitmapinfoheader.biCompression);
  581.       bwrite.Write(Fbitmapinfoheader.biSizeImage);
  582.       bwrite.Write(Fbitmapinfoheader.biXPelsPerMeter);
  583.       bwrite.Write(Fbitmapinfoheader.biYPelsPerMeter);
  584.       bwrite.Write(Fbitmapinfoheader.biClrUsed);
  585.       bwrite.Write(Fbitmapinfoheader.biClrImportant);
  586.  
  587.       Index := 0;
  588.       SetLength(lines, RealHeight, bytes_in_line * 3);
  589.       SetLength(line, bytes_in_line * 3);
  590.       for i := 0 to RealHeight - 1 do
  591.       begin
  592.         if (Index <> 0) then
  593.         begin
  594.           for j := 0 to Index - 1 do
  595.           begin
  596.             line[j] := data; // fills a contiguous block
  597.           end;
  598.         end;
  599.         while (Index < bytes_per_line) do // read 1 line of data (all planes)
  600.         begin
  601.           data := byte(IStream.ReadByte);
  602.           if (byte(data and byte($C0)) = byte($C0)) then
  603.           begin
  604.             count := word(byte(data and byte($3F)));
  605.             data := byte(IStream.ReadByte);
  606.             for j := 0 to count - 1 do
  607.             begin
  608.               line[Index + j] := data; // fills a contiguous block
  609.             end;
  610.             Inc(Index, count);
  611.           end
  612.           else
  613.           begin
  614.             line[Index] := data;
  615.             Inc(Index);
  616.           end;
  617.         end;
  618.         Index := Index - bytes_per_line;
  619.         x := 0;
  620.         for L := 0 to PCXheader.Bytes_per_line_per_plane - 1 do
  621.         begin
  622.           lines[i, x + 2] := line[L];
  623.           lines[i, x + 1] := line[L + PCXheader.Bytes_per_line_per_plane];
  624.           lines[i, x] := line[L + 2 * PCXheader.Bytes_per_line_per_plane];
  625.           lines[i, x + 3] := 0;
  626.           x := x + 3;
  627.         end;
  628.       end;
  629.       for k := RealHeight - 1 downto 0 do
  630.       begin
  631.         for i := 0 to bytes_in_line - 1 do
  632.         begin
  633.           bwrite.Write(byte(lines[k, i]));
  634.         end;
  635.       end;
  636.     except
  637.       Error := 6; // Any problem with reading from or writing to a stream of the image
  638.     end;
  639.  
  640.   end;
  641.  
  642. end;
  643.  
  644. procedure PCX_Reader.ReadVGA16palette(IStream: Stream); // Read in a 16 color PCX file
  645. var
  646.   bitwise: ByteBitWise;
  647.   c: byte;
  648.   bytes_in_line, dY, i, j, k, L, x, kmax: integer;
  649.   count: word;
  650.   lines: array of array of byte;
  651.   line: array of byte;
  652.  
  653. begin
  654.   bitwise := ByteBitWise.Create;
  655.  
  656.   IStream.Seek(128, SeekOrigin(0)); /// guaranted go to start of PCX data
  657.   if (Error = 0) then
  658.   begin
  659.     try
  660.       Fbitmapfileheader.bfSize := UInt32((3 * 15) + 14 {*Sizeof(BitmapFileHeader)*}
  661.         + 40 {* Sizeof(TBitmapInfoHeader) *}
  662.         + ((RealHeight) * (RealWidth)));
  663.       Fbitmapfileheader.bfOffBits := (4 * 16) + 14 {*Sizeof(BitmapFileHeader)*}
  664.         + 40 {* Sizeof(TBitmapInfoHeader) *};
  665.       Fbitmapinfoheader.biBitCount := word(4); //biBitCount  :=  24;
  666.       bwrite.Write(Fbitmapfileheader.bfType);
  667.       bwrite.Write(Fbitmapfileheader.bfSize);
  668.       bwrite.Write(Fbitmapfileheader.bfReserved1);
  669.       bwrite.Write(Fbitmapfileheader.bfReserved2);
  670.       bwrite.Write(Fbitmapfileheader.bfOffBits);
  671.       bwrite.Write(Fbitmapinfoheader.biSize);
  672.       bwrite.Write(Fbitmapinfoheader.biWidth);
  673.       bwrite.Write(Fbitmapinfoheader.biHeight);
  674.       bwrite.Write(Fbitmapinfoheader.biPlanes);
  675.       bwrite.Write(Fbitmapinfoheader.biBitCount);
  676.       bwrite.Write(Fbitmapinfoheader.biCompression);
  677.       bwrite.Write(Fbitmapinfoheader.biSizeImage);
  678.       bwrite.Write(Fbitmapinfoheader.biXPelsPerMeter);
  679.       bwrite.Write(Fbitmapinfoheader.biYPelsPerMeter);
  680.       bwrite.Write(Fbitmapinfoheader.biClrUsed);
  681.       bwrite.Write(Fbitmapinfoheader.biClrImportant);
  682.       for L := 0 to 15 do // R, G, and B must be 0..63
  683.       begin
  684.         bwrite.Write(byte(PCXheader.ColorMap[L, 2]));
  685.         bwrite.Write(byte(PCXheader.ColorMap[L, 1]));
  686.         bwrite.Write(byte(PCXheader.ColorMap[L, 0]));
  687.         bwrite.Write(byte(0));
  688.       end;
  689.       kmax := PCXheader.Ymin + PCXheader.Ymax;
  690.       x := 0;
  691.       Index := 0;
  692.       bytes_in_line := RealWidth div 2;
  693.       dY := 4 - (bytes_in_line - (bytes_in_line div 4) * 4);
  694.       if (dY = 4) then
  695.       begin
  696.         dY := 0;
  697.       end;
  698.       bytes_in_line := bytes_in_line + dY;
  699.       SetLength(lines, RealHeight, bytes_in_line * 2);
  700.       SetLength(line, bytes_in_line * 2);
  701.       for i := 0 to RealHeight - 1 do
  702.       begin
  703.         if (Index = 0) then
  704.         begin
  705.           for j := 0 to Index - 1 do
  706.           begin
  707.             line[j] := data; // fills a contiguous block
  708.           end;
  709.         end;
  710.         while (Index < bytes_per_line) do // read 1 line of data (all planes)
  711.         begin
  712.           data := byte(IStream.ReadByte);
  713.           if (byte(data and byte($C0)) = byte($C0)) then
  714.           begin
  715.             count := word(byte(data and byte($3F)));
  716.             data := byte(IStream.ReadByte);
  717.             for j := 0 to count - 1 do
  718.             begin
  719.               line[Index + j] := data; // fills a contiguous block
  720.             end;
  721.             Inc(Index, count);
  722.           end
  723.           else
  724.           begin
  725.             line[Index] := data;
  726.             Inc(Index);
  727.           end;
  728.         end;
  729.         Index := Index - bytes_per_line;
  730.         for dY := 0 to (bytes_in_line * 2) - 1 do
  731.         begin
  732.           lines[i, dY] := 0;
  733.         end;
  734.         x := 0;
  735.         for dY := 0 to PCXheader.Nplanes - 1 do
  736.         begin
  737.           for j := 0 to PCXheader.Bytes_per_line_per_plane - 1 do
  738.           begin
  739.             c := line[x];
  740.             Inc(x);
  741.             for k := 0 to 7 do
  742.             begin
  743.               if ((byte(c) and bitwise.byteshr(128, byte(k))) > 0) then
  744.               begin
  745.                 lines[i, (j * 8) + k] := byte(lines[i, (j * 8) + k] or bitwise.byteshl(1, byte(dY)));
  746.               end;
  747.             end;
  748.           end;
  749.         end;
  750.         for dY := 0 to (bytes_in_line * 2) - 1 do
  751.         begin
  752.           line[dY] := lines[i, dY];
  753.         end;
  754.         dY := (-1);
  755.         x := (-1);
  756.         while (x < (PCXheader.Xmax - PCXheader.Xmin)) do
  757.         begin
  758.           Inc(dY);
  759.           Inc(x);
  760.           lines[i, dY] := byte(bitwise.byteshl(line[x], 4) xor line[x + 1] and $0F);
  761.           Inc(x);
  762.         end;
  763.       end;
  764.       for k := RealHeight - 1 downto 0 do
  765.       begin
  766.         for i := 0 to bytes_in_line - 1 do
  767.         begin
  768.           bwrite.Write(byte(lines[k, i]));
  769.         end;
  770.       end;
  771.     except
  772.       Error := 6; // Any problem with reading from or writing to a stream of the image
  773.     end;
  774.   end;
  775. end;
  776.  
  777. end.
  778.