delphi - OpenGL 快速闪烁问题 - 现在不显示图像

标签 delphi opengl delphi-xe2 flicker

我在使用 OpenGL 时遇到了一些问题。首先，我有一个正在构建的自定义控件，它封装了 OpenGL。我遇到一个问题，它快速闪烁，就像它在“闪烁”一样。该控件太大且复杂，无法在此处发布，因此我制作了一个新的小型演示应用程序来演示和重新创建相同的场景。

现在的问题:我没有得到任何图像。在我的自定义控件中，事情会显示得很好，但由于我已经复制了代码并在一个小型演示应用程序中将其剥离，因此它不会显示图像。所以这里我手头有两个问题:闪烁(或闪烁)，现在图像甚至不显示。以前不会出现闪烁，但是经过一些重大代码修改后，它开始闪烁。代码更改太多，无法解释到底更改了什么，几乎所有内容。

背景显示了，所以我知道它正在绘制一些东西(它是彩色的)。出于演示目的，它应该只绘制一个立方体，但我没有看到任何东西。我必须将其从大约 1,000 行代码精简到不到 300 行。

这不是您通常所说的闪烁，它实际上更像是闪烁或闪烁，想象一下汽车闪光灯的闪烁。这肯定与计时器有关，因为我设置的计时器间隔越大，它闪烁的速度就越慢。

为什么我什么也没看到？一旦解决了这个问题，为什么它会闪烁得那么厉害？

这是单个表单的代码，不需要 DFM:

unit uMain;

interface

uses
  Winapi.Windows, Winapi.Messages, Winapi.OpenGL,
  System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    FDrawing: Bool;
    FDC: HDC;
    FRC: HGLRC;
    FDL: glUint;
    FTimer: TTimer;
    procedure Draw;
    procedure SetDC(const Value: HDC);
    procedure SetRC(const Value: HGLRC);
    procedure SetDL(const Value: glUint);
  public
    property DC: HDC read FDC write SetDC;
    property RC: HGLRC read FRC write SetRC;
    property DL: glUint read FDL write SetDL;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  PixelFormat: glUint;
  pfd: TPIXELFORMATDESCRIPTOR;
begin
  FDrawing := False;
  FDC := GetDC(Handle);
  with pfd do begin
    nSize := SizeOf(TPIXELFORMATDESCRIPTOR);
    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 := 32; // 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;
  PixelFormat := ChoosePixelFormat(FDC, @pfd);
  SetPixelFormat(FDC, PixelFormat, @pfd);
  FRC := wglCreateContext(FDC);
  wglMakeCurrent(FDC, FRC);
  FormResize(nil);
  wglMakeCurrent(FDC, FRC);
  glClearColor(0.8, 0.8, 0.9, 0.0);
  glShadeModel(GL_FLAT);
  glClearDepth(1.0);
  glEnable(GL_DEPTH_TEST);
  glDepthFunc(GL_LESS);
  glEnable(GL_ALPHA_TEST);
  glAlphaFunc(GL_GREATER, 0.4);
  glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
  glEnable(GL_BLEND);
  glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST);
  glEnable(GL_TEXTURE_2D);
  glNewList(FDL, GL_COMPILE);
    glBegin(GL_QUADS);
      // Front Face
      glTexCoord2f(0.0, 0.0);
      glVertex3f(-2.0, -1.0, 1.0);
      glTexCoord2f(2.0, 0.0);
      glVertex3f(2.0, -1.0, 1.0);
      glTexCoord2f(2.0, 1.0);
      glVertex3f(2.0, 1.0, 1.0);
      glTexCoord2f(0.0, 1.0);
      glVertex3f(-2.0, 1.0, 1.0);
      // Back Face
      glTexCoord2f(2.0, 0.0);
      glVertex3f(-2.0, -1.0, -1.0);
      glTexCoord2f(2.0, 1.0);
      glVertex3f(-2.0, 1.0, -1.0);
      glTexCoord2f(0.0, 1.0);
      glVertex3f(2.0, 1.0, -1.0);
      glTexCoord2f(0.0, 0.0);
      glVertex3f(2.0, -1.0, -1.0);
      // Top Face
      glTexCoord2f(0.0, 1.0);
      glVertex3f(-2.0, 1.0, -1.0);
      glTexCoord2f(0.0, 0.0);
      glVertex3f(-2.0, 1.0, 1.0);
      glTexCoord2f(2.0, 0.0);
      glVertex3f(2.0, 1.0, 1.0);
      glTexCoord2f(2.0, 1.0);
      glVertex3f(2.0, 1.0, -1.0);
      // Bottom Face
      glTexCoord2f(2.0, 1.0);
      glVertex3f(-2.0, -1.0, -1.0);
      glTexCoord2f(0.0, 1.0);
      glVertex3f(2.0, -1.0, -1.0);
      glTexCoord2f(0.0, 0.0);
      glVertex3f(2.0, -1.0, 1.0);
      glTexCoord2f(2.0, 0.0);
      glVertex3f(-2.0, -1.0, 1.0);
      // Left Face
      glTexCoord2f(0.0, 0.0);
      glVertex3f(2.0, -1.0, -1.0);
      glTexCoord2f(1.0, 0.0);
      glVertex3f(2.0, -1.0, 1.0);
      glTexCoord2f(1.0, 1.0);
      glVertex3f(2.0, 1.0, 1.0);
      glTexCoord2f(0.0, 1.0);
      glVertex3f(2.0, 1.0, -1.0);
    glEnd();
  glEndList();
  FTimer:= TTimer.Create(nil);
  FTimer.OnTimer:= Timer1Timer;
  FTimer.Interval:= 100;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FTimer.Free;
  if (not wglMakeCurrent(FDC, 0)) then
    MessageBox(0, 'Release of DC and RC failed!', 'Error', MB_OK or MB_ICONERROR);
  if (not wglDeleteContext(FRC)) then begin
    MessageBox(0, 'Release of rendering context failed!', 'Error', MB_OK or MB_ICONERROR);
    FRC := 0;
  end;
  if ((FDC > 0) and (ReleaseDC(Handle, FDC) = 0)) then begin
    MessageBox(0, 'Release of device context failed!', 'Error', MB_OK or MB_ICONERROR);
    FDC := 0;
  end;
end;

procedure TForm1.Draw;
var
  I: Integer;
begin
  if not FDrawing then begin
    FDrawing := TRUE;
    try
      glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
      glEnable(GL_NORMALIZE);
      glShadeModel(GL_FLAT);
      glCullFace(GL_BACK);
      glLoadIdentity;
      glPushMatrix();
      glCallList(DL);
      glPopMatrix();
      SwapBuffers(wglGetCurrentDC);
    finally
      FDrawing := False;
    end;
  end;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  glViewport(0, 0, Width, Height);
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity();
  gluPerspective(45.0, Width / Height, 0.1, 500.0);
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity();
end;

procedure TForm1.SetDC(const Value: HDC);
begin
  FDC := Value;
end;

procedure TForm1.SetDL(const Value: glUint);
begin
  FDL := Value;
end;

procedure TForm1.SetRC(const Value: HGLRC);
begin
  FRC := Value;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Draw;
end;

end.

现在上面的代码与我原来的代码的工作方式有很大不同。原始的 Draw 过程对对象列表进行迭代，每个对象都包含自己的 Draw 过程。因此，控件的绘制过程准备整个场景，然后逐一绘制每个“项目”，如下所示:

procedure TGLImage.Draw;
var
  X: Integer;
begin
  if not FDrawing then begin
    FDrawing := TRUE;
    try
      glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
      glEnable(GL_NORMALIZE);
      glShadeModel(GL_FLAT);
      glCullFace(GL_BACK);
      glLoadIdentity();

      glRotatef(FElapsedTime / 70, 0, 0, 1);
      glRotatef(90, 0, 1, 0);
      glTranslatef(-FElapsedTime / 400, 0, 0);

      if FInitialized then begin
        for X := 0 to FItems.Count - 1 do begin
          FItems[X].Draw;
        end;
      end;

      SwapBuffers(wglGetCurrentDC);
    finally
      FDrawing := False;
    end;
  end;
end;

这是它绘制的其中一个项目...

constructor TGLBeam.Create(AOwner: TGLItems);
begin
  inherited;
  glNewList(DL, GL_COMPILE);
    glBegin(GL_QUADS);
      // Front Face
      glTexCoord2f(0.0, 0.0);
      glVertex3f(-2.0, -1.0, 1.0);
      glTexCoord2f(2.0, 0.0);
      glVertex3f(2.0, -1.0, 1.0);
      glTexCoord2f(2.0, 1.0);
      glVertex3f(2.0, 1.0, 1.0);
      glTexCoord2f(0.0, 1.0);
      glVertex3f(-2.0, 1.0, 1.0);
      // Back Face
      glTexCoord2f(2.0, 0.0);
      glVertex3f(-2.0, -1.0, -1.0);
      glTexCoord2f(2.0, 1.0);
      glVertex3f(-2.0, 1.0, -1.0);
      glTexCoord2f(0.0, 1.0);
      glVertex3f(2.0, 1.0, -1.0);
      glTexCoord2f(0.0, 0.0);
      glVertex3f(2.0, -1.0, -1.0);
      // Top Face
      glTexCoord2f(0.0, 1.0);
      glVertex3f(-2.0, 1.0, -1.0);
      glTexCoord2f(0.0, 0.0);
      glVertex3f(-2.0, 1.0, 1.0);
      glTexCoord2f(2.0, 0.0);
      glVertex3f(2.0, 1.0, 1.0);
      glTexCoord2f(2.0, 1.0);
      glVertex3f(2.0, 1.0, -1.0);
      // Bottom Face
      glTexCoord2f(2.0, 1.0);
      glVertex3f(-2.0, -1.0, -1.0);
      glTexCoord2f(0.0, 1.0);
      glVertex3f(2.0, -1.0, -1.0);
      glTexCoord2f(0.0, 0.0);
      glVertex3f(2.0, -1.0, 1.0);
      glTexCoord2f(2.0, 0.0);
      glVertex3f(-2.0, -1.0, 1.0);
      // Left Face
      glTexCoord2f(0.0, 0.0);
      glVertex3f(2.0, -1.0, -1.0);
      glTexCoord2f(1.0, 0.0);
      glVertex3f(2.0, -1.0, 1.0);
      glTexCoord2f(1.0, 1.0);
      glVertex3f(2.0, 1.0, 1.0);
      glTexCoord2f(0.0, 1.0);
      glVertex3f(2.0, 1.0, -1.0);
    glEnd();
  glEndList();
end;

procedure TGLBeam.Draw;
var
  I: Integer;
begin
  glRotatef(Directions.X, 1.0, 0.0, 0.0);
  glRotatef(Directions.Y, 0.0, 1.0, 0.0);
  glRotatef(Directions.Z, 0.0, 0.0, 1.0);
  for I := 1 to 10 do begin
    //Main Center
    glPushMatrix();
    glTranslatef(I * 4 + Owner.Owner.ClockTime * 4, 0, 0);
    glCallList(DL);
    glPopMatrix();
    //Above
    glPushMatrix();
    glTranslatef(I * 4 + Owner.Owner.ClockTime * 4, 6, 0);
    glCallList(DL);
    glPopMatrix();
  end;
end;

最佳答案 

glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
glEnable(GL_NORMALIZE);
glShadeModel(GL_FLAT);
glCullFace(GL_BACK);
glLoadIdentity;
glPushMatrix();
glCallList(DL);
glPopMatrix();
SwapBuffers(wglGetCurrentDC);

首先将 () 添加到对 glLoadIdentity 的调用中

您加载单位矩阵，然后推送它，然后渲染并弹出它，而无需实际执行任何转换。

删除 3 行

glLoadIdentity;
glPushMatrix();

glPopMatrix();

或将glPushMatrix()移动到glLoadIdentity()

之前的行

我还建议关闭着色和剔除，以确保它们不会干扰。即使您不希望从前面剔除它们，以稍微错误的顺序声明的四边形并启用背面剔除也会剔除它们。

关于delphi - OpenGL 快速闪烁问题 - 现在不显示图像，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/10729526/

上一篇：delphi - Firemonkey 和可停靠表单

下一篇：sql-server - Unicode 转换、数据库问题(Delphi 2007 到 XE2)

相关文章：

delphi - 如何运行项目组中的所有项目？

delphi - Delphi Android无法使用TPath

opengl - 为什么在顶点着色器之后处理几何着色器？

delphi - 如何在运行时获取表单的实例？

delphi - 如何显示TActionMainMenuBar组件的自定义对话框？

Delphi IDE 编辑器不再显示提示

delphi - 使用 FIREDAC 创建表 MS ACCESS

c - C 中的 Gtk GLArea 小部件不显示 gl 命令

java - OpenGL 混合 (Java)

delphi - 使用通用接口(interface)的错误重载调用

©2024 IT工具网  联系我们