Hey Ben,
here is my BMP loading code I wrote for my xeEngine:
Code:
unit unit_bmp_loader;
{$ifdef fpc}
{$mode Delphi}
{$endif}
{$H+}
interface
uses
Classes,
unit_ImageBuffer32;
function LoadBMPFromStream(Stream: TStream; Buffer: TImageBuffer32): Boolean;
function LoadBMPFromFile(FileName: String; Buffer: TImageBuffer32): Boolean;
implementation
uses
SysUtils;
type
//File information header
//provides general information about the file
TBITMAPFILEHEADER = packed record
bfType : Word;
bfSize : LongWord;
bfReserved1 : Word;
bfReserved2 : Word;
bfOffBits : LongWord;
end;
//Bitmap information header
//provides information specific to the image data
TBITMAPINFOHEADER = packed record
biSize : LongWord;
biWidth : LongInt;
biHeight : LongInt;
biPlanes : Word;
biBitCount : Word;
biCompression : LongWord;
biSizeImage : LongWord;
biXPelsPerMeter : LongInt;
biYPelsPerMeter : LongInt;
biClrUsed : LongWord;
biClrImportant : LongWord;
end;
//Colour palette
TRGBQUAD = packed record
rgbBlue : Byte;
rgbGreen : Byte;
rgbRed : Byte;
rgbReserved : Byte;
end;
PBitmapPixel = ^TBitmapPixel;
TBitmapPixel = packed record
b,g,r: Byte;
end;
function LoadBMPFromStream(Stream: TStream; Buffer: TImageBuffer32): Boolean;
var
FileHeader : TBITMAPFILEHEADER;
InfoHeader : TBITMAPINFOHEADER;
Palette : array of TRGBQUAD;
BitmapLength : LongWord;
PaletteLength : LongWord;
ReadBytes : LongWord;
Width,Height : Integer;
BitmapPixels : PBitmapPixel;
BitmapAddr : PBitmapPixel;
BufferRow : PRGBAArray;
x,y : LongWord;
OldPos : Int64;
begin
OldPos := Stream.Position;
// Get header information
Stream.Read(FileHeader, SizeOf(FileHeader));
if FileHeader.bfType <> $4d42 then
// not a BMP file!
begin
// reset position
Stream.Seek(OldPos,soFromBeginning);
Exit;
end;
Stream.Read(InfoHeader, SizeOf(InfoHeader));
if InfoHeader.biBitCount <> 24 then
// only supports 24 bit bitmaps!
Exit;
// Get palette
PaletteLength := InfoHeader.biClrUsed;
if PaletteLength > 0 then
begin
SetLength(Palette, PaletteLength);
ReadBytes := Stream.Read(Palette,PaletteLength);
if (ReadBytes <> PaletteLength) then
begin
// MessageBox(0, PChar('Error reading palette'), PChar('BMP Loader'), MB_OK);
Exit;
end;
end;
Width := InfoHeader.biWidth;
Height := InfoHeader.biHeight;
Buffer.SetSize(Width,Height);
BitmapLength := InfoHeader.biSizeImage;
if BitmapLength = 0 then
BitmapLength := Width * Height * (InfoHeader.biBitCount Div 8);
// Get the actual pixel data
GetMem(BitmapPixels, BitmapLength);
try
ReadBytes := Stream.Read(BitmapPixels^, BitmapLength);
if (ReadBytes <> BitmapLength) then
begin
// MessageBox(0, PChar('Error reading bitmap data'), PChar('BMP Unit'), MB_OK);
Exit;
end;
BitmapAddr := BitmapPixels;
// copy bitmap pixels to buffer pixels
for y := 0 to Height - 1 do
begin
BufferRow := Buffer.ScanLine[(Height - 1) - y];
for x := 0 to Width - 1 do
begin
BufferRow^[x].r := BitmapAddr^.r;
BufferRow^[x].g := BitmapAddr^.g;
BufferRow^[x].b := BitmapAddr^.b;
BufferRow^[x].a := 255;
Inc(BitmapAddr);
end;
end;
finally
FreeMem(BitmapPixels)
end;
end;
function LoadBMPFromFile(Filename: String; Buffer: TImageBuffer32): Boolean;
var
BMPFile : TFileStream;
begin
Result := False;
if not FileExists(FileName) then Exit;
BMPFile := TFileStream.Create(FileName,fmOpenRead or fmShareDenyWrite);
try
Result := LoadBMPFromStream(BMPFile,Buffer);
finally
BMPFile.Free;
end;
end;
end.
cheers,
Paul
Bookmarks