opengl+delphi 鼠标拾取

opengl+delphi 鼠标拾取

//------------------------------------------------------------------------
//
// OBJECT PICKING TUTORIAL
// Author: Ben Humphrey -
// Delphi Converter: David "DavesLord" Caouette -
// OpenGL Template Author: Jan Horn - http://www.sulaco.co.za
//
//------------------------------------------------------------------------
program OpenGLApp;

uses
Windows,
Messages,
OpenGL,
Textures;

const
WND_TITLE = 'OpenGL App by Jan Horn';
FPS_TIMER = 1; // Timer to calculate FPS
FPS_INTERVAL = 1000; // Calculate FPS every 1000 ms

SUN = 100;// This is the object ID for the SUN
EARTH = 101;// This is the object ID for the EARTH
PLUTO= 102;// This is the object ID for PLUTO

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 : cardinal; // Elapsed time between frames

// Textures
SunTex : glUInt;
EarthTex: glUInt;
PlutoTex: glUInt;

// User variables
pObj: GLUQuadricObj;
SunRotation : single = 90;// This holds our sun's current rotation
EarthRotation : single = 90;// This holds our earth's current rotation
PlutoRotation : single = 90;// This holds pluto's current rotation
g_Fullscreen: boolean;

{$R *.RES}

procedure glBindTexture(target: GLenum; texture: GLuint); stdcall; external opengl32;

{------------------------------------------------------------------}
{ Function to convert int to string. (No sysutils = smaller EXE) }
{------------------------------------------------------------------}
function IntToStr(Num : Integer) : String; // using SysUtils increase file size by 100K
begin
Str(Num, result);
end;


{------------------------------------------------------------------}
{ Function to draw the actual scene }
{------------------------------------------------------------------}
procedure glDraw();
begin
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);// Clear The Screen And The Depth Buffer
glLoadIdentity();// Reset The matrix

// We make our position a bit high and back to view the whole scene

// Position View Up Vector
gluLookAt(0, 3, 6, 0, 0, 0, 0, 1, 0);// This determines where the camera's position and view is

glInitNames();// This clears the name stack so we always start with 0 names.

// This next line is important. If you don't push on at least ONE name,
// The selection won'
t work. Instead of glLoadName()/glEnd() you can use
// glPushName(TheID) and glPopName(); Then you don't need to glPushName(0);

glPushName

opengl+delphi 鼠标拾取

(0);// This starts off the first object in the stack

pObj := gluNewQuadric();// Get a new Quadric off the stack

gluQuadricTexture(pObj, true);// This turns on texture coordinates for our Quadrics

// Bind the sun texture to the sun quadratic
glBindTexture(GL_TEXTURE_2D, SunTex);// Bind the Sun texture to the sun

// Below we call glLoadName(). We need to pass in an ID that we can check later that will
// be associated with the polygons drawn next. Here is how it works. We call glLoadName()
// and pass an ID. Then we draw any primitives or shapes, then we call glEnd() which
// stops assigning polys to that object name. We now have a group of polygons that are
// given an ID. Our ID SUN now refers to the sun Quadric we draw below.

glLoadName(SUN);// Push on our SUN label (IMPORTANT)

// If we use glLoadName(), then we need to end it with glEnd(). There is a problem
// though with some video cards that MUST have a glBegin()/glEnd() between
// the calls to glLoadName()/glEnd(). This is strange but some cards grind
// to a 2 FPS speed (VoodooCards). Since we are using Quadrics there is
// no glBegin()/glEnd() being called explicitly, so we need to fake it.
// *Remember, you only have to do this if you are using Quadrics.* So, to fix
// this we just put a empty glBegin()/glEnd() statement between each object ID passed in.
{glBegin(GL_LINES);
glEnd(); }

// Here we push on a new matrix so we don't affect any other quadrics.
// We first translate the quadric to the origin (0, 0, 0), Then we rotate it
// about the Y axis. This gives it the spinning effect. Then we draw the
// largest of the spheres. This represents the sun with its texture map.

glPushMatrix();// Push on a new matrix scope
glTranslatef(0, 0, 0);// Translate this sphere to the left
glRotatef(SunRotation, 0, 1.0, 0);// Rotate the sphere around the Y axis to make it spin
gluSphere(pObj, 0.5, 20, 20);// Draw the sunwith a radius of 0.5
glPopMatrix();// End the current scope of this matrix

// Now that we drew the sun, we want to end our Object name. We call glPopName()
// to do that. Now nothing else will be associated with the SUN ID.

glEnd();// Stop assigning polygons to the SUN label (IMPORTANT)

// Next, we want to bind the Earth texture to our Earth sphere
glBindTexture(GL_TEXTURE_2D, EarthTex);

// Once again, we want to create a object ID for our earth, so we push on the EARTH ID.
// Now, when we draw the next sphere, it will be associated with the EARTH ID.

glLoadName(EARTH);// Push on our EARTH label (IMPORTANT)

// Pass in our empty glBegin()/glEnd() statement because we are using Quadrics.
// If
we don't do this when using glLoadName(), it will grind to a hault on some cards.
glBegin(GL_LINES);
glEnd();

// Once again, we want to pop

opengl+delphi 鼠标拾取

on a new matrix as not to affect any other spheres.
// We rotate the sphere by its current rotation value FIRST before we translate it.
// This makes it rotate around the origin, which is where the sun is.
// Then we rotate it again about the Y-axis to make it spin around itself.

glPushMatrix();// Push on a new matrix scope
glRotatef(EarthRotation / 3, 0, 1.0, 0);// Rotate the sphere around the origin (the sun)
glTranslatef(-2, 0, 0);// Translate this sphere to the left
glRotatef(EarthRotation, 0, 1.0, 0);// Rotate the sphere to make it spin
gluSphere(pObj, 0.2, 20, 20);// Draw the sphere with a radius of 0.2 so it's smaller than the sun
glPopMatrix();// End the current scope of this matrix

// We are done assigning the EARTH object, so we need
// to stop assigning polygons to the current ID.

glEnd();// Stop assigning polygons to the EARTH label (IMPORTANT)

// Bind the pluto texture to the last sphere
glBindTexture(GL_TEXTURE_2D, PlutoTex);

// Finally, we want to be able to click on Pluto, so we need a pluto ID.

glLoadName(PLUTO);// Push on our PLUTO label (IMPORTANT)

// Like we did with the earth, we rotate Pluto around the sun first,
// then we translate it farther away from the sun. Next, we rotate Pluto
// around the Y axis to give it some spin.

// Pass in our empty glBegin()/glEnd() statement because we are using Quadrics.
// If we don't do this when using glLoadName(), it will grind to a hault on some cards.
glBegin(GL_LINES);
glEnd();

glPushMatrix();// Push on a new matrix scope
glRotatef(PlutoRotation / 2, 0, 1.0, 0);// Rotate the sphere around the sun
glTranslatef(3, 0, 0);// Translate this sphere farther away from the sun than the earth
glRotatef(PlutoRotation, 0, 1.0, 0);// Rotate the sphere around itself to produce the spin
gluSphere(pObj, 0.1, 20, 20);// Draw the sphere with a radius of 0.1 (smallest planet)
glPopMatrix();// End the current scope of this matrix

// We are finished with the PLUTO object ID, so we need to pop it off the name stack.
glEnd();// Stop assigning polygons to our PLUTO label (IMPORTANT)

//SwapBuffers(h_DC);// Swap the backbuffers to the foreground

gluDeleteQuadric(pObj);// Free the Quadric

glPopName();// We pushed a name on the stack, we must pop it back off

// Below we increase the rotations for each sphere.

SunRotation := SunRotation + 0.2;// Rotate the sun slowly
EarthRotation := EarthRotation + 0.5;// Increase the rotation for the each
PlutoRotation := PlutoRotation + 0.6;// Make pluto go the fastest
end;

function RetrieveObjectID(x, y: integer): intege
r;
var
objectsFound: integer;
viewportCoords: array [0..3] of integer;
selectBuffer: array[0..31] of cardinal;
lowestDepth: cardinal;
sele

opengl+delphi 鼠标拾取

ctedObject: cardinal;
i: integer;
begin
objectsFound := 0;// This will hold the amount of objects clicked
ZeroMemory(@viewportCoords, sizeof(viewportCoords));// We need an array to hold our view port coordinates
ZeroMemory(@selectBuffer, sizeof(selectBuffer));
// This will hold the ID's of the objects we click on.
// We make it an arbitrary number of 32 because openGL also stores other information
// that we don't care about. There is about 4 slots of info for every object ID taken up.

// glSelectBuffer is what we register our selection buffer with. The first parameter
// is the size of our array. The next parameter is the buffer to store the information found.
// More information on the information that will be stored in selectBuffer is further below.

glSelectBuffer(32, @selectBuffer);// Setup our selection buffer to accept object ID's

// This function returns information about many things in OpenGL. We pass in GL_VIEWPORT
// to get the view port coordinates. It saves it like a RECT with {top, left, bottom, right}

glGetIntegerv(GL_VIEWPORT, @viewportCoords);// Get the current view port coordinates

// Now we want to get out of our GL_MODELVIEW matrix and start effecting our
// GL_PROJECTION matrix. This allows us to check our X and Y coords against 3D space.

glMatrixMode(GL_PROJECTION);// We want to now effect our projection matrix

glPushMatrix();// We push on a new matrix so we don't effect our 3D projection

// This makes it so it doesn't change the frame buffer if we render into it, instead,
// a record of the names of primitives that would have been drawn if the render mode was
// GL_RENDER are now stored in the selection array (selectBuffer).

glRenderMode(GL_SELECT);// Allows us to render the objects, but not change the frame buffer

glLoadIdentity();// Reset our projection matrix

// gluPickMatrix allows us to create a projection matrix that is around our
// cursor. This basically only allows rendering in the region that we specify.
// If an object is rendered into that region, then it saves that objects ID for us (The magic).
// The first 2 parameters are the X and Y position to start from, then the next 2
// are the width and height of the region from the starting point. The last parameter is
// of course our view port coordinates. You will notice we subtract "y" from the
// BOTTOM view port coordinate. We do this to flip the Y coordinates around. The 0 y
// coordinate starts from the bottom, which is opposite to window's coordinates.
// We also give a 2 by 2 region to look for an object in. This can be changed to preference.
//-Integer(not g_Fullscreen)*(GetSystemMetrics(SM_CYCAPTION)+ GetSystemMetrics(SM_C
YSIZEFRAME) shl 1)
gluPickMatrix(x, viewportCoords[3]-y-Integer(not g_Fullscreen)*(GetSystemMetrics(SM_CYCAPTION)+ GetSystemMetrics(SM_CYSIZEFR

opengl+delphi 鼠标拾取

AME) shl 1), 2, 2, @viewportCoords);

// Next, we just call our normal gluPerspective() function, exactly as we did on startup.
// This is to multiply the perspective matrix by the pick matrix we created up above.

gluPerspective(45.0, viewportCoords[2]/viewportCoords[3], 0.5, 150.0);

glMatrixMode(GL_MODELVIEW);// Go back into our model view matrix

glDraw();// Now we render into our selective mode to pinpoint clicked objects

// If we return to our normal render mode from select mode, glRenderMode returns
// the number of objects that were found in our specified region (specified in gluPickMatrix())

objectsFound := glRenderMode(GL_RENDER);// Return to render mode and get the number of objects found

glMatrixMode(GL_PROJECTION);// Put our projection matrix back to normal.
glPopMatrix();// Stop effecting our projection matrix

glMatrixMode(GL_MODELVIEW);// Go back to our normal model view matrix

// PHEW! That was some stuff confusing stuff. Now we are out of the clear and should have
// an ID of the object we clicked on. objectsFound should be at least 1 if we found an object.

if (objectsFound > 0) then
begin
// If we found more than one object, we need to check the depth values
// of all the objects found. The object with the LEAST depth value is
// the closest object that we clicked on. Depending on what you are doing,
// you might want ALL the objects that you clicked on (if some objects were
// behind the closest one), but for this tutorial we just care about the one
// in front. So, how do we get the depth value? Well, The selectionBuffer
// holds it. For every object there is 4 values. The first value is
// "the number of names in the name stack at the time of the event, followed
// by the minimum and maximum depth values of all vertices that hit since the
// previous event, then followed by the name stack contents, bottom name first." - MSDN
// The only ones we care about are the minimum depth value (the second value) and
// the object ID that was passed into glLoadName() (This is the fourth value).
// So, [0 - 3] is the first object's data, [4 - 7] is the second object's data, etc...
// Be carefull though, because if you are displaying 2D text in front, it will
// always find that as the lowest object. So make sure you disable text when
// rendering the screen for the object test. I use a flag for RenderScene().
// So, lets get the object with the lowest depth!

// Set the lowest depth to the first object to start it off.
// 1 is the first object's minimum Z value.
// We use an unsigned int so we don't get a warning with selectBuffer below.
lowestDepth := selectBuffer[1];

// Set the selected object to the first object
to start it off.
// 3 is the first object's object ID we passed into glLoadName().
selectedObject := selectBuffer[3];

// Go through all of

opengl+delphi 鼠标拾取

the objects found, but start at the second one
for i := 1 to objectsFound - 1 do
begin
// Check if the current objects depth is lower than the current lowest
// Notice we times i by 4 (4 values for each object) and add 1 for the depth.
if (selectBuffer[(i * 4) + 1] < lowestDepth) then
begin
// Set the current lowest depth
lowestDepth := selectBuffer[(i * 4) + 1];

// Set the current object ID
selectedObject := selectBuffer[(i * 4) + 3];
end
end;

// Return the selected object
result := selectedObject;
exit;
end;

// We didn't click on any objects so return 0
result := 0;
end;


{------------------------------------------------------------------}
{ Initialise OpenGL }
{------------------------------------------------------------------}
procedure glInit();
begin
glClearColor(0.0, 0.0, 0.0, 0.0); // Black Background
glShadeModel(GL_SMOOTH); // Enables Smooth Color Shading
glClearDepth(1.0); // Depth Buffer Setup
glEnable(GL_DEPTH_TEST); // Enable Depth Buffer
glDepthFunc(GL_LESS); // The Type Of Depth Test To Do

glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST); //Realy Nice perspective calculations

glEnable(GL_TEXTURE_2D); // Enable Texture Mapping

LoadTexture('Sun.bmp', SunTex, false);// Load "Sun.bmp" into openGL as a texture for the Sun
LoadTexture('Earth.bmp', EarthTex, false);// Load "Earth.bmp" into openGL as a texture for the Earth
LoadTexture('Pluto.bmp', PlutoTex, false);// Load "Pluto.bmp" into openGL as a texture for Pluto
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, 0.5, 150.0);

glMatrixMode(GL_MODELVIEW); // Return to the modelview matrix
glLoadIdentity(); // Reset View
end;


{------------------------------------------------------------------}
{ Processes all the keystrokes }
{------------------------------------------------------------------}
procedure ProcessKeys;
begin

end;


{------------------------------------------------------------------}
{ Determines the application
e response to the messages received }
{------------------------------------------------------------------}
function WndProc(hWnd: HWND; Msg:

opengl+delphi 鼠标拾取

UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
objectID: integer;
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;
WM_KEYDOWN: // Set the pressed key (wparam) to equal true so we can check if its pressed
begin
keys[wParam] := True;
Result := 0;
end;
WM_KEYUP: // Set the released key (wparam) to equal false so we can check if its pressed
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;
WM_LBUTTONDOWN:
begin// If the left mouse button was clicked
// Here we pass in the cursors X and Y coordinates to test for an object under the mouse.
//MessageBox(Inttostr(LOWORD(lParam)))；
objectID := RetrieveObjectID(LOWORD(lParam), HIWORD(lParam));

// Now we just do a switch on our object ID's to see if we hit one.

case (objectID)of // Check the objectID passed back
SUN: MessageBox(0, 'The Sun!', 'Click', MB_OK);
EARTH: MessageBox(0, 'The Earth!', 'Click', MB_OK);
PLUTO: MessageBox(0, 'Pluto!', 'Click', MB_OK);
end;
end;
else
Result := DefWindowProc(hWnd, Msg, wParam, lParam); // Default result if nothing happens
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 f
ailed!', 'Error', MB_OK or MB_ICONERROR);
h_RC := 0;
end;

// Attemps to release the device context
if ((h_DC > 0) and (ReleaseDC(h_Wnd,

opengl+delphi 鼠标拾取

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 MB_ICONERROR);
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); //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 scre
en mode to fullscreen
if (ChangeDisplaySettings(dmScreenSettings, CDS_FULLSCREEN) = DISP_CHANGE_FAILED) then
begin
MessageBox(0, 'Unable to s

opengl+delphi 鼠标拾取

witch 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
nSize := SizeOf(TPIXELFORMATDESCRIPTOR); // Size Of This Pixel Format Descriptor
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; // S
hift count for red bitplanes
cGreenBits := 0; // Number of green bitplanes
cGreenShift := 0; //

opengl+delphi 鼠标拾取

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;


{----------------------

opengl+delphi 鼠标拾取

----------------------------------------------}
{ 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;
g_Fullscreen := false;

// Perform application initialization:
if not glCreateWnd(800, 600, g_Fullscreen, 32) then
begin
Result := 0;
Exit;
end;

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

// Main message loop:
while not finished do
begin
if (PeekMessage(msg, 0, 0, 0, PM_REMOVE)) then // Check if there is a message for this window
begin
if (msg.message = WM_QUIT) then // If WM_QUIT message received then we are done
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
ElapsedTime :=(LastTime + ElapsedTime) DIV 2; // Average it out for smoother movement

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(Bool
ean(g_Fullscreen));
Result := msg.wParam;
end;


begin
{$WARNINGS OFF}
WinMain( hInstance, 0, CmdLine, CmdShow );
{$WARNINGS ON}
end.

本文来源：https://www.bwwdw.com/article/w5v1.html