{ This Code Was Created By Jan Koci 2001 Visit My Site At koci.opengl.cz } unit BumpMap_f; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, OpenGL, jpeg, Menus, StdCtrls, Math; 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; 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 DrawBump; procedure BumpPlus; procedure BumpMinus; 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 TPoint3=record x: TGLFloat; y: TGLFloat; z: TGLFloat; end; type TPoint2=record x: TGLFloat; y: TGLFloat; end; var Point1, Point2, Point3, Point4: array [1..3] of TPoint3; Coord1, Coord2, Coord3, Coord4: array [1..3] of TPoint2; ViewAngle, NearClip, FarClip: TGLFloat; //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: TPoint3; KeybUp, KeybDown, KeybRight, KeybLeft, KeybHome, KeybEnd, KeybEsc, KeybMoveUp, KeybMoveDown: boolean; RC : HGLRC; MoveSpeed: single=0.1; 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 Tran.Z := -25; ViewAngle := 30; NearClip := 0.1; FarClip := 100000; Coord1[1].x := 0; Coord1[1].y := 0; Coord2[1].x := 1; Coord2[1].y := 0; Coord3[1].x := 0; Coord3[1].y := 1; Coord4[1].x := 1; Coord4[1].y := 1; Point1[1].x := -6; Point1[1].y := 6; Point1[1].z := 0; Point2[1].x := 6; Point2[1].y := 6; Point2[1].z := 0; Point3[1].x := -6; Point3[1].y := -6; Point3[1].z := 0; Point4[1].x := 6; Point4[1].y := -6; Point4[1].z := 0; Coord1[2].x := 0.005; Coord1[2].y := 0.005; Coord2[2].x := 1.005; Coord2[2].y := 0.005; Coord3[2].x := 0.005; Coord3[2].y := 1.005; Coord4[2].x := 1.005; Coord4[2].y := 1.005; Point1[2].x := -6; Point1[2].y := 6; Point1[2].z := 0.01; Point2[2].x := 6; Point2[2].y := 6; Point2[2].z := 0.01; Point3[2].x := -6; Point3[2].y := -6; Point3[2].z := 0.01; Point4[2].x := 6; Point4[2].y := -6; Point4[2].z := 0.01; Coord1[3].x := 0; Coord1[3].y := 0; Coord2[3].x := 1; Coord2[3].y := 0; Coord3[3].x := 0; Coord3[3].y := 1; Coord4[3].x := 1; Coord4[3].y := 1; Point1[3].x := -6; Point1[3].y := 6; Point1[3].z := 0.02; Point2[3].x := 6; Point2[3].y := 6; Point2[3].z := 0.02; Point3[3].x := -6; Point3[3].y := -6; Point3[3].z := 0.02; Point4[3].x := 6; Point4[3].y := -6; Point4[3].z := 0.02; InitWindow; InitArea; Handles := BeginThread(nil, 0, Thread, nil, 0, ThreadID); 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; DrawBump; glFlush; SwapBuffers(Form1.Canvas.Handle); wglMakeCurrent(0,0) end; procedure MoveObject; begin ProcessKeyb; glMatrixMode(GL_MODELVIEW); glLoadIdentity; glPushMatrix; 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.1, 0.1, 0.1, 1.0); //GL_AMBIENT = ambientní světlo, světlo které září i když jsou světla vypnuta glfLightDiffuse : Array[0..3] of TGLfloat = (1.0, 1.0, 1.0, 1.0); //GL_DIFFUSE = barva světla, které zdroj vyzařuje do okolí glfLightSpecular: Array[0..3] of TGLfloat = (0.5, 0.5, 0.5, 1.0); //GL_SPECULAR = zrcadlový odraz světla glfLightShininess: TGLFloat = 127; //GL_SHININESS = intenzita světelného odlesku glflightPosition: Array[0..3] of TGLfloat = (0.0,0.0,1.0,1.0); //GL_Position = pozice světelného bodu v prostoru glfSpotDirection: Array[0..3] of TGLfloat = (0.0,0.0,-1.0,1.0); // GL_SPOT_DIRECTION = zadání směru světelného kužele glfLightEmission: Array[0..3] of TGLfloat = (0.0,0.0,0.0,1.0); // světlo, které vyzařuje určitý objekt, nepůsobí jako zdroj světla glfLinearAttenuation: TGLFloat = 0; // GL_LINEAR_ATTENUATION = lineární slábnutí intenzity světla glfSpotExponent: TGLFloat = 1; //GL_SPOT_EXPONENT = charakterizuje způsob rozptylu světla při odrazu glfSpotCutoff:TGLFloat = 180; //GL_SPOT_CUTOFF = úhel, nímž se kužel světla 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 + 'stone.bmp',gl_rgb8); //base texture LoadTexture(2,Path + 'invert.bmp',gl_rgba8); //invert texture LoadTexture(3,Path + 'stone.bmp',gl_rgba8); //top texture end; procedure DrawBump; var i: integer; begin //base i := 1; glDisable(GL_LIGHTING); glBindTexture(GL_TEXTURE_2D, TextureBin[i]); glEnable(GL_TEXTURE_2D); glBegin(GL_TRIANGLES); glTexCoord2f(Coord1[i].x,Coord1[i].y); 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); 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); glTexCoord2f(Coord4[i].x,Coord4[i].y); glVertex3f(Point4[i].x,Point4[i].y,Point4[i].z); glEnd; //invert i := 2; glEnable(GL_LIGHTING); glEnable(GL_BLEND); glBlendFunc(GL_ONE, GL_ONE); glBindTexture(GL_TEXTURE_2D, TextureBin[i]); glEnable(GL_TEXTURE_2D); glBegin(GL_TRIANGLES); glTexCoord2f(Coord1[i].x,Coord1[i].y); 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); 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); glTexCoord2f(Coord4[i].x,Coord4[i].y); glVertex3f(Point4[i].x,Point4[i].y,Point4[i].z); glEnd; //top i := 3; glBlendFunc(GL_DST_COLOR,GL_SRC_COLOR); glBindTexture(GL_TEXTURE_2D, TextureBin[i]); glEnable(GL_TEXTURE_2D); glBegin(GL_TRIANGLES); glTexCoord2f(Coord1[i].x,Coord1[i].y); 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); 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); glTexCoord2f(Coord4[i].x,Coord4[i].y); glVertex3f(Point4[i].x,Point4[i].y,Point4[i].z); glEnd; glDisable(GL_BLEND); glDisable(GL_LIGHTING); glPopMatrix; end; procedure BumpPlus; begin Coord1[2].x := Coord1[2].x + 0.0001; Coord1[2].y := Coord1[2].y + 0.0001; Coord2[2].x := Coord2[2].x + 0.0001; Coord2[2].y := Coord2[2].y + 0.0001; Coord3[2].x := Coord3[2].x + 0.0001; Coord3[2].y := Coord3[2].y + 0.0001; Coord4[2].x := Coord4[2].x + 0.0001; Coord4[2].y := Coord4[2].y + 0.0001; end; procedure BumpMinus; begin Coord1[2].x := Coord1[2].x - 0.0001; Coord1[2].y := Coord1[2].y - 0.0001; Coord2[2].x := Coord2[2].x - 0.0001; Coord2[2].y := Coord2[2].y - 0.0001; Coord3[2].x := Coord3[2].x - 0.0001; Coord3[2].y := Coord3[2].y - 0.0001; Coord4[2].x := Coord4[2].x - 0.0001; Coord4[2].y := Coord4[2].y - 0.0001; 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.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); //procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char); 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 Tran.Z := Tran.Z + ((-sin((Angle.Y - 90) * (Pi/180))) * MoveSpeed); Tran.X := Tran.X - ((sin((Angle.Y) * (Pi/180))) * MoveSpeed); end; if KeybDown then begin Tran.Z := Tran.Z - ((-sin((Angle.Y - 90) * (Pi/180))) * MoveSpeed); Tran.X := Tran.X + ((sin((Angle.Y) * (Pi/180))) * MoveSpeed); end; if KeybRight then begin //Tran.X := Tran.X + MoveSpeed; Angle.Y := Angle.Y + 1; end; if KeybLeft then begin //Tran.X := Tran.X - MoveSpeed; 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 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 '+': BumpPlus; '-': BumpMinus; end; end; end.