//----------------------------------------------------------------------------
//
// Autor : MatthiasG. (turboPASCAL)
// Website : [url]http://www.mgsdh.de.vu[/url]
// Version : 2.00 lite
// Date : Jun 2006
// Changes : * Ver 1.9 -> Ver 2.0 Debugzeugs eingebaut
// * Ver 1.8 -> Unterstützung von RGB-Dateien
//
// Hint : * in der Datei "pngimage.pas" den Compilerschalter
// {$DEFINE UseDelphi} durch {.$DEFINE UseDelphi} ersetzen
// * nicht 100% Optimiert für nonVCL
//----------------------------------------------------------------------------
unit PNGLoader;
{$WARNINGS OFF}
// For Debug only: --------------------
{.$DEFINE ViewLoadedFilesOnConsole}
// ------------------------------------
interface
uses
Windows,
OpenGL,
pngimage,
sysutils;
// für Uppercase und solch einen Käse...
function LoadTexture(
const Filename:
String;
var Texture: GLuint;
const LoadFromRes: Boolean = FALSE): Boolean;
function gluBuild2DMipmaps(Target: GLenum; Components, Width, Height: GLint;
Format, atype: GLenum; Data: Pointer): GLint;
stdcall;
external '
glu32.dll';
procedure glGenTextures(n: GLsizei;
var textures: GLuint);
stdcall;
external OpenGL32;
procedure glBindTexture(target: GLenum; texture: GLuint);
stdcall;
external OpenGL32;
procedure glDeleteTextures(n: Integer; textures: PGLuint);
stdcall;
external OpenGL32;
implementation
{------------------------------------------------------------------}
{ 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
{$IFDEF ViewLoadedFilesOnConsole}
if Format = GL_RGBA
then Write('
-> CreateTexture (RGBA): ')
else Write('
-> CreateTexture (RGB): ');
WriteLn(Width, '
x', Height);
{$ENDIF ViewLoadedFilesOnConsole}
result := Texture;
end;
{------------------------------------------------------------------}
{ Load PNG textures }
{------------------------------------------------------------------}
function LoadPNGTexture(Filename:
String;
var Texture: GLuint; LoadFromResource: Boolean): Boolean;
var
Data :
Array of DWORD;
W, Width : Integer;
H, Height : Integer;
AlphaPtr: PByte;
PNG : TPngObject;
begin
{$IFDEF ViewLoadedFilesOnConsole}
Writeln('
LoadTexture "Type PNG": ', Filename);
{$ENDIF ViewLoadedFilesOnConsole}
PNG := TPngObject.Create;
if LoadFromResource
then // Load from resource
begin
PNG.LoadFromResourceName(hInstance, copy(Filename, 1, Pos('
.', Filename)-1));
// to do: on Error exit
// Result := FALSE;
end else
begin
PNG.LoadFromFile(Filename);
// to do: on Error exit
// Result := FALSE;
end;
//
// Nö, Palettenzeugs will ich nicht.
/////////////////////////////////////////////////////////////////////////
if PNG.Header.ColorType = COLOR_PALETTE
then
begin
MessageBox(0,
PChar('
Dieser PNG-Typ in der Datei:'#13#10'
"' + Filename +
'
"'#13#10'
wird nicht unterstützt.'),
PChar('
Information:' + IntToStr(PNG.Header.ColorType)),
MB_APPLMODAL
or MB_SYSTEMMODAL
or MB_ICONINFORMATION
or MB_OK);
Result := FALSE;
exit;
end;
Width := PNG.Width;
Height := PNG.Height;
SetLength(Data, Width * Height);
if (PNG.Header.ColorType = COLOR_RGB)
or
(PNG.Header.ColorType = COLOR_GRAYSCALE)
then
begin
For H := 0
to Height - 1
do
For W := 0
to Width - 1
do
Data[W + (H * Width)] := $FF000000
or PNG.Pixels[W, (Height-1)-H];
end else
if (PNG.Header.ColorType = COLOR_RGBALPHA)
or
(PNG.Header.ColorType = COLOR_GRAYSCALEALPHA)
then
begin
for H := 0
to Height - 1
do
begin
AlphaPtr := PByte(PNG.AlphaScanline[(Height-1)-H]);
for W := 0
to Width - 1
do
begin
Data[W + (H * Width)] := (($FF000000
and (AlphaPtr^
shl 24))
or PNG.Pixels[W, (Height-1)-H]);
Inc(AlphaPtr);
end;
end;
end;
PNG.free;
Texture := CreateTexture(Width, Height, GL_RGBA, @Data[0]);
Result := TRUE;
end;
{------------------------------------------------------------------}
{ Determines file type and sends to correct function }
{------------------------------------------------------------------}
function LoadTexture(
const Filename:
String;
var Texture: GLuint;
const LoadFromRes: Boolean = FALSE): Boolean;
begin
result := False;
if copy(Uppercase(filename), length(filename)-3, 4) = '
.PNG'
then
LoadPNGTexture(Filename, Texture, LoadFromRes);
end;
{$IFDEF ViewLoadedFilesOnConsole}
initialization
AllocConsole;
SetConsoleTitle('
Unit PNGLoader:');
finalization
FreeConsole;
{$ENDIF ViewLoadedFilesOnConsole}
end.