unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DGLOpenGL, ComCtrls;
type
TForm1 =
class(TForm)
StatusBar1: TStatusBar;
procedure FormCreate(Sender: TObject);
procedure IdleHandler(Sender: TObject;
var Done: Boolean);
procedure FormResize(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormPaint(Sender: TObject);
private
StartTime, TimeCount, FrameCount : Cardinal;
// FrameCounter
Frames, DrawTime : Cardinal;
// Timebased Movement
procedure SetupGL;
procedure Init;
procedure Render;
procedure ErrorHandler;
public
DC: HDC;
// Handle auf Zeichenflaeche
RC: HGLRC;
// Rendering Context
end;
var
Form1: TForm1;
const
NearClipping = 1;
FarClipping = 1000;
dreieck = 1;
viereck = 2;
stern = 3;
namen :
array[-1..3]
of String = ('
nichts', '
', '
das Dreieck', '
das Viereck', '
den Stern');
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
DC := GetDC(
Handle);
// Hier wird der Gerätekontext (Device Context)
// von Formular Form1 abgefragt.
if not InitOpenGL
then Application.Terminate;
// Hier wird der RenderingContext erzeugt. Den braucht OpenGL zum Zeichnen auf das Formular.
RC := CreateRenderingContext(
DC,
[opDoubleBuffered],
32,
24,
0,0,0,
0);
// Rendering Context wird gestartet
ActivateRenderingContext(
DC, RC);
SetupGL;
Init;
end;
procedure TForm1.SetupGL;
// Allgemeine Einstellungen
begin
glClearColor(0, 0, 0, 0);
// Hintergrundfarbe
glEnable(GL_DEPTH_TEST);
// Tiefentest aktivieren
glEnable(GL_CULL_FACE);
// Backface Culling aktivieren
end;
procedure TForm1.Init;
// Globale Variablen
begin
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.Render;
begin
glClear(GL_COLOR_BUFFER_BIT
or GL_DEPTH_BUFFER_BIT);
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
gluPerspective(45.0, ClientWidth/ClientHeight, NearClipping, FarClipping);
glTranslatef(0, 0, -6);
glMatrixMode(GL_MODELVIEW);
glLoadIdentity;
glInitNames;
glPushName(0);
glPushMatrix;
glColor3f(1,0,0);
glTranslatef(-0.4,-0.6,0);
glLoadName(dreieck);
glBegin(gl_triangles);
glVertex3f(1,-1,0);
glVertex3f(1,0,0);
glVertex3f(-1,1,0);
glEnd;
glPopMatrix;
glColor3f(0,1,0);
glTranslatef(1,1.2,0);
glLoadName(viereck);
glBegin(gl_quads);
glVertex3f(0.5,-1,0);
glVertex3f(0.6,0.2,0);
glVertex3f(-1,0.3,0);
glVertex3f(-1.2,-0.9,0);
glEnd;
glPopMatrix;
glColor3f(0,0,1);
glTranslatef(0.1,-0.2,0);
glColor3f(1,0,0);
glLoadName(stern);
glBegin(gl_triangles);
glVertex3f(0.75,1,0);
glVertex3f(0.50,1.45,0);
glVertex3f(0.25,1,0);
glVertex3f(0.25,1.3,0);
glVertex3f(0.5,0.85,0);
glVertex3f(0.75,1.3,0);
glEnd;
SwapBuffers(
DC);
end;
function Selection(X,Y: Integer) : integer;
var
Puffer :
array[0..256]
of GLUInt;
Viewport : TGLVectori4;
Treffer,i : Integer;
Z_Wert : GLUInt;
Getroffen : GLUInt;
begin
glGetIntegerv(GL_VIEWPORT, @viewport);
//Die Sicht speichern
glSelectBuffer(256, @Puffer);
//Den Puffer zuordnen
glRenderMode(GL_SELECT);
//In den Selectionsmodus schalten
glMatrixmode(GL_PROJECTION);
//In den Projektionsmodus
glPushMatrix;
//Um unsere Matrix zu sichern
glLoadIdentity;
//Und dieselbige wieder zurückzusetzen
gluPickMatrix(X, viewport[3]-Y, 1.0, 1.0, viewport);
gluPerspective(45.0, Form1.ClientWidth/Form1.ClientHeight, NearClipping, FarClipping);
Form1.render;
//Die Szene zeichnen
glMatrixmode(GL_PROJECTION);
//Wieder in den Projektionsmodus
glPopMatrix;
//um unsere alte Matrix wiederherzustellen
treffer := glRenderMode(GL_RENDER);
//Anzahl der Treffer auslesen
getroffen := High(GLUInt);
//Höchsten möglichen Wert annehmen
Z_Wert := High(GLUInt);
//Höchsten Z - Wert
for i := 0
to Treffer-1
do
if Puffer[(i*4)+1] < Z_Wert
then
begin
getroffen := Puffer[(i*4)+3];
Z_Wert := Puffer[(i*4)+1];
end;
Result := getroffen;
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.ErrorHandler;
begin
gluErrorString(glGetError);
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
statusbar1.Simpletext := '
Sie haben auf ' + namen[selection(X,Y)] + '
geklickt!';
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
Form1.Render;
end;
end.