{ This Code Was Created By Jan Koci 2001 Visit My Site At koci.opengl.cz } unit Env_f; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, OpenGL, jpeg; type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormPaint(Sender: TObject); procedure FormResize(Sender: TObject); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); procedure ClearFace(var Message: TWMEraseBkgnd); message WM_ERASEBKGND; end; procedure InitScene; procedure InitWindow; procedure PixelFormat(DC : HDC); procedure InitArea; procedure InitSphereTexture; procedure InitSphere; procedure InitMultitexture; procedure DrawSphere; procedure SphereNormals; procedure SphereSmoothNormals; procedure SphereTexCoord; procedure MoveObject; procedure DrawScene; procedure SetFullScreen(SizeX,SizeY,Bits:longint); procedure RestoreMode; procedure ProcessKeyb; procedure InitTexture; procedure LoadTexture(Num:LongInt;FileName:string;Typ:word); procedure LoadPicture(FileName:String;var Pic:TPicture); procedure StoreTexture(Num:LongInt;Pic:TPicture); procedure SetTexture(Num:Longint;Typ:word); type TRGBByte=record r: byte; g: byte; b: byte; end; type TRGBAByte=record r: byte; g: byte; b: byte; a: byte; end; type TRGBColors=array[1..1024*1024] of TRGBByte; TRGBAColors=array[1..1024*1024] of TRGBAByte; type TTexture=record ColorSystem:TGLEnum;{ defaultne GL_RGB, mozno GL_RGBA } FileName:String; rgbcolor:^TRGBColors; rgbacolor:^TRGBAColors; Width:Word; Height:Word; Mip:boolean; end; //Sphere type TPoint3=record x: double; y: double; z: double; end; type TPoint2=record x: double; y: double; end; type TVector=record x: double; y: double; z: double; end; procedure CalcNormalVector(Vect1,Vect2,Vect3:TPoint3); var SpFace: integer=20; SpRadius: double=20; SphereRot: double; SpPoint, SpNormal1, SpNormal2, SpNormal3, SpNormal4: array [0..50, 0..100] of TPoint3; SpNormalSmooth: TPoint3; SpCoord1, SpCoord2, SpCoord3, SpCoord4: array [0..50, 0..100] of TPoint2; SphereTriangles: boolean=true; NormalVector:TVector; //mutlitexturing type PFNGLMULTITEXCOORD1FARBPROC = procedure(target: TGLenum; s,t : TGLfloat); stdcall; PFNGLMULTITEXCOORD2FARBPROC = procedure(target: TGLenum; s,t : TGLfloat); stdcall; PFNGLMULTITEXCOORD3FARBPROC = procedure(target: TGLenum; s,t : TGLfloat); stdcall; PFNGLMULTITEXCOORD4FARBPROC = procedure(target: TGLenum; s,t : TGLfloat); stdcall; PFNGLACTIVETEXTUREARBPROC = procedure(target: TGLenum); stdcall; PFNGLCLIENTACTIVETEXTUREARBPROC = procedure(target: TGLenum); stdcall; const GL_MAX_TEXTURE_UNITS_ARB = $84E2; GL_RGB8 = $8051; GL_RGBA8 = $8058; GL_TEXTURE0_ARB = $84C0; GL_COMBINE_EXT = $8570; GL_COMBINE_RGB_EXT = $8571; GL_TEXTURE1_ARB = $84C1; var glMultiTexCoord1fARB : PFNGLMULTITEXCOORD1FARBPROC = nil; glMultiTexCoord2fARB : PFNGLMULTITEXCOORD2FARBPROC = nil; glMultiTexCoord3fARB : PFNGLMULTITEXCOORD3FARBPROC = nil; glMultiTexCoord4fARB : PFNGLMULTITEXCOORD4FARBPROC = nil; glActiveTextureARB : PFNGLACTIVETEXTUREARBPROC = nil; glClientActiveTextureARB : PFNGLCLIENTACTIVETEXTUREARBPROC = nil; maxTexelUnits : integer = 1; //other var Form1: TForm1; Handles : integer; ThreadID : LongWord; TextureBin:array[1..256] of word; TextureH:TTexture; Texture:array[1..256] of TTexture; UniPicture:TPicture; a: real; Angle, Tran: TPoint3; KeybUp, KeybDown, KeybRight, KeybLeft, KeybHome, KeybEnd, KeybEsc, KeybMoveUp, KeybMoveDown: boolean; RC : HGLRC; const PFDError = 'Chyba při nastavení PFD.'; implementation {$R *.DFM} function Thread(P : pointer) : integer; var i: integer; begin i := 1; repeat Form1.Repaint; until i = 2; end; procedure TForm1.FormCreate(Sender: TObject); begin InitScene; end; procedure InitScene; begin InitWindow; InitArea; Handles := BeginThread(nil, 0, Thread, nil, 0, ThreadID); end; procedure InitWindow; var i: integer; begin PixelFormat(Form1.Canvas.Handle); RC := wglCreateContext(Form1.Canvas.Handle); wglMakeCurrent(Form1.Canvas.Handle,RC); glClearColor(0.0,0.0,0.0,0.0); glShadeModel(GL_SMOOTH); glEnable(GL_DEPTH_TEST); InitSphere; InitSphereTexture; InitMultitexture; wglMakeCurrent(0,0); end; procedure PixelFormat(DC : HDC); var PFD : TPixelFormatDescriptor; nPixelFormat : integer; begin FillChar(PFD,SizeOf(PFD),0); with PFD do begin nSize := SizeOf(TPixelFormatDescriptor); nVersion := 1; dwFlags := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER; iPixelType := PFD_TYPE_RGBA; cColorBits := 24; cDepthBits := 32; iLayerType := PFD_MAIN_PLANE; end; nPixelFormat := ChoosePixelFormat(DC,@PFD); Assert(nPixelFormat <> 0,PFDError); SetPixelFormat(DC,nPixelFormat,@PFD) end; procedure InitArea; begin glMatrixMode(GL_PROJECTION); glLoadIdentity; gluPerspective(30.0,Form1.ClientWidth / Form1.ClientHeight,0.1,10000.0); glViewport(0,0,Form1.ClientWidth,Form1.ClientHeight); end; procedure InitSphereTexture; var Path: string; begin Path := ExtractFilePath(Application.ExeName); InitTexture; LoadTexture(1,Path + 'amer.jpg',gl_rgb8); LoadTexture(2,Path + 'bila.bmp',gl_rgb8); LoadTexture(3,Path + 'envi.jpg',gl_rgb8); LoadTexture(4,Path + 'crystal.jpg',gl_rgb8); end; procedure InitMultitexture; begin glGetIntegerv(GL_MAX_TEXTURE_UNITS_ARB, @maxTexelUnits); glMultiTexCoord1fARB := wglGetProcAddress('glMultiTexCoord1fARB'); glMultiTexCoord2fARB := wglGetProcAddress('glMultiTexCoord2fARB'); glMultiTexCoord3fARB := wglGetProcAddress('glMultiTexCoord3fARB'); glMultiTexCoord4fARB := wglGetProcAddress('glMultiTexCoord4fARB'); glActiveTextureARB := wglGetProcAddress('glActiveTextureARB'); glClientActiveTextureARB := wglGetProcAddress('glClientActiveTextureARB'); end; procedure InitSphere; {Calculate Sphere Points} var rVert, rHoriz: array [0..100] of double; Angle: double; i,j: integer; begin Angle := 360 / SpFace; for i := 1 to (SpFace div 2)-1 do begin rVert[i] := cos((i*Angle)*(pi/180))* SpRadius; rHoriz[i] := sin((i*Angle)*(pi/180))* SpRadius; for j := 1 to SpFace do begin SpPoint[i,j].x := cos((j*Angle)*(pi/180)) * rHoriz[i]*2; //New SpPoint[i,j].y := rVert[i]; SpPoint[i,j].z := -sin((j*Angle)*(pi/180)) * rHoriz[i]/2; //New //first point SpPoint[0,j].x := 0; SpPoint[0,j].y := SpRadius; SpPoint[0,j].z := 0; //last point SpPoint[SpFace div 2,j].x := 0; SpPoint[SpFace div 2,j].y := -SpRadius; SpPoint[SpFace div 2,j].z := 0; end; end; SphereTexCoord; SphereNormals; SphereSmoothNormals; end; procedure DrawBackground; begin glActiveTextureARB(GL_TEXTURE0_ARB); glDisable(GL_TEXTURE_GEN_S); // Enable Texture Coord Generation For S ( NEW ) glDisable(GL_TEXTURE_GEN_T); glBindTexture(GL_TEXTURE_2D, TextureBin[1]); glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE); glEnable(GL_TEXTURE_2D); glActiveTextureARB(GL_TEXTURE1_ARB); glDisable(GL_TEXTURE_GEN_S); // Enable Texture Coord Generation For S ( NEW ) glDisable(GL_TEXTURE_GEN_T); glBindTexture(GL_TEXTURE_2D, TextureBin[2]); glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_Modulate); glEnable(GL_TEXTURE_2D); glPushMatrix; glMatrixMode(GL_MODELVIEW); glLoadIdentity; glTranslatef(0,0,-1000); glBegin(GL_Triangles); glMultiTexCoord2fARB(GL_TEXTURE0_ARB,0,0); glMultiTexCoord2fARB(GL_TEXTURE1_ARB,0,0); glVertex3f(-360, 270, 0); glMultiTexCoord2fARB(GL_TEXTURE0_ARB,1,0); glMultiTexCoord2fARB(GL_TEXTURE1_ARB,1,0); glVertex3f( 360, 270, 0); glMultiTexCoord2fARB(GL_TEXTURE0_ARB,0,1); glMultiTexCoord2fARB(GL_TEXTURE1_ARB,0,1); glVertex3f(-360, -270, 0); glMultiTexCoord2fARB(GL_TEXTURE0_ARB,1,0); glMultiTexCoord2fARB(GL_TEXTURE1_ARB,1,0); glVertex3f( 360, 270, 0); glMultiTexCoord2fARB(GL_TEXTURE0_ARB,0,1); glMultiTexCoord2fARB(GL_TEXTURE1_ARB,0,1); glVertex3f(-360, -270, 0); glMultiTexCoord2fARB(GL_TEXTURE0_ARB,1,1); glMultiTexCoord2fARB(GL_TEXTURE1_ARB,1,1); glVertex3f( 360, -270, 0); glEnd; glPopMatrix; end; procedure DrawSphere; var i,j: integer; begin glPushMatrix; //Draw Triangles if SphereTriangles then begin glActiveTextureARB(GL_TEXTURE0_ARB); glEnable(GL_TEXTURE_GEN_S); // Enable Texture Coord Generation For S ( NEW ) glEnable(GL_TEXTURE_GEN_T); // Enable Texture Coord Generation For T ( NEW ) glBindTexture(GL_TEXTURE_2D, TextureBin[3]); glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_Replace); glEnable(GL_TEXTURE_2D); glActiveTextureARB(GL_TEXTURE1_ARB); glDisable(GL_TEXTURE_GEN_S); // Disable Texture Coord Generation For S ( NEW ) glDisable(GL_TEXTURE_GEN_T); // Disable Texture Coord Generation For S ( NEW ) glBindTexture(GL_TEXTURE_2D, TextureBin[4]); glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_Modulate); glEnable(GL_TEXTURE_2D); glBegin(GL_TRIANGLES); for i := 1 to (SpFace div 2)-2 do begin for j := 1 to SpFace do begin if j <> SpFace then begin glMultiTexCoord2fARB(GL_TEXTURE0_ARB,SpCoord1[i,j].x,SpCoord1[i,j].y); glMultiTexCoord2fARB(GL_TEXTURE1_ARB,SpCoord1[i,j].x,SpCoord1[i,j].y); glNormal3f(SpNormal1[i,j].x,SpNormal1[i,j].y,SpNormal1[i,j].z); glVertex3f(SpPoint[i,j].x,SpPoint[i,j].y,SpPoint[i,j].z); glMultiTexCoord2fARB(GL_TEXTURE0_ARB,SpCoord2[i,j+1].x,SpCoord2[i,j+1].y); glMultiTexCoord2fARB(GL_TEXTURE1_ARB,SpCoord2[i,j+1].x,SpCoord2[i,j+1].y); glNormal3f(SpNormal2[i,j+1].x,SpNormal2[i,j+1].y,SpNormal2[i,j+1].z); glVertex3f(SpPoint[i,j+1].x,SpPoint[i,j+1].y,SpPoint[i,j+1].z); glMultiTexCoord2fARB(GL_TEXTURE0_ARB,SpCoord3[i+1,j].x,SpCoord3[i+1,j].y); glMultiTexCoord2fARB(GL_TEXTURE1_ARB,SpCoord3[i+1,j].x,SpCoord3[i+1,j].y); glNormal3f(SpNormal3[i+1,j].x,SpNormal3[i+1,j].y,SpNormal3[i+1,j].z); glVertex3f(SpPoint[i+1,j].x,SpPoint[i+1,j].y,SpPoint[i+1,j].z); /////////////////////////////////////////////////////////////////// glMultiTexCoord2fARB(GL_TEXTURE0_ARB,SpCoord2[i,j+1].x,SpCoord2[i,j+1].y); glMultiTexCoord2fARB(GL_TEXTURE1_ARB,SpCoord2[i,j+1].x,SpCoord2[i,j+1].y); glNormal3f(SpNormal2[i,j+1].x,SpNormal2[i,j+1].y,SpNormal2[i,j+1].z); glVertex3f(SpPoint[i,j+1].x,SpPoint[i,j+1].y,SpPoint[i,j+1].z); glMultiTexCoord2fARB(GL_TEXTURE0_ARB,SpCoord3[i+1,j].x,SpCoord3[i+1,j].y); glMultiTexCoord2fARB(GL_TEXTURE1_ARB,SpCoord3[i+1,j].x,SpCoord3[i+1,j].y); glNormal3f(SpNormal3[i+1,j].x,SpNormal3[i+1,j].y,SpNormal3[i+1,j].z); glVertex3f(SpPoint[i+1,j].x,SpPoint[i+1,j].y,SpPoint[i+1,j].z); glMultiTexCoord2fARB(GL_TEXTURE0_ARB,SpCoord4[i+1,j+1].x,SpCoord4[i+1,j+1].y); glMultiTexCoord2fARB(GL_TEXTURE1_ARB,SpCoord4[i+1,j+1].x,SpCoord4[i+1,j+1].y); glNormal3f(SpNormal4[i+1,j+1].x,SpNormal4[i+1,j+1].y,SpNormal4[i+1,j+1].z); glVertex3f(SpPoint[i+1,j+1].x,SpPoint[i+1,j+1].y,SpPoint[i+1,j+1].z); end else begin glMultiTexCoord2fARB(GL_TEXTURE0_ARB,SpCoord1[i,j].x,SpCoord1[i,j].y); glMultiTexCoord2fARB(GL_TEXTURE1_ARB,SpCoord1[i,j].x,SpCoord1[i,j].y); glNormal3f(SpNormal1[i,j].x,SpNormal1[i,j].y,SpNormal1[i,j].z); glVertex3f(SpPoint[i,j].x,SpPoint[i,j].y,SpPoint[i,j].z); glMultiTexCoord2fARB(GL_TEXTURE0_ARB,SpCoord2[i,1].x,SpCoord2[i,1].y); glMultiTexCoord2fARB(GL_TEXTURE1_ARB,SpCoord2[i,1].x,SpCoord2[i,1].y); glNormal3f(SpNormal2[i,1].x,SpNormal2[i,1].y,SpNormal2[i,1].z); glVertex3f(SpPoint[i,1].x,SpPoint[i,1].y,SpPoint[i,1].z); glMultiTexCoord2fARB(GL_TEXTURE0_ARB,SpCoord3[i+1,j].x,SpCoord3[i+1,j].y); glMultiTexCoord2fARB(GL_TEXTURE1_ARB,SpCoord3[i+1,j].x,SpCoord3[i+1,j].y); glNormal3f(SpNormal3[i+1,j].x,SpNormal3[i+1,j].y,SpNormal3[i+1,j].z); glVertex3f(SpPoint[i+1,j].x,SpPoint[i+1,j].y,SpPoint[i+1,j].z); /////////////////////////////////////////////////////////////////// glMultiTexCoord2fARB(GL_TEXTURE0_ARB,SpCoord2[i,1].x,SpCoord2[i,1].y); glMultiTexCoord2fARB(GL_TEXTURE1_ARB,SpCoord2[i,1].x,SpCoord2[i,1].y); glNormal3f(SpNormal2[i,1].x,SpNormal2[i,1].y,SpNormal2[i,1].z); glVertex3f(SpPoint[i,1].x,SpPoint[i,1].y,SpPoint[i,1].z); glMultiTexCoord2fARB(GL_TEXTURE0_ARB,SpCoord3[i+1,j].x,SpCoord3[i+1,j].y); glMultiTexCoord2fARB(GL_TEXTURE1_ARB,SpCoord3[i+1,j].x,SpCoord3[i+1,j].y); glNormal3f(SpNormal3[i+1,j].x,SpNormal3[i+1,j].y,SpNormal3[i+1,j].z); glVertex3f(SpPoint[i+1,j].x,SpPoint[i+1,j].y,SpPoint[i+1,j].z); glMultiTexCoord2fARB(GL_TEXTURE0_ARB,SpCoord4[i+1,1].x,SpCoord4[i+1,1].y); glMultiTexCoord2fARB(GL_TEXTURE1_ARB,SpCoord4[i+1,1].x,SpCoord4[i+1,1].y); glNormal3f(SpNormal4[i+1,1].x,SpNormal4[i+1,1].y,SpNormal4[i+1,1].z); glVertex3f(SpPoint[i+1,1].x,SpPoint[i+1,1].y,SpPoint[i+1,1].z); end; end; end; glEnd; //first point glBegin(GL_TRIANGLES); for j := 1 to SpFace do begin glMultiTexCoord2fARB(GL_TEXTURE0_ARB,SpCoord1[0,j].x,SpCoord1[0,j].y); glMultiTexCoord2fARB(GL_TEXTURE1_ARB,SpCoord1[0,j].x,SpCoord1[0,j].y); glNormal3f(SpNormal1[0,j].x,SpNormal1[0,j].y,SpNormal1[0,j].z); glVertex3f(SpPoint[0,j].x,SpPoint[0,j].y,SpPoint[0,j].z); glMultiTexCoord2fARB(GL_TEXTURE0_ARB,SpCoord3[1,j].x,SpCoord3[1,j].y); glMultiTexCoord2fARB(GL_TEXTURE1_ARB,SpCoord3[1,j].x,SpCoord3[1,j].y); glNormal3f(SpNormal3[1,j].x,SpNormal3[1,j].y,SpNormal3[1,j].z); glVertex3f(SpPoint[1,j].x,SpPoint[1,j].y,SpPoint[1,j].z); if j <> SpFace then begin glMultiTexCoord2fARB(GL_TEXTURE0_ARB,SpCoord4[1,j+1].x,SpCoord4[1,j+1].y); glMultiTexCoord2fARB(GL_TEXTURE1_ARB,SpCoord4[1,j+1].x,SpCoord4[1,j+1].y); glNormal3f(SpNormal4[1,j+1].x,SpNormal4[1,j+1].y,SpNormal4[1,j+1].z); glVertex3f(SpPoint[1,j+1].x,SpPoint[1,j+1].y,SpPoint[1,j+1].z); end else begin glMultiTexCoord2fARB(GL_TEXTURE0_ARB,SpCoord4[1,1].x,SpCoord4[1,1].y); glMultiTexCoord2fARB(GL_TEXTURE1_ARB,SpCoord4[1,1].x,SpCoord4[1,1].y); glNormal3f(SpNormal4[1,1].x,SpNormal4[1,1].y,SpNormal4[1,1].z); glVertex3f(SpPoint[1,1].x,SpPoint[1,1].y,SpPoint[1,1].z); end; end; glEnd; //last point glBegin(GL_TRIANGLES); for j := 1 to SpFace do begin glMultiTexCoord2fARB(GL_TEXTURE0_ARB,SpCoord3[(SpFace div 2)+1,j].x,SpCoord3[(SpFace div 2)+1,j].y); glMultiTexCoord2fARB(GL_TEXTURE1_ARB,SpCoord3[(SpFace div 2)+1,j].x,SpCoord3[(SpFace div 2)+1,j].y); glNormal3f(SpNormal3[(SpFace div 2),j].x,SpNormal3[(SpFace div 2),j].y,SpNormal3[(SpFace div 2),j].z); glVertex3f(SpPoint[(SpFace div 2),j].x,SpPoint[(SpFace div 2),j].y,SpPoint[(SpFace div 2),j].z); glMultiTexCoord2fARB(GL_TEXTURE0_ARB,SpCoord1[(SpFace div 2),j].x,SpCoord1[(SpFace div 2),j].y); glMultiTexCoord2fARB(GL_TEXTURE1_ARB,SpCoord1[(SpFace div 2),j].x,SpCoord1[(SpFace div 2),j].y); glNormal3f(SpNormal1[(SpFace div 2)-1,j].x,SpNormal1[(SpFace div 2)-1,j].y,SpNormal1[(SpFace div 2)-1,j].z); glVertex3f(SpPoint[(SpFace div 2)-1,j].x,SpPoint[(SpFace div 2)-1,j].y,SpPoint[(SpFace div 2)-1,j].z); if j <> SpFace then begin glMultiTexCoord2fARB(GL_TEXTURE0_ARB,SpCoord2[(SpFace div 2),j+1].x,SpCoord2[(SpFace div 2),j+1].y); glMultiTexCoord2fARB(GL_TEXTURE1_ARB,SpCoord2[(SpFace div 2),j+1].x,SpCoord2[(SpFace div 2),j+1].y); glNormal3f(SpNormal2[(SpFace div 2)-1,j+1].x,SpNormal2[(SpFace div 2)-1,j+1].y,SpNormal2[(SpFace div 2)-1,j+1].z); glVertex3f(SpPoint[(SpFace div 2)-1,j+1].x,SpPoint[(SpFace div 2)-1,j+1].y,SpPoint[(SpFace div 2)-1,j+1].z); end else begin glMultiTexCoord2fARB(GL_TEXTURE0_ARB,SpCoord2[(SpFace div 2),1].x,SpCoord2[(SpFace div 2),1].y); glMultiTexCoord2fARB(GL_TEXTURE1_ARB,SpCoord2[(SpFace div 2),1].x,SpCoord2[(SpFace div 2),1].y); glNormal3f(SpNormal2[(SpFace div 2)-1,1].x,SpNormal2[(SpFace div 2)-1,1].y,SpNormal2[(SpFace div 2)-1,1].z); glVertex3f(SpPoint[(SpFace div 2)-1,1].x,SpPoint[(SpFace div 2)-1,1].y,SpPoint[(SpFace div 2)-1,1].z); end; end; glEnd; glDisable(GL_BLEND); glEnable(GL_DEPTH_TEST); end; glPopMatrix; end; procedure CalcNormalVector(Vect1,Vect2,Vect3:TPoint3); var longi,vx1,vy1,vz1,vx2,vy2,vz2:double; VectRes:TVector; begin vx1:=Vect1.x-Vect2.x;vy1:=Vect1.y-Vect2.y;vz1:=Vect1.z-Vect2.z; vx2:=Vect2.x-Vect3.x;vy2:=Vect2.y-Vect3.y;vz2:=Vect2.z-Vect3.z; with VectRes do begin x:=vy1*vz2 - vz1*vy2; y:=vz1*vx2 - vx1*vz2; z:=vx1*vy2 - vy1*vx2; //Optimalization vector longi:=sqrt(sqr (x) + sqr(y) + sqr(z)); if longi>0 then //avoid zero division error x:=x/longi;y:=y/longi;z:=z/longi; end; NormalVector := VectRes; end; procedure SphereNormals; var Vect1, Vect2, Vect3, Vect4: TPoint3; i,j: integer; begin for i := 1 to (SpFace div 2)-2 do begin for j := 1 to SpFace do begin if j <> SpFace then begin Vect1.x := SpPoint[i,j].x; Vect1.y := SpPoint[i,j].y; Vect1.z := SpPoint[i,j].z; Vect2.x := SpPoint[i,j+1].x; Vect2.y := SpPoint[i,j+1].y; Vect2.z := SpPoint[i,j+1].z; Vect3.x := SpPoint[i+1,j].x; Vect3.y := SpPoint[i+1,j].y; Vect3.z := SpPoint[i+1,j].z; Vect4.x := SpPoint[i+1,j+1].x; Vect4.y := SpPoint[i+1,j+1].y; Vect4.z := SpPoint[i+1,j+1].z; // Vertex Normal Point 1 CalcNormalVector(Vect1,Vect3,Vect2); SpNormal1[i,j].x := NormalVector.x; SpNormal1[i,j].y := NormalVector.y; SpNormal1[i,j].z := NormalVector.z; // Vertex Normal Point 2 CalcNormalVector(Vect2,Vect3,Vect4); SpNormal2[i,j+1].x := NormalVector.x; SpNormal2[i,j+1].y := NormalVector.y; SpNormal2[i,j+1].z := NormalVector.z; // Vertex Normal Point 3 CalcNormalVector(Vect3,Vect2,Vect1); SpNormal3[i+1,j].x := NormalVector.x; SpNormal3[i+1,j].y := NormalVector.y; SpNormal3[i+1,j].z := NormalVector.z; // Vertex Normal Point 4 CalcNormalVector(Vect4,Vect2,Vect3); SpNormal4[i+1,j+1].x := NormalVector.x; SpNormal4[i+1,j+1].y := NormalVector.y; SpNormal4[i+1,j+1].z := NormalVector.z; end else begin Vect1.x := SpPoint[i,j].x; Vect1.y := SpPoint[i,j].y; Vect1.z := SpPoint[i,j].z; Vect2.x := SpPoint[i,1].x; Vect2.y := SpPoint[i,1].y; Vect2.z := SpPoint[i,1].z; Vect3.x := SpPoint[i+1,j].x; Vect3.y := SpPoint[i+1,j].y; Vect3.z := SpPoint[i+1,j].z; Vect4.x := SpPoint[i+1,1].x; Vect4.y := SpPoint[i+1,1].y; Vect4.z := SpPoint[i+1,1].z; // Vertex Normal Point 1 CalcNormalVector(Vect1,Vect3,Vect2); SpNormal1[i,j].x := NormalVector.x; SpNormal1[i,j].y := NormalVector.y; SpNormal1[i,j].z := NormalVector.z; // Vertex Normal Point 2 CalcNormalVector(Vect2,Vect3,Vect4); SpNormal2[i,1].x := NormalVector.x; SpNormal2[i,1].y := NormalVector.y; SpNormal2[i,1].z := NormalVector.z; // Vertex Normal Point 3 CalcNormalVector(Vect3,Vect2,Vect1); SpNormal3[i+1,j].x := NormalVector.x; SpNormal3[i+1,j].y := NormalVector.y; SpNormal3[i+1,j].z := NormalVector.z; // Vertex Normal Point 4 CalcNormalVector(Vect4,Vect2,Vect3); SpNormal4[i+1,1].x := NormalVector.x; SpNormal4[i+1,1].y := NormalVector.y; SpNormal4[i+1,1].z := NormalVector.z; end; end; end; //first point for j := 1 to SpFace do begin if j <> SpFace then begin Vect1.x := SpPoint[0,j].x; Vect1.y := SpPoint[0,j].y; Vect1.z := SpPoint[0,j].z; Vect2.x := SpPoint[1,j].x; Vect2.y := SpPoint[1,j].y; Vect2.z := SpPoint[1,j].z; Vect3.x := SpPoint[1,j+1].x; Vect3.y := SpPoint[1,j+1].y; Vect3.z := SpPoint[1,j+1].z; // Vertex Normal Point 1 CalcNormalVector(Vect1,Vect2,Vect3); SpNormal1[0,j].x := NormalVector.x; SpNormal1[0,j].y := NormalVector.y; SpNormal1[0,j].z := NormalVector.z; // Vertex Normal Point 2 CalcNormalVector(Vect2,Vect3,Vect1); SpNormal3[1,j].x := NormalVector.x; SpNormal3[1,j].y := NormalVector.y; SpNormal3[1,j].z := NormalVector.z; // Vertex Normal Point 3 CalcNormalVector(Vect3,Vect1,Vect2); SpNormal4[1,j+1].x := NormalVector.x; SpNormal4[1,j+1].y := NormalVector.y; SpNormal4[1,j+1].z := NormalVector.z; end else begin Vect1.x := SpPoint[0,j].x; Vect1.y := SpPoint[0,j].y; Vect1.z := SpPoint[0,j].z; Vect2.x := SpPoint[1,j].x; Vect2.y := SpPoint[1,j].y; Vect2.z := SpPoint[1,j].z; Vect3.x := SpPoint[1,1].x; Vect3.y := SpPoint[1,1].y; Vect3.z := SpPoint[1,1].z; // Vertex Normal Point 1 CalcNormalVector(Vect1,Vect2,Vect3); SpNormal1[0,j].x := NormalVector.x; SpNormal1[0,j].y := NormalVector.y; SpNormal1[0,j].z := NormalVector.z; // Vertex Normal Point 2 CalcNormalVector(Vect2,Vect3,Vect1); SpNormal3[1,j].x := NormalVector.x; SpNormal3[1,j].y := NormalVector.y; SpNormal3[1,j].z := NormalVector.z; // Vertex Normal Point 3 CalcNormalVector(Vect3,Vect1,Vect2); SpNormal4[1,1].x := NormalVector.x; SpNormal4[1,1].y := NormalVector.y; SpNormal4[1,1].z := NormalVector.z; end; end; //last point for j := 1 to SpFace do begin if j <> SpFace then begin Vect1.x := SpPoint[(SpFace div 2)-1,j].x; Vect1.y := SpPoint[(SpFace div 2)-1,j].y; Vect1.z := SpPoint[(SpFace div 2)-1,j].z; Vect2.x := SpPoint[(SpFace div 2)-1,j+1].x; Vect2.y := SpPoint[(SpFace div 2)-1,j+1].y; Vect2.z := SpPoint[(SpFace div 2)-1,j+1].z; Vect3.x := SpPoint[(SpFace div 2),j].x; Vect3.y := SpPoint[(SpFace div 2),j].y; Vect3.z := SpPoint[(SpFace div 2),j].z; // Vertex Normal Point 1 CalcNormalVector(Vect1,Vect3,Vect2); SpNormal1[(SpFace div 2)-1,j].x := NormalVector.x; SpNormal1[(SpFace div 2)-1,j].y := NormalVector.y; SpNormal1[(SpFace div 2)-1,j].z := NormalVector.z; // Vertex Normal Point 2 CalcNormalVector(Vect2,Vect1,Vect3); SpNormal2[(SpFace div 2)-1,j+1].x := NormalVector.x; SpNormal2[(SpFace div 2)-1,j+1].y := NormalVector.y; SpNormal2[(SpFace div 2)-1,j+1].z := NormalVector.z; // Vertex Normal Point 3 CalcNormalVector(Vect3,Vect2,Vect1); SpNormal3[(SpFace div 2),j].x := NormalVector.x; SpNormal3[(SpFace div 2),j].y := NormalVector.y; SpNormal3[(SpFace div 2),j].z := NormalVector.z; end else begin Vect1.x := SpPoint[(SpFace div 2)-1,j].x; Vect1.y := SpPoint[(SpFace div 2)-1,j].y; Vect1.z := SpPoint[(SpFace div 2)-1,j].z; Vect2.x := SpPoint[(SpFace div 2)-1,1].x; Vect2.y := SpPoint[(SpFace div 2)-1,1].y; Vect2.z := SpPoint[(SpFace div 2)-1,1].z; Vect3.x := SpPoint[(SpFace div 2),j].x; Vect3.y := SpPoint[(SpFace div 2),j].y; Vect3.z := SpPoint[(SpFace div 2),j].z; // Vertex Normal Point 1 CalcNormalVector(Vect1,Vect3,Vect2); SpNormal1[(SpFace div 2)-1,j].x := NormalVector.x; SpNormal1[(SpFace div 2)-1,j].y := NormalVector.y; SpNormal1[(SpFace div 2)-1,j].z := NormalVector.z; // Vertex Normal Point 2 CalcNormalVector(Vect2,Vect1,Vect3); SpNormal2[(SpFace div 2)-1,1].x := NormalVector.x; SpNormal2[(SpFace div 2)-1,1].y := NormalVector.y; SpNormal2[(SpFace div 2)-1,1].z := NormalVector.z; // Vertex Normal Point 3 CalcNormalVector(Vect3,Vect2,Vect1); SpNormal3[(SpFace div 2),j].x := NormalVector.x; SpNormal3[(SpFace div 2),j].y := NormalVector.y; SpNormal3[(SpFace div 2),j].z := NormalVector.z; end; end; end; procedure SphereSmoothNormals; var i,j: integer; SpNormalXpom, SpNormalYpom, SpNormalZpom: double; begin for i := 1 to (SpFace div 2)-1 do begin for j := 1 to SpFace do begin SpNormalSmooth.x := (SpNormal1[i,j].x + SpNormal2[i,j].x + SpNormal3[i,j].x + SpNormal4[i,j].x)/4; SpNormalSmooth.y := (SpNormal1[i,j].y + SpNormal2[i,j].y + SpNormal3[i,j].y + SpNormal4[i,j].y)/4; SpNormalSmooth.z := (SpNormal1[i,j].z + SpNormal2[i,j].z + SpNormal3[i,j].z + SpNormal4[i,j].z)/4; SpNormal1[i,j].x := SpNormalSmooth.x; SpNormal1[i,j].y := SpNormalSmooth.y; SpNormal1[i,j].z := SpNormalSmooth.z; SpNormal2[i,j].x := SpNormalSmooth.x; SpNormal2[i,j].y := SpNormalSmooth.y; SpNormal2[i,j].z := SpNormalSmooth.z; SpNormal3[i,j].x := SpNormalSmooth.x; SpNormal3[i,j].y := SpNormalSmooth.y; SpNormal3[i,j].z := SpNormalSmooth.z; SpNormal4[i,j].x := SpNormalSmooth.x; SpNormal4[i,j].y := SpNormalSmooth.y; SpNormal4[i,j].z := SpNormalSmooth.z; end; end; //first point for j := 1 to SpFace do begin SpNormalXpom := SpNormalXpom + SpNormal1[0,j].x; SpNormalYpom := SpNormalYpom + SpNormal1[0,j].y; SpNormalZpom := SpNormalZpom + SpNormal1[0,j].z; end; for j := 1 to SpFace do begin SpNormal1[0,j].x := SpNormalXpom / SpFace; SpNormal1[0,j].y := SpNormalYpom / SpFace; SpNormal1[0,j].z := SpNormalZpom / SpFace; end; //last point SpNormalXpom := 0; SpNormalYpom := 0; SpNormalZpom := 0; for j := 1 to SpFace do begin SpNormalXpom := SpNormalXpom + SpNormal3[(SpFace div 2),j].x; SpNormalYpom := SpNormalYpom + SpNormal3[(SpFace div 2),j].y; SpNormalZpom := SpNormalZpom + SpNormal3[(SpFace div 2),j].z; end; for j := 1 to SpFace do begin SpNormal3[(SpFace div 2),j].x := SpNormalXpom / SpFace; SpNormal3[(SpFace div 2),j].y := SpNormalYpom / SpFace; SpNormal3[(SpFace div 2),j].z := SpNormalZpom / SpFace; end; end; procedure SphereTexCoord; var x,y: double; i,j: integer; begin y := 1/((SpFace div 2)); x := 1/SpFace; for i := 1 to (SpFace div 2)-2 do begin for j := 1 to SpFace do begin if j <> SpFace then begin SpCoord1[i,j].x := (j-1) * x; SpCoord1[i,j].y := (i) * y; SpCoord2[i,j+1].x := j * x; SpCoord2[i,j+1].y := (i) * y; SpCoord3[i+1,j].x := (j-1) * x; SpCoord3[i+1,j].y := (i+1) * y; SpCoord4[i+1,j+1].x := j * x; SpCoord4[i+1,j+1].y := (i+1) * y; end else begin SpCoord1[i,j].x := (j-1) * x; SpCoord1[i,j].y := (i) * y; SpCoord2[i,1].x := j * x; SpCoord2[i,1].y := (i) * y; SpCoord3[i+1,j].x := (j-1) * x; SpCoord3[i+1,j].y := (i+1) * y; SpCoord4[i+1,1].x := j * x; SpCoord4[i+1,1].y := (i+1) * y; end; end; end; //first point for j := 1 to SpFace do begin if j <> SpFace then begin SpCoord1[0,j].x := ((j-1)*x)+(x/2); SpCoord1[0,j].y := 0; SpCoord3[1,j].x := (j-1)*x; SpCoord3[1,j].y := y; SpCoord4[1,j+1].x := (j)*x; SpCoord4[1,j+1].y := y; end else begin SpCoord1[0,j].x := ((j-1)*x)+(x/2); SpCoord1[0,j].y := 0; SpCoord3[1,j].x := (j-1)*x; SpCoord3[1,j].y := y; SpCoord4[1,1].x := (j)*x; SpCoord4[1,1].y := y; end; end; //last point for j := 1 to SpFace do begin if j <> SpFace then begin SpCoord3[(SpFace div 2)+1,j].x := ((j-1)*x)+(x/2); SpCoord3[(SpFace div 2)+1,j].y := 1; SpCoord1[(SpFace div 2),j].x := (j-1)*x; SpCoord1[(SpFace div 2),j].y := i*y; SpCoord2[(SpFace div 2),j+1].x := (j)*x; SpCoord2[(SpFace div 2),j+1].y := i*y; end else begin SpCoord3[(SpFace div 2)+1,j].x := ((j-1)*x)+(x/2); SpCoord3[(SpFace div 2)+1,j].y := 1; SpCoord1[(SpFace div 2),j].x := (j-1)*x; SpCoord1[(SpFace div 2),j].y := i*y; SpCoord2[(SpFace div 2),1].x := (j)*x; SpCoord2[(SpFace div 2),1].y := i*y; end; end; end; procedure MoveObject; begin ProcessKeyb; glMatrixMode(GL_MODELVIEW); glLoadIdentity; //Rotation Sphere Angle.y := Angle.y + 0.1; glTranslatef(0,0,-200); glRotatef(Angle.x, 1, 0, 0); //rotation X glRotatef(Angle.y, 0, 1, 0); //rotation Y glRotatef(Angle.z, 0, 0, 1); //rotation Z end; procedure DrawScene; begin wglMakeCurrent(Form1.Canvas.Handle,RC); glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); DrawBackground; MoveObject; DrawSphere; glFlush; SwapBuffers(Form1.Canvas.Handle); wglMakeCurrent(0,0) end; procedure SetFullScreen(SizeX,SizeY,Bits:longint); var dmScreenSettings: DEVMODE; begin ZeroMemory( @dmScreenSettings, sizeof( DEVMODE ) ); dmScreenSettings.dmSize := sizeof( DEVMODE ); dmScreenSettings.dmPelsWidth := SizeX; // Width dmScreenSettings.dmPelsHeight := SizeY; // Height dmScreenSettings.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT; // Color Depth dmScreenSettings.dmBitsPerPel := Bits; ChangeDisplaySettings(dmScreenSettings, CDS_FULLSCREEN); // Switch To Fullscreen Mode Form1.WindowState := wsMaximized; end; procedure RestoreMode; begin ChangeDisplaySettings(DEVMODE(nil^), 0); end; procedure InitTexture; var a:word; f:TGluint; begin UniPicture:=TPicture.Create; for a:=1 to 256 do begin glGenTextures(1, @f);TextureBin[a]:=f; end; for a:=1 to 256 do begin with texture[a] do begin rgbacolor:=nil; rgbcolor:=nil; ColorSystem:=Gl_RGB; glBindTexture(GL_TEXTURE_2D,TextureBin[a]); glTexParameterf(GL_Texture_2D,GL_Texture_Wrap_S,gl_repeat); glTexParameterf(GL_Texture_2D,GL_Texture_Wrap_T,gl_repeat); glTexParameterf(GL_Texture_2D,GL_Texture_Mag_Filter,GL_Linear); glTexParameterf(GL_Texture_2D,GL_Texture_Min_Filter,GL_Linear); glTexEnvf(GL_Texture_Env, GL_Texture_Env_Mode, GL_MODULATE); glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, GL_SPHERE_MAP); // Set The Texture Generation Mode For S To Sphere Mapping glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, GL_SPHERE_MAP); // Set The Texture Generation Mode For T To Sphere Mapping end; end; end; procedure LoadTexture(Num:LongInt;FileName:string;Typ:word); begin if (Typ=gl_rgba2) or (Typ=gl_rgba4) or (Typ=gl_rgba8) or (Typ=gl_rgba16) then texture[num].colorsystem:=gl_rgba else texture[num].colorsystem:=gl_rgb; LoadPicture(FileName,UniPicture); texture[num].filename:=ExtractFileName(FileName); StoreTexture(Num,UniPicture); SetTexture(Num,Typ); end; procedure LoadPicture(FileName:String;var Pic:TPicture); var Y:TPicture; temp:boolean; searchrec:tsearchrec; begin filename:=uppercase(filename); if findfirst(filename,$3f,searchrec)<>0 then begin MessageDlg('Picture '+filename+' not found !!!', mtError, [mbOK], 0); halt; end; if ExtractFileExt(FileName)='.JPG' then begin Y:=TPicture.Create; Y.LoadFromFile(FileName); temp:=y.Graphic is TJPEGImage; if temp then begin Pic.Bitmap.Width:=y.Graphic.Width; Pic.Bitmap.Height:=y.Graphic.Height; Pic.Bitmap.Canvas.draw(0,0,Y.Graphic); end; Y.Free; end; if ExtractFileExt(FileName)='.BMP' then begin Pic.LoadFromFile(FileName); end; end; procedure StoreTexture(Num:LongInt;Pic:TPicture); var bih : TBitmapInfoHeader; bi : TBitmapInfo; poz,poz2:longint; i,j : longint; begin with Texture[Num] do begin Width:=Pic.Bitmap.Width;Height:=Pic.Bitmap.Height; TextureH.rgbcolor:=AllocMem(Width*Height*sizeof(TRGBByte)); end; with bih do begin biSize:=SizeOf(bih); biWidth:=Pic.width;biHeight:=Pic.height; biPlanes:=1;biBitCount:=24;biCompression:=BI_RGB; biSizeImage:=Pic.width; biXPelsPerMeter:=0;biYPelsPerMeter:=0;biClrImportant:=0; biClrUsed := 0; end; bi.bmiHeader := bih; GetDIBits(Pic.Bitmap.Canvas.Handle,Pic.Bitmap.Handle,0,Pic.width,textureH.rgbcolor,bi,dib_rgb_colors); with Texture[Num] do begin if ColorSystem=GL_RGB then begin rgbcolor:=AllocMem(Width*Height*sizeof(TRGBByte)); for i := 0 to Pic.height-1 do begin for j := 1 to Pic.width do begin poz:=j+i*texture[num].width; poz2:=j+((pic.height-1)-i)*texture[num].width; with texture[num].rgbcolor^[poz2] do begin r:=textureH.rgbcolor^[poz].b; g:=textureH.rgbcolor^[poz].g; b:=textureH.rgbcolor^[poz].r; end; end; end; end else begin rgbacolor:=AllocMem(Width*Height*sizeof(TRGBAByte)); for i := 0 to Pic.height-1 do begin for j := 1 to Pic.width do begin poz:=j+i*texture[num].width; poz2:=j+((pic.height-1)-i)*texture[num].width; with texture[num].rgbacolor^[poz2] do begin r:=textureH.rgbcolor^[poz].b; g:=textureH.rgbcolor^[poz].g; b:=textureH.rgbcolor^[poz].r; if r+g+b=0 then a:=0 else a:=255; end; end; end; end; end; FreeMem(TextureH.rgbcolor); end; procedure SetTexture(Num:Longint;Typ:word); begin with Texture[Num] do begin Mip:=false; glBindTexture(GL_TEXTURE_2D,TextureBin[num]); if ColorSystem=GL_RGB then begin glTexImage2d(GL_Texture_2D,0,TYP,width,height,0,GL_RGB,GL_Unsigned_byte,rgbcolor); end else begin glTexImage2d(GL_Texture_2D,0,TYP,width,height,0,GL_RGBA,GL_Unsigned_byte,rgbacolor); end; end; end; procedure TForm1.ClearFace(var Message: TWMEraseBkgnd); begin Message.Result := 1; end; procedure TForm1.FormDestroy(Sender: TObject); begin wglDeleteContext(RC); end; procedure TForm1.FormPaint(Sender: TObject); begin DrawScene; end; procedure TForm1.FormResize(Sender: TObject); begin wglMakeCurrent(Canvas.Handle,RC); InitArea; DrawScene; wglMakeCurrent(0,0); end; procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin case Key of VK_UP: begin //Forward KeybUp := True; end; end; case Key of VK_DOWN: begin //Backward KeybDown := True; end; end; case Key of VK_RIGHT: begin //Rotate right KeybRight := True; end; end; case Key of VK_LEFT: begin //Rotate left KeybLeft := True; end; end; case Key of VK_Home: begin //Look up KeybHome := True; end; end; case Key of VK_END: begin //Look down KeybEnd := True; end; end; case Key of 27: begin //Q - Quit Application.Terminate; RestoreMode; end; end; case Key of VK_Return: begin //Full Screen SetFullScreen(640,480,16); end; end; case Key of VK_Prior: begin //move up KeybMoveUp := True; end; end; case Key of VK_Next: begin //move down KeybMoveDown := True; end; end; end; procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin case Key of VK_UP: begin //Forward KeybUp := False; end; end; case Key of VK_DOWN: begin //Backward KeybDown := False; end; end; case Key of VK_RIGHT: begin //Rotate right KeybRight := False; end; end; case Key of VK_LEFT: begin //Rotate left KeybLeft := False; end; end; case Key of VK_Home: begin //Look up KeybHome := False; end; end; case Key of VK_END: begin //Look down KeybEnd := False; end; end; case Key of VK_Prior: begin //move up KeybMoveUp := False; end; end; case Key of VK_Next: begin //move down KeybMoveDown := False; end; end; end; procedure ProcessKeyb; begin if KeybUp then begin Angle.z := Angle.z + 1; end; if KeybDown then begin Angle.z := Angle.z - 1; end; if KeybRight then begin Angle.Y := Angle.Y + 1; end; if KeybLeft then begin Angle.Y := Angle.Y - 1; end; if KeybHome then begin Angle.X := Angle.X - 1; end; if KeybEnd then begin Angle.X := Angle.X + 1; end; if KeybMoveUp then begin end; if KeybMoveDown then begin end; end; end.