代码之家  ›  专栏  ›  技术社区  ›  Remus Rigo

delphiopengl测试

  •  1
  • Remus Rigo  · 技术社区  · 16 年前

    我正在读《Delphi开发者指南OpenGL》,这段代码应该设置窗口的背景色,但它不起作用,有人能告诉我出了什么问题吗??

    type
       TForm1 = class(TForm)
          procedure Form_Create(Sender: TObject);
        procedure Form_Destroy(Sender: TObject);
        procedure FormPaint(Sender: TObject);
          private
             glContext   : HGLRC;
             glDC        : HDC;
             errorCode   : GLenum;
             openGLReady : Boolean;
          public
       end;
    
    var
       Form1 : TForm1;
    
    implementation
    
    {$R *.dfm}
    
    procedure TForm1.FormPaint(Sender: TObject);
    begin
       if not openGLReady then
          exit;
       {background}
       glClearColor(0.1,0.4,0.0,0.0);
       glClear(GL_COLOR_BUFFER_BIT);
       {error checking}
       errorCode:=glGetError;
       if errorCode<>GL_NO_ERROR then
          raise Exception.Create('Error in Paint'#13+gluErrorString(errorCode));
    end;
    
    procedure TForm1.Form_Create(Sender: TObject);
    var
       pfd : TPixelFormatDescriptor;
       FormatIndex: integer;
    begin
       fillchar(pfd,SizeOf(pfd),0);
       with pfd do
       begin
          nSize := SizeOf(pfd);
          nVersion := 1; {The current version of the desccriptor is 1}
          dwFlags := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL;
          iPixelType := PFD_TYPE_RGBA;
          cColorBits := 24; {support 24-bit color}
          cDepthBits := 32; {depth of z-axis}
          iLayerType := PFD_MAIN_PLANE;
       end; {with}
       glDC := getDC(handle);
       FormatIndex := ChoosePixelFormat(glDC,@pfd);
       if FormatIndex=0 then
          raise Exception.Create('ChoosePixelFormat failed '+IntToStr(GetLastError));
       if not SetPixelFormat(glDC,FormatIndex,@pfd) then
          raise Exception.Create('SetPixelFormat failed '+IntToStr(GetLastError));
       GLContext := wglCreateContext(glDC);
       if GLContext=0 then
          raise Exception.Create('wglCreateContext failed '+IntToStr(GetLastError));
       if not wglMakeCurrent(glDC,GLContext) then
          raise Exception.Create('wglMakeCurrent failed '+IntToStr(GetLastError));
       OpenGLReady := true;
    end;
    
    procedure TForm1.Form_Destroy(Sender: TObject);
    begin
       wglMakeCurrent(Canvas.Handle, 0);
       wglDeleteContext(GLContext);
    end;
    
    2 回复  |  直到 16 年前
        1
  •  3
  •   user81864    16 年前

    在过程末尾添加FormPaint opengl命令:

    glFlush();
    
        2
  •  0
  •   Marco van de Voort    16 年前
    swapbuffers(gldc);