Работа с TGA файлами

Previous  Top  Next

    
 

 

 

Code:

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;

 

 

©Drkb::04305

Взято с Delphi Knowledge Base: http://www.baltsoft.com/