Delphi版OpenGL樣例代碼導(dǎo)游

2019-11-18 18:40:19

字體：大中小

供稿：網(wǎng)友

由于Delphi自帶OpenGL.pas是1.0版的，而現(xiàn)在實(shí)際使用的至少是1.1版，Windows純軟件模擬方式也是1.1版的，所以要自己導(dǎo)入一些必要的函數(shù)。也可用一些開源的免費(fèi)單元，如Mike Lischke的OpenGL12.pas。當(dāng)然，自己寫可以設(shè)計(jì)得更簡(jiǎn)潔，而且不必在過于超前完備的龐大代碼中找錯(cuò)誤。

首先引入必要的單元Windows, Messages, OpenGL

要增加一些必要的擴(kuò)展。

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的一個(gè)bug
function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; Data: Pointer): GLint; stdcall; external opengl32;

現(xiàn)在接口已經(jīng)基本升級(jí)到1.1版。如果還需要其他擴(kuò)展，可類似增加。

接下來，要?jiǎng)?chuàng)建OpenGL的繪圖上下文RC，為此需要GDI窗口的設(shè)備上下文DC。TForm.Handle屬性或其他TWinControl的Handle屬性都是DC?？墒褂萌缦潞瘮?shù)由DC創(chuàng)建RC，返回值為RC的句柄。之后即可使用OpenGL繪圖。一般可在Form的OnCreate事件內(nèi)使用。此函數(shù)的選項(xiàng)含義分別為深度緩沖區(qū)，模版緩沖區(qū)，積累緩沖區(qū)，生成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)交換繪圖緩沖和顯示緩沖，這樣圖象才會(huì)顯示出來。還要記得在Form的OnResize事件里調(diào)用 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;

至此，一個(gè)OpenGL程序的框架就大致成型。但還有問題要解決。

第一，要防止Windows擦除背景而影響速度。在Form中加入成員函數(shù)

private
procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;

procedure TGLWindow.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
Message.Result := 1;
end;

第二，為了更保險(xiǎn)些。再增加以下成員函數(shù)。

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;

好，現(xiàn)在就可以忘掉這些麻煩的東西了，寫你的精彩3D顯示吧：）

還得嘮叨幾句，在一個(gè)線程里不要?jiǎng)?chuàng)建多個(gè)RC，這樣會(huì)嚴(yán)重影響性能。有些個(gè)人的OpenGL窗口控件演示有在一個(gè)Form上放多個(gè)控件，其實(shí)并非好主義。應(yīng)該用一個(gè)OpenGL窗口顯示多個(gè)視圖。另外，不要跨線程訪問OpenGL函數(shù)。

還有Windows自動(dòng)安裝顯卡驅(qū)動(dòng)時(shí)不會(huì)安裝OpenGL的硬件加速，一定要自己安裝顯卡廠商的驅(qū)動(dòng)！

另外，副贈(zèng)全屏顯示的函數(shù)：）

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;