const WND_TITLE = 'OpenGL Pick Demo by inRm'; BUFSIZE = 32; // Size of selection buffer. type gl1f = glfloat; gl3f = array [0..2] of glfloat; gl4f = array [0..3] of glfloat; var h_Wnd : HWND; // Global window handle h_DC : HDC; // Global device context h_RC : HGLRC; // OpenGL rendering context winW : integer=800; // window size winH : integer=600; keys : Array[0..255] of Boolean; // Holds keystrokes viewP :TviewPortArray; modeM,projM :T16DArray; // User vaiables Ldown,Rdown :boolean; hit,eye : Integer; zPos :Tpoint; x0, y0 :Integer; // mouse movement rx, ry :single; // Object position obj :array[1..2] of gl3f; //对象的空间坐标 Pos :array[1..2] of gl3f; //对象的屏幕坐标 {------------------------------------------------------------------} { Function to convert int to string. } {------------------------------------------------------------------} function IntToStr(Num : Integer) : String; begin Str(Num, result); end; function Vert( x,y,z :gl1f) :gl3f; begin result[0]:=x; result[1]:=y; result[2]:=z; end; function Point(X, Y: Integer): TPoint; begin Result.X:= X; Result.Y:= Y; end; procedure setAxisList; begin glNewList(1,GL_COMPILE); //坐标线 glColor3f(1,0.5,0.5); glLineWidth (1);//绘图直线时笔的宽度 glBegin(GL_LINE_STRIP); glColor3f(1,0,1); glVertex3f( 0,0,0); glVertex3f( 4,0,0); glColor3f(0,1,0); glVertex3f( 0,0,0); glVertex3f( 0,3,0); glColor3f(0,0,1); glVertex3f( 0,0,0); glVertex3f( 0,0,2); glEnd; glEndList; end; {------------------------------------------------------------------} { Function to draw the actual scene } {------------------------------------------------------------------} procedure glDraw( Mode :integer); var h :integer; begin glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); // Clear The Screen And The Depth Buffer glLoadIdentity(); // Reset The View glTranslatef(0,0,-eye);
glRotatef( ry, 1,0,0); glRotatef( rx, 0,0,1); glColor3f(0, 0.1, 0.6); glCallList(1); glPointSize( 6); glLineWidth(2); if mode = GL_SELECT then glLoadName(1); glBegin(GL_POINTS); glColor3f(1, 1, 0); if hit=1 then glColor3f(1, 0, 0) else glColor3f(1, 1, 0); glVertex3fv( @obj[1]); //画第一点 glEnd; if mode = GL_SELECT then glLoadName(2); glBegin(GL_POINTS); glColor3f(1, 1, 0); if hit=2 then glColor3f(1, 0, 0) else glColor3f(1, 1, 0); glVertex3fv( @obj[2]); //画第二点 glEnd; if mode = GL_SELECT then glLoadName(3); glBegin( GL_LINES); if hit=3 then glColor3f(1, 0, 0) else glColor3f(1, 0.5, 0.5); glVertex3fv( @obj[1]); glVertex3fv( @obj[2]); //连接线 glEnd; if mode = GL_SELECT then glLoadName(0); glCallList(1); //画坐标轴线 if Ldown and(hit>0) then begin //画坐标指示线 glColor3f( 0.5,0.5,0.5); glEnable( GL_LINE_STIPPLE); glLineStipple(1,$4444); if hit<3 then h:=hit else h:=1; glBegin( GL_LINE_STRIP); glVertex3fv( @obj[h]); glVertex3f( obj[h,0],obj[h,1],0); glVertex3f( obj[h,0],0,0); glVertex3f( 0,0,0); glVertex3f( 0,obj[h,1],0); glVertex3f( obj[h,0],obj[h,1],0); glEnd; glDisable( GL_LINE_STIPPLE); end; 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 glDepthFunc(GL_LESS); // The Type Of Depth Test To Do glEnable(GL_DEPTH_TEST); // Enable Depth Buffer
glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST); //Realy Nice perspective calculations glBlendFunc (GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); //控制混合方式 glEnable(GL_BLEND); //混合(透明)使能 glEnable(GL_line_smooth); glEnable(GL_POINT_SMOOTH); setAxisList; rx:= -125; ry:= -65; //视角 eye:= 10; //景深 obj[1]:=Vert(-1, 2, 0.8); obj[2]:=Vert( 2,-1,-0.5); end; {------------------------------------------------------------------} { Handle window resize } {------------------------------------------------------------------} procedure glResizeWnd(Width, Height : Integer); begin winW:= width; winH:= Height; if (Height = 0) then Height := 1; // prevent divide by zero exception 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, Width/Height, 1, 100); // Do the perspective calculations. Last value = max clipping depth
glMatrixMode(GL_MODELVIEW); // Return to the modelview matrix glLoadIdentity(); // Reset View end; {------------------------------------------------------------------} { Processes all mouse Clicks } {------------------------------------------------------------------} function doSelect(X, Y : Integer) :integer; var selectBuff : Array[0..23] of glUint; begin glGetIntegerv(GL_VIEWPORT, @viewP); // Viewport = [0, 0, width, height] glSelectBuffer(BUFSIZE, @selectBuff); glRenderMode(GL_SELECT); glInitNames; glPushName(32);
glMatrixMode(GL_PROJECTION); glPushMatrix(); glLoadIdentity(); gluPickMatrix(x, winH-y, 4, 4, viewP); // Set-up pick matrix gluPerspective(45, winW/winH, 1, 100); // Do the perspective calculations. Last value = max clipping depth glMatrixMode(GL_MODELVIEW);
glDraw( GL_SELECT);
glMatrixMode(GL_PROJECTION); glPopMatrix(); glMatrixMode(GL_MODELVIEW); if glRenderMode(GL_RENDER)>0 then result:= selectBuff[3] else result:= -1; end; //############ 获得对象的屏幕坐标 ################ function GetWinPos( h:integer) :gl3f; var wx,wy,wz :glDouble; // 屏幕坐标 begin gluProject( obj[h,0],obj[h,1],obj[h,2], modeM,projM,viewP, @wx,@wy,@wz); result:= Vert( wx,wy,wz); end; //############ 将屏幕坐标转换为空间坐标 ################ function GetObjPos( x,y,z:gl1f) :gl3f; var px,py,pz :glDouble; // 对象坐标 begin gluUnProject( x,y,z, modeM,projM,viewP, @px,@py,@pz); result:= Vert( px,py,pz); end; //============ 按下鼠标 ============= procedure MouseDown( hit, x,y : Integer); var i :integer; begin Ldown:= TRUE; if hit<=0 then exit; zPos:= point(x,y); //很奇怪，这个变量无任何用处，但在这里却不能删除，否则就会黑屏！ glGetDoublev( GL_Modelview_Matrix, @modeM); glGetDoublev(GL_Projection_Matrix, @projM); for i:= 1 to 2 do Pos[i]:= GetWinPos(i);//构件的屏幕坐标 glDraw(GL_RENDER); end; //============= 移动鼠标 ============== procedure MouseMove( hit, x,y, x0,y0 : Integer); var dx,dy, i :integer; begin dx:= x-x0; dy:= y-y0; if hit<0 then begin rx:= rx+ (x-x0)/5; ry:= ry+ (y-y0)/5; end; //改变视角 if hit<3 then obj[hit]:= GetObjPos( x, winH-y, GetWinPos( hit)[2]); //直接将构件移动到新的位置 if hit=3 then for i:= 1 to 2 do begin obj[i]:= GetObjPos( Pos[i][0]+dx,(Pos[i][1]-dy),Pos[i][2]);//将构件移动到新的位置 Pos[i]:= GetWinPos(i);//构件的屏幕坐标 end; end; {------------------------------------------------------------------} { Determines the application抯 response to the messages received } {------------------------------------------------------------------} function WndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; var x,y :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_LBUTTONDOWN: begin x0:= LoWord(lParam); y0:= HiWord(lParam); MouseDown( hit, x0,y0 ); Result := 0; end; WM_RBUTTONDOWN: begin x0:= LoWord(lParam); y0:= HiWord(lParam); Rdown:= true; Result := 0; end; WM_LBUTTONUP: begin Ldown :=FALSE; Result := 0; end; WM_RBUTTONUP: begin Rdown :=FALSE; Result := 0; end; WM_MOUSEMOVE:begin x:= LoWord(lParam); y:= HiWord(lParam); if not(Ldown or Rdown) then hit:= doSelect(x, y); //自由移动 if Ldown then MouseMove( hit, x,y, x0,y0); //拖动左键 if Rdown then begin //拖动右键 eye:= eye- (x-x0); //改变景深 if eye>80 then eye:=80; if eye<5 then eye:=5; end; x0:= x; y0:= y; SetWindowText(h_Wnd, PChar('OpenGL Pick Demo by inRm ... Object number: '+IntToStr(hit))); Result := 0; end; WM_TIMER: // Add code here for all timers to be used. 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 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 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 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+27, // 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; // 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;
// 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; begin finished := False; // Perform application initialization: if not glCreateWnd(800, 600, false, 32) then begin Result := 0; Exit; end; // 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) // If WM_QUIT message received then we are done then finished := True else begin // Else translate and dispatch the message to this window TranslateMessage(msg); DispatchMessage(msg); end; end else begin glDraw(GL_RENDER); // Draw the scene SwapBuffers(h_DC); // Display the scene if(keys[VK_ESCAPE])then finished := True; // If user pressed ESC then set finised TRUE end; end; glKillWnd(FALSE); Result := msg.wParam; end;
begin WinMain( hInstance, hPrevInst, CmdLine, CmdShow ); end.
