Модуль

← →
ЫШО © (2004-06-05 20:42) [0]

Народ, у кого есть PowerDraw то скиньте на мыло пожалуйста модуль, который отвечает за поддержку изображений *.tga
Вроде называется tgareader.pas

mailto:grei@balabanovo.ru

← →
ЫШО © (2004-06-05 21:01) [1]

Ну пожалуйста! Жалко 6 мег трафика ради модуля на 20 кило!

← →
lyeh © (2004-06-06 00:25) [2]

Лень отсылать, забирай так: (да простят меня админы :) )

unit TGAReader;

interface

uses SYSUtils, Graphics;

type
TBitmapEx = class(TBitmap)
public
procedure LoadFromFile(const FileName: String); override;
procedure SaveToFile(const FileName: String); override;
end;

implementation

type
TTGAHeader = packed record
tfIDLength: Byte;
tfColorMapType: Byte;
tfImageType: Byte;
tfColorMapSpec: Array[0..4] of Byte;
tfOrigX: Word;
tfOrigY: Word;
tfWidth: Word;
tfHeight: Word;
tfBpp: Byte;
tfImageDesc: Byte;
end;

procedure TBitmapEx.LoadFromFile(const FileName: String);
var
F: File;
Header: TTGAHeader;
Bpp, I: Integer;
Flip: Boolean;

RLE: Boolean; // RLE flag
p, // pointer to move trough data
Data: Pointer; // temp store for imagedata, used for unpacking RLE data
BytePP: Integer; // Bytes Per Pixels
b, // RLE BlockLength
RLEHeader: Byte; // RLE blockheader
RLEBuf: Cardinal;// Temp store for one pixel
TSize: Integer;
begin
if (CompareText(ExtractFileExt(FileName), ".tga") <> 0) then
begin
inherited LoadFromFile(FileName);
Exit;
end;

AssignFile(F, FileName);
Reset(F, 1);

BlockRead(F, Header, SizeOf(Header));

RLE:= Header.tfImageType = 10;
// checking if True-Color format is present
if (Header.tfImageType <> 2)and(not RLE) then
begin
CloseFile(F);
raise Exception.Create("TGA graphics is not in True-Color");
end;

// checking is colormapping present
if (Header.tfColorMapType <> 0) then
begin
CloseFile(F);
raise Exception.Create("Color-mapped TGA is not supported");
end;

// checking bit-depth
Bpp:= Header.tfBpp;
if (Bpp <> 32)and(Bpp <> 24) then
begin
CloseFile(F);
raise Exception.Create("Invalid TGA Bit-depth!");
end;

// checking if the image is mirrored
if (Header.tfImageDesc and $10 = $10) then
begin
CloseFile(F);
raise Exception.Create("Mirrored TGA is not supported!");
end;
Flip:= (Header.tfImageDesc and $20 <> $20);

// skip Image ID field
if (Header.tfIDLength <> 0) then
Seek(F, FilePos(F) + Header.tfIDLength);

Width:= Header.tfWidth;
Height:= Header.tfHeight;

BytePP:= Bpp div 8;
TSize:= Width * Height * BytePP;
GetMem(Data, TSize);

if (RLE) then
begin
i:= 0;
while (i < TSize) do
begin
// read the RLE header
BlockRead(F, RLEHeader, 1);
// RLE Block length
b:= RLEHeader and $7F + 1;
if (RLEHeader and $80) = $80 then
begin
// If highest bit is set, the read one pixel and repeat it b times
BlockRead(F, RLEBuf, BytePP); // read the pixel
while (b > 0) do
begin
Move(RLEBuf, Pointer(Integer(Data) + i)^, BytePP); // repeat the pixel, one at a time
Inc(i, BytePP); // inc "read pointer"
Dec(b); // dec remaining pixels
end; // while (b > 0)
end else
begin
// read b pixels
BlockRead(f,Pointer(Integer(Data)+i)^,BytePP*b);
// inc "read pointer"
Inc(i,BytePP*b);
end; // if (RLEHeader and $80) = $80 ...
end; // while (i < TSize)
end else
BlockRead(F, Data^, TSize); // Not RunLengthEncoded, just read it all

p:= data;
if (Bpp = 32) then PixelFormat:= pf32bit
else PixelFormat:= pf24bit;

// move the picture from data to scanlines
if (Flip) then
begin
for I:= Height - 1 downto 0 do
begin
Move(p^, ScanLine[I]^,Width * BytePP);
p:= Pointer(Integer(p) + Width * BytePP);
end;
end else
begin
for I:= 0 to Height - 1 do
begin
Move(p^,ScanLine[I]^,Width * BytePP);
p:= Pointer(Integer(p) + Width * BytePP);
end;
end;

// clean up
FreeMem(Data);
CloseFile(F);
end;

procedure TBitmapEx.SaveToFile(const FileName: String);
Var F: File;
Header: TTGAHeader;
I: Integer;
begin
if (CompareText(ExtractFileExt(FileName), ".tga") <> 0) then
begin
inherited SaveToFile(FileName);
Exit;
end;

if (PixelFormat <> pf24bit)and(PixelFormat <> pf32bit) then
raise Exception.Create("Invalid pixel format!");

AssignFile(F, FileName);
ReWrite(F, 1);

FillChar(Header, SizeOf(Header), 0);

Header.tfImageType:= 2; // True-color
Header.tfColorMapType:= 0; // No colormapping

Header.tfImageDesc:= $20; // the image is not flipped

Header.tfWidth:= Width;
Header.tfHeight:= Height;

Header.tfBpp:= 32;
if (PixelFormat = pf24bit) then
Header.tfBpp:= 24;

BlockWrite(F, Header, SizeOf(Header));

Case Header.tfBpp of
32: begin
PixelFormat:= pf32bit;

for I:= 0 to Height - 1 do
BlockWrite(F, ScanLine[I]^, Width * 4);
end;
24: begin
PixelFormat:= pf24bit;

for I:= 0 to Height - 1 do
BlockWrite(F, ScanLine[I]^, Width * 3);
end;
end;

CloseFile(F);
end;

end.

Поможет библиотека GraphicEx (бесплатно, с исходниками):
http://www.delphi-gems.com

Модуль Найти похожие ветки