Create OpenGL Texture from TBitmap

[FelipeFS]

I'm trying to create a texture from a TBitmap and not directly from a *.bmp file, because my bitmaps are loaded from a resource file(but it is a type of resource file created by me - and it is working fine).

This is my class TNewBitmap descendant of TBitmap, and it has a FBitmapIntF(TLazIntFImage) and FTexture(gluint) variables - an how I am trying to load the texture:


procedure TNewBitmap.UpdateTexture;
var
BData: Array of Byte;
BIndexX, BIndexY : Integer;
begin
Self.FBitmapIntF := TLazIntFImage.Create(Self.Width, Self.Height);
Self.FBitmapIntF.LoadFromBitmap(Self.Handle, Self.MaskHandle);

SetLength(BData, Self.Width * Self.Height * 3);
for BIndexY := 0 to Self.Height - 1 do
begin
for BIndexX := 0 to Self.Width - 1 do
begin
BData[(BIndexY * BIndexX) + BIndexX + 0] := GetBValue(Self.FBitmapIntF.Pixels[BIndexX, BIndexY]);
BData[(BIndexY * BIndexX) + BIndexX + 1] := GetGValue(Self.FBitmapIntF.Pixels[BIndexX, BIndexY]);
BData[(BIndexY * BIndexX) + BIndexX + 2] := GetRValue(Self.FBitmapIntF.Pixels[BIndexX, BIndexY]);
end;
end;

Self.FTexture := CreateTexture(Width, Height, @BData);

Self.LoadFromIntFImage(Self.FBitmapIntF);
Self.FBitmapIntF.Free;
end;

function CreateTexture(Width, Height: Integer; pData : Pointer) : GLUInt;
var
Texture : GLuint;
begin
glEnable(GL_TEXTURE_2D);
glGenTextures(1, Texture);
glBindTexture(GL_TEXTURE_2D, Texture);

glPixelStorei(GL_UNPACK_ALIGNMENT, 4);
glPixelStorei(GL_UNPACK_ROW_LENGTH, 0);
glPixelStorei(GL_UNPACK_SKIP_ROWS, 0);
glPixelStorei(GL_UNPACK_SKIP_PIXELS, 0);

glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT);
glTexImage2D(GL_TEXTURE_2D, 0, 3, Width, Height, 0, GL_RGB, GL_UNSIGNED_BYTE, pData);

Result := Texture;
end;


And this is how I'm try to draw the texture in the screen - this is in the render procedure:


glViewport(0, 0, FMainForm.Width, FMainForm.Height);
glMatrixMode(GL_PROJECTION);
glLoadIdentity();
glOrtho(0, FMainForm.Width, 0, FMainForm.Height, -100, 100);
glMatrixMode(GL_MODELVIEW);
glClearColor(1.0, 1.0, 1.0, 1.0);

glEnable(GL_DEPTH_TEST);
glDepthMask(GL_TRUE);

glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
glLoadIdentity();
glPushMatrix();

// loop for each object in game:
glEnable(GL_TEXTURE_2D);
glBindTexture(GL_TEXTURE_2D, BSprite.FTexture); // Bind the Texture of the the object
glTranslatef(BObjectPosX + BObjectCenterX, BObjectPosY + BObjectCenterY, 0.0);
glRotatef(BSprite.FAngle, 0.0, 0.0, 1.0);
glNormal3f( 0.0, 0.0, 1.0);

glBegin(GL_QUADS);
//glColor3f(0, 0.35, 0.5);
glTexCoord2f(0.0, 0.0); glVertex3f(-32.0, -32.0, 1.0);
glTexCoord2f(1.0, 0.0); glVertex3f( 32.0, -32.0, 1.0);
glTexCoord2f(1.0, 1.0); glVertex3f( 32.0, 32.0, 1.0);
glTexCoord2f(0.0, 1.0); glVertex3f(-32.0, 32.0, 1.0);
glEnd();
// end of the loop for;

glPopMatrix;
SwapBuffers(GetDC(FMainForm.Handle));
glFlush;

[User137]

Does it work if you comment this out? Seems to do nothing useful, if i read the code right...

//Self.LoadFromIntFImage(Self.FBitmapIntF);
Self.FBitmapIntF.Free;

Also you don't need to use Self. that often :) It does give clarity in some cases, but many people don't do that. For example:

label1.caption := 'Test';
Looks tidier than with "Self".

[FelipeFS]

But still, the texture is not being displayed in the screen.
:(

[deathshadow]

You are REALLY overthinking this IMHO... don't waste time making a copy, just send it tbitmap.canvas.pixels. You seem to be expanding tBitmap for no good reason near as I can tell...

Literally if your expanded object inherits from tBitmap, why aren't you just doing:



procedure TNewBitmap.UpdateTexture;
begin
self.FTexture:=CreateTexture(width,height,@canvas. pixels);
end;


??? I'm not getting what all that extra code is even in there for.

Likewise, once I've bound it, I'd release tbitmap -- I'd probably have tbitmap as a property of the texture instead of the other way around -- if I had it a property at all and not a local var in the constructor. Load it, bind it, release the tbitmap, continue on your merry way -- unless you really need to keep allocating and releasing it because you're running dry on available memory on the GPU.

[User137]

But still, the texture is not being displayed in the screen.
:(
You didn't say that in first post ;D I assumed it is working code just in need of optimizations.



self.FTexture:=CreateTexture(width,height,@canvas. pixels);
You won't be able to do that. Pixels is a property with GetPixel(X, Y: Integer): TColor function internally. But you are able to read the pixels without converting to TLazIntFImage. You can also send the TBitmap as parameter, and then read from its canvas pixels[] or colors[] property.
(Canvas.Colors[] is record structure divided in R,G,B, but works for freepascal only)

[FelipeFS]

Hi guys, I know that the code can be improved, but the most important part that is display the texture is not working, after accomplish that, I could improve it. Still got nothingwith @canvas.pixels or @canvas.colors.

I found this code on internet:

function LoadTexture(Filename: String; var Texture : GLuint) : Boolean;
var
FileHeader : BITMAPFILEHEADER;
InfoHeader : BITMAPINFOHEADER;
Palette : array of RGBQUAD;
pData : Pointer;
BitmapFile : THandle;
BitmapLength : LongWord;
PaletteLength : LongWord;
ReadBytes : LongWord;
Width, Height : Integer;
begin
result :=FALSE;

BitmapFile := CreateFile(PChar(Filename), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
if (BitmapFile = INVALID_HANDLE_VALUE) then begin
MessageBox(0, PChar('Error opening ' + Filename), PChar('BMP Unit'), MB_OK);
Exit;
end;

// Get header information
ReadFile(BitmapFile, FileHeader, SizeOf(FileHeader), ReadBytes, nil);
ReadFile(BitmapFile, InfoHeader, SizeOf(InfoHeader), ReadBytes, nil);

// Get palette
PaletteLength := InfoHeader.biClrUsed;
SetLength(Palette, PaletteLength);
ReadFile(BitmapFile, Palette, PaletteLength, ReadBytes, nil);
if (ReadBytes <> PaletteLength) then begin
MessageBox(0, PChar('Error reading palette'), PChar('BMP Unit'), MB_OK);
Exit;
end;

Width := InfoHeader.biWidth;
Height := InfoHeader.biHeight;
BitmapLength := InfoHeader.biSizeImage;
if BitmapLength = 0 then
BitmapLength := Width * Height * InfoHeader.biBitCount Div 8;

// Get the actual pixel data
GetMem(pData, BitmapLength);
ReadFile(BitmapFile, pData^, BitmapLength, ReadBytes, nil);
if (ReadBytes <> BitmapLength) then begin
MessageBox(0, PChar('Error reading bitmap data'), PChar('BMP Unit'), MB_OK);
Exit;
end;
CloseHandle(BitmapFile);

// Bitmaps are stored BGR and not RGB, so swap the R and B bytes.
SwapRGB(pData, Width*Height);

Texture :=CreateTexture(Width, Height, GL_RGB, pData);
FreeMem(pData);
result :=TRUE;
end;

and I changed to this - Putting some showmessage() commands to know as far the code goes without crash, and after ShowMessage('4') the program crashes:


procedure TNewBitmap.UpdateTexture;
var
FileHeader : BITMAPFILEHEADER;
InfoHeader : BITMAPINFOHEADER;
Palette : array of RGBQUAD;
pData : Pointer;
BitmapFile : THandle;
BitmapLength : LongWord;
PaletteLength : LongWord;
ReadBytes : LongWord;
Width, Height : Integer;
begin
ShowMessage('1');
BitmapFile := Self.Handle; //CreateFile(PChar(Filename), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
if (BitmapFile = INVALID_HANDLE_VALUE) then begin
MessageBox(0, PChar('Error opening bitmap'), PChar('BMP Unit'), MB_OK);
Exit;
end;

ShowMessage('2');
// Get header information
ReadFile(BitmapFile, FileHeader, SizeOf(FileHeader), ReadBytes, nil);
ReadFile(BitmapFile, InfoHeader, SizeOf(InfoHeader), ReadBytes, nil);

ShowMessage('3');
// Get palette
PaletteLength := InfoHeader.biClrUsed;

ShowMessage('4');
SetLength(Palette, PaletteLength);

ShowMessage('5');
ReadFile(BitmapFile, Palette, PaletteLength, ReadBytes, nil);
if (ReadBytes <> PaletteLength) then begin
MessageBox(0, PChar('Error reading palette'), PChar('BMP Unit'), MB_OK);
Exit;
end;

ShowMessage('6');
BitmapLength := InfoHeader.biSizeImage;
if BitmapLength = 0 then
BitmapLength := Width * Height * InfoHeader.biBitCount Div 8;

ShowMessage('7');
// Get the actual pixel data
GetMem(pData, BitmapLength);
ReadFile(BitmapFile, pData^, BitmapLength, ReadBytes, nil);
if (ReadBytes <> BitmapLength) then begin
MessageBox(0, PChar('Error reading bitmap data'), PChar('BMP Unit'), MB_OK);
Exit;
end;

ShowMessage('8');
SwapRGB(pData, Width*Height);
FTexture :=CreateTexture(Width, Height, GL_RGB, pData);
FreeMem(pData);
ShowMessage('7');
end;


In the palette part, the program crashes. My bitmap to be loaded is a 24 bit depth color(also the bitmap loaded by the original code - and it loads fine). The main change was "BitmapFile := Self.Handle;"
But even so, the texture is not being displayed. =(

What I accomplished so far was display shapes like triangles. And the place which should display the texture, displays a colored square, instead.

[deathshadow]

You won't be able to do that. Pixels is a property with GetPixel(X, Y: Integer): TColor function internally. But you are able to read the pixels without converting to TLazIntFImage. You can also send the TBitmap as parameter, and then read from its canvas pixels[] or colors[] property.
(Canvas.Colors[] is record structure divided in R,G,B, but works for freepascal only)
Is that a recent change or something? I thought that was the pointer to the buffer just like scanlines[0] would be...

Or did they go the retard route and stop providing you an actual pointer to the pixel buffer?

I stopped using delphi because of idiocy like that and went to FPC. Several times I've ended up screaming at the display "lands sake just let me access the data I just loaded!" -- SDL_image or using your own loader has far, far less headaches.

Actually, I use a bit harsher language than that. If you have to make a second copy of it using some idiotic array like scanlines or via pixel[x,y], then IMHO tBitmap is useless bull... that ends up being THREE copies just to load one image into openGL; if that's not idiotic nonsensical BS, I don't know what is.

would scanline[0] then work? Or do they not even guarantee that scanlines are contiguous in memory?

If I was forced to use code like that because tBitmap won't even provide a proper pointer to the buffer the bitmap is stored in, I'd say {expletive omitted} that {even nastier expletive omitted}, kick tBitmap to the curb, forget that resources BS, and just make my own loader... because if that's how it works, it's not worth even TRYING to use.

But then I've never liked resource files to begin with. Royal PITA... and if I was writing for OpenGL, Delphi would be pretty far down my list of choices -- but that's probably because FPC+SDL+OPENGL is so bloody brilliant from a functionality and ease of use standpoint.

[deathshadow]

That new code looks much, much more promising, though it's not really all that versatile in terms of BMP formats... gimme a bit to play with that. I'll compare it to my PHP code for loading BMP files (which shockingly PHP/gd has no support for -- WBMP != BMP).


I suspect the unsized palette array is the contributing factor to it's failure... though using all the stock data types could also be it since there's no guarantee they match the physical header info across compilation targets.

Have you tried outputting the values from the header read to make sure it actually is getting valid header data from reading 'self'? I didn't think a handle to tBitmap would be file readable?

If you put it in an external file, does it work? If you can load it from an external file, then the problem lies with how you're trying to use a resource and/or tBitmap. Start going through and eliminating possible causes.

[paul_nicholls]

Here are my texture units I made for a game engine that you could look at for ideas :)

unit_ImageBuffer32

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

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:

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;

[deathshadow]

Best i can come up with is to pitch tBitmap in the trash, it does NOT provide the information you need to do this in a reasonable manner.



function createGlTextureFromResource(h:hInstance; resId:integer):glInt;
var
textureStream:tResourceStream;
fileHeader:BITMAPFILEHEADER;
infoHeader:BITMAPINFOHEADER;
data:pointer;
dataSize:longint;
begin
ShowMessage('Opening Bitmap File');
textureStream:=tResourceStream.createFromId(h,resI D,RT_RCDATA);

showMessage('Loading Headers');
// Get header information
textureStream.read(fileHeader,sizeOf(fileHeader));
textureStream.read(infoHeader,sizeOf(infoHeader));

if not(infoHeader.biBitcount=24) then begin
MessageBox(
0,
PChar('Error - Attempt to load non 24 bit texture'),
PChar('BMP Unit'),
MB_OK
);
exit;
end;

// 24 bit means we don't need the palette, so let's skip it!

textureStream.seek(fileHeader.bfOffBits);

dataSize:=(
infoHeader.width *
infoHeader.height *
infoHeader.biBitCount div 8
);
getMem(data,dataSize);

showMessage('Loading bitmap data');
// Get the actual pixel data
textureStream.read(data^,dataSize);

showMessage('Assigning bitmap to OpenGL texture');

createGlTextureFromResource:=createTexture(
infoHeader.biWidth,
infoHeader.biHeight,
GL_RGB,
data
);

showMessage('Unallocating bitmap memory');

freeMem(dData,dataSize);

showMessage('Bitmap resource to OpenGL texture complete');
end;


Is roughly how I'd go about it. Note you have to pass the application hInstance to it... untested, so I'm not sure if you should be forcing it to be rcdata, or rcBitmap -- I suspect the latter may have 'issues'... also not sure if you need to rgbswap or not. (sdl_image's load_img seems to handle that for me)... if you do need the swap, rather than wasting time flipping it manually, why not send gl_BGR to the texture loader?

[FelipeFS]

Thank you very much, guys!

Maybe part of the code I did was right, I discovered that when the TNewBitmap is being created, the functions GetWidth and GetHeight used by the properties Width and Height are not being created(a message is telling that both methods are abstract).

I do not know why, even calling the constructor of the TNewBitmap ancestor (inherited Create), these methods are still abstract. Probably the data which I was storing to make the texture was a 0x0 matrix!!!

I will check it out, and I will post the result here!

[FelipeFS]

OHHHH YEAH!!!
Best result so far! A blurry texture! The previous problem was really about the matrix being passed as 0x0 to the CreateTexture procedure.
https://lh6.googleusercontent.com/-sMmj7JbzxCI/T-B77YbUF8I/AAAAAAAABM4/C8rv8Nfccnk/s800/imagem.PNG
and should look like this:
https://lh6.googleusercontent.com/-fD5YjD9uYbc/T7YikL9LxmI/AAAAAAAABLs/sZBWEXIJdhg/s800/MEScreenshot.png

[FelipeFS]

Thank you, guys! It is working!