程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> Delphi版OpenGL樣例代碼導游

Delphi版OpenGL樣例代碼導游

編輯:Delphi

  由於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;

  1. 上一頁:
  2. 下一頁:
Copyright © 程式師世界 All Rights Reserved