From aa7f70fc5e4b6144d923b8b8cb6582dd9b2feb7a Mon Sep 17 00:00:00 2001 From: michael Date: Thu, 22 Nov 2007 18:14:44 +0000 Subject: [PATCH] * Fix by Laurent Jacques to read all formats git-svn-id: trunk@9317 - --- packages/fcl-image/src/fpreadtga.pp | 201 +++++++++++++++++----------- 1 file changed, 123 insertions(+), 78 deletions(-) diff --git a/packages/fcl-image/src/fpreadtga.pp b/packages/fcl-image/src/fpreadtga.pp index 5ad4bdf964..28338539f0 100644 --- a/packages/fcl-image/src/fpreadtga.pp +++ b/packages/fcl-image/src/fpreadtga.pp @@ -14,6 +14,8 @@ } {*****************************************************************************} +{ - 22/11/2007 Modified by Laurent Jacques for support all format } + {$mode objfpc} {$h+} @@ -23,17 +25,27 @@ interface uses FPImage, classes, sysutils, targacmn; +const + TARGA_EMPTY_IMAGE = 0; + TARGA_INDEXED_IMAGE = 1; + TARGA_TRUECOLOR_IMAGE = 2; + TARGA_GRAY_IMAGE = 3; + type + + { TFPReaderTarga } + TFPReaderTarga = class (TFPCustomImageReader) Private Procedure FreeBuffers; // Free (and nil) buffers. protected Header : TTargaHeader; + AlphaBits : Byte; Identification : ShortString; Compressed, BottomUp : Boolean; BytesPerPixel : Byte; - FPalette : PFPColor; + FPalette : PFPColor; FScanLine : PByte; FLineSize : Integer; FPaletteSize : Integer; @@ -42,6 +54,7 @@ type FLastPixel : Packed Array[0..3] of byte; // AnalyzeHeader will allocate the needed buffers. Procedure AnalyzeHeader(Img : TFPCustomImage); + procedure CreateGrayPalette; Procedure ReadPalette(Stream : TStream); procedure ReadScanLine(Row : Integer; Stream : TStream); virtual; procedure WriteScanLine(Row : Integer; Img : TFPCustomImage); virtual; @@ -87,62 +100,87 @@ Procedure TFPReaderTarga.AnalyzeHeader(Img : TFPCustomImage); begin With Header do begin - If (Flags shl 6)<>0 then - Raise Exception.Create('Interlaced targa images not supported.'); - If MapType>1 then - Raise Exception.CreateFmt('Unknown targa colormap type: %d',[MapType]); - if (PixelSize and 7)<>0 then - Raise Exception.Create('Pixelsize must be multiple of 8'); + if not (ImgType in [1, 2, 3, 9, 10, 11]) and + not (PixelSize in [8, 16, 24, 32]) then + Raise Exception.Create('Unknown/Unsupported Targa image type'); BottomUp:=(Flags and $20) <>0; - BytesPerPixel:=PixelSize shr 3; + AlphaBits := Flags and $0F; + BytesPerPixel:=PixelSize; Compressed:=ImgType>8; If Compressed then ImgType:=ImgType-8; - Case ImgType of - 1: if (BytesPerPixel<>1) or (MapType<>1) then - Raise Exception.Create('Error in targa header: Colormapped image needs 1 byte per pixel and maptype 1'); - 2: If not (BytesPerPixel in [2..4]) then - Raise Exception.Create('Error in targa header: RGB image needs bytes per pixel between 2 and 4'); - 3: begin - if BytesPerPixel<>1 then - Raise Exception.Create('Error in targa header: Grayscale image needs 1 byte per pixel.'); - end; - else - Raise Exception.CreateFmt('Unknown/Unsupported Targa image type : %d',[ImgType]); - end; - if (ToWord(MapLength)>0) and (MapEntrySize<>24) then - Raise Exception.CreateFmt('Only targa BGR colormaps are supported. Got : %d',[MapEntrySize]); - if (ToWord(MapLength)>0) and (MapType<>0) then - Raise Exception.Create('Empty colormap in Targa image file'); - FLineSize:=BytesPerPixel*ToWord(Width); + FLineSize:=(BytesPerPixel div 8)*ToWord(Width); GetMem(FScanLine,FLineSize); - FPaletteSize:=SizeOf(TFPColor)*ToWord(MapLength); + + if ImgType = TARGA_GRAY_IMAGE then + FPaletteSize:=SizeOf(TFPColor)*255 + else + FPaletteSize:=SizeOf(TFPColor)*ToWord(MapLength); GetMem(FPalette,FPaletteSize); Img.Width:=ToWord(Width); Img.Height:=ToWord(Height); end; end; +Procedure TFPReaderTarga.CreateGrayPalette; + +Var + I : Integer; + +Begin + For I:=0 To 255 Do + Begin + With FPalette[I] do + begin + Red:=I*255; + Green:=I*255; + Blue:=I*255; + Alpha:=AlphaOpaque; + end; + end; +End; + Procedure TFPReaderTarga.ReadPalette(Stream : TStream); Var - Entry : TBGREntry; + BGREntry : TBGREntry; + BGRAEntry : TBGRAEntry; I : Integer; begin - For I:=0 to ToWord(Header.MapLength)-1 do - begin - Stream.ReadBuffer(Entry,SizeOf(Entry)); - With FPalette[i] do - begin - Red:=Entry.Red; - Green:=Entry.Green; - Blue:=Entry.Blue; - Alpha:=AlphaOpaque; - end; + Case Header.MapEntrySize Of + 16, 24: + For I:=0 to ToWord(Header.MapLength)-1 do + begin + Stream.ReadBuffer(BGREntry, SizeOf(BGREntry)); + With FPalette[I] do + begin + Red:=BGREntry.Red shl 8; + Green:=BGREntry.Green shl 8; + Blue:=BGREntry.Blue shl 8; + Alpha:=alphaOpaque; + end; + end; + 32: + For I:=0 to ToWord(Header.MapLength)-1 do + begin + Stream.ReadBuffer(BGRAEntry,SizeOf(BGRAEntry)); + With FPalette[I] do + begin + Red:=BGRAEntry.Red shl 8; + Green:=BGRAEntry.Green shl 8; + Blue:=BGRAEntry.Blue shl 8; + if alphaBits = 8 then + if (BGRAEntry.Alpha and $80) <> 0 then + Alpha:=alphaTransparent + else + Alpha:=AlphaOpaque; + end; + end; end; end; + Procedure TFPReaderTarga.InternalRead (Stream:TStream; Img:TFPCustomImage); var @@ -158,8 +196,12 @@ begin If Length(Identification)<>0 then Img.Extra[KeyIdentification]:=Identification; end; - If Toword(Header.MapLength)>0 then + + If Header.MapType<>0 then ReadPalette(Stream); + if Header.ImgType = TARGA_GRAY_IMAGE then + CreateGrayPalette; + H:=Img.height; If BottomUp then For Row:=0 to H-1 do @@ -206,9 +248,9 @@ begin else FBlockCount:=B and $7F end; - Stream.ReadBuffer(FlastPixel,BytesPerPixel); + Stream.ReadBuffer(FlastPixel,BytesPerPixel shr 3); end; - For J:=0 to BytesPerPixel-1 do + For J:=0 to (BytesPerPixel shr 3)-1 do begin P[0]:=FLastPixel[j]; Inc(P); @@ -217,19 +259,10 @@ begin end; end; -const - c5to8bits : array[0..32-1] of Byte = - ( 0, 8, 16, 25, 33, 41, 49, 58, - 66, 74, 82, 90, 99, 107, 115, 123, - 132, 140, 148, 156, 165, 173, 181, 189, - 197, 206, 214, 222, 230, 239, 247, 255); - - Procedure TFPReaderTarga.WriteScanLine(Row : Integer; Img : TFPCustomImage); Var Col : Integer; - B : Byte; C : TFPColor; W : Word; P : PByte; @@ -238,54 +271,66 @@ begin C.Alpha:=AlphaOpaque; P:=FScanLine; Case Header.ImgType of - 1 : for Col:=0 to Img.width-1 do + TARGA_INDEXED_IMAGE + : for Col:=0 to Img.width-1 do Img.Colors[Col,Row]:=FPalette[P[Col]]; - 2 : for Col:=0 to Img.Width-1 do + TARGA_TRUECOLOR_IMAGE + : for Col:=0 to Img.Width-1 do begin // Fill C depending on number of pixels. case BytesPerPixel of - 2 : begin - W:=P[0]; - inc(P); - W:=W or (P[0] shl 8); - With C do - begin - Blue:=c5to8bits[W and $1F]; - W:=W shr 5; - Green:=c5to8bits[W and $1F]; - W:=W shr 5; - Red:=c5to8bits[W and $1F]; - end; + 8,16 : begin + W:=P[0]; + inc(P); + W:=W or (P[0] shl 8); + With C do + begin + Red:=((W)shr 10) shl 11; + Green:=((w)shr 5) shl 11; + Blue:=((w)) shl 11; + end; end; - 3,4 : With C do + 24,32 : With C do begin Blue:=P[0] or (P[0] shl 8); Inc(P); Green:=P[0] or (P[0] shl 8); Inc(P); Red:=P[0] or (P[0] shl 8); - If bytesPerPixel=4 then + If bytesPerPixel=32 then begin Inc(P); - // Alpha:=P[0] or (P[0] shl 8); what is TARGA Attribute ?? + Alpha:=AlphaOpaque; + if alphaBits = 8 then + if (P[0] and $80) = 0 then + Alpha:=alphaTransparent; end; end; end; // Case BytesPerPixel; Img[Col,Row]:=C; Inc(P); end; - 3 : For Col:=0 to Img.Width-1 do - begin - B:=FScanLine[Col]; - B:=B+(B Shl 8); - With C do - begin - Red:=B; - Green:=B; - Blue:=B; - end; - Img.Colors[Col,Row]:=C; - end; + TARGA_GRAY_IMAGE + : case BytesPerPixel of + 8 : for Col:=0 to Img.width-1 do + Img.Colors[Col,Row]:=FPalette[P[Col]]; + 16 : for Col:=0 to Img.width-1 do + begin + With C do + begin + Blue:=FPalette[P^].blue; + Green:=FPalette[P^].green; + Red:=FPalette[P^].red; + Inc(P); + Alpha:=AlphaOpaque; + if alphaBits = 8 then + if (P[0] and $80) = 0 then + Alpha:=alphaTransparent; + Inc(P); + end; + Img[Col,Row]:=C; + end; + end; end; end;