OpenGL - радиальное размытие

Previous  Top  Next

    
 

 

 

Code:

// К заголовку RadialBlur(For OpenGL)

// Данный код работает правильно только, если в пректе 0 форм ,

// а сам код введен в DPR файл!

 

program RadialBlur;

 

uses

Windows,

Messages,

OpenGL;

 

const

WND_TITLE = 'Radial Blur';

FPS_TIMER = 1; // Timer to calculate FPS

FPS_INTERVAL = 1000; // Calculate FPS every 1000 ms

 

type

TVector = array[0..2] of glFloat;

var

h_Wnd: HWND; // Global window handle

h_DC: HDC; // Global device context

h_RC: HGLRC; // OpenGL rendering context

keys: array[0..255] of Boolean; // Holds keystrokes

FPSCount: Integer = 0; // Counter for FPS

ElapsedTime: Integer; // Elapsed time between frames

 

// Textures

BlurTexture: glUint; // An Unsigned Int To Store The Texture Number

 

// User vaiables

Angle: glFloat;

Vertexes: array[0..3] of TVector;

normal: TVector;

 

// Lights and Materials

globalAmbient: array[0..3] of glFloat = (0.2, 0.2, 0.2, 1.0);

// Set Ambient Lighting To Fairly Dark Light (No Color)

Light0Pos: array[0..3] of glFloat = (0.0, 5.0, 10.0, 1.0);

// Set The Light Position

Light0Ambient: array[0..3] of glFloat = (0.2, 0.2, 0.2, 1.0);

// More Ambient Light

Light0Diffuse: array[0..3] of glFloat = (0.3, 0.3, 0.3, 1.0);

// Set The Diffuse Light A Bit Brighter

Light0Specular: array[0..3] of glFloat = (0.8, 0.8, 0.8, 1.0);

// Fairly Bright Specular Lighting

 

LmodelAmbient: array[0..3] of glFloat = (0.2, 0.2, 0.2, 1.0);

// And More Ambient Light

 

{$R *.RES}

 

procedure glBindTexture(target: GLenum; texture: GLuint);

stdcall; external opengl32;

 

procedure glGenTextures(n: GLsizei; var textures: GLuint);

stdcall; external opengl32;

 

procedure glCopyTexSubImage2D(target: GLenum; level, xoffset,

yoffset, x, y: GLint; width, height: GLsizei);

stdcall; external opengl32;

 

procedure glCopyTexImage2D(target: GLenum; level: GLint;

internalFormat: GLenum; x, y: GLint;

width, height: GLsizei; border: GLint); stdcall; external opengl32;

 

{------------------------------------------------------------------}

{ Function to convert int to string. (No sysutils = smaller EXE) }

{------------------------------------------------------------------}

// using SysUtils increase file size by 100K

 

function IntToStr(Num: Integer): string;

begin

Str(Num, result);

end;

 

function EmptyTexture: glUint;

var

txtnumber: glUint;

data: array of glUint;

pData: Pointer;

begin

// Create Storage Space For Texture Data (128x128x4)

GetMem(pData, 128 * 128 * 4);

 

glGenTextures(1, txtnumber); // Create 1 Texture

glBindTexture(GL_TEXTURE_2D, txtnumber); // Bind The Texture

glTexImage2D(GL_TEXTURE_2D, 0, 4, 128, 128, 0, GL_RGBA,

   GL_UNSIGNED_BYTE, pData);

glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);

glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);

 

result := txtNumber;

end;

 

procedure ReduceToUnit(var vector: array of glFloat);

var

length: glFLoat;

begin

// Calculates The Length Of The Vector

length := sqrt((vector[0] * vector[0]) + (vector[1] * vector[1]) +

   (vector[2] * vector[2]));

if Length = 0 then

   Length := 1;

 

vector[0] := vector[0] / length;

vector[1] := vector[1] / length;

vector[2] := vector[2] / length;

end;

 

procedure calcNormal(const v: array of TVector;

var cross: array of glFloat);

var

v1, v2: array[0..2] of glFloat;

begin

// Finds The Vector Between 2 Points By Subtracting

// The x,y,z Coordinates From One Point To Another.

 

// Calculate The Vector From Point 1 To Point 0

v1[0] := v[0][0] - v[1][0]; // Vector 1.x=Vertex[0].x-Vertex[1].x

v1[1] := v[0][1] - v[1][1]; // Vector 1.y=Vertex[0].y-Vertex[1].y

v1[2] := v[0][2] - v[1][2]; // Vector 1.z=Vertex[0].y-Vertex[1].z

// Calculate The Vector From Point 2 To Point 1

v2[0] := v[1][0] - v[2][0]; // Vector 2.x=Vertex[0].x-Vertex[1].x

v2[1] := v[1][1] - v[2][1]; // Vector 2.y=Vertex[0].y-Vertex[1].y

v2[2] := v[1][2] - v[2][2]; // Vector 2.z=Vertex[0].z-Vertex[1].z

// Compute The Cross Product To Give Us A Surface Normal

cross[0] := v1[1] * v2[2] - v1[2] * v2[1]; // Cross Product For Y - Z

cross[1] := v1[2] * v2[0] - v1[0] * v2[2]; // Cross Product For X - Z

cross[2] := v1[0] * v2[1] - v1[1] * v2[0]; // Cross Product For X - Y

 

ReduceToUnit(cross); // Normalize The Vectors

end;

 

// Draws A Helix

 

procedure ProcessHelix;

const

Twists = 5;

MaterialColor: array[1..4] of glFloat = (0.4, 0.2, 0.8, 1.0);

Specular: array[1..4] of glFloat = (1, 1, 1, 1);

var

x, y, z: glFLoat;

phi, theta: Integer;

r, u, v: glFLoat;

begin

glLoadIdentity(); // Reset The Modelview Matrix

// Eye Position (0,5,50) Center Of Scene (0,0,0), Up On Y Axis

gluLookAt(0, 5, 50, 0, 0, 0, 0, 1, 0);

 

glPushMatrix(); // Push The Modelview Matrix

glTranslatef(0, 0, -50); // Translate 50 Units Into The Screen

glRotatef(angle / 2.0, 1, 0, 0); // Rotate By angle/2 On The X-Axis

glRotatef(angle / 3.0, 0, 1, 0); // Rotate By angle/3 On The Y-Axis

 

glMaterialfv(GL_FRONT_AND_BACK, GL_AMBIENT_AND_DIFFUSE, @MaterialColor);

glMaterialfv(GL_FRONT_AND_BACK, GL_SPECULAR, @specular);

 

r := 1.5; // Radius

 

glBegin(GL_QUADS); // Begin Drawing Quads

phi := 0;

while phi < 360 do

begin

   theta := 0;

   while theta < 360 * twists do

   begin

     v := phi / 180 * pi; // Calculate Angle Of First Point ( 0 )

     u := theta / 180.0 * pi; // Calculate Angle Of First Point ( 0 )

 

     x := cos(u) * (2 + cos(v)) * r; // Calculate x Position (1st Point)

     y := sin(u) * (2 + cos(v)) * r; // Calculate y Position (1st Point)

     z := (u - (2 * pi) + sin(v)) * r; // Calculate z Position (1st Point)

 

     vertexes[0][0] := x; // Set x Value Of First Vertex

     vertexes[0][1] := y; // Set y Value Of First Vertex

     vertexes[0][2] := z; // Set z Value Of First Vertex

 

     v := (phi / 180 * pi); // Calculate Angle Of Second Point ( 0 )

     u := ((theta + 20) / 180 * pi); // Calculate Angle Of Second Point ( 20 )

 

     x := cos(u) * (2 + cos(v)) * r; // Calculate x Position (2nd Point)

     y := sin(u) * (2 + cos(v)) * r; // Calculate y Positio

     z := (u - (2 * pi) + sin(v)) * r; // Calculate z Position (2nd Point)

 

     vertexes[1][0] := x; // Set x Value Of Second Vertex

     vertexes[1][1] := y; // Set y Value Of Second Vertex

     vertexes[1][2] := z; // Set z Value Of Second Vertex

 

     v := (phi + 20) / 180 * pi; // Calculate Angle Of Third Point ( 20 )

     u := (theta + 20) / 180 * pi; // Calculate Angle Of Third Point ( 20 )

 

     x := cos(u) * (2 + cos(v)) * r; // Calculate x Position (3rd Point)

     y := sin(u) * (2 + cos(v)) * r; // Calculate y Position (3rd Point)

     z := (u - (2 * pi) + sin(v)) * r; // Calculate z Position (3rd Point)

 

     vertexes[2][0] := x; // Set x Value Of Third Vertex

     vertexes[2][1] := y; // Set y Value Of Third Vertex

     vertexes[2][2] := z; // Set z Value Of Third Vertex

 

     v := (phi + 20) / 180 * pi; // Calculate Angle Of Fourth Point ( 20 )

     u := theta / 180 * pi; // Calculate Angle Of Fourth Point ( 0 )

 

     x := cos(u) * (2 + cos(v)) * r; // Calculate x Position (4th Point)

     y := sin(u) * (2 + cos(v)) * r; // Calculate y Position (4th Point)

     z := (u - (2 * pi) + sin(v)) * r; // Calculate z Position (4th Point)

 

     vertexes[3][0] := x; // Set x Value Of Fourth Vertex

     vertexes[3][1] := y; // Set y Value Of Fourth Vertex

     vertexes[3][2] := z; // Set z Value Of Fourth Vertex

 

     calcNormal(vertexes, normal); // Calculate The Quad Normal

 

     glNormal3f(normal[0], normal[1], normal[2]); // Set The Normal

 

     // Render The Quad

     glVertex3f(vertexes[0][0], vertexes[0][1], vertexes[0][2]);

     glVertex3f(vertexes[1][0], vertexes[1][1], vertexes[1][2]);

     glVertex3f(vertexes[2][0], vertexes[2][1], vertexes[2][2]);

     glVertex3f(vertexes[3][0], vertexes[3][1], vertexes[3][2]);

     theta := theta + 20;

   end;

   phi := phi + 20;

end;

glEnd(); // Done Rendering Quads

glPopMatrix(); // Pop The Matrix

end;

 

// Set Up An Ortho View

 

procedure ViewOrtho;

begin

glMatrixMode(GL_PROJECTION); // Select Projection

glPushMatrix(); // Push The Matrix

glLoadIdentity(); // Reset The Matrix

glOrtho(0, 640, 480, 0, -1, 1); // Select Ortho Mode (640x480)

glMatrixMode(GL_MODELVIEW); // Select Modelview Matrix

glPushMatrix(); // Push The Matrix

glLoadIdentity(); // Reset The Matrix

end;

 

// Set Up A Perspective View

 

procedure ViewPerspective;

begin

glMatrixMode(GL_PROJECTION); // Select Projection

glPopMatrix(); // Pop The Matrix

glMatrixMode(GL_MODELVIEW); // Select Modelview

glPopMatrix(); // Pop The Matrix

end;

 

// Renders To A Texture

 

procedure RenderToTexture;

begin

glViewport(0, 0, 128, 128); // Set Our Viewport (Match Texture Size)

ProcessHelix(); // Render The Helix

glBindTexture(GL_TEXTURE_2D, BlurTexture); // Bind To The Blur Texture

 

// Copy Our ViewPort To The Blur Texture (From 0,0 To 128,128... No Border)

glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_LUMINANCE, 0, 0, 128, 128, 0);

glClearColor(0.0, 0.0, 0.5, 0.5); // Set The Clear Color To Medium Blue

// Clear The Screen And Depth Buffer

glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);

glViewport(0, 0, 640, 480); // Set Viewport (0,0 to 640x480)

end;

 

// Draw The Blurred Image

 

procedure DrawBlur(const times: Integer; const inc: glFloat);

var

spost, alpha, alphainc: glFloat;

I: Integer;

begin

alpha := 0.2;

 

glEnable(GL_TEXTURE_2D); // Enable 2D Texture Mapping

glDisable(GL_DEPTH_TEST); // Disable Depth Testing

glBlendFunc(GL_SRC_ALPHA, GL_ONE); // Set Blending Mode

glEnable(GL_BLEND); // Enable Blending

glBindTexture(GL_TEXTURE_2D, BlurTexture); // Bind To The Blur Texture

ViewOrtho(); // Switch To An Ortho View

 

alphainc := alpha / times; // alphainc=0.2f / Times To Render Blur

 

glBegin(GL_QUADS); // Begin Drawing Quads

// Number Of Times To Render Blur

for I := 0 to times - 1 do

begin

   glColor4f(1.0, 1.0, 1.0, alpha); // Set The Alpha Value (Starts At 0.2)

   glTexCoord2f(0 + spost, 1 - spost); // Texture Coordinate ( 0, 1 )

   glVertex2f(0, 0); // First Vertex ( 0, 0 )

 

   glTexCoord2f(0 + spost, 0 + spost); // Texture Coordinate ( 0, 0 )

   glVertex2f(0, 480); // Second Vertex ( 0, 480 )

 

   glTexCoord2f(1 - spost, 0 + spost); // Texture Coordinate ( 1, 0 )

   glVertex2f(640, 480); // Third Vertex ( 640, 480 )

 

   glTexCoord2f(1 - spost, 1 - spost); // Texture Coordinate ( 1, 1 )

   glVertex2f(640, 0); // Fourth Vertex ( 640, 0 )

 

   // Gradually Increase spost (Zooming Closer To Texture Center)

   spost := spost + inc;

   // Gradually Decrease alpha (Gradually Fading Image Out)

   alpha := alpha - alphainc;

end;

glEnd(); // Done Drawing Quads

 

ViewPerspective(); // Switch To A Perspective View

 

glEnable(GL_DEPTH_TEST); // Enable Depth Testing

glDisable(GL_TEXTURE_2D); // Disable 2D Texture Mapping

glDisable(GL_BLEND); // Disable Blending

glBindTexture(GL_TEXTURE_2D, 0); // Unbind The Blur Texture

end;

 

{------------------------------------------------------------------}

{ Function to draw the actual scene }

{------------------------------------------------------------------}

 

procedure glDraw();

begin

// Clear The Screen And The Depth Buffer

glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);

glLoadIdentity(); // Reset The View

RenderToTexture; // Render To A Texture

ProcessHelix; // Draw Our Helix

DrawBlur(25, 0.02); // Draw The Blur Effect

 

angle := ElapsedTime / 5; // Update angle Based On The Clock

end;

 

{------------------------------------------------------------------}

{ Initialise OpenGL }

{------------------------------------------------------------------}

 

procedure glInit();

begin

glClearColor(0.0, 0.0, 0.0, 0.5); // Black Background

glShadeModel(GL_SMOOTH); // Enables Smooth Color Shading

glClearDepth(1.0); // Depth Buffer Setup

glDepthFunc(GL_LESS); // The Type Of Depth Test To Do

 

glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST);

file:

//Realy Nice perspective calculations

 

glEnable(GL_DEPTH_TEST); // Enable Depth Buffer

glEnable(GL_TEXTURE_2D); // Enable Texture Mapping

 

// Set The Ambient Light Model

glLightModelfv(GL_LIGHT_MODEL_AMBIENT, @LmodelAmbient);

 

// Set The Global Ambient Light Model

glLightModelfv(GL_LIGHT_MODEL_AMBIENT, @GlobalAmbient);

glLightfv(GL_LIGHT0, GL_POSITION, @light0Pos); // Set The Lights Position

glLightfv(GL_LIGHT0, GL_AMBIENT, @light0Ambient); // Set The Ambient Light

glLightfv(GL_LIGHT0, GL_DIFFUSE, @light0Diffuse); // Set The Diffuse Light

// Set Up Specular Lighting

glLightfv(GL_LIGHT0, GL_SPECULAR, @light0Specular);

glEnable(GL_LIGHTING); // Enable Lighting

glEnable(GL_LIGHT0); // Enable Light0

 

BlurTexture := EmptyTexture(); // Create Our Empty Texture

glShadeModel(GL_SMOOTH); // Select Smooth Shading

glMateriali(GL_FRONT, GL_SHININESS, 128);

end;

 

{------------------------------------------------------------------}

{ Handle window resize }

{------------------------------------------------------------------}

 

procedure glResizeWnd(Width, Height: Integer);

begin

if (Height = 0) then // prevent divide by zero exception

   Height := 1;

glViewport(0, 0, Width, Height); // Set the viewport for the OpenGL window

glMatrixMode(GL_PROJECTION); // Change Matrix Mode to Projection

glLoadIdentity(); // Reset View

gluPerspective(45.0, Width / Height, 2.0, 200.0);

// Do the perspective calculations. Last value = max clipping depth

 

glMatrixMode(GL_MODELVIEW); // Return to the modelview matrix

glLoadIdentity(); // Reset View

end;

 

{------------------------------------------------------------------}

{ Processes all the keystrokes }

{------------------------------------------------------------------}

 

procedure ProcessKeys;

begin

end;

 

{------------------------------------------------------------------}

{ Determines the application's response to the messages received }

{------------------------------------------------------------------}

 

function WndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM):

LRESULT; stdcall;

begin

case (Msg) of

   WM_CREATE:

     begin

       // Insert stuff you want executed when the program starts

     end;

   WM_CLOSE:

     begin

       PostQuitMessage(0);

       Result := 0

     end;

   // Set the pressed key (wparam) to equal true so we can check if its pressed

   WM_KEYDOWN:

     begin

       keys[wParam] := True;

       Result := 0;

     end;

   // Set the released key (wparam) to equal false so we can check if its pressed

   WM_KEYUP:

     begin

       keys[wParam] := False;

       Result := 0;

     end;

   WM_SIZE: // Resize the window with the new width and height

     begin

       glResizeWnd(LOWORD(lParam), HIWORD(lParam));

       Result := 0;

     end;

   WM_TIMER: // Add code here for all timers to be used.

     begin

       if wParam = FPS_TIMER then

       begin

         FPSCount := Round(FPSCount * 1000 / FPS_INTERVAL);

         // calculate to get per Second incase intercal is

         // less or greater than 1 second

         SetWindowText(h_Wnd, PChar(WND_TITLE + ' [' + intToStr(FPSCount)

           + ' FPS]'));

         FPSCount := 0;

         Result := 0;

       end;

     end;

else

   // Default result if nothing happens

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

end;

end;

 

{---------------------------------------------------------------------}

{ Properly destroys the window created at startup (no memory leaks) }

{---------------------------------------------------------------------}

 

procedure glKillWnd(Fullscreen: Boolean);

begin

if Fullscreen then // Change back to non fullscreen

begin

   ChangeDisplaySettings(devmode(nil^), 0);

   ShowCursor(True);

end;

 

// Makes current rendering context not current, and releases the device

// context that is used by the rendering context.

if (not wglMakeCurrent(h_DC, 0)) then

   MessageBox(0, 'Release of DC and RC failed!', 'Error',

     MB_OK or MB_ICONERROR);

 

// Attempts to delete the rendering context

if (not wglDeleteContext(h_RC)) then

begin

   MessageBox(0, 'Release of rendering context failed!', 'Error',

     MB_OK or MB_ICONERROR);

   h_RC := 0;

end;

 

// Attemps to release the device context

if ((h_DC = 1) and (ReleaseDC(h_Wnd, h_DC) < > 0)) then

begin

   MessageBox(0, 'Release of device context failed!', 'Error',

     MB_OK or MB_ICONERROR);

   h_DC := 0;

end;

 

// Attempts to destroy the window

if ((h_Wnd < > 0) and (not DestroyWindow(h_Wnd))) then

begin

   MessageBox(0, 'Unable to destroy window!', 'Error', MB_OK or

     h_Wnd := 0;

end;

 

// Attempts to unregister the window class

if (not UnRegisterClass('OpenGL', hInstance)) then

begin

   MessageBox(0, 'Unable to unregister window class!', 'Error',

     MB_OK or MB_ICONERROR);

   hInstance := 0;

end;

end;

 

{--------------------------------------------------------------------}

{ Creates the window and attaches a OpenGL rendering context to it }

{--------------------------------------------------------------------}

 

function glCreateWnd(Width, Height: Integer; Fullscreen: Boolean;

PixelDepth: Integer): Boolean;

var

wndClass: TWndClass; // Window class

dwStyle: DWORD; // Window styles

dwExStyle: DWORD; // Extended window styles

dmScreenSettings: DEVMODE; // Screen settings (fullscreen, etc...)

PixelFormat: GLuint; // Settings for the OpenGL rendering

h_Instance: HINST; // Current instance

pfd: TPIXELFORMATDESCRIPTOR; // Settings for the OpenGL window

begin

h_Instance := GetModuleHandle(nil);

file: //Grab An Instance For Our Window

ZeroMemory(@wndClass, SizeOf(wndClass)); // Clear the window class structure

 

with wndClass do // Set up the window class

begin

   style := CS_HREDRAW or // Redraws entire window if length changes

   CS_VREDRAW or // Redraws entire window if height changes

   CS_OWNDC; // Unique device context for the window

   lpfnWndProc := @WndProc; // Set the window procedure to our func WndProc

   hInstance := h_Instance;

   hCursor := LoadCursor(0, IDC_ARROW);

   lpszClassName := 'OpenGL';

end;

 

if (RegisterClass(wndClass) = 0) then // Attemp to register the window class

begin

   MessageBox(0, 'Failed to register the window class!', 'Error',

     MB_OK or MB_ICONERROR);

   Result := False;

   Exit

end;

 

// Change to fullscreen if so desired

if Fullscreen then

begin

   ZeroMemory(@dmScreenSettings, SizeOf(dmScreenSettings));

   with dmScreenSettings do

   begin // Set parameters for the screen setting

     dmSize := SizeOf(dmScreenSettings);

     dmPelsWidth := Width; // Window width

     dmPelsHeight := Height; // Window height

     dmBitsPerPel := PixelDepth; // Window color depth

     dmFields := DM_PELSWIDTH or DM_PELSHEIGHT or DM_BITSPERPEL;

   end;

 

   // Try to change screen mode to fullscreen

   if (ChangeDisplaySettings(dmScreenSettings, CDS_FULLSCREEN) =

     DISP_CHANGE_FAILED) then

   begin

     MessageBox(0, 'Unable to switch to fullscreen!', 'Error',

       MB_OK or MB_ICONERROR);

     Fullscreen := False;

   end;

end;

 

// If we are still in fullscreen then

if (Fullscreen) then

begin

   dwStyle := WS_POPUP or // Creates a popup window

   WS_CLIPCHILDREN // Doesn't draw within child windows

   or WS_CLIPSIBLINGS; // Doesn't draw within sibling windows

   dwExStyle := WS_EX_APPWINDOW; // Top level window

   ShowCursor(False); // Turn of the cursor (gets in the way)

end

else

begin

   dwStyle := WS_OVERLAPPEDWINDOW or // Creates an overlapping window

   WS_CLIPCHILDREN or // Doesn't draw within child windows

   WS_CLIPSIBLINGS; // Doesn't draw within sibling windows

   dwExStyle := WS_EX_APPWINDOW or // Top level window

   WS_EX_WINDOWEDGE; // Border with a raised edge

end;

 

// Attempt to create the actual window

h_Wnd := CreateWindowEx(dwExStyle, // Extended window styles

   'OpenGL', // Class name

   WND_TITLE, // Window title (caption)

   dwStyle, // Window styles

   0, 0, // Window position

   Width, Height, // Size of window

   0, // No parent window

   0, // No menu

   h_Instance, // Instance

   nil); // Pass nothing to WM_CREATE

if h_Wnd = 0 then

begin

   glKillWnd(Fullscreen); // Undo all the settings we've changed

   MessageBox(0, 'Unable to create window!', 'Error', MB_OK or MB_ICONERROR);

   Result := False;

   Exit;

end;

 

// Try to get a device context

h_DC := GetDC(h_Wnd);

if (h_DC = 0) then

begin

   glKillWnd(Fullscreen);

   MessageBox(0, 'Unable to get a device context!', 'Error',

     MB_OK or MB_ICONERROR);

   Result := False;

   Exit;

end;

 

// Settings for the OpenGL window

with pfd do

begin

   // Size Of This Pixel Format Descriptor

   nSize := SizeOf(TPIXELFORMATDESCRIPTOR);

   nVersion := 1; // The version of this data structure

   dwFlags := PFD_DRAW_TO_WINDOW // Buffer supports drawing to window

   or PFD_SUPPORT_OPENGL // Buffer supports OpenGL drawing

   or PFD_DOUBLEBUFFER; // Supports double buffering

   iPixelType := PFD_TYPE_RGBA; // RGBA color format

   cColorBits := PixelDepth; // OpenGL color depth

   cRedBits := 0; // Number of red bitplanes

   cRedShift := 0; // Shift count for red bitplanes

   cGreenBits := 0; // Number of green bitplanes

   cGreenShift := 0; // Shift count for green bitplanes

   cBlueBits := 0; // Number of blue bitplanes

   cBlueShift := 0; // Shift count for blue bitplanes

   cAlphaBits := 0; // Not supported

   cAlphaShift := 0; // Not supported

   cAccumBits := 0; // No accumulation buffer

   cAccumRedBits := 0; // Number of red bits in a-buffer

   cAccumGreenBits := 0; // Number of green bits in a-buffer

   cAccumBlueBits := 0; // Number of blue bits in a-buffer

   cAccumAlphaBits := 0; // Number of alpha bits in a-buffer

   cDepthBits := 16; // Specifies the depth of the depth buffer

   cStencilBits := 0; // Turn off stencil buffer

   cAuxBuffers := 0; // Not supported

   iLayerType := PFD_MAIN_PLANE; // Ignored

   bReserved := 0; // Number of overlay and underlay planes

   dwLayerMask := 0; // Ignored

   dwVisibleMask := 0; // Transparent color of underlay plane

   dwDamageMask := 0; // Ignored

end;

 

// Attempts to find the pixel format supported by a device context that

// is the best match to a given pixel format specification.

PixelFormat := ChoosePixelFormat(h_DC, @pfd);

if (PixelFormat = 0) then

begin

   glKillWnd(Fullscreen);

   MessageBox(0, 'Unable to find a suitable pixel format', 'Error',

     MB_OK or MB_ICONERROR);

   Result := False;

   Exit;

end;

 

// Sets the specified device context's pixel format to the format

// specified by the PixelFormat.

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

begin

   glKillWnd(Fullscreen);

   MessageBox(0, 'Unable to set the pixel format', 'Error',

     MB_OK or MB_ICONERROR);

   Result := False;

   Exit;

end;

 

// Create a OpenGL rendering context

h_RC := wglCreateContext(h_DC);

if (h_RC = 0) then

begin

   glKillWnd(Fullscreen);

   MessageBox(0, 'Unable to create an OpenGL rendering context',

     'Error', MB_OK or MB_ICONERROR);

   Result := False;

   Exit;

end;

 

// Makes the specified OpenGL rendering context the calling

// thread's current rendering context

if (not wglMakeCurrent(h_DC, h_RC)) then

begin

   glKillWnd(Fullscreen);

   MessageBox(0, 'Unable to activate OpenGL rendering context', 'Error',

     MB_OK or MB_ICONERROR);

   Result := False;

   Exit;

end;

 

// Initializes the timer used to calculate the FPS

SetTimer(h_Wnd, FPS_TIMER, FPS_INTERVAL, nil);

 

// Settings to ensure that the window is the topmost window

ShowWindow(h_Wnd, SW_SHOW);

SetForegroundWindow(h_Wnd);

SetFocus(h_Wnd);

 

// Ensure the OpenGL window is resized properly

glResizeWnd(Width, Height);

glInit();

 

Result := True;

end;

 

{--------------------------------------------------------------------}

{ Main message loop for the application }

{--------------------------------------------------------------------}

 

function WinMain(hInstance: HINST; hPrevInstance: HINST;

lpCmdLine: PChar; nCmdShow: Integer): Integer; stdcall;

var

msg: TMsg;

finished: Boolean;

DemoStart, LastTime: DWord;

begin

finished := False;

 

// Perform application initialization:

if not glCreateWnd(640, 480, FALSE, 32) then

begin

   Result := 0;

   Exit;

end;

 

DemoStart := GetTickCount(); // Get Time when demo started

 

// Main message loop:

while not finished do

begin

   // Check if there is a message for this window

   if (PeekMessage(msg, 0, 0, 0, PM_REMOVE)) then

   begin

     // If WM_QUIT message received then we are done

     if (msg.message = WM_QUIT) then

       finished := True

     else

     begin // Else translate and dispatch the message to this window

       TranslateMessage(msg);

       DispatchMessage(msg);

     end;

   end

   else

   begin

     Inc(FPSCount); // Increment FPS Counter

 

     LastTime := ElapsedTime;

     ElapsedTime := GetTickCount() - DemoStart; // Calculate Elapsed Time

     // Average it out for smoother movement

     ElapsedTime := (LastTime + ElapsedTime) div 2;

 

     glDraw(); // Draw the scene

     SwapBuffers(h_DC); // Display the scene

 

     if (keys[VK_ESCAPE]) then // If user pressed ESC then set finised TRUE

       finished := True

     else

       ProcessKeys; // Check for any other key Pressed

   end;

end;

glKillWnd(FALSE);

Result := msg.wParam;

end;

 

begin

WinMain(hInstance, hPrevInst, CmdLine, CmdShow);

end.

 

 

       

Взято с http://delphiworld.narod.ru

©Drkb::03939