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:
Code:
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:
Code:
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.
Bookmarks