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

// К заголовку 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

.

Другое по теме:

• Записать содержимое окна OpenGL в BMP файл
• Каким обpазом выбиpать pазмеp шpифта
• Получение OpenGL расширений