_A TARGA VIEWER IN BORLAND DELPHI_
by Gunter Born


Listing One

unit TGAToBMP;
{
  Warranty and Copyright Disclaimer:

  TGA to BMP conversion routine, implementation for Borland
  Delphi by: (c) Guenter Born - Version 17-July-1995
  The TARGA and BMP specification may be found in:
  The File Formats Handbook - by Gunter Born, 1300 pages,
  published by International Thomson Publishing,
  ISBN 1-85032-117-5
  This code comes unsupported AS IS without any warranty.
  The code was written as an example for my article in the
  Dr. Dobb's Journal of Software Tools.
  Users are given the right to use/modify and distribute this
  source code as long as this disclaimer are included and
  credits are given.
}

interface

function ConvertTGABMP (Infile, Outfile: string): Byte;
{
  Infile : Input TARGA File
  Outfile: Output BMP File
  Return:  0 conversion successful
           1 can't open input file
           2 can't create output file
           3 TARGA type not implemented (Header check)
           4 Data processing error
}
implementation
uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls,
  FileCtrl, StdCtrls, ExtCtrls, Buttons, Spin;
 const
   MAX_WIDTH = 8000;                  { max. ImageWidth in Byte }
   MAX_BLOCK = 4096;                  { Input Buffer size       }
 type
   block_array = array [0..MAX_BLOCK] of byte;
   line_array = array [0..MAX_WIDTH] of byte;
   name = String [255];

   TGA_header = record
    ID_Size: Byte;   { Length ID-field }
    Pal_flag: Byte;  { Flag indicates a palette }
    Typ : Byte;      { Image Type Mono, Color   }
    Pal_index: Word; { Index into Palette       }
    Pal_size: Word;  { No. of palette entries   }
    Pal_entry_size: Byte; { Size of a pal. entry }
    leftx: Word;     { Coordinate X0 }
    lefty: Word;     { Coordinate Y0 }
    ImageWidth: Word; { Image width   }
    ImageHeight: Word; { Image height  }
    Bits_per_pixel:Byte; { Bits per Pixel }
    Image_descr:Byte; { Image descriptor byte }
   end;
var
   RawData: block_array;              { Input buffer raw data  }
   NextByte: integer;                 { Index in raw buffer    }
   Data: byte;                        { current ras data byte  }
   Header: TGA_header;                { TGA File Header        }

   IMGline: line_array;               { buffer Output data     }
   Index: integer;                    { IMGline Index          }

   TGABytes_per_Line : word;          { Byte per line TGA      }
   BMPBytes_per_Line : word;          { Byte per line BMP      }
   Bits_per_pixel: byte;
Function OPEN (Var handle : file; Filename: name) : boolean;
{--------------------------------------------------------}
{  Open File for Input Function                          }
{--------------------------------------------------------}
begin
  AssignFile (handle,Filename);
  {$I-}                                {* Errorcheck off     *}
  Reset(handle,1);                     {* open file          *}
  {$I+}                                {* Errorcheck on      *}
  Open := IOResult = 0;
end;

Function OPENNew (Var handle : file; Filename: name) : boolean;
{--------------------------------------------------------}
{  Open File for Output Function                         }
{--------------------------------------------------------}
begin
  Assign(handle,Filename);
  {$I-}                                {* Errorcheck off     *}
  Rewrite(handle,1);                   {* open file          *}
  {$I+}                                {* Errorcheck on      *}
  OpenNew := IOResult = 0
end;
function ProcessHeader (Var FIn,FOut: File): Boolean;
{--------------------------------------------------------}
{ Read TGA Header data and create a BMP Header           }
{--------------------------------------------------------}
 const
     Red =  0;                         { constants for Palette   }
     Green = 1;
     Blue = 2;
     Attr = 3;
 var
     Ofs:       LongInt;
     I, count:  Integer;
     BmHeader : TBitmapInfoHeader; { BMP-Header             }
     BitFile:   TBitmapFileHeader; { BMP File Header        }
     BMP_pal:   TRGBQuad;          { Palette BMP            }
     TGApal_array : array [Red .. Attr] of Byte; { buffer palette}
begin
 {$I-}
 BlockRead (FIn, Header, SizeOf(Header)); { get TGA Header  }
 {$I+}
 IF IOResult <> 0 Then
  begin
   ProcessHeader := false;
   exit;
  end;
 IF NOT (Header.Typ IN [1, 2, 3, 9, 10, 11]) Then
  begin  {  sorry TARGA types 32, 33 not implemented yet  }
   ProcessHeader := false;
   exit;
  end;
 IF NOT(Header.Bits_per_pixel IN [1, 8, 24]) Then
  begin { TARGA types with 16/32 Bit/pixel not implemented yet  }
   ProcessHeader := false;
   exit;
  end;
{
  calculate the number of Bytes per line (for n color planes)
}
 CASE Header.Bits_per_pixel OF
  1: TGABytes_per_line := Header.ImageWidth div 8;
  8: TGABytes_per_line := Header.ImageWidth;
 24: TGABytes_per_line := Header.ImageWidth * 3;
 end;
 BMPBytes_per_line := TGABytes_per_line;
 count := BMPBytes_per_line Mod 4;    { adjust length to 32 Bit }
 IF count <> 0 THEN
   INC (BMPBytes_per_line,(4-count));
{
  construct the BitmapInfoHeader
}
  BmHeader.biSize := Sizeof(TBitmapInfoHeader);
  BmHeader.biWidth := Header.ImageWidth;
  BmHeader.biHeight := Header.ImageHeight;
  BmHeader.biPlanes := 1;           { set always to 1         }
  BmHeader.biBitCount := Header.Bits_per_Pixel;
  BmHeader.biCompression := BI_RGB; { no compression }
  BmHeader.biSizeImage := 0;        { valid, no compress. used }
  BmHeader.biXPelsPerMeter :=0;     { not used yet             }
  BmHeader.biYPelsPerMeter :=0;     { ditto                    }
  BmHeader.biClrUsed := 0;          { all colors are used      }
  BmHeader.biClrImportant := 0;     { all colors important     }
{
  construct the BitmapFileHeader
}
  BitFile.bfType := $4D42;          { Signature 'BM'           }
  BitFile.bfReserved1 := 0;         { not used                 }
  BitFile.bfReserved2 := 0;         { dito                     }
  BitFile.bfOffBits := (256 * SizeOf(TRGBQuad))+ { Offset to Data }
                       sizeof(TBitmapFileHeader)+
                       sizeof(TBitmapInfoHeader);
  BitFile.bfSize := (256 * SizeOf(TRGBQuad)) +   { File size      }
                       sizeof(TBitmapFileHeader) +
                       sizeof(TBitmapInfoHeader) +
                      (Header.ImageHeight*BMPBytes_per_Line);

  {$I-}
  BlockWrite (FOut, BitFile, SizeOf(BitFile)); { write BMP-File Header }
  {$I+}
  IF IOResult <> 0 Then
   begin
    ProcessHeader := false;
    exit;
   end;

  {$I-}
  BlockWrite (FOut, BmHeader, SizeOf(BmHeader)); { write BitmapInfoHeader }
  {$I+}
  IF IOResult <> 0 Then
   begin
    ProcessHeader := false;
    exit;
   end;
{ *** process the color palette if available  *** }
 IF (Header.Pal_flag <> 0) THEN
  begin
   Ofs := SizeOf(Header) + Header.ID_Size;   { Offset to palette     }
   SEEK (FIn, Ofs);                          { set to Palette        }
   count := Header.Pal_entry_size div 8;     { Byte per Pal entry    }

   FOR i := 1 to Header.Pal_size do          { process all entries   }
    begin
   {$I-}
     BlockRead (FIn, TGAPal_array[0],count); { get one plaette entry }
   {$I-}
     IF IOResult <> 0 Then
      begin                                  { something wrong       }
       ProcessHeader := false;
       exit;
      end;
   { Write the BGR palete information to this file}
     IF count > 2 Then
      begin
       BMP_pal.rgbBlue := TGAPal_array[Red];
       BMP_pal.rgbGreen := TGAPal_array[Green];
       BMP_pal.rgbRed := TGAPal_array[Blue];
      end
     ELSE  { 16 Bit Palette Entry -> create 3 Byte Attribute  }
      begin{ Entry is ARRRRRGGGGGBBBBB coded                  }
       BMP_pal.rgbBlue := (TGAPal_array[1] SHR 2) AND $1F; { Red   }
       BMP_pal.rgbGreen := (TGAPal_array[0] SHR 5)+        { Green }
                         + (TGAPal_array[1]  AND $03) SHL 3;
       BMP_pal.rgbRed := TGAPal_array[0] AND $1F;          { Blue  }
      end;
           { in 32 Bit Palette entry, clear attribute byte always !! }
     BMP_pal.rgbReserved := 0;               { 4th byte in Palette   }

   {$I-}
     BlockWrite (FOut, BMP_pal,SizeOf(TRGBQuad)); { write Palette      }
   {$I+}
     IF IOResult <> 0 Then
      begin
       ProcessHeader := false;
       exit;
      end;
    end; { FOR }
 end; { Process Palette }
{ *** calculate Offset TGA Image Data *** }
  Ofs := SizeOf(Header)+
         Header.ID_Size;
  IF Header.Pal_flag <> 0 THEN
   Ofs := Ofs + Header.Pal_size*count;   { add Pal size to Offset   }
  SEEK (FIn, Ofs);                       { set to 1st Image Byte    }
end;  { ReadHeader }
procedure ReadByte (Var FIn : File);
{--------------------------------------------------------}
{ get a byte from the buffer, if buffer empty, fill      }
{--------------------------------------------------------}
var
 NumBlocksRead: integer;
begin
 if NextByte = MAX_BLOCK then   { buffer empty ?            }
  begin
   {$I-}                        { Yes, read next block      }
   BlockRead (FIn, RawData, MAX_BLOCK, NumBlocksRead);
   {$I+}
   IF IOResult <> 0 THEN
    begin
     Close (FIn);
     exit;
    end;
   NextByte := 0;                { reset buffer pointer     }
  end;

 data := RawData [NextByte];     { return next byte         }
 inc (NextByte);                 { pointer to next entry    }
end;  { ReadByte }

Function put_line (Var FOut: File; count: Integer): Boolean;
{----------------------------------------------------------}
{ write a uncompressed line into the BMP file              }
{----------------------------------------------------------}
Var X : Integer;
 begin
 {$I-}                        { Write the buffer        }
  BlockWrite(FOut, IMGLine[0], count);
 {$I+}
  IF IOResult <> 0 THEN
   put_line := false
  ELSE
   put_line := true;
end;  { Put_line }
function ProcessData (Var FIn, Fout : File): Boolean;
{--------------------------------------------------------}
{ read the TGA-data step by step, decode the data and    }
{ write 1, 8 and 24 Bit per Pixel to the BMP file        }
{--------------------------------------------------------}
var
   count: word;                        { repeat variable    }
   i,j,k: integer;
   pixel: array [0..2] of Byte;        { 24 Bit Data buffer }
begin
 NextByte := MAX_BLOCK;                { clear input buffer!}
{
  Attention: this implementation defines the image lines
  from top to bottom. TGA may have an invers order for the image lines.
}
 FOR j := 1 TO Header.ImageHeight do     { all lines           }
  begin
   index := 0;                           { Reset output ptr    }
{------------------------------------------------------}
{  TGA decoding starts here                            }
{------------------------------------------------------}
   WHILE (index < TGABytes_per_line) Do   { all bytes in line   }
    begin
{  *** RLE compression for 1 and 8 Bit per Pixel *** }
     IF Header.typ IN [9, 11] Then
      begin
       ReadByte (FIn);                    { get 1st Recordbyte  }
       count := (data AND $7F) + 1;       { get count value     }
       IF (data AND $80) > 0 THEN
        begin                             { RLE-Record          }
         ReadByte (Fin);                  { get pixel value     }
         FillChar (IMGLine[index],count,data); { expand         }
         INC (index, count);              { index ++n           }
        end
       ELSE                               { RAW-Record          }
        FOR k := 1 TO count do
         begin
          ReadByte (FIn);                 { get pixel data      }
          ImgLine[index] := data;         { copy to output buf  }
          INC (index, 1);                 { index ++            }
         end;
      end;  { RLE 1,8 Bit...}

{*** RLE compression for 24 Bit/Pixel, 16/32 Bit not supported *** }

     IF Header.typ IN [10] Then
      begin
       ReadByte (FIn);                    { get 1st Recordbyte  }
       count := (data AND $7F) + 1;       { get count value     }
       IF (data AND $80) > 0 THEN
        begin { RLE-Record -> 24 Bit per Pixel, process 3 Byte  }
         For i := 0 To 2 Do               { get 3 Byte          }
           begin
            ReadByte (Fin);               { get value           }
            pixel[i] := data;             { store value         }
           end;
          For i := 1 To count Do          { expand n pixel      }
           begin
            MOVE (pixel[0],IMGLine[index],3);
            INC (index,3);                { index ++3           }
           end;
        end
       ELSE                               { RAW-Record          }
        FOR k := 1 TO count*3 Do          { 3 Byte per Pixel    }
         begin
          ReadByte (Fin);                 { get value           }
          IMGLine[index] := data;         { store value         }
          INC (index, 1);                 { index ++1           }
         end;
      end; { 24 Bit RLE  }

     IF Header.typ IN [1, 2, 3] Then      { no Compression      }
      begin
       ReadByte (FIn);                    { get TGA-Pixel       }
       IMGLine[index] := data;            { copy to output buf  }
       INC (index,1);                     { index ++            }
      end;
    end; { While }
 IF BMPBytes_per_line<>TGABytes_per_line THEN
  FillChar (IMGLine[index],                { clear last n bytes }
           BMPBytes_per_line-TGABytes_per_line,0);
 IF Not put_line (FOut,BMPBytes_per_Line) Then { Write line     }
  begin
   ProcessData := false;
   exit;
  end;
 end; { FOR j .... }
end;  { ProcessData }

function ConvertTGABMP (Infile, Outfile: string): Byte;
{-------------------------------------------}
{ This is the root of the TGA BMP converter }
{-------------------------------------------}
Var
  FromF : File;
  ToF : File;
  status : byte;
begin
 status := 0;
 IF NOT Open (FromF, InFile) Then        { Open Input file     }
  status := 1                            { Error during open   }
 ELSE
  IF NOT OpenNew (ToF, OutFile) Then     { Open Output file    }
   status := 2                           { Error during open   }
  ELSE
   IF NOT ProcessHeader(FromF, ToF) THEN { process TGA Header  }
    status := 3                          { Error in Header     }
   ELSE
   IF NOT ProcessData (FromF, ToF) THEN  { process TGA Data    }
    status := 4;
 close (FromF);
 close (ToF);
 ConvertTGABMP := status;              { success status     }
end; { ConvertTGA }
end.


Listing Two

unit ImageWin;
{
  This is the unit to display BMP, ICO, WMF and TGA graphics.
  The code was taken from the Borland Delphi example IMAGEVIEW and was 
  changed by Guenter Born. Note: this unit need the TGAToBMP conversion unit.
}
interface
uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls,
  FileCtrl, StdCtrls, ExtCtrls, Buttons, Spin, TGAToBmp;

type
    TImageForm = class(TForm)
    DirectoryListBox1: TDirectoryListBox;
    DriveComboBox1: TDriveComboBox;
    PathLabel: TLabel;
    FileEdit: TEdit;
    Panel1: TPanel;
    FileListBox1: TFileListBox;
    Label1: TLabel;
    ViewBtn: TBitBtn;
    Bevel1: TBevel;
    FilterComboBox1: TFilterComboBox;
    StretchCheck: TCheckBox;
    Image1: TImage;
    procedure FileListBox1Click(Sender: TObject);
    procedure ViewBtnClick(Sender: TObject);
    procedure StretchCheckClick(Sender: TObject);
    procedure FileEditKeyPress(Sender: TObject; var Key: Char);
   end;
   name = string [255];
var
   ImageForm: TImageForm;
implementation
uses ViewWin, SysUtils;
{$R *.DFM}
{------------------------------------------}
procedure TImageForm.FileListBox1Click(Sender: TObject);
{ call if FileListBox is checked by a user }
var
  FileExt: string[4];
  FileName: string [255];
  TMPFileName: String [255];
  status : byte;
begin
  FileExt := UpperCase(ExtractFileExt(FileListBox1.Filename));
  if (FileExt = '.BMP') or (FileExt = '.ICO') or (FileExt = '.WMF') then
   begin
    Image1.Picture.LoadFromFile(FileListBox1.Filename);
    Label1.Caption := ExtractFilename(FileListBox1.Filename);
    if (FileExt = '.BMP') then
     begin
      { show image height and width in window }
      Label1.Caption := Label1.Caption +
        Format(' (%d x %d)', [Image1.Picture.Height, Image1.Picture.Width]);
      ViewForm.Image1.Picture := Image1.Picture; { show picture as icon }
     end;
    if FileExt = '.ICO' then Icon := Image1.Picture.Icon;
    if FileExt = '.WMF' then
      ViewForm.Image1.Picture.Metafile := Image1.Picture.Metafile;
   end
  else
{
   Here comes the extension for the TARGA format. Note: to avoid all this 
   dirty BitBld stuff I read the TARGA file, convert it and store it as
   a BMP-File. This file is easy to load and display with delphi.
}
   if FileExt = '.TGA' then
   begin
    FileName := FileListBox1.Filename; { Get Input Filename  }
    TMPFileName := 'TMP.BMP';          { Set Output Filename }
    status := ConvertTGABMP(FileName,TMPFileName); { Conversion TGA->BMP }
    IF status = 0 Then                 { conversion was succesful }
     begin
      Image1.Picture.LoadFromFile(TMPFileName); { Load BMP File }
      { show image height and width in window }
      Label1.Caption := ExtractFilename(FileListBox1.Filename);
      Label1.Caption := Label1.Caption +
        Format(' (%d x %d)', [Image1.Picture.Height,
               Image1.Picture.Width]);
      ViewForm.Image1.Picture := Image1.Picture;
     end
    ELSE
     begin                            { display conversion error }
{ show image height and width in window }
      Label1.Caption := ExtractFilename(FileListBox1.Filename);
      Label1.Caption := Label1.Caption +
        Format(' Error: (%d )', [status]);
end;
   end; { TARGA Branch }
end;
procedure TImageForm.ViewBtnClick(Sender: TObject);
begin
  ViewForm.HorzScrollBar.Range := Image1.Picture.Width;
  ViewForm.VertScrollBar.Range := Image1.Picture.Height;
  ViewForm.Caption := Label1.Caption;
  ViewForm.Show;
end;
procedure TImageForm.StretchCheckClick(Sender: TObject);
begin
  Image1.Stretch := StretchCheck.Checked;
end;
procedure TImageForm.FileEditKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
  begin
    FileListBox1.ApplyFilePath(FileEdit.Text);
    Key := #0;
  end;
end;
end.


Example 1: 

get header byte
n := (Byte and 3FH) +1
IF (Byte and 80H) > 0 THEN
 get next pixel in RLE record
 output pixel n times
ELSE
 FOR k := 1 TO n
  get raw pixel
  output pixel 
 END FOR k
END IF


Figure 4: 

var Image 1: TImage;
 ....
Image1.Picture.LoadFromFile (Filename);
ViewForm.Image1.Picture:= Image1.Picture;