Code:
unit unit_ImageBuffer32;
{$ifdef fpc}
{$mode Delphi}
{$endif}
{$H+}
interface
uses
Classes;
type
PRGBA = ^TRGBA;
TRGBA = packed record
case Integer of
0 : (r,g,b,a: Byte);
1 : (Value: LongWord);
end;
PRGBAArray = ^TRGBAArray;
TRGBAArray = array[0..(MaxInt div SizeOf(TRGBA)) - 1] of TRGBA;
TImageBuffer32 = class
private
FWidth : Word;
FHeight : Word;
FPixels : array of TRGBA;
function GetScanLine(y: Word): Pointer;
function GetBit(Index: Integer): TRGBA;
procedure SetBit(Index: Integer; Color: TRGBA);
public
constructor Create;
destructor Destroy; override;
procedure SetSize(aWidth,aHeight: Word);
procedure SetBitRGBA(Index: Integer; r,g,b,a: Byte);
function GetPixels: Pointer;
function LoadFromStream(Stream: TStream): Boolean;
function LoadFromFile(FileName: String): Boolean;
function LoadBMPFromFile(FileName: String): Boolean;
function LoadPNGFromFile(FileName: String): Boolean;
function LoadTGAFromFile(FileName: String): Boolean;
property Width : Word read FWidth;
property Height: Word read FHeight;
property ScanLine[y: Word]: Pointer read GetScanLine;
property Bits[Index: Integer]: TRGBA read GetBit write SetBit;
end;
implementation
uses
SysUtils,
unit_bmp_loader,
unit_tga_loader,
unit_png_loader;
type
TImageType = (itUnknown,itBMP,itPNG,itTGA);
function GetImageTypeFromStream(Stream: TStream): TImageType;
type
TTGAHeader = packed record // Header type for TGA images
FileType : Byte;
ColorMapType : Byte;
ImageType : Byte;
ColorMapSpec : Array[0..4] of Byte;
OrigX : Array [0..1] of Byte;
OrigY : Array [0..1] of Byte;
Width : Array [0..1] of Byte;
Height : Array [0..1] of Byte;
BPP : Byte;
ImageInfo : Byte;
end;
const
cBMPSig = $4d42;
cPNGSig: array[0..7] of Byte = (137, 80, 78, 71, 13, 10, 26, 10);
var
BMPSig : Word;
PNGSig : array[0..7] of Byte;
TGAHeader: TTGAHeader;
i : Integer;
OldPos : Int64;
Image : AnsiString;
begin
Result := itUnknown;
OldPos := Stream.Position;
try
// check for BMP
Stream.Read(BMPSig, SizeOf(BMPSig));
if BMPSig = cBMPSig then
begin
Result := itBMP;
Exit;
end;
//check for PNG
Result := itPNG;
Stream.Seek(OldPos,soFromBeginning);
Stream.Read(PNGSig,SizeOf(PNGSig));
for i := 0 to 7 do
begin
if PNGSig[i] <> cPNGSig[i] then
begin
Result := itUnknown;
Break;
end;
end;
if Result = itPNG then Exit;
Result := itUnknown;
//check for TGA
Stream.Seek(OldPos,soFromBeginning);
Stream.Read(TGAHeader,SizeOf(TGAHeader));
// Only support 24, 32 bit images
if (TGAHeader.ImageType <> 2) and { TGA_RGB }
(TGAHeader.ImageType <> 10) then { Compressed RGB }
begin
Exit;
end;
// Don't support colormapped files
if TGAHeader.ColorMapType <> 0 then
begin
Exit;
end;
Result := itTGA;
{ SetLength(Image,Stream.Size);
Stream.Read(PAnsiChar(Image)^,Stream.Size);
if Pos('TRUEVISION-XFILE',Image) > 0 then
begin
Result := itTGA;
Exit;
end;}
finally
Stream.Seek(OldPos,soFromBeginning);
end;
end;
function NewRGBA(r,g,b,a: Byte): TRGBA;
begin
Result.r := r;
Result.g := g;
Result.b := b;
Result.a := a;
end;
constructor TImageBuffer32.Create;
begin
inherited Create;
SetSize(0,0);
end;
destructor TImageBuffer32.Destroy;
begin
SetSize(0,0);
inherited Destroy;
end;
procedure TImageBuffer32.SetSize(aWidth,aHeight: Word);
var
i: Integer;
begin
FWidth := aWidth;
FHeight := aHeight;
SetLength(FPixels,FWidth * FHeight);
for i := 0 to FWidth * FHeight - 1 do
FPixels[i].Value := 0;
end;
function TImageBuffer32.GetScanLine(y: Word): Pointer;
begin
Result := @FPixels[y * FWidth];
end;
function TImageBuffer32.GetBit(Index: Integer): TRGBA;
begin
Result := FPixels[Index];
end;
procedure TImageBuffer32.SetBit(Index: Integer; color: TRGBA);
begin
FPixels[Index] := color;
end;
procedure TImageBuffer32.SetBitRGBA(Index: Integer; r,g,b,a: Byte);
begin
FPixels[Index].r := r;
FPixels[Index].g := g;
FPixels[Index].b := b;
FPixels[Index].a := a;
end;
function TImageBuffer32.GetPixels: Pointer;
begin
Result := nil;
if Length(FPixels) = 0 then Exit;
Result := @FPixels[0];
end;
function TImageBuffer32.LoadFromStream(Stream: TStream): Boolean;
var
ImgType: TImageType;
begin
Result := False;
ImgType := GetImageTypeFromStream(Stream);
case ImgType of
itBMP : Result := LoadBMPFromStream(Stream,Self);
itPNG : Result := LoadPNGFromStream(Stream,Self);
itTGA : Result := LoadTGAFromStream(Stream,Self);
else
end;
end;
function TImageBuffer32.LoadFromFile(FileName: String): Boolean;
var
Ext: String;
begin
Result := False;
if not FileExists(FileName) then Exit;
Ext := LowerCase(ExtractFileExt(FileName));
if Ext = '.bmp' then Result := unit_bmp_loader.LoadBMPFromFile(FileName,Self)
else if Ext = '.tga' then Result := unit_tga_loader.LoadTGAFromFile(FileName,Self)
else if Ext = '.png' then Result := unit_png_loader.LoadPNGFromFile(FileName,Self);
end;
function TImageBuffer32.LoadBMPFromFile(FileName: String): Boolean;
begin
Result := False;
if not FileExists(FileName) then Exit;
Result := unit_bmp_loader.LoadBMPFromFile(FileName,Self);
end;
function TImageBuffer32.LoadPNGFromFile(FileName: String): Boolean;
begin
Result := False;
if not FileExists(FileName) then Exit;
Result := unit_png_loader.LoadPNGFromFile(FileName,Self);
end;
function TImageBuffer32.LoadTGAFromFile(FileName: String): Boolean;
begin
Result := False;
if not FileExists(FileName) then Exit;
Result := unit_tga_loader.LoadTGAFromFile(FileName,Self);
end;
end.
cheers,
Bookmarks