unit gltexture;
{$mode delphi}
interface
uses
Classes, SysUtils, dglopengl, Graphics, GraphType, Interfaces;
type
{ TTextureLoader }
TTextureLoader = class(TObject)
private
fChecker: GLuint;
fList: TList;
procedure MakeChecker;
procedure FlipVertical(const px: TRawImage);
procedure AddTextureToList(filename: string; Texture: GLuint);
function FindTextureFromList(filename: string; var Texture: GLuint): boolean;
function CreateTexture(Width, Height: integer; Alpha: boolean;
Data: Pointer): integer;
procedure LoadFromBMP(Filename: string; var Texture: GLuint);
procedure LoadFromJPG(Filename: string; var Texture: GLuint);
procedure LoadFromPNG(Filename: string; var Texture: GLuint);
public
constructor Create;
destructor Destroy; override;
function LoadTexture(const filename: string): GLuint;
procedure FreeTexture(const id: GLuint);
end;
implementation
{ TTextureLoader }
type
PTextureRef = ^TTextureRef;
TTextureRef = record
Name: shortstring;
id: GlUint;
end;
procedure TTextureLoader.MakeChecker;
const
size = 64;
var
i, j: integer;
c: glubyte;
t: array[0..size - 1, 0..size - 1, 0..3] of glubyte;
begin
for i := 0 to size - 1 do
begin
for j := 0 to size - 1 do
begin
c := 255;
if ((i and 8) xor (j and 8)) > 0 then
c := 0;
t[i, j, 0] := c;
t[i, j, 1] := c;
t[i, j, 2] := c;
t[i, j, 3] := 255;
end;
end;
fChecker := CreateTexture(size, size, true, @t);
end;
procedure TTextureLoader.FlipVertical(const px: TRawImage);
var
p: array of byte;
i, half: integer;
LoPtr, HiPtr: PInteger;
bpl: integer;
begin
bpl := px.Description.BytesPerLine;
if px.Description.Height < 3 then
exit;
half := (px.Description.Height div 2);
LoPtr := PInteger(px.Data);
HiPtr := PInteger(px.Data + ((px.Description.Height - 1) * bpl));
setlength(p, bpl);
for i := 1 to half do
begin
System.Move(LoPtr^, p[0], bpl); //(src, dst,sz)
System.Move(HiPtr^, LoPtr^, bpl); //(src, dst,sz)
System.Move(p[0], HiPtr^, bpl); //(src, dst,sz)
Inc(PByte(LoPtr), bpl);
Dec(PByte(HiPtr), bpl);
end;
end;
procedure TTextureLoader.AddTextureToList(filename: string; Texture: GLuint);
var
p: PTextureRef;
begin
new(p);
p^.Name := filename;
p^.id := Texture;
fList.add(p);
end;
function TTextureLoader.FindTextureFromList(filename: string;
var Texture: GLuint): boolean;
var
i: integer;
p: PTextureRef;
begin
Result := False;
i := 0;
while i < fList.Count do
begin
p := PTextureRef(fList.Items[i]);
if p^.Name = filename then
begin
texture := p^.id;
Result := True;
exit;
end;
Inc(i);
end;
end;
function TTextureLoader.CreateTexture(Width, Height: integer;
Alpha: boolean; Data: Pointer): integer;
var
Texture: GLuint;
begin
glGenTextures(1, @Texture);
glBindTexture(GL_TEXTURE_2D, Texture);
glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
if Alpha then
gluBuild2DMipmaps(GL_TEXTURE_2D, GL_RGBA, Width, Height, GL_RGBA,
GL_UNSIGNED_BYTE, Data)
else
gluBuild2DMipmaps(GL_TEXTURE_2D, 3, Width, Height, GL_RGB, GL_UNSIGNED_BYTE, Data);
Result := Texture;
end;
procedure TTextureLoader.LoadFromBMP(Filename: string; var Texture: GLuint);
var
bmp: TBitmap;
PixelRowPtr: PInteger;
useAlpha: boolean;
begin
if not fileexists(filename) then
exit;
bmp := TBitmap.Create;
try
bmp.LoadFromFile(Filename);
PixelRowPtr := PInteger(bmp.RawImage.Data);
useAlpha := False;
if bmp.RawImage.Description.BitsPerPixel div 8 = 4 then
useAlpha := True;
FlipVertical(bmp.RawImage);
Texture := CreateTexture(bmp.Width, bmp.Height, useAlpha, PixelRowPtr);
finally
bmp.Free;
end;
end;
procedure TTextureLoader.LoadFromJPG(Filename: string; var Texture: GLuint);
var
jpg: TJPEGImage;
PixelRowPtr: PInteger;
useAlpha: boolean;
begin
if not fileexists(filename) then
exit;
jpg := TJPEGImage.Create;
try
jpg.LoadFromFile(Filename);
PixelRowPtr := PInteger(jpg.RawImage.Data);
useAlpha := False;
if jpg.RawImage.Description.BitsPerPixel div 8 = 4 then
useAlpha := True;
FlipVertical(jpg.RawImage);
Texture := CreateTexture(jpg.Width, jpg.Height, useAlpha, PixelRowPtr);
finally
jpg.Free;
end;
end;
procedure TTextureLoader.LoadFromPNG(Filename: string; var Texture: GLuint);
var
png: TPortableNetworkGraphic;
PixelRowPtr: PInteger;
useAlpha: boolean;
begin
if not fileexists(filename) then
exit;
png := TPortableNetworkGraphic.Create;
try
png.LoadFromFile(Filename);
PixelRowPtr := PInteger(png.RawImage.Data);
useAlpha := False;
if png.RawImage.Description.BitsPerPixel div 8 = 4 then
useAlpha := True;
FlipVertical(png.RawImage);
Texture := CreateTexture(png.Width, png.Height, useAlpha, PixelRowPtr);
finally
png.Free;
end;
end;
constructor TTextureLoader.Create;
begin
MakeChecker;
fList := TList.Create;
end;
destructor TTextureLoader.Destroy;
var
p: PTextureRef;
i: integer;
begin
for i := 0 to flist.Count - 1 do
begin
p := PTextureRef(fList.Items[i]);
glDeleteTextures(1, @p^.id);
dispose(p);
end;
flist.free;
inherited Destroy;
end;
function TTextureLoader.LoadTexture(const filename: string): GLuint;
var
ext: string;
begin
if FindTextureFromList(filename, Result) then
exit;
Result := fChecker;
ext := UpperCase(ExtractFileExt(filename));
if ext = '.BMP' then
LoadFromBMP(Filename, Result)
else if ext = '.JPG' then
LoadFromJPG(Filename, Result)
else if ext = '.PNG' then
LoadFromPNG(Filename, Result);
AddTextureToList(filename, Result);
end;
procedure TTextureLoader.FreeTexture(const id: GLuint);
var
p: PTextureRef;
i: integer;
begin
if glIsTexture(id) = GL_TRUE then
begin
for i := 0 to fList.Count - 1 do
begin
p := PTextureRef(fList.Items[i]);
if p^.id = id then
dispose(p);
end;
glDeleteTextures(1, @id);
end;
end;
end.
Recent
