Работа с TGA файлами
Материал из DRKB
const
FERRORMSG2 = 'Sorry, Unsupported Compressed(RLE) File Format';
FERRORMSG3 = 'Sorry, Unsupported More Than 256 Colours File Format';
type
TArrBuff = array[1..512] of Byte;
TPalette_Cell = record
b2, g2, r2: byte;
end;
TPal = array[0..255] of TPalette_Cell;
TPPal = ^TPal;
TTGA_Header = record // Targa(TGA) HEADER //
IDLength, ColorMap, ImageType: Byte;
ClrMapSpes: array[1..5] of Byte;
XAwal, YAwal, Width, Height: SmallInt;
BpPixel, ImageDescription: Byte;
end;
var
pal: TPPal;
pFile: File;
buffer: TArrBuff;
FTgaHeader: TTGA_Header;
procedure THPTGA.ReadImageData2Bitmap;
var
i, j, idx: Integer;
begin
Seek(pFile, sizeof(FtgaHeader) + FtgaHeader.IDLength + 768);
for i := FtgaHeader.Height - 1 downto FtgaHeader.YAwal do
begin
BlockRead(pFile, buffer, FtgaHeader.Width);
for j := FtgaHeader.XAwal to FtgaHeader.Width - 1 do
begin
idx := j - FtgaHeader.XAwal + 1;
SetPixel(Bitmap.Canvas.Handle, j, i, rgb(pal^[buffer[idx]].r2,
pal^[buffer[idx]].g2, pal^[buffer[idx]].b2));
end;
end;
end;
procedure THPTGA.LoadFromFile(const FileName: string);
begin
AssignFile(pFile, FileName);
{$I-}
Reset(pFile, 1);
{$I+}
if (IOResult = 0) then
begin
try
BlockRead(pFile, FtgaHeader, SizeOf(FtgaHeader));
// checking unsupported features here
if (FtgaHeader.ImageType > 3) then
begin
MessageBox(Application.Handle, FERRORMSG2, 'TGA Viewer Error', MB_ICONHAND);
exit;
end;
if (FtgaHeader.BpPixel > 8) then
begin
MessageBox(Application.Handle, FERRORMSG3, 'TGA Viewer Error', MB_ICONHAND);
exit;
end;
GetMem(pal, 768);
try
Bitmap.Width := FtgaHeader.Width;
Bitmap.Height := FtgaHeader.Height;
// if use Color-Map and Uncompressed then read it
if (FtgaHeader.ImageType = 1) then
BlockRead(pFile, pal^, 768);
ReadImageData2Bitmap;
finally
FreeMem(pal);
end;
finally
CloseFile(pFile);
end;
end
else
MessageBox(Application.Handle, 'Error Opening File', 'TGA Viewer Error', MB_ICONHAND);
end;
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 04305