由于Delphi自带OpenGL.pas是1.0版的,而现在实际使用的至少是1.1版,Windows纯软件模拟方式也是1.1版的,所以要自己导入一些必要的函数。也可用一些开源的免费单元,如Mike Lischke的OpenGL12.pas。当然,自己写可以设计得更简洁,而且不必在过于超前完备的庞大代码中找错误。
首先引入必要的单元Windows, Messages, OpenGL
要增加一些必要的扩展。
const // GL_EXT_bgra GL_BGR_EXT = $80E0; GL_BGRA_EXT = $80E1;
// polygon offset GL_POLYGON_OFFSET_UNITS = $2A00; GL_POLYGON_OFFSET_POINT = $2A01; GL_POLYGON_OFFSET_LINE = $2A02; GL_POLYGON_OFFSET_FILL = $8037; GL_POLYGON_OFFSET_FACTOR = $8038;
procedure glBindTexture(target: GLEnum; texture: GLuint); stdcall; external opengl32; procedure glDeleteTextures(n: GLsizei; textures: PGLuint); stdcall; external opengl32; procedure glGenTextures(n: GLsizei; textures: PGLuint); stdcall; external opengl32; function glIsTexture(texture: GLuint): GLboolean; stdcall; external opengl32; procedure glPolygonOffset(factor, units: GLfloat); stdcall; external opengl32;
// 此声明用于纠正OpenGL.pas的一个bug function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; Data: Pointer): GLint; stdcall; external opengl32;
现在接口已经基本升级到1.1版。如果还需要其他扩展,可类似增加。
接下来,要创建OpenGL的绘图上下文RC,为此需要GDI窗口的设备上下文DC。TForm.Handle属性或其他TWinControl的Handle属性都是DC。可使用如下函数由DC创建RC,返回值为RC的句柄。之后即可使用OpenGL绘图。一般可在Form的OnCreate事件内使用。此函数的选项含义分别为深度缓冲区,模版缓冲区,积累缓冲区,生成Alpha通道的值。
type TRCOptions = set of (roDepth, roStencil, roAccum, roAlpha);
function CreateRC(dc: HDC; opt: TRCOptions): HGLRC; var PFDescriptor: TPixelFormatDescriptor; PixelFormat: Integer; begin FillChar(PFDescriptor, SizeOf(PFDescriptor), 0); with PFDescriptor do begin nSize := SizeOf(PFDescriptor); nVersion := 1; dwFlags := PFD_SUPPORT_OPENGL or PFD_DRAW_TO_WINDOW or PFD_DOUBLEBUFFER; iPixelType := PFD_TYPE_RGBA; cColorBits := GetDeviceCaps(DC, BITSPIXEL) * GetDeviceCaps(DC, PLANES); if roDepth in opt then cDepthBits := 24; if roStencil in opt then cStencilBits := 8; if roAccum in opt then cAccumBits := 64; iLayerType := PFD_MAIN_PLANE; end;
PixelFormat := ChoosePixelFormat(DC, @PFDescriptor); Assert(PixelFormat <> 0); Assert(SetPixelFormat(DC, PixelFormat, @PFDescriptor)); Result := wglCreateContext(DC); Assert(Result <> 0); wglMakeCurrent(dc, Result); end;
在Form的OnPaint事件里绘图。记住,绘图完成后要用SwapBuffers(dc: HDC)交换绘图缓冲和显示缓冲,这样图象才会显示出来。还要记得在Form的OnResize事件里调用 glViewport(0, 0, ClientWidth, ClientHeight); 好让RC和DC同步。
在Form的OnDestroy事件里销毁RC。
procedure DestroyRC(rc: HGLRC); begin if rc = 0 then Exit; wglMakeCurrent(0, 0); wglDeleteContext(rc); end;
至此,一个OpenGL程序的框架就大致成型。但还有问题要解决。
第一,要防止Windows擦除背景而影响速度。在Form中加入成员函数
private procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
procedure TGLWindow.WMEraseBkgnd(var Message: TWmEraseBkgnd); begin Message.Result := 1; end;
第二,为了更保险些。再增加以下成员函数。
protected procedure CreateParams(var Params: TCreateParams); override;
procedure TGLWindow.CreateParams(var Params: TCreateParams); begin inherited; with Params do begin Style := Style or WS_CLIPCHILDREN or WS_CLIPSIBLINGS; WindowClass.Style := CS_VREDRAW or CS_HREDRAW or CS_OWNDC; end; end;
好,现在就可以忘掉这些麻烦的东西了,写你的精彩3D显示吧:)
还得唠叨几句,在一个线程里不要创建多个RC,这样会严重影响性能。有些个人的OpenGL窗口控件演示有在一个Form上放多个控件,其实并非好主义。应该用一个OpenGL窗口显示多个视图。另外,不要跨线程访问OpenGL函数。
还有Windows自动安装显卡驱动时不会安装OpenGL的硬件加速,一定要自己安装显卡厂商的驱动!
另外,副赠全屏显示的函数:)
function FullScreen(win: TWinControl; width, height, bitdepth: integer): boolean; var displaymode: DEVMODE; begin FillChar(displaymode, sizeof(displaymode), 0); with displaymode do begin dmSize := sizeof(displaymode); dmPelsWidth := width; dmPelsHeight := height; dmBitsPerPel := bitdepth; dmFields := DM_BITSPERPEL or DM_PELSWIDTH or DM_PELSHEIGHT; end; if ChangeDisplaySettings(displaymode, CDS_FULLSCREEN) = DISP_CHANGE_SUCCESSFUL then begin ShowWindow(win.Handle, WS_MAXIMIZE); result := true; end else result := false; end;
procedure RestoreDisplay(win: TWinControl); begin ChangeDisplaySettings(PDEVMODE(0)^, 0); ShowWindow(win.Handle, SW_RESTORE); end;
========================================
LI Qingrui http://wrighteagle.org/appdev
[Delphi程序]NeHe的opengl教程delphi版(6)----纹理映射(贴图) [Delphi程序]NeHe的opengl教程delphi版(5)----3D [Delphi程序]NeHe的opengl教程delphi版(4)----旋转 [Delphi程序]NeHe的opengl教程delphi版(3)----着色 [Delphi程序]NeHe的opengl教程delphi版(9)----星星 [Delphi程序]NeHe的opengl教程delphi版(8)----简单的透明 [Delphi程序]NeHe的opengl教程delphi版(7)----滤波 [Delphi程序]Delphi下的OpenGL开发 [VB.NET程序]OpenGL 入门教程 - 准备好OpenGL(1)
|