TGA Unit

[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! :)