hackbard: Convert TGA to Bitmap

Das Targa Image File Format (kurz: TGA, übliche Dateiendung: .tga) ist ein Dateiformat zur Speicherung von Bildern. Targa steht für „Truevision Advanced Raster Graphics Array“.

Das Targa-Dateiformat wurde ursprünglich 1984 von der Firma Truevision entwickelt. 1989 wurde es erweitert, um Vorschaubilder, Werte für Alphakanal, Gammakorrektur und Text als Metainformationen beinhalten zu können.

Um die Targa Datei in ein Bitmap zu konvertieren, muss sie erstmal gemalt werden und das geht am besten mit einer PaintBox. Von dort aus kann man sie gut weiter bearbeiten.

Es werden benötigt 3xButton und 1xPaintBox

Unit TARGA.pas

unit TARGA;

interface

{Unit TARGA.pas}

type
 TGA_Header = packed record
  FileType       : Byte;
  ColorMapType   : Byte;
  ImageType      : Byte;
  ColorMapStart  : WORD;
  ColorMapLength : WORD;
  ColorMapDepth  : Byte;
  OrigX          : WORD;
  OrigY          : WORD;
  Width          : WORD;
  Height         : WORD;
  BPP            : Byte;
  ImageInfo      : Byte;
  Data           : pointer;
 end;

 function LoadTGA(const FileName: string): TGA_Header;
 function SaveTGA(const FileName: string; Width, Height: integer; pixels: pointer): boolean;

implementation

type
 TByteArray = array [0..1] of Byte;
 PByteArray = ^TByteArray;

 TWordArray = array [0..1] of Word;
 PWordArray = ^TWordArray;

var
 F   : File of Byte;
 TGA : TGA_Header;

function inci(var i: integer): integer;
begin
Result := i;
i := i + 1;
end;

procedure FlipHorizontally(Data: PByteArray);
var
 scanLine : PByteArray;
 i, j, x, w, h, pixelSize: Integer;
begin
w := TGA.Width;
h := TGA.Height;
pixelSize := TGA.BPP div 8;

GetMem(scanLine, w*pixelSize);
for i := 0 to h - 1 do
 begin
 Move(Data[i*w*pixelSize], scanLine[0], w*pixelSize);
 for x := 0 to w div 2 do
  for j := 0 to pixelSize - 1 do
   scanLine[x*pixelSize + j] := scanLine[(w-1-x)*pixelSize + j];
 Move(scanLine[0], Data[i*w*pixelSize], w*pixelSize);
 end;
FreeMem(scanLine);
end;

procedure FlipVertically(Data: PByteArray);
var
 scanLine : PByteArray;
 i, w, h, pixelSize: Integer;
begin
w := TGA.Width;
h := TGA.Height;
pixelSize := TGA.BPP div 8;
GetMem(scanLine, w*pixelSize);

for i := 0 to h div 2 - 1 do
 begin
 Move(Data[i*w*pixelSize], scanLine[0], w*pixelSize);
 Move(Data[(h-i-1)*w*pixelSize], Data[i*w*pixelSize], w*pixelSize);
 Move(scanLine[0], Data[(h-i-1)*w*pixelSize], w*pixelSize);
 end;
FreeMem(scanLine); 
end;

procedure TGA_GetPackets(data: PByteArray; width, height, depth: WORD);
var
 current_byte, run_length, i: integer;
 buffer8: array [0..3] of Byte;
 buffer16: WORD;
 bpp: Byte;
 header: Byte;
begin
current_byte := 0;

if depth = 16 then
 bpp := 3
else
 bpp := depth div 8;

while current_byte < width * height * bpp do
 begin
 BlockRead(F, header, 1);
 run_length := (header and $7F) + 1;

 if (header and $80)<>0 then
  begin
  if depth = 32 then
   BlockRead(F, buffer8[0], 4);

  if depth = 24 then
   BlockRead(F, buffer8[0], 3);

  if depth = 16 then
   BlockRead(F, buffer16, 2);

  if depth = 8 then
   BlockRead(F, buffer8[0], 1);

  for i := 0 to run_length - 1 do
   begin
   if depth = 32 then
    begin
    data[inci(current_byte)] := buffer8[0];
    data[inci(current_byte)] := buffer8[1];
    data[inci(current_byte)] := buffer8[2];
    data[inci(current_byte)] := buffer8[3];
    end;

   if depth = 24 then
    begin
    data[inci(current_byte)] := buffer8[0];
    data[inci(current_byte)] := buffer8[1];
    data[inci(current_byte)] := buffer8[2];
    end;

   if depth = 16 then
    begin
    data[inci(current_byte)] := (buffer16 and $1F) shl 3;
    data[inci(current_byte)] := ((buffer16 shr 5) and $1F) shl 3;
    data[inci(current_byte)] := ((buffer16 shr 10) and $1F) shl 3;
    end;

  if depth = 8 then
   data[inci(current_byte)] := buffer8[0];
  end;
 end;

 if (header and $80) = 0 then
  begin
  for i := 0 to run_length - 1 do
   begin
   if depth = 32 then
    begin
    BlockRead(F, buffer8[0], 4);
    data[inci(current_byte)] := buffer8[0];
    data[inci(current_byte)] := buffer8[1];
    data[inci(current_byte)] := buffer8[2];
    data[inci(current_byte)] := buffer8[3];
    end;

   if depth = 24 then
    begin
    BlockRead(F, buffer8[0], 3);
    data[inci(current_byte)] := buffer8[0];
    data[inci(current_byte)] := buffer8[1];
    data[inci(current_byte)] := buffer8[2];
    end;

   if depth = 16 then
    begin
    BlockRead(F, buffer16, 2);
    data[inci(current_byte)] := (buffer16 and $1F) shl 3;
    data[inci(current_byte)] := ((buffer16 shr 5)and $1F) shl 3;
    data[inci(current_byte)] := ((buffer16 shr 10)and $1F) shl 3;
    end;

   if depth = 8 then
    begin
    BlockRead(F, buffer8[0], 1);
    data[inci(current_byte)] := buffer8[0];
    end;

   end;
  end;
 end;
end;


function TGA_GetData(const FileName: string): boolean;
var
 buffer1: PByteArray;
 buffer2: PWordArray;
 i: integer;
 ColorMap: PByteArray;
begin
Result := false;
FileMode := 64;
AssignFile(F, FileName);
{$I-}
Reset(F);
{$I+}
if IOResult <> 0 then Exit;

BlockRead(F, TGA, sizeof(TGA) - 4); // -4 Data pointer
Seek(F, FilePos(F) + TGA.FileType);
ColorMap := nil;

case TGA.ImageType of
 1:
  if (TGA.ColorMapType = 1) and (TGA.ColorMapDepth = 24) then
   begin
   GetMem(ColorMap, TGA.ColorMapLength*(TGA.ColorMapDepth div 8));
   BlockRead(F, ColorMap[0], TGA.ColorMapLength*(TGA.ColorMapDepth div 8));
   end
  else
   begin
   CloseFile(F);
   Exit;
   end;

 9:
  if (TGA.ColorMapType = 1) and (TGA.ColorMapDepth = 24) then
   begin
   GetMem(ColorMap, TGA.ColorMapLength*(TGA.ColorMapDepth div 8));
   BlockRead(F, ColorMap[0], TGA.ColorMapLength*(TGA.ColorMapDepth div 8));
   end
  else
   begin
   CloseFile(F);
   Exit;
   end;
 end;


case TGA.BPP of
 32:
  begin
  GetMem(TGA.Data, TGA.Width * TGA.Height * 4);

  if TGA.ImageType=2 then
   BlockRead(F, TGA.Data^, TGA.Width * TGA.Height * 4)
  else
   if TGA.ImageType=10 then
    TGA_GetPackets(TGA.Data, TGA.Width, TGA.Height, TGA.BPP);
  end;

 24:
  begin
  GetMem(TGA.Data, TGA.Width * TGA.Height * 3);

  if TGA.ImageType=2 then
   BlockRead(F, TGA.Data^, TGA.Width*TGA.Height*3)
  else
   if TGA.ImageType=10 then
    TGA_GetPackets(TGA.Data, TGA.Width, TGA.Height, TGA.BPP);
  end;

 16:
  begin
  GetMem(TGA.Data, TGA.Width * TGA.Height * 3);

  if TGA.ImageType = 2 then
   begin
   GetMem(buffer2, 2 * TGA.Width * TGA.Height);
   BlockRead(F, buffer2[0], 2 * TGA.Width * TGA.Height);

   for i := 0 to TGA.Width * TGA.Height - 1 do
    begin
    PByteArray(TGA.Data)[3*i]   := (buffer2[i] and $1F) shl 3;
    PByteArray(TGA.Data)[3*i+1] := ((buffer2[i] shr 5) and $1F) shl 3;
    PByteArray(TGA.Data)[3*i+2] := ((buffer2[i] shr 10) and $1F) shl 3;
    end;

   FreeMem(buffer2);
   TGA.BPP := 24;
   end
  else
   if TGA.ImageType = 10 then
    begin
    TGA_GetPackets(TGA.Data, TGA.Width, TGA.Height, TGA.BPP);
    TGA.BPP := 24;
    end;
  end;


 8:
  begin
  GetMem(TGA.Data, TGA.Width * TGA.Height * 3);
  GetMem(Buffer1, TGA.Width * TGA.Height);

  if (TGA.ColorMapType = 1) and (TGA.ColorMapDepth = 24) then
   begin
   if TGA.ImageType = 9 then
    TGA_GetPackets(buffer1, TGA.Width, TGA.Height, TGA.BPP)
   else
    BlockRead(F, buffer1[0], TGA.Width * TGA.Height);

   For i := 0 to TGA.Width * TGA.Height - 1 do
    begin
    PByteArray(TGA.Data)[3*i]   := ColorMap[3*buffer1[i]];
    PByteArray(TGA.Data)[3*i+1] := ColorMap[3*buffer1[i]+1];
    PByteArray(TGA.Data)[3*i+2] := ColorMap[3*buffer1[i]+2];
    end;

   FreeMem(ColorMap);
   end
  else
   begin
   if TGA.ImageType = 3 then
    BlockRead(F, Buffer1[0], TGA.Width * TGA.Height)
   else
    if TGA.ImageType = 11 then
     TGA_GetPackets(Buffer1, TGA.Width, TGA.Height, TGA.BPP);

   for i := 0 to TGA.Width * TGA.Height - 1 do
    begin
    PByteArray(TGA.Data)[3*i]   := Buffer1[i];
    PByteArray(TGA.Data)[3*i+1] := Buffer1[i];
    PByteArray(TGA.Data)[3*i+2] := Buffer1[i];
    end;
   end;

  FreeMem(buffer1);
  TGA.BPP := 24;
  end;
 end;
CloseFile(F);

if (TGA.ImageInfo and (1 shl 4)) <> 0 then FlipHorizontally(TGA.Data);
if (TGA.ImageInfo and (1 shl 5)) <> 0 then FlipVertically(TGA.Data);

Result := true;
end;

function LoadTGA(const FileName: string): TGA_Header;
begin
TGA.Data := nil;
Result   := TGA;
if not TGA_GetData(FileName) then Exit;
Result := TGA;
end;

function SaveTGA(const FileName: string; Width, Height: integer; pixels: pointer): boolean;
var
 F   : File of Byte;
 TGA : TGA_Header;
begin
TGA.FileType       := 0;
TGA.ColorMapType   := 0;
TGA.ImageType      := 2;
TGA.ColorMapStart  := 0;
TGA.ColorMapLength := 0;
TGA.ColorMapDepth  := 0;
TGA.OrigX          := 0;
TGA.OrigY          := 0;
TGA.Width          := Width;
TGA.Height         := Height;
TGA.BPP            := 24;
TGA.ImageInfo      := 0;

AssignFile(F, FileName);
Rewrite(F);
BlockWrite(F, TGA, SizeOf(TGA) - 4);
BlockWrite(F, pixels^, Width * Height * 3);
CloseFile(F);
Result := true;
end;

procedure Copyright;
begin
end;

exports
 Copyright name '< Copyright (c) Delphi TARGA Loader >';

end.

Unit1 :

uses TARGA

type
 TRGB = array [0..1] of
  record
   B, G, R : Byte;
  end;
 PRGB = ^TRGB;
 
var
 bmp: TBitmap;
 
//

procedure TForm1.FormCreate(Sender: TObject);
begin
 bmp := TBitmap.Create;
 bmp.PixelFormat := pf24bit;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
 PaintBox1.Canvas.Draw(0, 0, bmp);
end;

Laden der Targa Datei :

procedure TForm1.Button1Click(Sender: TObject);
var
 tga    : TGA_Header;
 x, y   : integer;
 d      : PByteArray;
 p      : PRGB;
 k, bpp : integer;
begin
 if OpenDialog1.Execute then
 begin
 try
  tga := LoadTGA(OpenDialog1.FileName);
 except
  tga.Data := nil;
 end;

 if tga.Data <> nil then
  begin
  bmp.Width  := tga.Width;
  bmp.Height := tga.Height;

  d := tga.Data;
  k := 0;
  bpp := tga.BPP div 8;
  for y := 0 to tga.Height - 1 do
   begin
   p := bmp.ScanLine[tga.Height - y - 1];
   for x := 0 to tga.Width - 1 do
    with p[x] do
     begin
     B := d[k];
     G := d[k + 1];
     R := d[k + 2];
     inc(k, bpp);
     end;
   end;

  FreeMem(tga.Data);
  with PaintBox1 do
   begin
   Width  := bmp.Width;
   Height := bmp.Height;
   Refresh;
   Paint;
   end;
  end
 else
  MessageBox(Handle, 'TARGA Error', 'Failed', MB_ICONHAND);
 end;
end;

Speichern der Targa als Bitmap :

procedure TForm1.Button3Click(Sender: TObject);
var bmp: TBitmap; r: TRect;
begin
   bmp := TBitmap.Create;
    try
    bmp.Width := Paintbox1.Width;
    bmp.Height := Paintbox1.Height;
    r := rect(0, 0, bmp.Width, bmp.Height);
    bmp.Canvas.CopyRect(r, paintbox1.Canvas, r);
    bmp.SaveToFile(OpenDialog1.FileName + '.bmp');
   finally
   bmp.Free;
   end;
end;

Speichere System Matrix als Targa Datei :

procedure TForm1.Button2Click(Sender: TObject);
var
 bmp : TBitmap;
 p   : ^TRGB;
 y   : integer;
begin
 if SaveDialog1.Execute then
 begin
  bmp       := TBitmap.Create;
  bmp.Width  := GetSystemMetrics(SM_CXSCREEN);
  bmp.Height := GetSystemMetrics(SM_CYSCREEN);
  bmp.PixelFormat := pf24bit;
  try
  BitBlt(bmp.Canvas.Handle, 0, 0, bmp.Width, bmp.Height, GetDC(0), 0, 0, SRCCOPY);
  GetMem(p, bmp.Width * bmp.Height * 3);
  for y := 0 to bmp.Height - 1 do
  Move(PRGB(bmp.ScanLine[bmp.Height - y - 1])[0], p[y*bmp.Width], bmp.Width*3);
  SaveTGA(SaveDialog1.FileName, bmp.Width, bmp.Height, p);
  finally
  FreeMem(p);
  bmp.Free;
  end;
 end;
end;

hackbard

Convert TGA to Bitmap

Keine Kommentare:

Kommentar veröffentlichen

Beliebte Posts

Translate