1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, dglOpenGL;


type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }

  end;

var
  Form1: TForm1;
  DC, RC:HDC;
  

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin

DC:=GetDC (Handle);
RC:=CreateRenderingContext(DC, [opDoubleBuffered], 32, 24, 0, 0, 0, 0);
ActivateRenderingContext(DC, RC);
glClear(GL_COLOR_BUFFER_BIT);
glViewport(0, 0, ClientWidth, ClientHeight);

end;





end.					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:

unit OpenGL15_MainForm;

interface

uses
  Windows,
  Messages,
  SysUtils,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,

  dglOpenGL;

type
  TGLForm = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure IdleHandler(Sender: TObject; var Done: Boolean);
    procedure ApplicationEventsIdle(Sender: TObject; var Done: Boolean);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
  private
    { Private-Deklarationen }
    StartTime, TimeCount, FrameCount  : Cardinal;
    Frames, DrawTime                  : Cardinal;
    procedure ErrorHandler;
    procedure SetupGL;
    procedure Init;
    procedure Render;
  public
    RC        : HGLRC;
    DC        : HDC;
    ShowFPS   : Boolean;
    FontBase  : GLUInt;
    StartTick : Cardinal;
    Frames    : Integer;
    FPS       : Single;
    procedure GoToFullScreen(pWidth, pHeight, pBPP, pFrequency : Word);
    procedure BuildFont(pFontName : String);
    procedure PrintText(pX,pY : Integer; const pText : String);
    procedure ShowText;
  end;

var
  GLForm: TGLForm;

implementation

{$R *.dfm}

// =============================================================================
//  TForm1.GoToFullScreen
// =============================================================================
//  Wechselt in den mit den Parametern angegebenen Vollbildmodus
// =============================================================================
procedure TGLForm.GoToFullScreen(pWidth, pHeight, pBPP, pFrequency : Word);
var
 dmScreenSettings : DevMode;
begin
// Fenster vor Vollbild vorbereiten
WindowState := wsMaximized;
BorderStyle := bsNone;
ZeroMemory(@dmScreenSettings, SizeOf(dmScreenSettings));
with dmScreenSettings do
 begin
 dmSize              := SizeOf(dmScreenSettings);
 dmPelsWidth         := pWidth;                    // Breite
 dmPelsHeight        := pHeight;                   // Höhe
 dmBitsPerPel        := pBPP;                      // Farbtiefe
 dmDisplayFrequency  := pFrequency;                // Bildwiederholfrequenz
 dmFields            := DM_PELSWIDTH or DM_PELSHEIGHT or DM_BITSPERPEL or DM_DISPLAYFREQUENCY;
 end;
if (ChangeDisplaySettings(dmScreenSettings, CDS_FULLSCREEN) = DISP_CHANGE_FAILED) then
 begin
 MessageBox(0, 'Konnte Vollbildmodus nicht aktivieren!', 'Error', MB_OK or MB_ICONERROR);
 exit
 end;
end;

// =============================================================================
//  TForm1.BuildFont
// =============================================================================
//  Displaylisten für Bitmapfont erstellen
// =============================================================================
procedure TGLForm.BuildFont(pFontName : String);
var
 Font : HFONT;
begin
// Displaylisten für 256 Zeichen erstellen
FontBase := glGenLists(96);
// Fontobjekt erstellen
Font     := CreateFont(16, 0, 0, 0, FW_MEDIUM, 0, 0, 0, ANSI_CHARSET, OUT_TT_PRECIS, CLIP_DEFAULT_PRECIS,
                       ANTIALIASED_QUALITY, FF_DONTCARE or DEFAULT_PITCH, PChar(pFontName));
// Fontobjekt als aktuell setzen
SelectObject(DC, Font);
// Displaylisten erstellen
wglUseFontBitmaps(DC, 0, 256, FontBase);
// Fontobjekt wieder freigeben
DeleteObject(Font)
end;

// =============================================================================
//  TForm1.PrintText
// =============================================================================
//  Gibt einen Text an Position x/y aus
// =============================================================================
procedure TGLForm.PrintText(pX,pY : Integer; const pText : String);
begin
if (pText = '') then
 exit;
glPushAttrib(GL_LIST_BIT);
 glRasterPos2i(pX, pY);
 glListBase(FontBase);
 glCallLists(Length(pText), GL_UNSIGNED_BYTE, PChar(pText));
glPopAttrib;
end;

// =============================================================================
//  TForm1.ShowText
// =============================================================================
//  FPS, Hilfstext usw. ausgeben
// =============================================================================
procedure TGLForm.ShowText;
begin
// Tiefentest und Texturierung für Textanzeige deaktivieren
glDisable(GL_DEPTH_TEST);
glDisable(GL_TEXTURE_2D);
// In orthagonale (2D) Ansicht wechseln
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
glOrtho(0,640,480,0, -1,1);
glMatrixMode(GL_MODELVIEW);
glLoadIdentity;
PrintText(5,15, FloatToStr(FPS)+' fps');
glEnable(GL_DEPTH_TEST);
glEnable(GL_TEXTURE_2D);
end;

// =============================================================================
//  TForm1.FormCreate
// =============================================================================
//  OpenGL-Initialisierungen kommen hier rein
// =============================================================================
procedure TGLForm.FormCreate(Sender: TObject);
begin
// Wenn gewollt, dann hier in den Vollbildmodus wechseln
// Muss vorm Erstellen des Kontextes geschehen, da durch den Wechsel der
// Gerätekontext ungültig wird!
// GoToFullscreen(1600, 1200, 32, 75);
                     
// OpenGL-Funtionen initialisieren
InitOpenGL;
// Gerätekontext holen
DC := GetDC(Handle);
// Renderkontext erstellen (32 Bit Farbtiefe, 24 Bit Tiefenpuffer, Doublebuffering)
RC := CreateRenderingContext(DC, [opDoubleBuffered], 32, 24, 0, 0, 0, 0);
// Erstellten Renderkontext aktivieren
ActivateRenderingContext(DC, RC);
// Tiefenpuffer aktivieren
glEnable(GL_DEPTH_TEST);
// Nur Fragmente mit niedrigerem Z-Wert (näher an Betrachter) "durchlassen"
glDepthFunc(GL_LESS);
// Löschfarbe für Farbpuffer setzen
glClearColor(0,0,0,0);
// Displayfont erstellen
BuildFont('MS Sans Serif');
// Idleevent für Rendervorgang zuweisen
Application.OnIdle := ApplicationEventsIdle;
// Zeitpunkt des Programmstarts für FPS-Messung speichern
StartTick := GetTickCount;
end;

// =============================================================================
//  TForm1.FormDestroy
// =============================================================================
//  Hier sollte man wieder alles freigeben was man so im Speicher belegt hat
// =============================================================================
procedure TGLForm.FormDestroy(Sender: TObject);
begin
// Renderkontext deaktiveren
DeactivateRenderingContext;
// Renderkontext "befreien"
wglDeleteContext(RC);
// Erhaltenen Gerätekontext auch wieder freigeben
ReleaseDC(Handle, DC);
// Falls wir im Vollbild sind, Bildschirmmodus wieder zurücksetzen
ChangeDisplaySettings(devmode(nil^), 0);
end;

procedure TForm1.IdleHandler(Sender: TObject; var Done: Boolean);
begin
  Startime:=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;

// =============================================================================
//  TForm1.ApplicationEventsIdle
// =============================================================================
//  Hier wird gerendert. Der Idle-Event wird bei Done=False permanent aufgerufen
// =============================================================================
procedure TGLForm.ApplicationEventsIdle(Sender: TObject; var Done: Boolean);
begin
// In die Projektionsmatrix wechseln
glMatrixMode(GL_PROJECTION);
// Identitätsmatrix laden
glLoadIdentity;
// Viewport an Clientareal des Fensters anpassen
glViewPort(0, 0, ClientWidth, ClientHeight);
// Perspective, FOV und Tiefenreichweite setzen
gluPerspective(60, ClientWidth/ClientHeight, 1, 128);

// In die Modelansichtsmatrix wechseln
glMatrixMode(GL_MODELVIEW);
// Identitätsmatrix laden
glLoadIdentity;
// Farb- und Tiefenpuffer löschen
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);

ShowText;

// Hinteren Puffer nach vorne bringen
SwapBuffers(DC);

// Windows denken lassen, das wir noch nicht fertig wären
Done := False;

// Nummer des gezeichneten Frames erhöhen
inc(Frames);
// FPS aktualisieren
if GetTickCount - StartTick >= 500 then
 begin
 FPS       := Frames/(GetTickCount-StartTick)*1000;
 Frames    := 0;
 StartTick := GetTickCount
 end;
end;

// =============================================================================
//  TForm1.FormKeyPress
// =============================================================================
procedure TGLForm.FormKeyPress(Sender: TObject; var Key: Char);
begin
case Key of
 #27 : Close;
end;
end;


procedure ErrorHandler;
begin
Form1.Caption := gluErrorString(glGetError);
end;

procedure SetupGL;
begin
glClearColor(0.3, 0.4, 0.7, 0.0);
glEnable(GL_DEPTH_TEST);
glEnable(GL_CULL_FACE);
end;

procedure 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);

glMatrixMode(GL_MODELVIEW);
glLoadIdentity;

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;



end.