- unit uDGLOpenGLGrundgeruest;
- {$mode delphi}{$H+}
- interface
- uses
- Classes, SysUtils, Forms, Controls, Graphics, Dialogs, dglOpenGL, Windows;
- type
- { TForm1 }
- TForm1 = class(TForm)
- procedure FormCreate(Sender: TObject);
- procedure IdleHandler(Sender: TObject; var Done: Boolean);
- procedure FormResize(Sender: TObject);
- procedure FormDestroy(Sender: TObject);
- private{ private declarations }
- StartTime, TimeCount, FrameCount: Cardinal;
- Frames, DrawTime: Cardinal;
- procedure SetupGL();
- procedure Init();
- procedure Render();
- procedure ErrorHandler(Frames: Cardinal);
- public{ public declarations }
- DC: HDC;
- RC: HGLRC;
- end;
- const
- NearClipping = 1;
- FarClipping = 1000;
- var
- Form1: TForm1;
- implementation
- {$R *.lfm}
- { TForm1 }
- procedure TForm1.FormCreate(Sender: TObject);
- begin
- with Form1 do
- begin
- Caption := 'DGLOpenGL QuickStart-Tutorial - ';
- Width := 640;
- Height := 480;
- Position := poScreenCenter;
- end;
- DC := GetDC(Form1.Handle);
- if not InitOpenGL then Application.Terminate;
- RC := CreateRenderingContext(DC,
- [opDoubleBuffered],
- 32,
- 24,
- 0,
- 0,
- 0,
- 0);
- ActivateRenderingContext(DC, RC);
- SetupGL();
- Init();
- Application.OnIdle := IdleHandler;
- end;
- procedure TForm1.SetupGL();
- begin
- glClearColor(0.3, 0.4, 0.7, 0.0);
- glEnable(GL_DEPTH_TEST);
- glEnable(GL_CULL_FACE);
- end;
- procedure TForm1.Init();
- begin
- // für eventuelle Initialisierung globaler Variablen
- end;
- procedure TForm1.FormResize(Sender: TObject);
- var
- tmpBool: Boolean;
- begin
- glViewport(0, 0, ClientWidth, ClientHeight);
- glMatrixMode(GL_PROJECTION);
- glLoadIdentity;
- gluPerspective(45.0, ClientWidth/ClientHeight, NearClipping, FarClipping);
- glMatrixMode(GL_MODELVIEW);
- glLoadIdentity;
- IdleHandler(Sender, tmpBool);
- end;
- procedure TForm1.Render();
- begin
- glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
- glMatrixMode(GL_PROJECTION);
- glLoadIdentity;
- gluPerspective(45.0, ClientWidth/ClientHeight, NearClipping, FarClipping);
- glMatrixMode(GL_MODELVIEW);
- glLoadIdentity;
- glTranslatef(0, 0, -5);
- glBegin(GL_QUADS);
- glColor3f(1, 0, 0); glVertex3f(0, 0, 0);
- glColor3f(0, 1, 0); glVertex3f(1, 0, 0);
- glColor3f(0, 0, 1); glVertex3f(1, 1, 0);
- glColor3f(1, 1, 0); glVertex3f(0, 1, 0);
- glEnd;
- SwapBuffers(DC);
- end;
- procedure TForm1.IdleHandler(Sender: TObject; var Done: Boolean);
- begin
- StartTime:= GetTickCount;
- Render();
- DrawTime:= GetTickCount - StartTime;
- Inc(TimeCount, DrawTime);
- Inc(FrameCount);
- if TimeCount >= 1000 then begin
- Frames:= FrameCount;
- TimeCount:= TimeCount - 1000;
- FrameCount:= 0;
- ErrorHandler(Frames);
- end;
- //Sleep(5);
- Done := false;
- end;
- // ErrorHandler übernimmt nicht nur die Fehlerausgabe sondern nun auch die
- // Ausgabe der Framerate in der Titelzeile des Formulars, dadurch entfällt
- // der ständige Wechsel der Anzeige
- procedure TForm1.ErrorHandler(Frames: Cardinal);
- begin
- Form1.Caption := 'DGLOpenGL QuickStart-Tutorial - ' + InttoStr(Frames) + ' FPS - ' + gluErrorString(glGetError);
- end;
- procedure TForm1.FormDestroy(Sender: TObject);
- begin
- DeactivateRenderingContext;
- DestroyRenderingContext(RC);
- ReleaseDC(Handle, DC);
- end;
- end.