/packages/fcl-image/src/fpreadpcx.pas
Pascal | 310 lines | 270 code | 20 blank | 20 comment | 19 complexity | 1e1670ac12ac3e11f54e1eb708eb75c7 MD5 | raw file
Possible License(s): LGPL-2.0, LGPL-2.1, LGPL-3.0
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.