OpenGL – радиальное размытие
01.01.2007
// К заголовку 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.
Взято с https://delphiworld.narod.ru