unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DGLOpenGL;
type
TForm1 =
class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure IdleHandler(Sender: TObject;
var Done: Boolean);
private
{ Private-Deklarationen }
StartTime, TimeCount, FrameCount : Cardinal;
//FrameCounter
Frames, DrawTime : Cardinal;
//& Timebased Movement
procedure SetupGL;
procedure Init;
procedure Render;
procedure ErrorHandler;
public
{ Public-Deklarationen }
DC : HDC;
//Handle auf Zeichenfläche
RC : HGLRC;
//Rendering Context
end;
var
Form1: TForm1;
const
NearClipping = 1;
FarClipping = 1000;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
DC:= GetDC(
Handle);
if not InitOpenGL
then Application.Terminate;
RC:= CreateRenderingContext(
DC,
[opDoubleBuffered],
32,
24,
0,0,0,
0);
ActivateRenderingContext(
DC, RC);
SetupGL;
Init;
//Was man sonst so initialisieren will.
end;
procedure TForm1.SetupGL;
begin
glClearColor(0.3, 0.4, 0.7, 0.0);
//Hintergrundfarbe: Hier ein leichtes Blau
glEnable(GL_DEPTH_TEST);
//Tiefentest aktivieren
glEnable(GL_CULL_FACE);
//Backface Culling aktivieren
end;
procedure TForm1.Init;
begin
Application.OnIdle := IdleHandler;
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;
Caption:= InttoStr(Frames) + '
FPS';
ErrorHandler;
end;
Done:= false;
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.FormDestroy(Sender: TObject);
begin
DeactivateRenderingContext;
DestroyRenderingContext(RC);
ReleaseDC(
Handle,
DC);
end;
procedure TForm1.ErrorHandler;
var s:
String;
begin
s := gluErrorString(glGetError);
If s <> '
no error'
then showmessage(s);
end;
end.