Here are my texture units I made for a game engine that you could look at for ideas
unit_ImageBuffer32
Code:
unit unit_ImageBuffer32;(*
Copyright (c) 2012, Paul Nicholls (paulfnicholls AT gmail DOT com)
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
1. Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR
ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)
{$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.
unit_bmp_loader
Code:
unit unit_bmp_loader;
(*
Copyright (c) 2012, Paul Nicholls (paulfnicholls AT gmail DOT com)
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
1. Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR
ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*){$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.
and this is how I create an OpenGL texture from the imagebuffer:
Code:
procedure TxeTexture.GenerateTexture;
begin
glEnable(GL_TEXTURE_2D);
glDeleteTextures(1,@FId);
glGenTextures(1, @FId);
glBindTexture(GL_TEXTURE_2D,FId);
glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE); {Texture blends with object background}
// glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL); {Texture does NOT blend with object background}
{ Select a filtering type. BiLinear filtering produces very good results with little performance impact
GL_NEAREST - Basic texture (grainy looking texture)
GL_LINEAR - BiLinear filtering
GL_LINEAR_MIPMAP_NEAREST - Basic mipmapped texture
GL_LINEAR_MIPMAP_LINEAR - BiLinear Mipmapped texture
}
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); { only first two can be used }
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); { all of the above can be used }
// gluBuild2DMipmaps(GL_TEXTURE_2D, GL_RGBA, FBuffer.Width, FBuffer.Height, GL_RGBA, GL_UNSIGNED_BYTE, FBuffer.GetPixels);
glTexImage2D (GL_TEXTURE_2D, 0, 4, FBuffer.Width, FBuffer.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, FBuffer.GetPixels); // Use when not wanting mipmaps to be built by openGL
// glDisable(GL_TEXTURE_2D);
end;
Bookmarks