TGA Unit

[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.

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.