{ This Code Was Created By Jan Koci 2001 Visit My Site At koci.opengl.cz } unit BaColl_f; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, OpenGL, jpeg, Menus, StdCtrls, Math, K3dMath; type TForm1 = class(TForm) procedure FormResize(Sender: TObject); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormKeyPress(Sender: TObject; var Key: Char); end; procedure InitScene; procedure InitWindow; procedure PixelFormat(DC : HDC); procedure InitArea; procedure InitLight; procedure DrawScene; procedure MoveObject; procedure InitTriangleTexture; procedure DrawTriangle; procedure DrawLine; procedure DrawSphere; procedure ChangeToLines; procedure ChangeToSphere; procedure CalcCollision(val: TGLInt); procedure CalcCameraCollision(val: TGLInt); 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); //Textures type TRGBByte=record r: TGLubyte; g: TGLubyte; b: TGLubyte; end; type TRGBAByte=record r: TGLubyte; g: TGLubyte; b: TGLubyte; a: TGLubyte; end; type TRGBColors=array[1..1024*1024] of TRGBByte; TRGBAColors=array[1..1024*1024] of TRGBAByte; type TTexture=record ColorSystem:TGLEnum; FileName:String; rgbcolor:^TRGBColors; rgbacolor:^TRGBAColors; Width:Word; Height:Word; Mip:boolean; end; //Triangles type TPoint2D=record x: TGLFloat; y: TGLFloat; end; var Point1, Point2, Point3: array [1..20] of TPoint3D; Normal1, Normal2, Normal3: array [1..20] of TPoint3D; Coord1, Coord2, Coord3: array [1..20] of TPoint2D; ViewAngle, NearClip, FarClip: TGLFloat; //Collision Lines pLineX1, pLineX2, pLineY1, pLineY2, pLineZ1, pLineZ2:TPoint3D; //Collision LineX, LineY, LineZ: boolean; FirstColl: boolean; //Moving Lines StartLineVector: TPoint3d; LineVector: TPoint3d; //Lines or Sphere Lines, Sphere: boolean; //other var Form1: TForm1; Handles : integer; ThreadID : LongWord; TextureBin:array[1..256] of word; TextureH:TTexture; Texture:array[1..256] of TTexture; UniPicture:TPicture; Angle, Tran: TPoint3D; KeybUp, KeybDown, KeybRight, KeybLeft, KeybHome, KeybEnd, KeybEsc, KeybMoveUp, KeybMoveDown, KeybSpace: boolean; RC : HGLRC; MoveSpeed: single=0.2; MoveSpeedLine: single=0.05; const PFDError = 'Chyba poi nastavení PFD.'; implementation {$R *.DFM} procedure InitScene; begin Tran.X := 6; Tran.Z := 12; Angle.y := 180; ViewAngle := 30; NearClip := 0.1; FarClip := 100000; //wall 1 Coord1[1].x := 0; Coord1[1].y := 0; Coord2[1].x := 3; Coord2[1].y := 0; Coord3[1].x := 0; Coord3[1].y := 1; Point1[1].x := -6; Point1[1].y := 6; Point1[1].z := 0; Point2[1].x := 36; Point2[1].y := 6; Point2[1].z := 0; Point3[1].x := -6; Point3[1].y := -6; Point3[1].z := 0; Normal1[1] := CalcCollVector(Point1[1],Point2[1],Point3[1]); Coord1[2].x := 3; Coord1[2].y := 0; Coord2[2].x := 3; Coord2[2].y := 1; Coord3[2].x := 0; Coord3[2].y := 1; Point1[2].x := 36; Point1[2].y := 6; Point1[2].z := 0; Point2[2].x := 36; Point2[2].y := -6; Point2[2].z := 0; Point3[2].x := -6; Point3[2].y := -6; Point3[2].z := 0; Normal1[2] := CalcCollVector(Point1[2],Point2[2],Point3[2]); //wall 2 Coord1[3].x := 0; Coord1[3].y := 0; Coord2[3].x := 3; Coord2[3].y := 0; Coord3[3].x := 0; Coord3[3].y := 1; Point1[3].x := 36; Point1[3].y := 6; Point1[3].z := 0; Point2[3].x := 36; Point2[3].y := 6; Point2[3].z := 36; Point3[3].x := 36; Point3[3].y := -6; Point3[3].z := 0; Normal1[3] := CalcCollVector(Point1[3],Point2[3],Point3[3]); Coord1[4].x := 3; Coord1[4].y := 0; Coord2[4].x := 3; Coord2[4].y := 1; Coord3[4].x := 0; Coord3[4].y := 1; Point1[4].x := 36; Point1[4].y := 6; Point1[4].z := 36; Point2[4].x := 36; Point2[4].y := -6; Point2[4].z := 36; Point3[4].x := 36; Point3[4].y := -6; Point3[4].z := 0; Normal1[4] := CalcCollVector(Point1[4],Point2[4],Point3[4]); //wall 3 Coord1[5].x := 0; Coord1[5].y := 0; Coord2[5].x := 3; Coord2[5].y := 0; Coord3[5].x := 0; Coord3[5].y := 1; Point1[5].x := 36; Point1[5].y := 6; Point1[5].z := 36; Point2[5].x := 0; Point2[5].y := 6; Point2[5].z := 36; Point3[5].x := 36; Point3[5].y := -6; Point3[5].z := 36; Normal1[5] := CalcCollVector(Point1[5],Point2[5],Point3[5]); Coord1[6].x := 3; Coord1[6].y := 0; Coord2[6].x := 3; Coord2[6].y := 1; Coord3[6].x := 0; Coord3[6].y := 1; Point1[6].x := 0; Point1[6].y := 6; Point1[6].z := 36; Point2[6].x := 0; Point2[6].y := -6; Point2[6].z := 36; Point3[6].x := 36; Point3[6].y := -6; Point3[6].z := 36; Normal1[6] := CalcCollVector(Point1[6],Point2[6],Point3[6]); //wall 4 Coord1[7].x := 0; Coord1[7].y := 0; Coord2[7].x := 3; Coord2[7].y := 0; Coord3[7].x := 0; Coord3[7].y := 1; Point1[7].x := 0; Point1[7].y := 6; Point1[7].z := 36; Point2[7].x := -6; Point2[7].y := 6; Point2[7].z := 0; Point3[7].x := 0; Point3[7].y := -6; Point3[7].z := 36; Normal1[7] := CalcCollVector(Point1[7],Point2[7],Point3[7]); Coord1[8].x := 3; Coord1[8].y := 0; Coord2[8].x := 3; Coord2[8].y := 1; Coord3[8].x := 0; Coord3[8].y := 1; Point1[8].x := -6; Point1[8].y := 6; Point1[8].z := 0; Point2[8].x := -6; Point2[8].y := -6; Point2[8].z := 0; Point3[8].x := 0; Point3[8].y := -6; Point3[8].z := 36; Normal1[8] := CalcCollVector(Point1[8],Point2[8],Point3[8]); //Floor Coord1[9].x := 0; Coord1[9].y := 0; Coord2[9].x := 3; Coord2[9].y := 0; Coord3[9].x := 0; Coord3[9].y := 3; Point1[9].x := -6; Point1[9].y := -6; Point1[9].z := 0; Point2[9].x := 36; Point2[9].y := -6; Point2[9].z := 0; Point3[9].x := -6; Point3[9].y := -6; Point3[9].z := 36; Normal1[9] := CalcCollVector(Point1[9],Point2[9],Point3[9]); Coord1[10].x := 3; Coord1[10].y := 0; Coord2[10].x := 3; Coord2[10].y := 3; Coord3[10].x := 0; Coord3[10].y := 3; Point1[10].x := 36; Point1[10].y := -6; Point1[10].z := 0; Point2[10].x := 36; Point2[10].y := -6; Point2[10].z := 36; Point3[10].x := -6; Point3[10].y := -6; Point3[10].z := 36; Normal1[10] := CalcCollVector(Point1[10],Point2[10],Point3[10]); //Roof Coord1[11].x := 0; Coord1[11].y := 0; Coord2[11].x := 3; Coord2[11].y := 0; Coord3[11].x := 0; Coord3[11].y := 3; Point1[11].x := -6; Point1[11].y := 6; Point1[11].z := 36; Point2[11].x := 36; Point2[11].y := 6; Point2[11].z := 36; Point3[11].x := -6; Point3[11].y := 6; Point3[11].z := 0; Normal1[11] := CalcCollVector(Point1[11],Point2[11],Point3[11]); Coord1[12].x := 3; Coord1[12].y := 0; Coord2[12].x := 3; Coord2[12].y := 3; Coord3[12].x := 0; Coord3[12].y := 3; Point1[12].x := 36; Point1[12].y := 6; Point1[12].z := 36; Point2[12].x := 36; Point2[12].y := 6; Point2[12].z := 0; Point3[12].x := -6; Point3[12].y := 6; Point3[12].z := 0; Normal1[12] := CalcCollVector(Point1[12],Point2[12],Point3[12]); //pillar wall 1 Coord1[13].x := 0; Coord1[13].y := 0; Coord2[13].x := 1; Coord2[13].y := 0; Coord3[13].x := 0; Coord3[13].y := 1; Point1[13].x := 18; Point1[13].y := 6; Point1[13].z := 21; Point2[13].x := 21; Point2[13].y := 6; Point2[13].z := 24; Point3[13].x := 18; Point3[13].y := -6; Point3[13].z := 21; Normal1[13] := CalcCollVector(Point1[13],Point2[13],Point3[13]); Coord1[14].x := 1; Coord1[14].y := 0; Coord2[14].x := 1; Coord2[14].y := 1; Coord3[14].x := 0; Coord3[14].y := 1; Point1[14].x := 21; Point1[14].y := 6; Point1[14].z := 24; Point2[14].x := 21; Point2[14].y := -6; Point2[14].z := 24; Point3[14].x := 18; Point3[14].y := -6; Point3[14].z := 21; Normal1[14] := CalcCollVector(Point1[14],Point2[14],Point3[14]); //pillar wall 2 Coord1[15].x := 0; Coord1[15].y := 0; Coord2[15].x := 1; Coord2[15].y := 0; Coord3[15].x := 0; Coord3[15].y := 1; Point1[15].x := 21; Point1[15].y := 6; Point1[15].z := 24; Point2[15].x := 24; Point2[15].y := 6; Point2[15].z := 21; Point3[15].x := 21; Point3[15].y := -6; Point3[15].z := 24; Normal1[15] := CalcCollVector(Point1[15],Point2[15],Point3[15]); Coord1[16].x := 1; Coord1[16].y := 0; Coord2[16].x := 1; Coord2[16].y := 1; Coord3[16].x := 0; Coord3[16].y := 1; Point1[16].x := 24; Point1[16].y := 6; Point1[16].z := 21; Point2[16].x := 24; Point2[16].y := -6; Point2[16].z := 21; Point3[16].x := 21; Point3[16].y := -6; Point3[16].z := 24; Normal1[16] := CalcCollVector(Point1[16],Point2[16],Point3[16]); //pillar wall 3 Coord1[17].x := 0; Coord1[17].y := 0; Coord2[17].x := 1; Coord2[17].y := 0; Coord3[17].x := 0; Coord3[17].y := 1; Point1[17].x := 24; Point1[17].y := 6; Point1[17].z := 21; Point2[17].x := 21; Point2[17].y := 6; Point2[17].z := 18; Point3[17].x := 24; Point3[17].y := -6; Point3[17].z := 21; Normal1[17] := CalcCollVector(Point1[17],Point2[17],Point3[17]); Coord1[18].x := 1; Coord1[18].y := 0; Coord2[18].x := 1; Coord2[18].y := 1; Coord3[18].x := 0; Coord3[18].y := 1; Point1[18].x := 21; Point1[18].y := 6; Point1[18].z := 18; Point2[18].x := 21; Point2[18].y := -6; Point2[18].z := 18; Point3[18].x := 24; Point3[18].y := -6; Point3[18].z := 21; Normal1[18] := CalcCollVector(Point1[18],Point2[18],Point3[18]); //pillar wall 4 Coord1[19].x := 0; Coord1[19].y := 0; Coord2[19].x := 1; Coord2[19].y := 0; Coord3[19].x := 0; Coord3[19].y := 1; Point1[19].x := 21; Point1[19].y := 6; Point1[19].z := 18; Point2[19].x := 18; Point2[19].y := 6; Point2[19].z := 21; Point3[19].x := 21; Point3[19].y := -6; Point3[19].z := 18; Normal1[19] := CalcCollVector(Point1[19],Point2[19],Point3[19]); Coord1[20].x := 1; Coord1[20].y := 0; Coord2[20].x := 1; Coord2[20].y := 1; Coord3[20].x := 0; Coord3[20].y := 1; Point1[20].x := 18; Point1[20].y := 6; Point1[20].z := 21; Point2[20].x := 18; Point2[20].y := -6; Point2[20].z := 21; Point3[20].x := 21; Point3[20].y := -6; Point3[20].z := 18; Normal1[20] := CalcCollVector(Point1[20],Point2[20],Point3[20]); //Collision Lines //LineX pLineX1.x := -2; pLineX1.y := 0; pLineX1.z := 10; pLineX2.x := 2; pLineX2.y := 0; pLineX2.z := 10; //LineY pLineY1.x := 0; pLineY1.y := 2; pLineY1.z := 10; pLineY2.x := 0; pLineY2.y := -2; pLineY2.z := 10; //LineZ pLineZ1.x := 0; pLineZ1.y := 0; pLineZ1.z := 8; pLineZ2.x := 0; pLineZ2.y := 0; pLineZ2.z := 12; //Collision FirstColl := True; //Moving Lines StartLineVector.x := 0; StartLineVector.y := 0; StartLineVector.z := 10; LineVector.x := 0.55; LineVector.y := 0.55; LineVector.z := 0.55; //0.5; //ViewSphere Sphere := True; //Start Scene InitWindow; InitArea; end; procedure InitWindow; 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); InitTriangleTexture; InitLight; 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(ViewAngle,Form1.ClientWidth / Form1.ClientHeight,NearClip,FarClip); glViewport(0,0,Form1.ClientWidth,Form1.ClientHeight); end; procedure DrawScene; begin wglMakeCurrent(Form1.Canvas.Handle,RC); glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); MoveObject; DrawTriangle; glFlush; SwapBuffers(Form1.Canvas.Handle); wglMakeCurrent(0,0) end; procedure MoveObject; begin ProcessKeyb; glMatrixMode(GL_MODELVIEW); glLoadIdentity; glRotatef(-Angle.x, 1, 0, 0); glRotatef(-Angle.y, 0, 1, 0); glRotatef(-Angle.z, 0, 0, 1); glTranslatef(-Tran.X,-Tran.Y,-Tran.Z); end; procedure InitLight; const glfLightAmbient : Array[0..3] of TGLfloat = (0.7, 0.7, 0.7, 1.0); //GL_AMBIENT = ambientní svitlo, svitlo které záoí i když jsou svitla vypnuta glfLightDiffuse : Array[0..3] of TGLfloat = (1.0, 1.0, 1.0, 1.0); //GL_DIFFUSE = barva svitla, které zdroj vyzaouje do okolí glfLightSpecular: Array[0..3] of TGLfloat = (0.7, 0.7, 0.7, 1.0); //GL_SPECULAR = zrcadlový odraz svitla glfLightShininess: TGLFloat = 127; //GL_SHININESS = intenzita svitelného odlesku glflightPosition: Array[0..3] of TGLfloat = (0.0,0.0,1.0,1.0); //GL_Position = pozice svitelného bodu v prostoru glfSpotDirection: Array[0..3] of TGLfloat = (0.0,0.0,-1.0,1.0); // GL_SPOT_DIRECTION = zadání smiru svitelného kužele glfLightEmission: Array[0..3] of TGLfloat = (0.0,0.0,0.0,1.0); // svitlo, které vyzaouje ureitý objekt, nepusobí jako zdroj svitla glfLinearAttenuation: TGLFloat = 0; // GL_LINEAR_ATTENUATION = lineární slábnutí intenzity svitla glfSpotExponent: TGLFloat = 1; //GL_SPOT_EXPONENT = charakterizuje zpusob rozptylu svitla poi odrazu glfSpotCutoff:TGLFloat = 180; //GL_SPOT_CUTOFF = úhel, nímž se kužel svitla rozevírá od své osy begin glEnable(GL_DEPTH_TEST); glLightfv(GL_LIGHT0, GL_AMBIENT, @glfLightAmbient); glLightfv(GL_LIGHT0, GL_DIFFUSE, @glfLightDiffuse); glLightfv(GL_LIGHT0, GL_SPECULAR, @glfLightSpecular); glLightfv(GL_LIGHT0, GL_SHININESS, @glfLightShininess); glLightfv(GL_LIGHT0, GL_POSITION,@glfLightPosition); glLightfv(GL_LIGHT0, GL_SPOT_DIRECTION, @glfSpotDirection); glLightfv(GL_LIGHT0, GL_EMISSION, @glfLightEmission); glLightfv(GL_LIGHT0, GL_LINEAR_ATTENUATION, @glfLinearAttenuation); glLightfv(GL_LIGHT0, GL_SPOT_EXPONENT, @glfSpotExponent); glLightfv(GL_LIGHT0, GL_SPOT_CUTOFF, @glfSpotCutoff); glEnable(GL_LIGHTING); glEnable(GL_LIGHT0); end; procedure InitTriangleTexture; var Path: string; begin Path := ExtractFilePath(Application.ExeName); InitTexture; LoadTexture(1,Path + 'wall.jpg',gl_rgb8); LoadTexture(2,Path + 'wall.jpg',gl_rgb8); LoadTexture(3,Path + 'wall.jpg',gl_rgb8); LoadTexture(4,Path + 'wall.jpg',gl_rgb8); LoadTexture(5,Path + 'wall.jpg',gl_rgb8); LoadTexture(6,Path + 'wall.jpg',gl_rgb8); LoadTexture(7,Path + 'wall.jpg',gl_rgb8); LoadTexture(8,Path + 'wall.jpg',gl_rgb8); LoadTexture(9,Path + 'wall.jpg',gl_rgb8); LoadTexture(10,Path + 'wall.jpg',gl_rgb8); LoadTexture(11,Path + 'wall.jpg',gl_rgb8); LoadTexture(12,Path + 'wall.jpg',gl_rgb8); LoadTexture(13,Path + 'pillar.jpg',gl_rgb8); LoadTexture(14,Path + 'pillar.jpg',gl_rgb8); LoadTexture(15,Path + 'pillar.jpg',gl_rgb8); LoadTexture(16,Path + 'pillar.jpg',gl_rgb8); LoadTexture(17,Path + 'pillar.jpg',gl_rgb8); LoadTexture(18,Path + 'pillar.jpg',gl_rgb8); LoadTexture(19,Path + 'pillar.jpg',gl_rgb8); LoadTexture(20,Path + 'pillar.jpg',gl_rgb8); LoadTexture(21,Path + 'sphere.jpg',gl_rgb8); end; procedure DrawTriangle; var i: integer; begin for i := 1 to 20 do begin CalcCollision(i); CalcCameraCollision(i); glPushMatrix; glEnable(GL_LIGHTING); glColor3f(1, 1, 1); glBindTexture(GL_TEXTURE_2D, TextureBin[i]); glEnable(GL_TEXTURE_2D); glBegin(GL_TRIANGLES); glTexCoord2f(Coord1[i].x,Coord1[i].y); glNormal3f(-Normal1[i].x,-Normal1[i].y,-Normal1[i].z); glVertex3f(Point1[i].x,Point1[i].y,Point1[i].z); glTexCoord2f(Coord2[i].x,Coord2[i].y); glVertex3f(Point2[i].x,Point2[i].y,Point2[i].z); glTexCoord2f(Coord3[i].x,Coord3[i].y); glVertex3f(Point3[i].x,Point3[i].y,Point3[i].z); glEnd; glPopMatrix; end; DrawLine; DrawSphere; end; procedure DrawLine; begin glDisable(GL_TEXTURE_2D); glDisable(GL_LIGHTING); if LineZ or LineX or LineY then begin glColor3f(1, 0, 0); // Make the line RED if we collided with the triangle's plane end else begin glColor3f(1, 1, 0); // Make the line YELLOW if we didn't collide end; LineZ := False; LineX := False; LineY := False; //Move collision lines pLineX1.x := pLineX1.x + (LineVector.x * MoveSpeedLine); pLineX1.y := pLineX1.y + (LineVector.y * MoveSpeedLine); pLineX1.z := pLineX1.z + (LineVector.z * MoveSpeedLine); pLineX2.x := pLineX2.x + (LineVector.x * MoveSpeedLine); pLineX2.y := pLineX2.y + (LineVector.y * MoveSpeedLine); pLineX2.z := pLineX2.z + (LineVector.z * MoveSpeedLine); pLineY1.x := pLineY1.x + (LineVector.x * MoveSpeedLine); pLineY1.y := pLineY1.y + (LineVector.y * MoveSpeedLine); pLineY1.z := pLineY1.z + (LineVector.z * MoveSpeedLine); pLineY2.x := pLineY2.x + (LineVector.x * MoveSpeedLine); pLineY2.y := pLineY2.y + (LineVector.y * MoveSpeedLine); pLineY2.z := pLineY2.z + (LineVector.z * MoveSpeedLine); pLineZ1.x := pLineZ1.x + (LineVector.x * MoveSpeedLine); pLineZ1.y := pLineZ1.y + (LineVector.y * MoveSpeedLine); pLineZ1.z := pLineZ1.z + (LineVector.z * MoveSpeedLine); pLineZ2.x := pLineZ2.x + (LineVector.x * MoveSpeedLine); pLineZ2.y := pLineZ2.y + (LineVector.y * MoveSpeedLine); pLineZ2.z := pLineZ2.z + (LineVector.z * MoveSpeedLine); if Lines then begin glPushMatrix; glBegin(GL_LINES); // This is our BEGIN to draw LineX glVertex3f(pLineX1.x, pLineX1.y, pLineX1.z); glVertex3f(pLineX2.x, pLineX2.y, pLineX2.z); glEnd; glBegin(GL_LINES); // This is our BEGIN to draw Line Y glVertex3f(pLineY1.x, pLineY1.y, pLineY1.z); glVertex3f(pLineY2.x, pLineY2.y, pLineY2.z); glEnd; glBegin(GL_LINES); // This is our BEGIN to draw LineZ glVertex3f(pLineZ1.x, pLineZ1.y, pLineZ1.z); glVertex3f(pLineZ2.x, pLineZ2.y, pLineZ2.z); glEnd; glPopMatrix; end; end; procedure DrawSphere; var qObj: PGLUquadricObj; X,Y,Z: TGLFloat; begin if Sphere then begin glEnable(GL_LIGHTING); X := pLineZ1.x; Y := pLineZ1.y; Z := pLineZ1.z + 2; glPushMatrix; glTranslatef(X,Y,Z); //pozice kamery glColor3f(1, 1, 1); glBindTexture(GL_TEXTURE_2D, TextureBin[21]); glEnable(GL_TEXTURE_2D); qobj := gluNewQuadric(); //vytvori novy objekt gluQuadricTexture(qobj,GL_true); //otexturuje gluQuadricDrawStyle(qobj, GLU_FILL); //typ zobrazeni gluQuadricOrientation(qobj,GLU_OUTSIDE); //vnejsi strana odrazi svetlo gluQuadricNormals(qobj, GLU_SMOOTH); //volba stinováni gluSphere(qobj, 2, 20, 20); //zobrazi kouli s polomerem 2 a siti 20x20 glPopMatrix; end; end; procedure ChangeToLines; begin Lines := True; Sphere := False; end; procedure ChangeToSphere; begin Lines := False; Sphere := True; end; procedure CalcCollision(val: TGLInt); var Coll:boolean; TriVector, NewVector: TPoint3d; bCollidedLineZ, bCollidedLineX, bCollidedLineY: boolean; begin //Collision Lines //LineX bCollidedLineX := IntersectedPolygon(Point1[val], Point2[val], Point3[val] , pLineX1, pLineX2); if bCollidedLineX then begin LineX := True; end; //LineY bCollidedLineY := IntersectedPolygon(Point1[val], Point2[val], Point3[val] , pLineY1, pLineY2); if bCollidedLineY then begin LineY := True; end; //LineZ bCollidedLineZ := IntersectedPolygon(Point1[val], Point2[val], Point3[val] , pLineZ1, pLineZ2); if bCollidedLineZ then begin LineZ := True; end; /////////////////////////////////////////////////////////////////////// //////////////////////////Ball Collision/////////////////////////////// /////////////////////////////////////////////////////////////////////// if LineX or LineY or LineZ then begin Coll := True; end else begin Coll := False; end; if Coll then begin if FirstColl then begin FirstColl := False; TriVector := CalcCollVector(Point1[val], Point2[val], Point3[val]); NewVector.x := (LineVector.x - TriVector.x); NewVector.y := (LineVector.y - TriVector.y); NewVector.z := (LineVector.z - TriVector.z); LineVector := NormalizeVector(NewVector); MoveSpeedLine := 0.06; end; //konec FirstColl end else begin FirstColl := True; MoveSpeedLine := 0.05; end; end; procedure CalcCameraCollision(val: TGLInt); var Coll:boolean; TriVector: TPoint3d; LineX1, LineX2, LineY1, LineY2, LineZ1, LineZ2: TPoint3d; bLineX, bLineY, bLineZ: boolean; bCollidedLineZ, bCollidedLineX, bCollidedLineY: boolean; begin bLineX := False; bLineY := False; bLineZ := False; //Line X LineX1.x := Tran.X - 2; LineX1.y := Tran.Y; LineX1.z := Tran.Z; LineX2.x := Tran.X + 2; LineX2.y := Tran.Y; LineX2.z := Tran.Z; //Line Y LineY1.x := Tran.X; LineY1.y := Tran.Y - 2; LineY1.z := Tran.Z; LineY2.x := Tran.X; LineY2.y := Tran.Y + 2; LineY2.z := Tran.Z; //Line Z LineZ1.x := Tran.X; LineZ1.y := Tran.Y; LineZ1.z := Tran.Z - 2; LineZ2.x := Tran.X; LineZ2.y := Tran.Y; LineZ2.z := Tran.Z + 2; //Collision Lines //LineX bCollidedLineX := IntersectedPolygon(Point1[val], Point2[val], Point3[val] , LineX1, LineX2); if bCollidedLineX then begin bLineX := True; end; //LineY bCollidedLineY := IntersectedPolygon(Point1[val], Point2[val], Point3[val] , LineY1, LineY2); if bCollidedLineY then begin bLineY := True; end; //LineZ bCollidedLineZ := IntersectedPolygon(Point1[val], Point2[val], Point3[val] , LineZ1, LineZ2); if bCollidedLineZ then begin bLineZ := True; end; if bLineX or bLineY or bLineZ then begin Coll := True; end else begin Coll := False; end; if Coll then begin TriVector := CalcCollVector(Point1[val], Point2[val], Point3[val]); Tran.x := Tran.x - (TriVector.x * MoveSpeed); Tran.y := Tran.y - (TriVector.y * MoveSpeed); Tran.z := Tran.z - (TriVector.z * MoveSpeed); end; 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); 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.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; case Key of VK_Space: begin //move down KeybSpace := 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; case Key of VK_Space: begin //move down KeybSpace := False; end; end; end; procedure ProcessKeyb; begin if KeybUp then begin Tran.Z := Tran.Z - ((cos(Angle.Y * (Pi/180))) * MoveSpeed); Tran.X := Tran.X - ((sin(Angle.Y * (Pi/180))) * MoveSpeed); end; if KeybDown then begin Tran.Z := Tran.Z + ((cos(Angle.Y * (Pi/180))) * MoveSpeed); Tran.X := Tran.X + ((sin(Angle.Y * (Pi/180))) * MoveSpeed); end; if KeybRight then begin if KeybSpace then begin Tran.Z := Tran.Z - ((cos((Angle.Y - 90) * (Pi/180))) * MoveSpeed); Tran.X := Tran.X - ((sin((Angle.Y - 90) * (Pi/180))) * MoveSpeed); end else begin Angle.Y := Angle.Y - 3; end; end; if KeybLeft then begin if KeybSpace then begin Tran.Z := Tran.Z + ((cos((Angle.Y - 90) * (Pi/180))) * MoveSpeed); Tran.X := Tran.X + ((sin((Angle.Y - 90) * (Pi/180))) * MoveSpeed); end else begin Angle.Y := Angle.Y + 3; end; end; if KeybHome then begin Angle.X := Angle.X + 3; end; if KeybEnd then begin Angle.X := Angle.X - 3; end; if KeybMoveUp then begin Tran.Y := Tran.Y + MoveSpeed; end; if KeybMoveDown then begin Tran.Y := Tran.Y - MoveSpeed; end; end; procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char); begin case Key of 'l': ChangeToLines; 'L': ChangeToLines; 's': ChangeToSphere; 'S': ChangeToSphere; end; end; end.