- type
- T3Dtex = object
- TexUnit : GLUInt;
- Depth : Cardinal;
- procedure LoadfromFile(Filename : String);
- procedure Free;
- end;
- implementation
- type
- TRGB = packed record
- r,g,b : byte;
- end;
- PRGB = ^TRGB;
- Pbyte = ^Byte;
- T3DTexData = array[0..2,0..255,0..255]of TRGB;
- procedure T3DTex.LoadfromFile(Filename : String);
- function loadJPEG(filen : String):TBitmap;
- var
- JPG : TJPEGImage;
- begin
- JPG := TJPEGImage.Create;
- JPG.LoadFromFile(filen);
- result := TBitmap.Create;
- result.Assign(JPG);
- JPG.Free;
- end;
- var
- s : TStrings;
- x,y,z : Cardinal;
- P : T3DTexData;//der Einfachheit halber wird ein statisches Array verwendet
- tmp : TColor;
- pointer : PByte;
- b : TBitmap;
- begin
- s := Tstringlist.Create;
- s.LoadFromFile(Filename);
- Depth := s.count;
- if s.Count = 0 then
- begin
- exit;
- end;
- b := LoadJPEG(s[0]);
- //erste Textur in den Speicher laden
- for x := 0 to 255 do
- for y := 0 to 255 do
- begin
- tmp := b.Canvas.Pixels[x,y];
- pointer := @tmp;
- inc(pointer);//Das erste Byte von Colors enthält keinen Farbwert, sondern System daten -> unnötig
- p[0,x,y] := PRGB(pointer)^;
- end;
- for z := 1 to 2 do
- begin
- b.Free;
- b := LoadJPEG(s[z]);
- for x := 0 to b.width-1 do
- for y := 0 to b.height-1 do
- begin
- tmp := b.Canvas.Pixels[x,y];
- pointer := @tmp;
- inc(pointer);//Das erste Byte von Colors enthält keinen Farbwert, sondern System daten -> unnötig
- p[z,x,y] := PRGB(pointer)^;
- end;
- end;
- //Textur in die Grafikkarte Laden
- glEnable(gl_texture_3d);
- glGenTextures(1,@TexUnit);
- glbindtexture(gl_texture_3d,texunit);
- glTExParameteri(GL_TEXTURE_3D,GL_TEXTURE_MAG_FILTER,GL_LINEAR);
- glTExParameteri(GL_TEXTURE_3D,GL_TEXTURE_MIN_FILTER,GL_LINEAR);
- glTexParameteri(GL_TEXTURE_3D,GL_TEXTURE_WRAP_S,GL_REPEAT);
- glTexParameteri(GL_TEXTURE_3D,GL_TEXTURE_WRAP_T,GL_REPEAT);
- glTexParameteri(GL_TEXTURE_3D,GL_TEXTURE_WRAP_R,GL_REPEAT);
- glTexImage3D(GL_TEXTURE_3D,0,GL_RGB,256,256,3,0,GL_RGB,GL_UNSIGNED_BYTE,@P[0,0,0]);
- //Speicherfreigeben
- b.free;
- end;
- procedure T3DTex.Free;
- begin
- glDeleteTextures(1,@TexUnit);
- end;