TGA Unit

[RobertP]

Hallo,
ich suche eine Unit mit der man Bitmaps in Targas umwandeln kann. Die hier http://www.efg2.com/Lab/Library/Delp...Conversion.htm aus der DP geht leider nicht...

[SirThornberry]

was bedeutet "geht nicht"? Kommt eine Fehlermeldung? wenn ja - welche?
Ich hab vor kurzem auch mal TGA genutzt. Dazu hab ich einfach eine Klasse von TBitmap abgeleitet und dann SaveToStream und LoadFromStream überschrieben. Die Infos zum Aufbau einer TGA-Datei hab ich aus Wikipedia gehabt.

[RobertP]

Nee keine Fehlermeldung aber wenn ich speicher hat die Datei keinen Inhalt.

[turboPASCAL]

Dann zeig mal deinen Quelltext und man kann gucken warum. ;)

[RobertP]

Naja da gibts wenig zu zeigen ^^

Delphi-Quellcode:

try
        bmp := TBitmap.Create;

        bmp.Assign(sourceimg);
        SaveToFileX(outpath, bmp, 2);
      finally
        bmp.Free;
      end;

In der targa.pas musste ich am Anfang noch was ändern, da sonst der Compiler gestreikt hat (Index1 und 2 werden im Code Werte zugewiesen):

Delphi-Quellcode:

const
  Index1:Word=0;
  Index2:Word=0;
  Const4096=8*1024;

zu

Delphi-Quellcode:

var
  Index1:Word=0;
  Index2:Word=0;
const
  Const4096=8*1024;

Das TGA wird auch gespeichert und ohne Fehlermeldung vom Grafikprogramm geöffnet, aber ist halt einfach nur schwarz.

[uligerhardt]

Hast du schon mal Mike Lischkes GraphicEx probiert? Die kann auch tga.

HTH,
Uli.

[Edit: URL korrigiert]

[turboPASCAL]

Zitat:

Zitat von RobertP

Naja da gibts wenig zu zeigen ^^

Delphi-Quellcode:

try
  bmp := TBitmap.Create;

  bmp.Assign(sourceimg);
  SaveToFileX(outpath, bmp, 2);
finally
  bmp.Free;
end;

[...]

Ja etwas zu wenig. ;) Was für ein Bild(typ) ist sourceimg ? Wenn es kein Bitmap ist wird es nicht funktionieren.

Zitat:

Zitat von uligerhardt

Hast du schon mal Mike Lischkes GraphicEx probiert? Die kann auch tga.

HTH,
Uli.

Aber nicht speichern oder ?

[uligerhardt]

Zitat:

Zitat von turboPASCAL

Aber nicht speichern oder ?

Ups. Das wäre denkbar. :oops: :)

[turboPASCAL]

Ja doch sie kann TGA's speichern. Habs gerade noch mal nachgeschaut im QT. :oops:

@uligerhardt, dein Link klappt nicht.
Der hier aber: http://www.soft-gems.net/Graphics.php

[RobertP]

sourceimg ist ein TBitmap32. Die Umwandlung von TBitmap32 in ein normales TBitmap funktioniert. (überprüft)

GraphicEx hab ich auch schon versucht, die kann zwar TGAs laden und speichern, aber kein Bitmap in ein TGA umwandeln.

[turboPASCAL]

Anders grefragt, brauchst du unbedingt TGA's oder willst du nur den Alphachannel mit speichern können ?
(Note: TBitmap32 ist nicht TBitmap )

[RobertP]

Nee mir gehts schon konkret um TGA.

Zitat:

Zitat von turboPASCAL

(Note: TBitmap32 ist nicht TBitmap )

Schon klar, aber die Umwandlung vom einen ins andere ist ja kein Problem. :wink:

[turboPASCAL]

Das schreiben in ein 32Bit (oder 24 Bit mit Alphakanal) TGA auch nicht.
Ich kenne das noch aus TP - Zeiten.

Wenn du nur die/ das eine Format brauchst (ohne Spezialflag des Umkerbitmap) lässt sich das schnell selber machen.

...mal gucken...

So, hier mal ein Beispiel. Ausweisnahme durchkommentiert. :mrgreen:

Delphi-Quellcode:

implementation

{$R *.dfm}

uses
  Gr32;

type
  TTGAFileHeader = packed record
    imageid: byte;         // bleibt Null eil wir keine BildID brauchen
    colourmaptype : byte;  // type of colour map 0=none, 1=has palette
    imagetype: byte;       // type of image
                           // 0 = none, 1=indexed, 2=rgb, 3=grey, 3+8=rle packed

    colourmapstart: word;  // first colour map entry in palette
    colourmaplength: word; // number of colours in palette
    colourmapbits: byte;   // number of bits per palette entry 15,16,24,32

    xstart: word;          // image x origin
    ystart: word;          // image y origin
    width: word;           // image width in pixels
    height: word;          // image height in pixels
    pixeldepth: byte;      // image bits per pixel 8,16,24,32
    descriptor: byte;      // image descriptor bits (vh - flip bits)
  end;

  TRGBA = packed record
    R, G, B, A: Byte;
  end;

/////////////////////////////////////////////////////////////////////////
// Keile Hilfsfunction die aus Bits Bytes macht
/////////////////////////////////////////////////////////////////////////
function BitsToByte(const s: string): Byte;
var
  i: Integer;
begin
  Result := 0;
  if Length(s) = 8 then
  begin
    for i := 1 to Length(s) do
      Result := Result shl 1 + Ord( s[i] = '1' );
  end else
    ShowMessage('Fehler in der Bit-Aangabe! Formatbeispiel: ''00010111''');
end;

/////////////////////////////////////////////////////////////////////////
// diese Procedure speichert ein TBitmap32 als TGA-Datei mit Alphakanal
/////////////////////////////////////////////////////////////////////////
procedure SaveBitmap32AsTGAFile(bmp32: TBitmap32; TGAFileName: String);
var
  f: file;
  DataBuffer: array of Byte;
  tgaHeader : TTGAFileHeader;
  i, n,
  DataSize: DWORD; // DWORD ist gleich Cardilan in Delphi
                   // man spaar tipperei..
  P: PColor32;
  c: TRGBA;
begin
  //Größe der Daten berechnen ( für Puffer)
  // Rot, Gruen, Blau und Alpha = 4 Bytes
  DataSize := bmp32.Width * bmp32.Height * 4;

  //Größe des RGB -Puffers festlegen
  SetLength(DataBuffer, DataSize);

  // TGA-Header mit Daten füllen
  tgaHeader.imageid         := 0;  // lassen wir  Null
  tgaHeader.colourmaptype   := 0;  // wir haben keine Palette
  tgaHeader.imagetype       := 2;  // RGB-Daten / keine Komprimierung
  tgaHeader.colourmapstart  := 0;  // es gibt keine
  tgaHeader.colourmaplength := 0;  // es gibt keine Länge da keine Palette
  tgaHeader.width           := bmp32.Width;
  tgaHeader.height          := bmp32.Height;
  tgaHeader.xstart          := 0;  // bleibt in diesem Fall Null
  tgaHeader.ystart          := 0;  // - " -
  tgaHeader.pixeldepth      := 32; // Truecolor & Alphakanal = 32Bit
  tgaHeader.descriptor      := BitsToByte('11110100');

  //  tgaHeader.descriptor  := BitsToByte('11110100');
  //                                       ^^^^^^^^
  //                                       ||||||||
  //                                       |||||||+--- muss Null sein
  //                                       ||||||+---- muss Null sein
  //                                       |||||+----- vertikale Lage des
  //                                       |||||       Nullpunkts
  //                                       |||||       (0 = unten, 1 = oben)
  //                                       ||||+------ horizontale Lage des
  //                                       ||||        Nullpunkts
  //                                       ||||        (0 = links, 1 = rechts)
  //                                       ||||
  //                                       +-- Alpha Bit }  Bits 1..4
  //                                       +--- Rot Bit   }  geben an ob
  //                                       +---- Gruen Bit }  ein Bit pro
  //                                       +----- Blau Bit  }  Farbe da ist

  // "Einscannen" des Bitmaps in den Puffer ( BGR also nicht RGB! )
  P := @bmp32.bits[0];
  n := 0;
  for i := 0 to (bmp32.Width * bmp32.Height) - 1 do
  begin
    Color32ToRGBA(P^ , c.r, c.g, c.b, c.a);

    DataBuffer[n] := c.B;
    inc(n);
    DataBuffer[n] := c.G;
    inc(n);
    DataBuffer[n] := c.R;
    inc(n);
    DataBuffer[n] := c.A;
    inc(n);

    inc(P);
  end;
  // ^ Das liese sich sicher noch optimieren ?!

  // Datei erstellen hier mal aus Turbo-Pascal's Zeiten Methode ;-)
  // das könne man auch auf Filestreams umbasten...
  // Achtung: keine sicherheitsprüfungen !

  AssignFile(f, TGAFileName); // Dateinamen zu eine File OP zuweisen

  Rewrite(f, 1); // erzeugen/erstellen  der Datei
  try
    // TGA- Header in die Datei schreiben
    BlockWrite(f, tgaHeader, SizeOf(tgaHeader));

    // Die eigentlichen Bilddaten in die Datei schreiben
    BlockWrite(f, DataBuffer[0], DataSize);
  finally
    CloseFile(f); // Datei zum Abschluss schliessen
  end;

  Windows.Beep(880, 25);
end; // Fertig ! ;-)


// no Comment...
procedure TForm1.Button1Click(Sender: TObject);
begin
  savedialog1.filter := 'Targa Image File (*.TGA)|*.tga';
  savedialog1.DefaultExt := '.tga';
  if savedialog1.execute then
    SaveBitmap32asTGAFile(Image321.Bitmap, savedialog1.FileName);
end;

end.

[turboPASCAL]

So gehts auch... :gruebel:

Kurtz Version:

Delphi-Quellcode:

implementation

{$R *.dfm}

uses
  Gr32;

type
  TTGAFileHeader = packed record
    imageid: byte;         // bleibt Null eil wir keine BildID brauchen
    colourmaptype : byte;  // type of colour map 0=none, 1=has palette
    imagetype: byte;       // type of image
                           // 0 = none, 1=indexed, 2=rgb, 3=grey, 3+8=rle packed

    colourmapstart: word;  // first colour map entry in palette
    colourmaplength: word; // number of colours in palette
    colourmapbits: byte;   // number of bits per palette entry 15,16,24,32

    xstart: word;          // image x origin
    ystart: word;          // image y origin
    width: word;           // image width in pixels
    height: word;          // image height in pixels
    pixeldepth: byte;      // image bits per pixel 8,16,24,32
    descriptor: byte;      // image descriptor bits (vh - flip bits)
  end;

procedure SaveBitmap32AsTGAFile(bmp32: TBitmap32; TGAFileName: String);
var
  fs: TFileStream;
  tgaHeader : TTGAFileHeader;
begin
  ZeroMemory(@tgaHeader, sizeof(tgaHeader));
  tgaHeader.imagetype  := 2;
  tgaHeader.width      := bmp32.Width;
  tgaHeader.height     := bmp32.Height;
  tgaHeader.pixeldepth := 32;
  tgaHeader.descriptor := 244;

  fs := TFilestream.Create(TGAFileName, fmCreate);
  try
    fs.Seek(soFromBeginning, 0);
    fs.Write(tgaHeader, SizeOf(tgaHeader));
    fs.Write(bmp32.bits[0], bmp32.Width * bmp32.Height * 4);
  finally
    FreeAndNil(fs);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  savedialog1.filter := 'Targa Image File (*.TGA)|*.tga';
  savedialog1.DefaultExt := '.tga';
  if savedialog1.execute then
    SaveBitmap32asTGAFile(Image32_1.Bitmap, savedialog1.FileName);
end;

end.

[RobertP]

Super! Danke für deine Arbeit!
Die Bilder werden allerdings vertikal gespiegelt gespeichert, aber das hab ich nun gelöst indem ich sie einfach vor dem Speichern einmal spiegel ;)
Bei ACDSee sind die Bilder einfach schwarz, Photoshop zeigt sie aber ohne Probleme an. Komisch :gruebel:

[turboPASCAL]

Nein, nicht komisch. Das TGA Format ist sehr Einfach und auch Komplex.
Nicht jede Software beherst das laden von TGA's richtig sodern geht von
einer Standardsituation aus.

[Lossy eX]

Die Aussage kann ich nur unterstreichen aber in dem Code ist auch ein Fehler enthalten. Der ImageDescriptor ist falsch. Die Bits müssen genau andersrum sein. Also das kleinste Bit muss eigentlich das Größte sein und damit würde sich als Wert dafür eine 47 ergeben. Dann sollte es auch weniger Probleme geben.

[turboPASCAL]

Jupp, hab ich gestern Abend gemerkt. Ich seh mal zu das ich das im laufe des Tages berichtige.
Die meisten Software zum speichern von TGA's verwenden ein vertikal gespigeltes Bild in der Datei,
und beim Descriptor kommt dan einfach eine $08 hin.

zB. so:

Delphi-Quellcode:

procedure SaveBitmap32AsTGAFile(bmp32: TBitmap32; TGAFileName: String);
var
  fs: TFileStream;
  tgaHeader : TTGAFileHeader;
  DataArray: Array of DWORD;
  DataSize, n: DWORD;
  X, Y : Integer;
begin
  ZeroMemory(@tgaHeader, sizeof(tgaHeader));
  tgaHeader.imagetype  := 2;
  tgaHeader.width      := bmp32.Width;
  tgaHeader.height     := bmp32.Height;
  tgaHeader.pixeldepth := $20; // 32 Bit
  tgaHeader.descriptor := $08; // Bits 00001000 = 8 = $08

  DataSize := bmp32.Width * bmp32.Height * 4;
  SetLength(DataArray, DataSize + 1);

  // Bitmap "flippen"
  n := 0;
  for Y := bmp32.Height - 1 downto 0 do
    for X := 0 to bmp32.Width - 1 do
    begin
      DataArray[n] := bmp32.Bits[X + Y * bmp32.Width];
      inc(n);
    end;

  fs := TFilestream.Create(TGAFileName, fmCreate);
  try
    fs.Seek(soFromBeginning, 0);
    fs.Write(tgaHeader, SizeOf(tgaHeader));
    fs.Write(DataArray[0], DataSize);
  finally
    FreeAndNil(fs);
  end;

  SetLength(DataArray, 0);
end;

[RobertP]

Jawoll jetzt kann auch ACDSee des ganze lesen!
Nochmal vielen Dank! :)