Ver código fonte

+ Targa support. Only 24 bit input tested.

michael 21 anos atrás
pai
commit
68d10233df
5 arquivos alterados com 359 adições e 237 exclusões
  1. 11 235
      fcl/image/Makefile
  2. 1 1
      fcl/image/Makefile.fpc
  3. 299 0
      fcl/image/fpreadtga.pp
  4. 7 1
      fcl/image/imgconv.pp
  5. 41 0
      fcl/image/targacmn.pp

+ 11 - 235
fcl/image/Makefile

@@ -1,8 +1,8 @@
 #
-# Don't edit, this file is generated by FPCMake Version 1.1 [2004/02/22]
+# Don't edit, this file is generated by FPCMake Version 1.1 [2003/09/24]
 #
 default: all
-MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx palmos macos darwin emx watcom
+MAKEFILETARGETS=linux
 override PATH:=$(subst \,/,$(PATH))
 ifeq ($(findstring ;,$(PATH)),)
 inUnix=1
@@ -10,7 +10,6 @@ SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
 else
 SEARCHPATH:=$(subst ;, ,$(PATH))
 endif
-SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE))))
 PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
 ifeq ($(PWD),)
 PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
@@ -184,14 +183,11 @@ override FPCDIR:=$(FPCDIR)/..
 ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
 override FPCDIR:=$(FPCDIR)/..
 ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
-override FPCDIR:=$(BASEDIR)
-ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
 override FPCDIR=c:/pp
 endif
 endif
 endif
 endif
-endif
 ifndef CROSSDIR
 CROSSDIR:=$(FPCDIR)/cross/$(FULL_TARGET)
 endif
@@ -208,16 +204,10 @@ UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
 endif
 PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
 override PACKAGE_NAME=fcl
-override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg ellipses
+override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg targacmn fpreadtga ellipses
 ifeq ($(OS_TARGET),linux)
 override TARGET_UNITS+=freetypeh freetype ftfont
 endif
-ifeq ($(OS_TARGET),win32)
-override TARGET_UNITS+=freetypeh freetype ftfont
-endif
-ifeq ($(OS_TARGET),freebsd)
-override TARGET_UNITS+=freetypeh freetype ftfont
-endif
 override TARGET_RSTS+=pscanvas
 override TARGET_EXAMPLES+=imgconv
 override INSTALL_FPCPACKAGE=y
@@ -304,17 +294,9 @@ endif
 endif
 ifndef INSTALL_BINDIR
 ifdef UNIXINSTALLDIR
-ifdef CROSSCOMPILE
-INSTALL_BINDIR:=$(INSTALL_BASEDIR)/cross/$(FULL_TARGET)/bin
-else
 INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
-endif
-else
-ifdef CROSSCOMPILE
-INSTALL_BINDIR:=$(INSTALL_BASEDIR)/cross/$(FULL_TARGET)/bin
 else
 INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
-endif
 ifdef INSTALL_FPCPACKAGE
 INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(OS_TARGET)
 endif
@@ -446,14 +428,6 @@ STATICLIBPREFIX=
 FPCMADE=fpcmade.dos
 ZIPSUFFIX=go32
 endif
-ifeq ($(OS_TARGET),watcom)
-STATICLIBPREFIX=
-FPCMADE=fpcmade.wat
-ZIPSUFFIX=watc
-OEXT=.obj
-ASMEXT=.asm
-SHAREDLIBEXT=.dll
-endif
 ifeq ($(OS_TARGET),linux)
 EXEEXT=
 HASSHAREDLIB=1
@@ -556,11 +530,6 @@ STATICLIBPREFIX=
 FPCMADE=fpcmade.dos
 ZIPSUFFIX=go32
 endif
-ifeq ($(OS_TARGET),watcom)
-STATICLIBPREFIX=
-FPCMADE=fpcmade.dos
-ZIPSUFFIX=watcom
-endif
 ifeq ($(OS_TARGET),linux)
 EXEEXT=
 HASSHAREDLIB=1
@@ -749,11 +718,7 @@ endif
 endif
 export MVPROG
 ifndef ECHOREDIR
-ifndef inUnix
-ECHOREDIR=echo
-else
-ECHOREDIR=$(ECHO)
-endif
+ECHOREDIR:=$(subst /,$(PATHSEP),$(ECHO))
 endif
 ifndef COPY
 COPY:=$(CPPROG) -fp
@@ -824,16 +789,14 @@ TARPROG:=$(firstword $(TARPROG))
 endif
 endif
 export TARPROG
-ASNAME=$(BINUTILSPREFIX)as
-LDNAME=$(BINUTILSPREFIX)ld
-ARNAME=$(BINUTILSPREFIX)ar
-RCNAME=$(BINUTILSPREFIX)rc
-ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
-ifeq ($(OS_TARGET),win32)
 ASNAME=as
 LDNAME=ld
 ARNAME=ar
-endif
+RCNAME=rc
+ifeq ($(OS_TARGET),win32)
+ASNAME=asw
+LDNAME=ldw
+ARNAME=arw
 endif
 ifndef ASPROG
 ifdef CROSSBINDIR
@@ -942,181 +905,6 @@ REQUIRE_PACKAGES_PASZLIB=1
 REQUIRE_PACKAGES_PASJPEG=1
 endif
 endif
-ifeq ($(OS_TARGET),linux)
-ifeq ($(CPU_TARGET),arm)
-REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_PASZLIB=1
-REQUIRE_PACKAGES_PASJPEG=1
-endif
-endif
-ifeq ($(OS_TARGET),go32v2)
-ifeq ($(CPU_TARGET),i386)
-REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_PASZLIB=1
-REQUIRE_PACKAGES_PASJPEG=1
-endif
-endif
-ifeq ($(OS_TARGET),win32)
-ifeq ($(CPU_TARGET),i386)
-REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_PASZLIB=1
-REQUIRE_PACKAGES_PASJPEG=1
-endif
-endif
-ifeq ($(OS_TARGET),os2)
-ifeq ($(CPU_TARGET),i386)
-REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_PASZLIB=1
-REQUIRE_PACKAGES_PASJPEG=1
-endif
-endif
-ifeq ($(OS_TARGET),freebsd)
-ifeq ($(CPU_TARGET),i386)
-REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_PASZLIB=1
-REQUIRE_PACKAGES_PASJPEG=1
-endif
-endif
-ifeq ($(OS_TARGET),freebsd)
-ifeq ($(CPU_TARGET),m68k)
-REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_PASZLIB=1
-REQUIRE_PACKAGES_PASJPEG=1
-endif
-endif
-ifeq ($(OS_TARGET),beos)
-ifeq ($(CPU_TARGET),i386)
-REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_PASZLIB=1
-REQUIRE_PACKAGES_PASJPEG=1
-endif
-endif
-ifeq ($(OS_TARGET),netbsd)
-ifeq ($(CPU_TARGET),i386)
-REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_PASZLIB=1
-REQUIRE_PACKAGES_PASJPEG=1
-endif
-endif
-ifeq ($(OS_TARGET),netbsd)
-ifeq ($(CPU_TARGET),m68k)
-REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_PASZLIB=1
-REQUIRE_PACKAGES_PASJPEG=1
-endif
-endif
-ifeq ($(OS_TARGET),netbsd)
-ifeq ($(CPU_TARGET),powerpc)
-REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_PASZLIB=1
-REQUIRE_PACKAGES_PASJPEG=1
-endif
-endif
-ifeq ($(OS_TARGET),netbsd)
-ifeq ($(CPU_TARGET),sparc)
-REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_PASZLIB=1
-REQUIRE_PACKAGES_PASJPEG=1
-endif
-endif
-ifeq ($(OS_TARGET),amiga)
-ifeq ($(CPU_TARGET),m68k)
-REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_PASZLIB=1
-REQUIRE_PACKAGES_PASJPEG=1
-endif
-endif
-ifeq ($(OS_TARGET),atari)
-ifeq ($(CPU_TARGET),m68k)
-REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_PASZLIB=1
-REQUIRE_PACKAGES_PASJPEG=1
-endif
-endif
-ifeq ($(OS_TARGET),sunos)
-ifeq ($(CPU_TARGET),i386)
-REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_PASZLIB=1
-REQUIRE_PACKAGES_PASJPEG=1
-endif
-endif
-ifeq ($(OS_TARGET),sunos)
-ifeq ($(CPU_TARGET),sparc)
-REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_PASZLIB=1
-REQUIRE_PACKAGES_PASJPEG=1
-endif
-endif
-ifeq ($(OS_TARGET),qnx)
-ifeq ($(CPU_TARGET),i386)
-REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_PASZLIB=1
-REQUIRE_PACKAGES_PASJPEG=1
-endif
-endif
-ifeq ($(OS_TARGET),netware)
-ifeq ($(CPU_TARGET),i386)
-REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_PASZLIB=1
-REQUIRE_PACKAGES_PASJPEG=1
-endif
-endif
-ifeq ($(OS_TARGET),openbsd)
-ifeq ($(CPU_TARGET),i386)
-REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_PASZLIB=1
-REQUIRE_PACKAGES_PASJPEG=1
-endif
-endif
-ifeq ($(OS_TARGET),openbsd)
-ifeq ($(CPU_TARGET),m68k)
-REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_PASZLIB=1
-REQUIRE_PACKAGES_PASJPEG=1
-endif
-endif
-ifeq ($(OS_TARGET),wdosx)
-ifeq ($(CPU_TARGET),i386)
-REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_PASZLIB=1
-REQUIRE_PACKAGES_PASJPEG=1
-endif
-endif
-ifeq ($(OS_TARGET),palmos)
-ifeq ($(CPU_TARGET),m68k)
-REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_PASZLIB=1
-REQUIRE_PACKAGES_PASJPEG=1
-endif
-endif
-ifeq ($(OS_TARGET),macos)
-ifeq ($(CPU_TARGET),powerpc)
-REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_PASZLIB=1
-REQUIRE_PACKAGES_PASJPEG=1
-endif
-endif
-ifeq ($(OS_TARGET),darwin)
-ifeq ($(CPU_TARGET),powerpc)
-REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_PASZLIB=1
-REQUIRE_PACKAGES_PASJPEG=1
-endif
-endif
-ifeq ($(OS_TARGET),emx)
-ifeq ($(CPU_TARGET),i386)
-REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_PASZLIB=1
-REQUIRE_PACKAGES_PASJPEG=1
-endif
-endif
-ifeq ($(OS_TARGET),watcom)
-ifeq ($(CPU_TARGET),i386)
-REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_PASZLIB=1
-REQUIRE_PACKAGES_PASJPEG=1
-endif
-endif
 ifdef REQUIRE_PACKAGES_RTL
 PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/$(OS_TARGET)/Makefile.fpc,$(PACKAGESDIR))))))
 ifneq ($(PACKAGEDIR_RTL),)
@@ -1204,14 +992,6 @@ endif
 ifeq ($(OS_SOURCE),openbsd)
 override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
 endif
-ifndef CROSSBOOTSTRAP
-ifneq ($(BINUTILSPREFIX),)
-override FPCOPT+=-XP$(BINUTILSPREFIX) -Xc
-endif
-ifneq ($(BINUTILSPREFIX),)
-override FPCOPT+=-Xr$(RLINKPATH)
-endif
-endif
 ifdef UNITDIR
 override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
 endif
@@ -1336,7 +1116,7 @@ endif
 .PHONY: fpc_examples
 ifdef TARGET_EXAMPLES
 HASEXAMPLES=1
-override EXAMPLESOURCEFILES:=$(wildcard $(addsuffix .pp,$(TARGET_EXAMPLES)) $(addsuffix .pas,$(TARGET_EXAMPLES)) $(addsuffix .dpr,$(TARGET_EXAMPLES)))
+override EXAMPLESOURCEFILES:=$(wildcard $(addsuffix .pp,$(TARGET_EXAMPLES)) $(addsuffix .pas,$(TARGET_EXAMPLES)))
 override EXAMPLEFILES:=$(addsuffix $(EXEEXT),$(TARGET_EXAMPLES))
 override EXAMPLEOFILES:=$(addsuffix $(OEXT),$(TARGET_EXAMPLES)) $(addprefix $(STATICLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_EXAMPLES)))
 override CLEANEXEFILES+=$(EXAMPLEFILES) $(EXAMPLEOFILES)
@@ -1361,7 +1141,7 @@ fpc_debug:
 	$(MAKE) all DEBUG=1
 fpc_release:
 	$(MAKE) all RELEASE=1
-.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .dpr .pp .rc .res
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .pp .rc .res
 %$(PPUEXT): %.pp
 	$(COMPILER) $<
 	$(EXECPPAS)
@@ -1374,14 +1154,10 @@ fpc_release:
 %$(EXEEXT): %.pas
 	$(COMPILER) $<
 	$(EXECPPAS)
-%$(EXEEXT): %.dpr
-	$(COMPILER) $<
-	$(EXECPPAS)
 %.res: %.rc
 	windres -i $< -o $@
 vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
 vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
-vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
 vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
 .PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
 ifdef INSTALL_UNITS

+ 1 - 1
fcl/image/Makefile.fpc

@@ -12,7 +12,7 @@ packages=paszlib pasjpeg
 units=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm \
       clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp \
       fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg \
-      ellipses
+      targacmn fpreadtga ellipses
 units_win32=freetypeh freetype ftfont
 units_linux=freetypeh freetype ftfont
 units_freebsd=freetypeh freetype ftfont

+ 299 - 0
fcl/image/fpreadtga.pp

@@ -0,0 +1,299 @@
+{*****************************************************************************}
+{
+    $Id$
+    This file is part of the Free Pascal's "Free Components Library".
+    Copyright (c) 2003 by Mazen NEIFER of the Free Pascal development team
+
+    BMP writer implementation.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+{*****************************************************************************}
+
+{$mode objfpc}
+{$h+}
+
+unit FPReadTGA;
+
+interface
+
+uses FPImage, classes, sysutils, targacmn;
+
+type
+  TFPReaderTarga = class (TFPCustomImageReader)
+  Private
+    Procedure FreeBuffers;       // Free (and nil) buffers.
+  protected
+    Header         : TTargaHeader;
+    Identification : ShortString;
+    Compressed,
+    BottomUp       : Boolean; 
+    BytesPerPixel  : Byte;
+    FPalette        : PFPColor;
+    FScanLine      : PByte;
+    FLineSize      : Integer;
+    FPaletteSize   : Integer;
+    FBlockCount    : Integer;
+    FPixelCount    : Integer;
+    FLastPixel     : Packed Array[0..3] of byte;
+    // AnalyzeHeader will allocate the needed buffers.
+    Procedure AnalyzeHeader(Img : TFPCustomImage);
+    Procedure ReadPalette(Stream : TStream);
+    procedure ReadScanLine(Row : Integer; Stream : TStream); virtual;
+    procedure WriteScanLine(Row : Integer; Img : TFPCustomImage); virtual;
+    // required by TFPCustomImageReader
+    procedure InternalRead  (Stream:TStream; Img:TFPCustomImage); override;
+    function  InternalCheck (Stream:TStream) : boolean; override;
+  public
+    constructor Create; override;
+    destructor Destroy; override;
+  end;
+
+Implementation
+
+Constructor TFPReaderTarga.Create;
+
+begin
+end;
+
+Destructor TFPReaderTarga.Destroy;
+
+begin
+  FreeBuffers;
+  Inherited;
+end;
+
+Procedure TFPReaderTarga.FreeBuffers;
+
+begin
+  If (FScanLine<>Nil) then
+    begin
+    FreeMem(FScanLine);
+    FScanLine:=Nil;
+    end;
+  If (FPalette<>Nil) then
+    begin
+    FreeMem(FPalette);
+    FScanLine:=Nil;
+    end;
+end;
+
+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');
+    BottomUp:=(Flags and $20) <>0;
+    BytesPerPixel:=PixelSize shr 3;
+    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);
+    GetMem(FScanLine,FLineSize);
+    FPaletteSize:=SizeOf(TFPColor)*ToWord(MapLength);
+    GetMem(FPalette,FPaletteSize);
+    Img.Width:=ToWord(Width);
+    Img.Height:=ToWord(Height);
+    end;
+end;
+
+Procedure TFPReaderTarga.ReadPalette(Stream : TStream);
+ 
+Var
+  Entry : TBGREntry;
+  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;
+    end;
+end;
+
+Procedure TFPReaderTarga.InternalRead  (Stream:TStream; Img:TFPCustomImage); 
+
+var
+  H,Row : Integer;
+  
+begin
+  Stream.Read(Header,SizeOf(Header));
+  AnalyzeHeader(Img);
+  If Header.IdLen>0 then
+    begin
+    SetLength(Identification,Header.IDLen);
+    Stream.Read(Identification[1],Header.Idlen);
+    end;
+  If Toword(Header.MapLength)>0 then
+    ReadPalette(Stream);
+  H:=Img.height;  
+  If BottomUp then
+    For Row:=0 to H-1 do
+      begin
+      ReadScanLine(Row,Stream);
+      WriteScanLine(Row,Img);
+      end
+  else
+    For Row:=H-1 downto 0 do
+      begin
+      ReadScanLine(Row,Stream);
+      WriteScanLine(Row,Img);
+      end;
+end;
+
+Procedure TFPReaderTarga.ReadScanLine(Row : Integer; Stream : TStream);
+
+Var
+  P : PByte;
+  B : Byte;
+  I : Integer;
+  
+begin
+  If Not Compressed then
+    Stream.ReadBuffer(FScanLine^,FLineSize)
+  else
+    begin
+    P:=FScanLine;
+    For I:=0 to ToWord(Header.Width)-1 do
+      begin
+      If (FPixelCount>0) then
+        Dec(FPixelCount)
+      else
+        begin
+        Dec(FBlockCount);
+        If (FBlockCount<0) then
+          begin
+          Stream.ReadBuffer(B,1);
+          If (B and $80)<>0 then
+            begin
+            FPixelCount:=B and $7F;
+            FblockCount:=0;
+            end
+          else
+            FBlockCount:=B and $7F  
+          end;
+        Stream.ReadBuffer(FlastPixel,BytesPerPixel);  
+        end;
+      For I:=0 to BytesPerPixel-1 do
+        begin
+        P[0]:=FLastPixel[i];
+        Inc(P);
+        end;
+      end;
+    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;
+  
+begin
+  C.Alpha:=AlphaOpaque;
+  P:=FScanLine;
+  Case Header.ImgType of
+    1 : for Col:=0 to Img.width-1 do
+         Img.Colors[Col,Row]:=FPalette[P[Col]];
+    2 : 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;
+                end;
+            3,4 : 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
+                    begin
+                    Inc(P);
+                    // Alpha:=P[0] or (P[0] shl 8); what is TARGA Attribute ??
+                    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;
+  end;
+end;
+
+function  TFPReaderTarga.InternalCheck (Stream:TStream) : boolean; 
+
+begin
+  Result:=True;
+end;            
+
+initialization
+  ImageHandlers.RegisterImageReader ('TARGA Format', 'tga', TFPReaderTarga);
+end.

+ 7 - 1
fcl/image/imgconv.pp

@@ -20,6 +20,7 @@ program ImgConv;
 
 uses FPWriteXPM, FPWritePNG, FPWriteBMP,
      FPReadXPM, FPReadPNG, FPReadBMP, fpreadjpeg,fpwritejpeg,
+     fpreadtga,
      {$ifndef UseFile}classes,{$endif}
      FPImage, sysutils;
 
@@ -42,6 +43,8 @@ begin
       Reader := TFPReaderJPEG.Create
     else if T = 'P' then
       Reader := TFPReaderPNG.Create
+    else if T = 'T' then
+      Reader := TFPReaderTarga.Create
     else
       begin
       Writeln('Unknown file format : ',T);
@@ -63,7 +66,10 @@ begin
   if T = 'X' then
     Writer := TFPWriterXPM.Create
   else if T = 'B' then
-    Writer := TFPWriterBMP.Create
+    begin
+    Writer := TFPWriterBMP.Create;
+    TFPWriterBMP(Writer).BytesPerPixel:=4;
+    end
   else if T = 'J' then
     Writer := TFPWriterJPEG.Create
   else if T = 'P' then

+ 41 - 0
fcl/image/targacmn.pp

@@ -0,0 +1,41 @@
+{$mode objfpc}
+{$h+}
+unit targacmn;
+
+interface
+
+Type
+  TWordRec = Packed Record
+    Lo,Hi : byte;
+  end;
+
+  TTargaHeader = packed record
+    IDLen        : Byte;
+    MapType      : Byte;
+    ImgType      : Byte;
+    MapStart     : TWordRec;
+    MapLength    : TWordRec;
+    MapEntrySize : Byte;
+    OriginX      : TWordrec;
+    OriginY      : TWordRec;
+    Width        : TWordRec;
+    Height       : TWordRec;
+    PixelSize    : Byte;
+    Flags        : Byte;
+  end;
+
+  TBGREntry = packed record
+    Blue, Green, Red : Byte;
+  end;
+
+Function ToWord(AWord : TWordRec) : Word;
+
+implementation
+
+Function ToWord(AWord : TWordRec) : Word;
+  
+begin
+  Result:=(AWord.Lo) or (AWord.Hi shl 8);
+end;
+
+end.