Teáskannán megcsillan a fény

Top  Previous  Next

program Texture;

 

uses

Windows,

Messages,Jpeg,Graphics,DGLUT,

OpenGL;

 

type

PPixelArray = ^TPixelArray;

TPixelArray = array [0..0] of Byte;

 

var

h_RC: HGLRC;

h_DC: HDC;

keys: array [0..255] of BOOL;

 

 

xrot: GLfloat;

yrot: GLfloat;

xspeed: GLfloat;

yspeed: GLfloat;

Radius:GLFloat;

Text:Cardinal;

 

function CreateTexture(Texture : String): cardinal;

var

bitmap: TBitmap;

BMInfo : TBitmapInfo;

I, ImageSize : Integer;

Temp : Byte;

MemDC : HDC;

Picture: TJpegImage;

Tex: PPixelArray;

begin

glenable(GL_TEXTURE_2D);

glGenTextures(1, @Result);

glBindTexture(GL_TEXTURE_2D, Result);

 

Bitmap:=TBitMap.Create;

Picture:=TJpegImage.Create;

 

Picture.LoadFromFile(Texture);

Bitmap.Assign(Picture);

with BMinfo.bmiHeader do begin

   FillChar (BMInfo, SizeOf(BMInfo), 0);

   biSize := sizeof (TBitmapInfoHeader);

   biBitCount := 24;

   biWidth := Picture.Width;

   biHeight := Picture.Height;

   ImageSize := biWidth * biHeight;

   biPlanes := 1;

   biCompression := BI_RGB;

 

   MemDC := CreateCompatibleDC (0);

   GetMem (Tex, ImageSize *3);

   try

     GetDIBits (MemDC, Bitmap.Handle, 0, biHeight, Tex, BMInfo, DIB_RGB_COLORS);

     glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);

     glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER,GL_LINEAR);

     glTexImage2d(GL_TEXTURE_2D, 0, 3, biwidth, biheight, 0, GL_BGR_EXT, GL_UNSIGNED_BYTE, tex);

     For I := 0 to ImageSize - 1 do begin

         Temp := tex [I * 3];

         tex [I * 3] := tex [I * 3 + 2];

         tex [I * 3 + 2] := Temp;

     end;

    finally

     DeleteDC (MemDC);

     Bitmap.Free;

     Picture.Free;

     freemem(tex);

  end;

end;

end;

 

procedure InitGL(Width: GLsizei; Height: GLsizei);

var fWidth, fHeight: GLfloat;

begin

glClearColor(0, 0, 0, 0);

glClearDepth(1.0);

glEnable(GL_DEPTH_TEST);

glEnable(GL_TEXTURE_2D);

glMatrixMode(GL_PROJECTION);

glLoadIdentity();

 

fWidth := Width;

fHeight := Height;

gluPerspective(45.0,fWidth/fHeight,0.1,100.0);

 

glMatrixMode(GL_MODELVIEW);

 

glEnable(GL_TEXTURE_GEN_S);

glEnable(GL_TEXTURE_GEN_T);

glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);

glTexGenf(GL_S, GL_TEXTURE_GEN_MODE, GL_SPHERE_MAP);

glTexGenf(GL_T, GL_TEXTURE_GEN_MODE, GL_SPHERE_MAP);

Text:=CreateTexture('Texture.jpg');

end;

 

procedure ReSizeGLScene(Width: GLsizei; Height: GLsizei);

 

var

fWidth, fHeight: GLfloat;

 

begin

if (Height=0)

   then Height:=1;

 

glViewport(0, 0, Width, Height);

 

glMatrixMode(GL_PROJECTION);

glLoadIdentity();

 

fWidth := Width;

fHeight := Height;

gluPerspective(45.0,fWidth/fHeight,0.1,100.0);

glMatrixMode(GL_MODELVIEW);

end;

 

procedure DrawGLScene;

begin

glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);

glLoadIdentity();

glTranslatef(0,0,-5);

glPushMatrix;

  glRotatef(xrot,1,0,0);

  glRotatef(yrot,0,1,0);

  glBindTexture(GL_TEXTURE_2D,text);

   Teapot(14, radius, GL_FILL);

glPopMatrix;

 

xrot := xrot + xspeed;

yrot := yrot + yspeed;

end;

 

function WndProc(hWnd: HWND; message: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;

var

Screen: TRECT;

PixelFormat: GLuint;

pfd: TPIXELFORMATDESCRIPTOR;

begin

   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:= 16;

   cDepthBits:= 16;

   iLayerType:= PFD_MAIN_PLANE;

end;

 

Result := 0;

case (message) of

   WM_CREATE:

     begin

     h_DC := GetDC(hWnd);

     PixelFormat := ChoosePixelFormat(h_DC, @pfd);

 

     if (PixelFormat=0) then

       begin

       MessageBox(0,'Cant''t Find A Suitable PixelFormat.','Error',MB_OK or MB_ICONERROR);

       PostQuitMessage(0);

       exit;

       end;

 

     if (not SetPixelFormat(h_DC,PixelFormat,@pfd)) then

       begin

       MessageBox(0,'Can''t Set The PixelFormat.','Error',MB_OK or MB_ICONERROR);

       PostQuitMessage(0);

       exit;

       end;

 

     h_RC := wglCreateContext(h_DC);

     if (h_RC=0) then

       begin

       MessageBox(0,'Can''t Create A GL Rendering Context.','Error',MB_OK or MB_ICONERROR);

       PostQuitMessage(0);

       exit;

       end;

 

     if (not wglMakeCurrent(h_DC, h_RC)) then

       begin

       MessageBox(0,'Can''t activate GLRC.','Error',MB_OK or MB_ICONERROR);

       PostQuitMessage(0);

       exit;

       end;

 

     GetClientRect(hWnd, Screen);

     InitGL(Screen.right, Screen.bottom);

     end;

               WM_DESTROY, WM_CLOSE:

     begin

       ChangeDisplaySettings(TDEVMODE(nil^), 0);

       wglMakeCurrent(h_DC,0);

       wglDeleteContext(h_RC);

       ReleaseDC(hWnd,h_DC);

 

       PostQuitMessage(0);

     end;

       WM_KEYDOWN:

     begin

       keys[wParam] := TRUE;

     end;

       WM_KEYUP:

     begin

       keys[wParam] := FALSE;

     end;

       WM_SIZE:

     begin

       ReSizeGLScene(LOWORD(lParam),HIWORD(lParam));

     end;

   else

     begin

       Result := DefWindowProc(hWnd, message, wParam, lParam);

     exit;

     end;

   end;

end;

 

function WinMain(hInstance: HINST; hPrevInstance: HINST; lpCmdLine: PChar; nCmdShow: integer): integer; stdcall;

var

msg: TMsg;

wc: TWndClass;

h_Wnd: HWND;

dmScreenSettings: TDEVMODE;

 

begin

ZeroMemory( @wc, sizeof( wc ) );

 

wc.style := CS_HREDRAW or CS_VREDRAW or CS_OWNDC;

wc.lpfnWndProc := @WndProc;

wc.hInstance := hInstance;

wc.hCursor := LoadCursor(0, IDC_ARROW);

wc.lpszClassName := 'OpenGL WinClass';

 

if(RegisterClass(wc)=0) then

begin

   MessageBox(0,'Failed To Register The Window Class.','Error',MB_OK or MB_ICONERROR);

   Result := 0;

   exit;

end;

 

h_Wnd := CreateWindow(

   'OpenGL WinClass',

   'AlexeyGL',

   WS_POPUP or

   WS_CLIPCHILDREN or

   WS_CLIPSIBLINGS,

   0, 0,

   640, 480,

   0,

   0,

   hInstance,

   nil);

 

if (h_Wnd = 0) then

begin

   MessageBox(0,'Window Creation Error.','Error',MB_OK or MB_ICONERROR);

   Result := 0;

   exit;

end;

 

ZeroMemory( @dmScreenSettings, sizeof( TDEVMODE ) );

dmScreenSettings.dmSize := sizeof( TDEVMODE );

dmScreenSettings.dmPelsWidth  := 640;

dmScreenSettings.dmPelsHeight := 480;

dmScreenSettings.dmFields     := DM_PELSWIDTH or DM_PELSHEIGHT;

ChangeDisplaySettings(dmScreenSettings, CDS_FULLSCREEN);

 

ShowWindow(h_Wnd, SW_SHOW);

UpdateWindow(h_Wnd);

SetFocus(h_Wnd);

 

while ( true ) do

begin

while (PeekMessage(msg, 0, 0, 0, PM_NOREMOVE)) do

begin

   if (GetMessage(msg, 0, 0, 0)) then

   begin

     TranslateMessage(msg);

     DispatchMessage(msg);

   end

   else

   begin

     Result := 1;

     exit;

   end;

end;

 

DrawGLScene();

SwapBuffers(h_DC);

 

if (keys[VK_ESCAPE]) then SendMessage(h_Wnd,WM_CLOSE,0,0);

 

  if (keys[VK_PRIOR]) then Radius := Radius - 0.1;

  if (keys[VK_NEXT]) then Radius := Radius + 0.1;

  if (keys[VK_UP]) then xspeed := xspeed - 0.1;

  if (keys[VK_DOWN]) then xspeed := xspeed + 0.1;

  if (keys[VK_RIGHT]) then yspeed := yspeed + 0.1;

  if (keys[VK_LEFT]) then yspeed := yspeed - 0.1;

  if (keys[VK_SPACE]) then

end;

end;

 

begin

InitOpenGL;

Radius:=1;

WinMain( hInstance, hPrevInst, CmdLine, CmdShow );

end.