Kod modułu ładującego tekstury dla D2. Powinien działać na d3.
unit Textures;
interface
uses
Windows, GL, GLU ,Classes; //Graphics, SysUtils;
function LoadTexture(Filename: String; var Texture: GLuint; LoadFromRes : Boolean): Boolean;
implementation
//function gluBuild2DMipmaps(Target: GLenum; Components, Width, Height: GLint; Format, atype: GLenum; Data: Pointer): GLint; stdcall; external glu32;
function gluBuild2DMipmaps(Target: GLenum; Components, Width, Height: GLint; Format, atype: GLenum; Data: Pointer): GLint; stdcall; external 'glu32.dll';//modified by fabrizio
procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32;
procedure glBindTexture(target: GLenum; texture: GLuint); stdcall; external opengl32;
{------------------------------------------------------------------}
{ Create the Texture }
{------------------------------------------------------------------}
function CreateTexture(Width, Height, Format : Word; pData : Pointer) : Integer;
var
Texture : GLuint;
begin
glGenTextures(1, Texture);
glBindTexture(GL_TEXTURE_2D, Texture);
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 }
if Format = GL_RGBA then
gluBuild2DMipmaps(GL_TEXTURE_2D, GL_RGBA, Width, Height, GL_RGBA, GL_UNSIGNED_BYTE, pData)
else
gluBuild2DMipmaps(GL_TEXTURE_2D, 3, Width, Height, GL_RGB, GL_UNSIGNED_BYTE, pData);
// glTexImage2D(GL_TEXTURE_2D, 0, 3, Width, Height, 0, GL_RGB, GL_UNSIGNED_BYTE, pData); // Use when not wanting mipmaps to be built by openGL
result :=Texture;
end;
{------------------------------------------------------------------}
{ Load BMP textures }
{------------------------------------------------------------------}
function LoadBMPTexture(Filename: String; var Texture : GLuint; LoadFromResource : Boolean) : Boolean;
var
FileHeader: TBITMAPFILEHEADER; // was FileHeader: BITMAPFILEHEADER; undeclared identifier
InfoHeader: TBITMAPINFOHEADER; // was InfoHeader: BITMAPINFOHEADER; undeclared identifier
Palette: array [byte] of TRGBQUAD; // Palette: array of RGBQUAD; declaration of array not supported by D2 and undeclared identifier RGBQUAD
BitmapFile: THandle;
BitmapLength: Integer; // changed from variant
PaletteLength: Integer; // '' '' ''
ReadBytes: Integer; // changed for incompatibility whith declaration of Win function Readfile
Front: ^Byte;
Back: ^Byte;
Temp: Byte;
I : Integer;
Width, Height : Integer;
pData : Pointer;
// used for loading from resource
ResStream : TResourceStream;
begin
result :=FALSE;
if LoadFromResource then // Load from resource
begin
try
ResStream := TResourceStream.Create(hInstance, PChar(copy(Filename, 1, Pos('.', Filename)-1)), 'BMP');
ResStream.ReadBuffer(FileHeader, SizeOf(FileHeader)); // FileHeader
ResStream.ReadBuffer(InfoHeader, SizeOf(InfoHeader)); // InfoHeader
PaletteLength := InfoHeader.biClrUsed;
//SetLength(Palette, PaletteLength); commented by fabrizio ( i don't know how to solve !!)
ResStream.ReadBuffer(Palette, PaletteLength); // Palette
Width := InfoHeader.biWidth;
Height := InfoHeader.biHeight;
BitmapLength := InfoHeader.biSizeImage;
if BitmapLength = 0 then
BitmapLength := Width * Height * InfoHeader.biBitCount Div 8;
GetMem(pData, BitmapLength);
ResStream.ReadBuffer(pData^, BitmapLength); // Bitmap Data
ResStream.Free;
except on
EResNotFound do
begin
MessageBox(0, PChar('File not found in resource - ' + Filename), PChar('BMP Texture'), MB_OK);
Exit;
end
else
begin
MessageBox(0, PChar('Unable to read from resource - ' + Filename), PChar('BMP Unit'), MB_OK);
Exit;
end;
end;
end
else
begin // Load image from file
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); commented by fabrizio ( i don't know how to solve !!)
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);
end;
// Bitmaps are stored BGR and not RGB, so swap the R and B bytes.
for I :=0 to Width * Height - 1 do
begin
Front := Pointer(Integer(pData) + I*3);
Back := Pointer(Integer(pData) + I*3 + 2);
Temp := Front^;
Front^ := Back^;
Back^ := Temp;
end;
Texture :=CreateTexture(Width, Height, GL_RGB, pData);
FreeMem(pData);
result :=TRUE;
end;
{------------------------------------------------------------------}
{ Determines file type and sends to correct function }
{------------------------------------------------------------------}
function LoadTexture(Filename: String; var Texture : GLuint; LoadFromRes : Boolean) : Boolean;
begin
if copy(filename, length(filename)-3, 4) = '.bmp' then
LoadBMPTexture(Filename, Texture, LoadFromRes);
//if copy(filename, length(filename)-3, 4) = '.jpg' then
// LoadJPGTexture(Filename, Texture, LoadFromRes);
//if copy(filename, length(filename)-3, 4) = '.tga' then
// LoadTGATexture(Filename, Texture, LoadFromRes);
end;
end.