/packages/fcl-image/src/fpreadpcx.pas

  1{ Copyright (C) 2007 Laurent Jacques
  2
  3  This library is free software; you can redistribute it and/or modify it
  4  under the terms of the GNU Library General Public License as published by
  5  the Free Software Foundation; either version 2 of the License, or (at your
  6  option) any later version.
  7
  8  This program is distributed in the hope that it will be useful, but WITHOUT
  9  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
 10  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
 11  for more details.
 12
 13  You should have received a copy of the GNU Library General Public License
 14  along with this library; if not, write to the Free Software Foundation,
 15  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 16
 17  Load all format compressed or not
 18}
 19
 20unit FPReadPCX;
 21
 22{$mode objfpc}{$H+}
 23
 24interface
 25
 26uses FPImage, Classes, SysUtils, pcxcomn;
 27
 28type
 29
 30  { TFPReaderPCX }
 31
 32  TFPReaderPCX = class(TFPCustomImageReader)
 33  private
 34    FCompressed: boolean;
 35  protected
 36    Header:     TPCXHeader;
 37    BytesPerPixel: byte;
 38    FScanLine:  PByte;
 39    FLineSize:  integer;
 40    TotalWrite: longint;
 41    procedure CreateGrayPalette(Img: TFPCustomImage);
 42    procedure CreateBWPalette(Img: TFPCustomImage);
 43    procedure CreatePalette16(Img: TFPCustomImage);
 44    procedure ReadPalette(Stream: TStream; Img: TFPCustomImage);
 45    procedure AnalyzeHeader(Img: TFPCustomImage);
 46    function InternalCheck(Stream: TStream): boolean; override;
 47    procedure InternalRead(Stream: TStream; Img: TFPCustomImage); override;
 48    procedure ReadScanLine(Row: integer; Stream: TStream); virtual;
 49    procedure UpdateProgress(percent: longint);
 50    procedure WriteScanLine(Row: integer; Img: TFPCustomImage); virtual;
 51  public
 52    property Compressed: boolean Read FCompressed;
 53  end;
 54
 55implementation
 56
 57
 58procedure TFPReaderPCX.CreatePalette16(Img: TFPCustomImage);
 59var
 60  I: integer;
 61  c: TFPColor;
 62begin
 63  Img.UsePalette := True;
 64  Img.Palette.Clear;
 65  for I := 0 to 15 do
 66  begin
 67    with c, header do
 68    begin
 69      Red   := ColorMap[I].red shl 8;
 70      Green := ColorMap[I].Green shl 8;
 71      Blue  := ColorMap[I].Blue shl 8;
 72      Alpha := alphaOpaque;
 73    end;
 74    Img.Palette.Add(c);
 75  end;
 76end;
 77
 78procedure TFPReaderPCX.CreateGrayPalette(Img: TFPCustomImage);
 79var
 80  I: integer;
 81  c: TFPColor;
 82begin
 83  Img.UsePalette := True;
 84  Img.Palette.Clear;
 85  for I := 0 to 255 do
 86  begin
 87    with c do
 88    begin
 89      Red   := I * 255;
 90      Green := I * 255;
 91      Blue  := I * 255;
 92      Alpha := alphaOpaque;
 93    end;
 94    Img.Palette.Add(c);
 95  end;
 96end;
 97
 98procedure TFPReaderPCX.CreateBWPalette(Img: TFPCustomImage);
 99begin
100  Img.UsePalette := True;
101  Img.Palette.Clear;
102  Img.Palette.Add(colBlack);
103  Img.Palette.Add(colWhite);
104end;
105
106procedure TFPReaderPCX.ReadPalette(Stream: TStream; Img: TFPCustomImage);
107var
108  RGBEntry: TRGB;
109  I:      integer;
110  c:      TFPColor;
111  OldPos: integer;
112begin
113  Img.UsePalette := True;
114  Img.Palette.Clear;
115  OldPos := Stream.Position;
116  Stream.Position := Stream.Size - 768;
117  for I := 0 to 255 do
118  begin
119    Stream.Read(RGBEntry, SizeOf(RGBEntry));
120    with c do
121    begin
122      Red   := RGBEntry.Red shl 8;
123      Green := RGBEntry.Green shl 8;
124      Blue  := RGBEntry.Blue shl 8;
125      Alpha := alphaOpaque;
126    end;
127    Img.Palette.Add(C);
128  end;
129  Stream.Position := OldPos;
130end;
131
132procedure TFPReaderPCX.AnalyzeHeader(Img: TFPCustomImage);
133begin
134  with Header do
135  begin
136    if not ((FileID in [$0A, $0C]) and (ColorPlanes in [1, 3, 4]) and
137      (Version in [0, 2, 3, 5]) and (PaletteType in [1, 2])) then
138      raise Exception.Create('Unknown/Unsupported PCX image type');
139    BytesPerPixel := BitsPerPixel * ColorPlanes;
140    FCompressed   := Encoding = 1;
141    Img.Width     := XMax - XMin + 1;
142    Img.Height    := YMax - YMin + 1;
143    FLineSize     := (BytesPerLine * ColorPlanes);
144    GetMem(FScanLine, FLineSize);
145  end;
146end;
147
148procedure TFPReaderPCX.ReadScanLine(Row: integer; Stream: TStream);
149var
150  P: PByte;
151  B: byte;
152  bytes, Count: integer;
153begin
154  P     := FScanLine;
155  bytes := FLineSize;
156  Count := 0;
157  if Compressed then
158  begin
159    while bytes > 0 do
160    begin
161      if (Count = 0) then
162      begin
163        Stream.ReadBuffer(B, 1);
164        if (B < $c0) then
165          Count := 1
166        else
167        begin
168          Count := B - $c0;
169          Stream.ReadBuffer(B, 1);
170        end;
171      end;
172      Dec(Count);
173      P[0] := B;
174      Inc(P);
175      Dec(bytes);
176    end;
177  end
178  else
179    Stream.ReadBuffer(FScanLine^, FLineSize);
180end;
181
182procedure TFPReaderPCX.UpdateProgress(percent: longint);
183var
184  continue: boolean;
185  Rect:     TRect;
186begin
187  Rect.Left   := 0;
188  Rect.Top    := 0;
189  Rect.Right  := 0;
190  Rect.Bottom := 0;
191  continue    := True;
192  Progress(psRunning, 0, False, Rect, '', continue);
193end;
194
195procedure TFPReaderPCX.InternalRead(Stream: TStream; Img: TFPCustomImage);
196var
197  H, Row:   integer;
198  continue: boolean;
199  Rect:     TRect;
200begin
201  TotalWrite  := 0;
202  Rect.Left   := 0;
203  Rect.Top    := 0;
204  Rect.Right  := 0;
205  Rect.Bottom := 0;
206  continue    := True;
207  Progress(psStarting, 0, False, Rect, '', continue);
208  Stream.Read(Header, SizeOf(Header));
209  AnalyzeHeader(Img);
210  case BytesPerPixel of
211    1: CreateBWPalette(Img);
212    4: CreatePalette16(Img);
213    8: ReadPalette(stream, Img);
214    else
215      if (Header.PaletteType = 2) then
216        CreateGrayPalette(Img);
217  end;
218  H := Img.Height;
219  TotalWrite := Img.Height * Img.Width;
220  for Row := 0 to H - 1 do
221  begin
222    ReadScanLine(Row, Stream);
223    WriteScanLine(Row, Img);
224  end;
225  Progress(psEnding, 100, False, Rect, '', continue);
226  freemem(FScanLine);
227end;
228
229procedure TFPReaderPCX.WriteScanLine(Row: integer; Img: TFPCustomImage);
230var
231  Col:   integer;
232  C:     TFPColor;
233  P, P1, P2, P3: PByte;
234  Z2:    word;
235  color: byte;
236begin
237  C.Alpha := AlphaOpaque;
238  P  := FScanLine;
239  Z2 := Header.BytesPerLine;
240  begin
241    case BytesPerPixel of
242      1:
243      begin
244        for Col := 0 to Img.Width - 1 do
245        begin
246          if (P[col div 8] and (128 shr (col mod 8))) <> 0 then
247            Img.Colors[Col, Row] := Img.Palette[1]
248          else
249            Img.Colors[Col, Row] := Img.Palette[0];
250          UpdateProgress(trunc(100.0 * (Row * Col / TotalWrite)));
251        end;
252      end;
253      4:
254      begin
255        P1 := P;
256        Inc(P1, Z2);
257        P2 := P;
258        Inc(P2, Z2 * 2);
259        P3 := P;
260        Inc(P3, Z2 * 3);
261        for Col := 0 to Img.Width - 1 do
262        begin
263          color := 0;
264          if (P[col div 8] and (128 shr (col mod 8))) <> 0 then
265            Inc(color, 1);
266          if (P1[col div 8] and (128 shr (col mod 8))) <> 0 then
267            Inc(color, 1 shl 1);
268          if (P2[col div 8] and (128 shr (col mod 8))) <> 0 then
269            Inc(color, 1 shl 2);
270          if (P3[col div 8] and (128 shr (col mod 8))) <> 0 then
271            Inc(color, 1 shl 3);
272          Img.Colors[Col, Row] := Img.Palette[color];
273          UpdateProgress(trunc(100.0 * (Row * Col / TotalWrite)));
274        end;
275      end;
276      8:
277      begin
278        for Col := 0 to Img.Width - 1 do
279        begin
280          Img.Colors[Col, Row] := Img.Palette[P[Col]];
281          UpdateProgress(trunc(100.0 * (Row * Col / TotalWrite)));
282        end;
283      end;
284      24:
285      begin
286        for Col := 0 to Img.Width - 1 do
287        begin
288          with C do
289          begin
290            Red   := P[col] or (P[col] shl 8);
291            Blue  := P[col + Z2 * 2] or (P[col + Z2 * 2] shl 8);
292            Green := P[col + Z2] or (P[col + Z2] shl 8);
293            Alpha := alphaOpaque;
294          end;
295          Img[col, row] := C;
296          UpdateProgress(trunc(100.0 * (Row * Col / TotalWrite)));
297        end;
298      end;
299    end;
300  end;
301end;
302
303function TFPReaderPCX.InternalCheck(Stream: TStream): boolean;
304begin
305  Result := True;
306end;
307
308initialization
309  ImageHandlers.RegisterImageReader('PCX Format', 'pcx', TFPReaderPCX);
310end.