tags:

views:

131

answers:

2
+1  Q: 

Delphi OpenGL test

i was reading the book Delphi Developer's Guide to OpenGL and this code should set the background color of the window, but it does not work, can anyone tell me what is wrong??

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;
A: 

swapbuffers(gldc);

?

Marco van de Voort
+2  A: 

Add at the end of procedure FormPaint opengl command:

glFlush();
thanks, it's working
Remus Rigo