- procedure CreateRC;
- begin
- //Rendering Context initialisieren
- RC := wglCreateContext(MainForm.Canvas.Handle);
- if (RC=0) then
- begin
- MessageDlg('Rendering Context kann nicht erstellt werden.', mtError, [mbOk], 0);
- Halt(100)
- end;
- if (not wglMakeCurrent(MainForm.Canvas.Handle, RC)) then
- begin
- MessageDlg('Rendering Context kann nicht aktiviert werden.', mtError, [mbOk], 0);
- Halt(100)
- end
- end; (*StartGL*)
- procedure SetupGL;
- begin
- glShadeModel(GL_SMOOTH);
- glClearColor(0.0, 0.0, 0.0, 0.5);
- glClearDepth(1.0);
- glEnable(GL_DEPTH_TEST);
- glDepthFunc(GL_LEQUAL);
- glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST);
- end; (*SetupGL*)
- procedure TMainForm.DrawScene(mode: Integer);
- begin
- glMatrixMode(GL_MODELVIEW);
- glClearColor(0,0,0,0);
- glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
- glLoadIdentity;
- glTranslatef(0,0,-2);
- glColor3f(1.0, 1.0, 0.0);
- glRasterPos2i(20, 50);
- PrintText2D('abcdefghijklmnwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz');
- end;
- procedure TMainForm.FormCreate(Sender: TObject);
- begin
- OpenGLInitialized:=false;
- If not LoadOpenGL() then Halt(100);
- //...
- end; {*FormCreate*}
- procedure TMainForm.FormShow(Sender: TObject);
- begin
- RC:=0;
- //pixelformat setzen und rendering context erstellen
- _SetPixelFormat(MainForm.Canvas);
- CreateRC;
- //opengl extensions auslesen
- ClearExtensions;
- ReadExtensions;
- //initialize glObjects
- glObject[1].id:=1;
- glObject[1].name:='linkes Objekt';
- glObject[2].id:=2;
- glObject[2].name:='zentrales Objekt';
- glObject[3].id:=3;
- glObject[3].name:='rechtes Objekt';
- //opengl szene initialisieren
- SetupGL;
- Application.OnIdle:=ApplicationEventsIdle;
- OpenGLInitialized:=true;
- BuildFont2D;
- end; {*FormShow*}
- procedure TMainForm.ApplicationEventsIdle(Sender: TObject; var Done: Boolean);
- var
- error: longint;
- begin
- if not OpenGLInitialized then Exit;
- done:=false;
- //szene zeichnen
- DrawScene(GL_RENDER);
- //errorhandler
- error := glgetError;
- if Error<>GL_NO_ERROR then
- begin
- Caption:=gluErrorString(error);
- Done:=true; //rendern kurz anhalten
- FlashWindow(handle, true)
- end;
- SwapBuffers(Canvas.Handle)
- end; (*ApplicationEventsIdle*)