- unit Main;
- interface
- uses
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, DGLOpenGL, StdCtrls;
- type
- TForm1 = class(TForm)
- procedure FormDestroy(Sender: TObject);
- procedure IdleHandler(Sender: TObject; var Done: Boolean);
- procedure FormResize(Sender: TObject);
- procedure FormCreate(Sender: TObject);
- 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;
- CONST
- NearClipping = 1;
- FarClipping = 100;
- var
- Form1: TForm1;
- rotx: Integer;
- implementation
- {$R *.dfm}
- procedure TForm1.SetupGL;
- begin
- glClearColor(0, 0, 0, 0.0); //Hintergrundfarbe
- glEnable(GL_DEPTH_TEST); //Tiefentest aktivieren
- glEnable(GL_CULL_FACE); //Backface Culling aktivieren
- 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,-5);
- glRotatef(rotx,1,0,0);
- glBegin(GL_QUADS);
- glColor3f(1,0,0); //Rot
- glVertex3f(1,-1,0);
- glColor3f(1,1,0); //Gelb
- glVertex3f(1,1,0);
- glColor3f(0,1,0); //Grün
- glVertex3f(-1,1,0);
- glColor3f(0,0,1); //Blau
- glVertex3f(-1,-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;
- inc(roty);
- if rotx>360 then
- rotx:=rotx - 360;
- sleep(5);
- Done:= false;
- end;
- procedure TForm1.ErrorHandler;
- begin
- Form1.Caption := gluErrorString(glGetError);
- end;
- 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;
- rotx := 0;
- Application.OnIdle := IdleHandler;
- 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;
- end.