TGA Unit

[turboPASCAL]

So gehts auch...

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.