1 unit ucube3d; 2 3 {$mode objfpc} 4 5 interface 6 7 uses 8 Classes, SysUtils, BGRAScene3D, BGRABitmapTypes; 9 10 type 11 12 { TCubeScene3D } 13 14 TCubeScene3D = class(TBGRAScene3D) 15 cube: IBGRAObject3D; 16 constructor Create; 17 procedure SetCubeTexture(ATexture: TBGRACustomBitmap); 18 procedure SetCubeTexture(ATexture: IBGRAScanner; tx,ty: single); 19 end; 20 21 implementation 22 23 { TCubeScene3D } 24 25 constructor TCubeScene3D.Create; 26 var v: arrayOfIBGRAVertex3D; 27 begin 28 inherited Create; 29 30 cube := CreateObject; 31 v := cube.MainPart.Add([-1,-1,-1, 1,-1,-1, 1,1,-1, -1,1,-1, 32 -1,-1,+1, 1,-1,+1, 1,1,+1, -1,1,+1]); 33 34 cube.AddFace([v[0],v[1],v[2],v[3]],BGRA(255,0,0)); 35 cube.AddFace([v[4],v[5],v[1],v[0]],BGRA(128,160,255)); 36 cube.AddFace([v[7],v[6],v[5],v[4]],BGRA(96,224,0)); 37 cube.AddFace([v[3],v[2],v[6],v[7]],BGRA(192,0,255)); 38 cube.AddFace([v[1],v[5],v[6],v[2]],BGRA(255,192,0)); 39 cube.AddFace([v[4],v[0],v[3],v[7]],BGRAWhite); 40 41 cube.MainPart.Scale(20); 42 43 AmbiantLightness := 0.5; 44 AddDirectionalLight(Point3D(1,1,1),1,-0.5); 45 end; 46 47 procedure TCubeScene3D.SetCubeTexture(ATexture: TBGRACustomBitmap); 48 begin 49 SetCubeTexture(ATexture,ATexture.Width-1,ATexture.Height-1); 50 end; 51 52 procedure TCubeScene3D.SetCubeTexture(ATexture: IBGRAScanner; tx, ty: single); 53 var 54 i: Integer; 55 begin 56 for i := 0 to cube.FaceCount-1 do 57 with cube.Face[i] do 58 begin 59 Texture := ATexture; 60 TexCoord[0] := PointF(0,0); 61 TexCoord[1] := PointF(tx,0); 62 TexCoord[2] := PointF(tx,ty); 63 TexCoord[3] := PointF(0,ty); 64 end; 65 end; 66 67 end. 68 69