unit TextureUnit;
interface
uses Windows, Classes;
type
TTexture = Class(TObject)
private
FFilename : String;
FCount : Integer;
FTexture : Cardinal;
FWidth,FHeight : Integer;
FBPP : Byte;
FFormat : Cardinal;
FUseMipmaps,
FUseNearest : Boolean;
public
constructor Create(Filename : String);
procedure Free;
procedure Inc; //DO NOT CALL!
// $0DE1 is GL_TEXTURE_2D
procedure BindTexture(Target : Cardinal = $0DE1; Texture : Cardinal = Cardinal(-1));
procedure UpdateTexture(Width,Height : Integer; BPP : Byte; Format,InternalFormat : Cardinal; Data : Pointer; Target : Cardinal = $0DE1; DataType : Cardinal = $1401); overload;
procedure UpdateTexture(Width,Height : Integer; Data : Pointer; Target : Cardinal = $0DE1; DataType : Cardinal = $1401); overload;
procedure UpdateTexture(Data : Pointer; Target : Cardinal = $0DE1; DataType : Cardinal = $1401); overload;
property UseMipmaps : Boolean read FUseMipmaps write FUseMipmaps;
property UseNearest : Boolean read FUseNearest write FUseNearest;
property Filename : String read FFilename;
end;
TTextureManager = Class(TObject)
private
FTextures : TList;
FLastTexture : Cardinal;
function GetTextureCount : Integer;
function GetTextureInt(Index : Integer) : TTexture;
public
constructor Create;
destructor Destroy; override;
function GetTexture(Filename : String) : TTexture;
function LoadTextureFromFile(Filename : String) : TTexture;
function LoadTextureFromStream(Stream : TStream; Filename : String) : TTexture;
procedure RemoveTexture(Texture : TTexture);
property LastTexture : Cardinal read FLastTexture write FLastTexture;
property TextureCount : Integer read GetTextureCount;
property Texture[Index : Integer] : TTexture read GetTextureInt;
end;
var
TextureManager : TTextureManager = Nil;
implementation
uses SysUtils, FreeBitmap, dglOpenGL;
constructor TTextureManager.Create;
begin
FTextures := TList.Create;
FLastTexture := 0;
end;
destructor TTextureManager.Destroy;
begin
FTextures.Free;
inherited;
end;
function TTextureManager.GetTexture(Filename : String) : TTexture;
var
X : Integer;
begin
if FTextures.Count > 0 then
for X := 0 to FTextures.Count-1 do
begin
Result := FTextures[X];
if not Assigned(Result) then Continue;
if Lowercase(Result.Filename) = Lowercase(Filename) then Exit;
end;
Result := Nil;
end;
function TTextureManager.LoadTextureFromFile(Filename : String) : TTexture;
var
Stream : TStream;
begin
Stream := TFileStream.Create(Filename,fmOpenRead);
Result := LoadTextureFromStream(Stream,Filename);
Stream.Free;
end;
procedure Convert8BitTransparentImage(FBI : TFreeBitmap);
var
Palette : TRGBQuad;
Pixels : PRGBQuad;
C,PC : Integer;
begin
Palette := TRGBQuad(FBI.GetPalette^);
FBI.ConvertTo32Bits;
Pixels := Pointer(FBI.AccessPixels);
PC := FBI.GetWidth*FBI.GetHeight;
for C := 1 to PC do
begin
if (Pixels.rgbRed = Palette.rgbRed) and (Pixels.rgbGreen = Palette.rgbGreen) and (Pixels.rgbBlue = Palette.rgbBlue) then
Pixels.rgbReserved := 0
else
Pixels.rgbReserved := 255;
if C < PC then
Inc(Cardinal(Pixels),4);
end;
end;
procedure LoadTexture(Texture : TTexture; FBI : TFreeBitmap; UseMipMaps : Boolean = True; UseNearest : Boolean = False);
var
BPP : Integer;
begin
Texture.UseMipmaps := UseMipMaps;
Texture.UseNearest := UseNearest;
BPP := FBI.GetBitsPerPixel div 8;
if (BPP = 1) and (FBI.IsTransparent) and (FBI.GetPaletteSize > 0) then
Convert8BitTransparentImage(FBI)
else
if (BPP <> 3) and (BPP <> 4) then
if FBI.IsTransparent then
FBI.ConvertTo32Bits
else
FBI.ConvertTo24Bits;
BPP := FBI.GetBitsPerPixel div 8;
//Fill the Texture up.
// Warning: If the BitsPerPixel/8 are not 3 or 4 then there will be problems.
if BPP = 3 then
Texture.UpdateTexture(FBI.GetWidth,FBI.GetHeight,3,GL_BGR, GL_RGB,FBI.AccessPixels)
else
if BPP = 4 then
Texture.UpdateTexture(FBI.GetWidth,FBI.GetHeight,4,GL_BGRA, GL_RGBA,FBI.AccessPixels)
else
(*LogError(IntToStr(BPP) + ' BPP Invalid: <' + Name + '>')*);
end;
function TTextureManager.LoadTextureFromStream(Stream : TStream; Filename : String) : TTexture;
var
FBI : TFreeBitmap;
begin
Result := GetTexture(Filename);
if Assigned(Result) then
begin
Result.Inc;
Exit;
end;
FBI := TFreeBitmap.Create();
FBI.LoadFromStream(Stream);
Result := TTexture.Create(Filename);
LoadTexture(Result,FBI);
FBI.Free;
FTextures.Add(Result);
end;
procedure TTextureManager.RemoveTexture(Texture : TTexture);
var
Index : Integer;
begin
Index := FTextures.IndexOf(Texture);
if Index = -1 then Exit;
FTextures.Delete(Index);
end;
function TTextureManager.GetTextureCount : Integer;
begin
Result := FTextures.Count;
end;
function TTextureManager.GetTextureInt(Index : Integer) : TTexture;
begin
if (Index < 0) or (Index >= FTextures.Count) then
Result := Nil
else
Result := FTextures[Index];
end;
constructor TTexture.Create(Filename : String);
begin
FFilename := Filename;
FCount := 1;
FTexture := 0;
FWidth := 0;
FHeight := 0;
FBPP := 0;
FFormat := 0;
FUseMipmaps := True;
FUseNearest := False;
end;
procedure TTexture.Free;
begin
Dec(FCount);
if FCount < 1 then
begin
if FTexture > 0 then
glDeleteTextures(1,@FTexture);
TextureManager.RemoveTexture(Self);
Inherited;
end;
end;
procedure TTexture.Inc;
begin
System.Inc(FCount);
end;
procedure TTexture.BindTexture(Target : Cardinal = $0DE1; Texture : Cardinal = Cardinal(-1));
begin
if Texture = Cardinal(-1) then
Texture := FTexture;
if TextureManager.LastTexture = Texture then Exit;
glBindTexture(Target,Texture);
TextureManager.LastTexture := Texture;
end;
procedure CheckForGLError;
var
Err : TGLenum;
begin
Err := glGetError;
if Err <> GL_NO_ERROR then
MessageBox(0,PChar('OGL ERROR: ' + IntToStr(Err)),'Error',0);
end;
procedure TTexture.UpdateTexture(Width,Height : Integer; BPP : Byte; Format,InternalFormat : Cardinal; Data : Pointer; Target : Cardinal = $0DE1; DataType : Cardinal = $1401);
begin
FBPP := BPP;
FFormat := InternalFormat;
if FTexture = 0 then
begin
glGenTextures(1, @FTexture);
end;
CheckForGLError;
BindTexture(Target);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT);
if FUseNearest then
glTexParameteri(Target,GL_TEXTURE_MAG_FILTER, GL_NEAREST)
else
glTexParameteri(Target,GL_TEXTURE_MAG_FILTER, GL_LINEAR);
if FUseMipmaps then
begin
if FUseNearest then
glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST_MIPMAP_LINEAR)
else
glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR);
gluBuild2DMipmaps(Target, BPP, Width, Height, Format, DataType, Data);
end
else
begin
if FUseNearest then
glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST)
else
glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
end;
if (not FUseMipmaps) then
glTexImage2D(Target,0,InternalFormat,Width,Height,0,Format,DataType,Data);
CheckForGLError;
BindTexture(Target,0);
FWidth := Width;
FHeight := Height;
end;
procedure TTexture.UpdateTexture(Width,Height : Integer; Data : Pointer; Target : Cardinal = $0DE1; DataType : Cardinal = $1401);
begin
if (FFormat = 0) or (FBPP = 0) then exit;
UpdateTexture(Width, Height, FBPP, FFormat, FFormat, Data, Target, DataType);
end;
procedure TTexture.UpdateTexture(Data : Pointer; Target : Cardinal = $0DE1; DataType : Cardinal = $1401);
begin
if (FFormat = 0) or (FBPP = 0) or (FWidth = 0) or (FHeight = 0) then exit;
UpdateTexture(FWidth, FHeight, FBPP, FFormat, FFormat, Data, Target, DataType);
end;
end.