unit uMultibleTextures;
interface
uses Windows,
Graphics,
Classes,
dglOpenGL,
uGDIUnit,
Math,
SysUtils;
type
PMmtTex = ^TMmtTex;
TMmtTex =
record
FullName:
string;
Texture: GLuint;
ID: integer;
Square: Bool;
end;
TMyBitmapInfo =
record
bmiHeader: TBitmapInfoHeader;
bmiColors:
array [0..255]
of RGBQUAD;
end;
procedure MakeMultipleTexture(N: integer);
function CreateGLTextureFromFile(FullPath:
string; Xin: integer;
Yin: integer; SquareTexture: Bool;
Index: Integer): boolean;
procedure UpdateNamedGLTextureFromFileEx(FullPath:
string;
SquareTexture: Bool;
Index: Integer);
function CreateTexture(Width, Height, Format: word; pData: Pointer): integer;
function MyCreateDIBSection(
DC: HDC;
const pbmi: TMyBitmapInfo;
dwUsage: UINT;
var ppvBits: Pointer; hSection: THandle;
dwOffset: DWORD): HBITMAP;
stdcall;
external '
GDI32.DLL'
Name '
CreateDIBSection';
var
MultibleTex :
array [0..8]
of TMmtTex;
P :
array[1..12]
of integer;
imgW, imgH : cardinal;
xSize, ySize: integer;
Texture :
array of TGLuint;
mPixelArray :
array of byte;
implementation
// Splite eine 32-Bit-ARGB Farbe in seine vier Komponente.
procedure SplitColorARGB(
const ARGB: COLORREF;
out A, R, G, B: byte);
begin
R := TRGBQuad(ARGB).rgbRed;
G := TRGBQuad(ARGB).rgbGreen;
B := TRGBQuad(ARGB).rgbBlue;
A := TRGBQuad(ARGB).rgbReserved;
end;
// Erstelle DIB Sektion
function hbCreateDIBSection(hDC: longword; Width, Height: integer;
BitCount: integer): HBITMAP;
var
bi: TMyBitmapInfo;
p: Pointer;
begin
bi.bmiHeader.biSize := SIZEOF(bi.bmiHeader);
bi.bmiHeader.biWidth := Width;
bi.bmiHeader.biHeight := Height;
bi.bmiHeader.biPlanes := 1;
bi.bmiHeader.biBitCount := BitCount;
bi.bmiHeader.biCompression := BI_RGB;
Result := MyCreateDIBSection(hDC, bi, DIB_RGB_COLORS, p, 0, 0);
end;
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}
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);
Result := Texture;
end;
function CreateImageFromFile(FileName: WideString): cardinal;
var
Img: cardinal;
begin
Result := 0;
if not FileExists(FileName)
then
begin
Result := 0;
Exit;
end;
//Lade das Image
if GdipLoadImageFromFile(PWideChar(FileName), Img) = 0
then
Result := Img;
end;
function CreateGLTextureFromFile(FullPath:
string; Xin: integer;
Yin: integer; SquareTexture: Bool;
Index: Integer): boolean;
var
bi : TMyBitmapInfo;
bi2 : BitmapInfo;
lBM : BITMAP;
scale : single;
hDIB : HBITMAP;
Img : cardinal;
mhDC : HDC;
xP, yP, xS, yS: integer;
K : integer;
So : boolean;
hIC : cardinal;
sImgName : WideString;
ARGBcolor : COLORREF;
A : byte;
R : byte;
G : byte;
B : byte;
lPixel : PRGBQuad;
ImageType :
string;
ImgType :
string;
gGraphics : cardinal;
Value : integer;
pp : Pointer;
begin
Result := True;
imgW := 0;
imgH := 0;
Xin := 0;
Yin := 0;
scale := 0;
So := False;
sImgName := FullPath;
if FileExists(AnsiUpperCase(sImgName))
then
So := True;
if So
then
begin
// Unterstützte Bildformate
ImgType := ExtractFileExt(AnsiUpperCase(sImgName));
if ImgType <> '
'
then
begin
if copy(Uppercase(sImgName), length(sImgName) - 3, 4) = '
.BMP'
then
ImageType := '
.BMP';
if copy(Uppercase(sImgName), length(sImgName) - 3, 4) = '
.DIB'
then
ImageType := '
.DIB';
if copy(Uppercase(sImgName), length(sImgName) - 3, 4) = '
.GIF'
then
ImageType := '
.GIF';
if copy(Uppercase(sImgName), length(sImgName) - 3, 4) = '
.ICO'
then
ImageType := '
.ICO';
if copy(Uppercase(sImgName), length(sImgName) - 4, 5) = '
.JPEG'
then
ImageType := '
.JPEG';
if copy(Uppercase(sImgName), length(sImgName) - 3, 4) = '
.JPG'
then
ImageType := '
.JPG';
if copy(Uppercase(sImgName), length(sImgName) - 3, 4) = '
.PNG'
then
ImageType := '
.PNG';
if copy(Uppercase(sImgName), length(sImgName) - 3, 4) = '
.TIF'
then
ImageType := '
.TIF';
if copy(Uppercase(sImgName), length(sImgName) - 4, 5) = '
.TIFF'
then
ImageType := '
.TIFF';
end
else
ImageType := '
';
if ImageType <> '
'
then
begin
// Lade GDI Image
img := CreateImageFromFile(PWideChar(sImgName));
if img <> 0
then
begin
// Hole die Image Höhe und Weite
GdipGetImageWidth(Img, imgW);
GdipGetImageHeight(Img, imgH);
P[1] := 2;
P[2] := 4;
P[3] := 8;
P[4] := 16;
P[5] := 32;
P[6] := 64;
P[7] := 128;
P[8] := 256;
P[9] := 512;
P[10] := 1024;
P[11] := 2048;
P[12] := 4096;
for K := 12
downto 1
do
begin
if (Xin = 0)
and (ImgW > cardinal(P[K]) - 1)
then
Xin := P[K];
if (Yin = 0)
and (ImgH > cardinal(P[K]) - 1)
then
Yin := P[K];
end;
if SquareTexture
and (Xin <> Yin)
then
begin
Xin := Max(Xin, Yin);
Yin := Xin;
end
else
SquareTexture := False;
// Adjustiere Scale
// ------------------------------------------------------------------------
if imgW <> 0
then
scale := Xin
div round(imgW);
if scale > 1
then
scale := 1;
xS := imgW * round(scale);
yS := imgH * round(scale);
// Höhe mehr wie > Yin erstelle neuen scale factor
if yS > Yin
then
begin
if imgH <> 0
then
scale := Yin
div round(imgH);
xS := imgW * round(scale);
yS := imgH * round(scale);
end;
xP := (Xin - xS)
div 2;
yP := (Yin - yS)
div 2;
// ------------------------------------------------------------------------
hIC := CreateIC('
DISPLAY',
nil,
nil,
nil);
mhDC := CreateCompatibleDC(hIC);
hDIB := hbCreateDIBSection(mhDC, Xin, Yin, 32);
SelectObject(mhDC, hDIB);
// Zeichne das Image
if GdipCreateFromHDC(mhDC, gGraphics) = 0
then
begin
// Setze Stretch Qualitäts Modus
GdipSetInterpolationMode(gGraphics, 2);
// Fülle den Hintergrund mit der Farbe der pixel(0,0)
if SquareTexture
then
begin
GdipBitmapGetPixel(img, 0, 0, ARGBcolor);
SplitColorARGB(ARGBcolor, A, R, G, B);
GetObject(hDIB, sizeof(lBM), @lBM);
lPixel := lBM.bmBits;
for K := (Xin * Yin)
downto 0
do
begin
lPixel.rgbReserved := A;
lPixel.rgbRed := R;
lPixel.rgbGreen := G;
lPixel.rgbBlue := B;
Inc(lPixel);
end;
end;
// Zeichne das Image
if GdipDrawImageRectRectI(gGraphics, Img, xP, yP, xS,
yS, 0, 0, ImgW, ImgH, 2,
nil, False,
nil) = 0
then
begin
bi2.bmiHeader.biSize := SIZEOF(bi.bmiHeader);
bi2.bmiHeader.biWidth := Xin;
bi2.bmiHeader.biHeight := Yin;
bi2.bmiHeader.biPlanes := 1;
bi2.bmiHeader.biBitCount := 32;
bi2.bmiHeader.biCompression := 0;
Value := (Xin * Yin * 4 - 1);
SetLength(mPixelArray, Value);
if GetDIBits(mhDC, hDIB, 0, Yin, @mPixelArray[0], bi2, 0) > 0
then
begin
// 2.Vertausche Rot und Grün
lPixel := @mPixelArray[0];
for K := (Xin * Yin)
downto 0
do
begin
R := lPixel.rgbRed;
lPixel.rgbRed := lPixel.rgbBlue;
lPixel.rgbBlue := R;
Inc(lPixel);
end;
Texture[
Index] := CreateTexture(Xin, Yin, GL_RGBA, addr(mPixelArray[0]));
xSize := Xin;
ySize := Yin;
end
else
Result := False;
end;
// Alles Freigeben
GdipDeleteGraphics(gGraphics);
end;
DeleteObject(hDIB);
if mhDC <> 0
then
DeleteDC(mhDC);
if hIC <> 0
then
DeleteDC(hIC);
end;
GdipDisposeImage(Img);
end;
end;
end;
procedure MakeMultipleTexture(N: integer);
var
mtCount : integer;
K : integer;
nRet : TGLenum;
OkDelete : Bool;
begin
mtCount := high(MultibleTex) - low(MultibleTex) + 1;
OkDelete := False;
// Array Redimensionieren
SetLength(Texture, mtCount);
if mtCount > 0
then
begin
for K := 0
to (mtCount - 1)
do
begin
Texture[K] := MultibleTex[k].Texture;
if Texture[K] <> 0
then
OkDelete := True;
end;
// befinden sich Texturen im Array dann löschen
if OkDelete
then
begin
glDeleteTextures(mtCount, @Texture[1]);
glGenTextures(mtCount, @Texture[1]);
end;
nRet := glGetError;
// Überprüfung ob ein OpenGL Fehler aufgetreten ist
if nRet = 0
then
begin
// alles OK Aktuelle Texture laden
// und ins OpenGl Format konvertieren
for K := 0
to (mtCount - 1)
do
begin
SetLength(mPixelArray, 0);
if CreateGLTextureFromFile(MultibleTex[K].FullName,
xSize, ySize, MultibleTex[K].Square, K)
then
begin
MultibleTex[k].Texture := Texture[K];
glBindTexture(GL_TEXTURE_2D, Texture[K]);
nRet := glGetError;
if nRet = 0
then
begin
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
glTexImage2D(GL_TEXTURE_2D, 0, 4, xSize, ySize,
0, GL_RGBA, GL_UNSIGNED_BYTE, @mPixelArray[0]);
end;
end;
end;
end;
end;
end;
procedure UpdateNamedGLTextureFromFileEx(FullPath:
string; SquareTexture: Bool;
Index: Integer);
var
nRet: TGLenum;
begin
// Übergebenen Index im Array prüfen
// und Texture mit neuer ersetzen
Texture[
Index] := MultibleTex[
Index].Texture;
nRet := glGetError;
// Überprüfung ob ein OpenGL Fehler aufgetreten ist
if nRet = 0
then
begin
// Array Redimensionieren
SetLength(mPixelArray, 0);
// alles OK Aktuelle Texture laden
// und ins OpenGl Format konvertieren
if CreateGLTextureFromFile(MultibleTex[
Index].FullName,
xSize, ySize, MultibleTex[
Index].Square,
Index)
then
begin
MultibleTex[
Index].Texture := Texture[
Index];
glBindTexture(GL_TEXTURE_2D, Texture[
Index]);
nRet := glGetError;
if nRet = 0
then
begin
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
glTexImage2D(GL_TEXTURE_2D, 0, 4, xSize, ySize,
0, GL_RGBA, GL_UNSIGNED_BYTE, mPixelArray);
end;
end;
end;
end;
end.