/packages/fcl-image/src/fpreadtga.pp
Puppet | 345 lines | 345 code | 0 blank | 0 comment | 0 complexity | 86f8fa337657dff63f406359be946ed8 MD5 | raw file
Possible License(s): LGPL-2.0, LGPL-2.1, LGPL-3.0
1{*****************************************************************************} 2{ 3 This file is part of the Free Pascal's "Free Components Library". 4 Copyright (c) 2003 by Mazen NEIFER of the Free Pascal development team 5 6 BMP writer implementation. 7 8 See the file COPYING.FPC, included in this distribution, 9 for details about the copyright. 10 11 This program is distributed in the hope that it will be useful, 12 but WITHOUT ANY WARRANTY; without even the implied warranty of 13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 14} 15{*****************************************************************************} 16 17{ - 22/11/2007 Modified by Laurent Jacques for support all format } 18 19{$mode objfpc} 20{$h+} 21 22unit FPReadTGA; 23 24interface 25 26uses FPImage, classes, sysutils, targacmn; 27 28const 29 TARGA_EMPTY_IMAGE = 0; 30 TARGA_INDEXED_IMAGE = 1; 31 TARGA_TRUECOLOR_IMAGE = 2; 32 TARGA_GRAY_IMAGE = 3; 33 34type 35 36 { TFPReaderTarga } 37 38 TFPReaderTarga = class (TFPCustomImageReader) 39 Private 40 Procedure FreeBuffers; // Free (and nil) buffers. 41 protected 42 Header : TTargaHeader; 43 AlphaBits : Byte; 44 Identification : ShortString; 45 Compressed, 46 BottomUp : Boolean; 47 BytesPerPixel : Byte; 48 FPalette : PFPColor; 49 FScanLine : PByte; 50 FLineSize : Integer; 51 FPaletteSize : Integer; 52 FBlockCount : Integer; 53 FPixelCount : Integer; 54 FLastPixel : Packed Array[0..3] of byte; 55 // AnalyzeHeader will allocate the needed buffers. 56 Procedure AnalyzeHeader(Img : TFPCustomImage); 57 procedure CreateGrayPalette; 58 Procedure ReadPalette(Stream : TStream); 59 procedure ReadScanLine(Row : Integer; Stream : TStream); virtual; 60 procedure WriteScanLine(Row : Integer; Img : TFPCustomImage); virtual; 61 // required by TFPCustomImageReader 62 procedure InternalRead (Stream:TStream; Img:TFPCustomImage); override; 63 function InternalCheck (Stream:TStream) : boolean; override; 64 public 65 constructor Create; override; 66 destructor Destroy; override; 67 end; 68 69Implementation 70 71Constructor TFPReaderTarga.Create; 72 73begin 74end; 75 76Destructor TFPReaderTarga.Destroy; 77 78begin 79 FreeBuffers; 80 Inherited; 81end; 82 83Procedure TFPReaderTarga.FreeBuffers; 84 85begin 86 If (FScanLine<>Nil) then 87 begin 88 FreeMem(FScanLine); 89 FScanLine:=Nil; 90 end; 91 If (FPalette<>Nil) then 92 begin 93 FreeMem(FPalette); 94 FScanLine:=Nil; 95 end; 96end; 97 98Procedure TFPReaderTarga.AnalyzeHeader(Img : TFPCustomImage); 99 100begin 101 With Header do 102 begin 103 if not (ImgType in [1, 2, 3, 9, 10, 11]) and 104 not (PixelSize in [8, 16, 24, 32]) then 105 Raise Exception.Create('Unknown/Unsupported Targa image type'); 106 BottomUp:=(Flags and $20) <>0; 107 AlphaBits := Flags and $0F; 108 BytesPerPixel:=PixelSize; 109 Compressed:=ImgType>8; 110 If Compressed then 111 ImgType:=ImgType-8; 112 FLineSize:=(BytesPerPixel div 8)*ToWord(Width); 113 GetMem(FScanLine,FLineSize); 114 115 if ImgType = TARGA_GRAY_IMAGE then 116 FPaletteSize:=SizeOf(TFPColor)*255 117 else 118 FPaletteSize:=SizeOf(TFPColor)*ToWord(MapLength); 119 GetMem(FPalette,FPaletteSize); 120 Img.Width:=ToWord(Width); 121 Img.Height:=ToWord(Height); 122 end; 123end; 124 125Procedure TFPReaderTarga.CreateGrayPalette; 126 127Var 128 I : Integer; 129 130Begin 131 For I:=0 To 255 Do 132 Begin 133 With FPalette[I] do 134 begin 135 Red:=I*255; 136 Green:=I*255; 137 Blue:=I*255; 138 Alpha:=AlphaOpaque; 139 end; 140 end; 141End; 142 143Procedure TFPReaderTarga.ReadPalette(Stream : TStream); 144 145Var 146 BGREntry : TBGREntry; 147 BGRAEntry : TBGRAEntry; 148 I : Integer; 149 150begin 151 Case Header.MapEntrySize Of 152 16, 24: 153 For I:=0 to ToWord(Header.MapLength)-1 do 154 begin 155 Stream.ReadBuffer(BGREntry, SizeOf(BGREntry)); 156 With FPalette[I] do 157 begin 158 Red:=BGREntry.Red shl 8; 159 Green:=BGREntry.Green shl 8; 160 Blue:=BGREntry.Blue shl 8; 161 Alpha:=alphaOpaque; 162 end; 163 end; 164 32: 165 For I:=0 to ToWord(Header.MapLength)-1 do 166 begin 167 Stream.ReadBuffer(BGRAEntry,SizeOf(BGRAEntry)); 168 With FPalette[I] do 169 begin 170 Red:=BGRAEntry.Red shl 8; 171 Green:=BGRAEntry.Green shl 8; 172 Blue:=BGRAEntry.Blue shl 8; 173 if alphaBits = 8 then 174 if (BGRAEntry.Alpha and $80) <> 0 then 175 Alpha:=alphaTransparent 176 else 177 Alpha:=AlphaOpaque; 178 end; 179 end; 180 end; 181end; 182 183 184Procedure TFPReaderTarga.InternalRead (Stream:TStream; Img:TFPCustomImage); 185 186var 187 H,Row : Integer; 188 189begin 190 Stream.Read(Header,SizeOf(Header)); 191 AnalyzeHeader(Img); 192 If Header.IdLen>0 then 193 begin 194 SetLength(Identification,Header.IDLen); 195 Stream.Read(Identification[1],Header.Idlen); 196 If Length(Identification)<>0 then 197 Img.Extra[KeyIdentification]:=Identification; 198 end; 199 200 If Header.MapType<>0 then 201 ReadPalette(Stream); 202 if Header.ImgType = TARGA_GRAY_IMAGE then 203 CreateGrayPalette; 204 205 H:=Img.height; 206 If BottomUp then 207 For Row:=0 to H-1 do 208 begin 209 ReadScanLine(Row,Stream); 210 WriteScanLine(Row,Img); 211 end 212 else 213 For Row:=H-1 downto 0 do 214 begin 215 ReadScanLine(Row,Stream); 216 WriteScanLine(Row,Img); 217 end; 218end; 219 220Procedure TFPReaderTarga.ReadScanLine(Row : Integer; Stream : TStream); 221 222Var 223 P : PByte; 224 B : Byte; 225 I,J : Integer; 226 227begin 228 If Not Compressed then 229 Stream.ReadBuffer(FScanLine^,FLineSize) 230 else 231 begin 232 P:=FScanLine; 233 For I:=0 to ToWord(Header.Width)-1 do 234 begin 235 If (FPixelCount>0) then 236 Dec(FPixelCount) 237 else 238 begin 239 Dec(FBlockCount); 240 If (FBlockCount<0) then 241 begin 242 Stream.ReadBuffer(B,1); 243 If (B and $80)<>0 then 244 begin 245 FPixelCount:=B and $7F; 246 FblockCount:=0; 247 end 248 else 249 FBlockCount:=B and $7F 250 end; 251 Stream.ReadBuffer(FlastPixel,BytesPerPixel shr 3); 252 end; 253 For J:=0 to (BytesPerPixel shr 3)-1 do 254 begin 255 P[0]:=FLastPixel[j]; 256 Inc(P); 257 end; 258 end; 259 end; 260end; 261 262Procedure TFPReaderTarga.WriteScanLine(Row : Integer; Img : TFPCustomImage); 263 264Var 265 Col : Integer; 266 C : TFPColor; 267 W : Word; 268 P : PByte; 269 270begin 271 C.Alpha:=AlphaOpaque; 272 P:=FScanLine; 273 Case Header.ImgType of 274 TARGA_INDEXED_IMAGE 275 : for Col:=0 to Img.width-1 do 276 Img.Colors[Col,Row]:=FPalette[P[Col]]; 277 TARGA_TRUECOLOR_IMAGE 278 : for Col:=0 to Img.Width-1 do 279 begin 280 // Fill C depending on number of pixels. 281 case BytesPerPixel of 282 8,16 : begin 283 W:=P[0]; 284 inc(P); 285 W:=W or (P[0] shl 8); 286 With C do 287 begin 288 Red:=((W)shr 10) shl 11; 289 Green:=((w)shr 5) shl 11; 290 Blue:=((w)) shl 11; 291 end; 292 end; 293 24,32 : With C do 294 begin 295 Blue:=P[0] or (P[0] shl 8); 296 Inc(P); 297 Green:=P[0] or (P[0] shl 8); 298 Inc(P); 299 Red:=P[0] or (P[0] shl 8); 300 If bytesPerPixel=32 then 301 begin 302 Inc(P); 303 Alpha:=AlphaOpaque; 304 if alphaBits = 8 then 305 if (P[0] and $80) = 0 then 306 Alpha:=alphaTransparent; 307 end; 308 end; 309 end; // Case BytesPerPixel; 310 Img[Col,Row]:=C; 311 Inc(P); 312 end; 313 TARGA_GRAY_IMAGE 314 : case BytesPerPixel of 315 8 : for Col:=0 to Img.width-1 do 316 Img.Colors[Col,Row]:=FPalette[P[Col]]; 317 16 : for Col:=0 to Img.width-1 do 318 begin 319 With C do 320 begin 321 Blue:=FPalette[P^].blue; 322 Green:=FPalette[P^].green; 323 Red:=FPalette[P^].red; 324 Inc(P); 325 Alpha:=AlphaOpaque; 326 if alphaBits = 8 then 327 if (P[0] and $80) = 0 then 328 Alpha:=alphaTransparent; 329 Inc(P); 330 end; 331 Img[Col,Row]:=C; 332 end; 333 end; 334 end; 335end; 336 337function TFPReaderTarga.InternalCheck (Stream:TStream) : boolean; 338 339begin 340 Result:=True; 341end; 342 343initialization 344 ImageHandlers.RegisterImageReader ('TARGA Format', 'tga', TFPReaderTarga); 345end.