- {Einzustellende Events:
- Form1 : OnCreate -> FormCreate
- OnShow -> FormShow
- ScrollBar1..3: OnChange -> ScrollBarChange}
- unit testunit1;
- interface
- uses
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, dglOpenGL, Math, ExtCtrls, StdCtrls;
- type
- TForm1 = class(TForm)
- Panel1: TPanel;
- ScrollBar1: TScrollBar;
- ScrollBar2: TScrollBar;
- ScrollBar3: TScrollBar;
- Label1: TLabel;
- Label2: TLabel;
- Label3: TLabel;
- Label4: TLabel;
- procedure FormCreate(Sender : TObject);
- procedure FormShow(Sender : TObject);
- procedure FormDestroy(Sender: TObject);
- procedure ScrollBarChange(Sender: TObject);
- private { Private-Deklarationen }
- procedure SetupGL;
- Procedure Render;
- public { Public-Deklarationen }
- DC : HDC; //Handle auf Zeichenfläche
- RC : HGLRC;//Rendering Context
- end;
- var
- Form1 : TForm1;
- NearClipping,
- FarClipping,
- alpha,
- x : integer;
- Distanz,
- ZoomFaktor : real;
- FlagCounter : byte;
- winx, winy, winz : GLDouble;
- modelMatrix : TGLMatrixd4;
- projMatrix : TGLMatrixd4;
- viewport : TGLVectori4;
- objx, objy, objz : double;
- implementation
- {$R *.dfm}
- {***************************************************************************}
- { SetUp GL }
- {***************************************************************************}
- procedure TForm1.SetupGL;
- begin
- glClearColor(0, 0, 0, 0);
- glEnable(GL_DEPTH_TEST);
- glEnable(GL_CULL_FACE);
- glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
- glMatrixMode(GL_PROJECTION);
- glLoadIdentity;
- end;
- {***************************************************************************}
- { Form erstellen }
- {***************************************************************************}
- procedure Tform1.FormCreate(Sender : TObject);
- begin
- // Definition Form
- form1.Height := 768;
- form1.Width := 1024;
- NearClipping := 0;
- FarClipping := 1000;
- // Panelgrösse in Relation zur Form
- Panel1.height := round(form1.Height/1.2);
- Panel1.Width := round(form1.Width/1.2);
- // Versatz wg. Platz für Scrollbars
- Panel1.Top := 25;
- Panel1.left := 150;
- // Definition Scrollbars
- ScrollBar1.Max := 90;
- ScrollBar1.Min := 0;
- ScrollBar1.Top := 5;
- ScrollBar1.Left := 3;
- ScrollBar1.Width := 120;
- ScrollBar1.Height := 15;
- ScrollBar2.Max := 90;
- ScrollBar2.Min := 0;
- ScrollBar2.Top := 22;
- ScrollBar2.Left := 3;
- ScrollBar2.Width := 120;
- ScrollBar2.Height := 15;
- ScrollBar3.Max := 90;
- ScrollBar3.Min := 0;
- ScrollBar3.Top := 39;
- ScrollBar3.Left := 3;
- ScrollBar3.Width := 120;
- ScrollBar3.Height := 15;
- // Definition Labels
- Label1.Left := 3;
- Label1.Top := 65;
- Label2.Left := 3;
- Label2.Top := 85;
- Label3.Left := 3;
- Label3.Top := 105;
- Label4.Left := 3;
- Label4.Top := 125;
- // Blickwinkel vertikal
- alpha := 30;
- // Kantenlänge Quadrat
- x := 20;
- DC:= GetDC(Panel1.Handle);
- RC:= CreateRenderingContext( DC,
- [opDoubleBuffered],
- 32,
- 24,
- 0,0,0,
- 0);
- ActivateRenderingContext(DC, RC);
- glViewport(0, 0, Panel1.Width, Panel1.Height);
- SetupGL;
- // Starteinstellung Zoomfaktor
- ZoomFaktor := 1;
- // Erstaufruf Render
- Render;
- end;
- {***************************************************************************}
- { Form zeichnen }
- {***************************************************************************}
- procedure TForm1.FormShow(Sender: TObject);
- begin
- if FlagCounter > 0 then Render; // Flackerunterdrückung
- end;
- {***************************************************************************}
- { Bindungen aufheben }
- {***************************************************************************}
- procedure TForm1.FormDestroy(Sender: TObject);
- begin
- DeactivateRenderingContext;
- DestroyRenderingContext(RC);
- ReleaseDC(Handle, DC);
- end;
- {***************************************************************************}
- { Reaktion auf Scrollbar-Änderung }
- {***************************************************************************}
- procedure TForm1.ScrollBarChange(Sender: TObject);
- begin
- FlagCounter := 2;
- Render;
- end;
- {***************************************************************************}
- { Render-Routine }
- {***************************************************************************}
- procedure TForm1.Render;
- begin
- glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
- glMatrixMode(GL_PROJECTION);
- glLoadIdentity;
- gluPerspective(alpha, Panel1.Width/Panel1.Height, NearClipping, FarClipping);
- glMatrixMode(GL_MODELVIEW);
- glLoadIdentity;
- // Berechnung Distanz aufgrund Öffnungswinkel
- // und Kantenlänge, dann Skalierung mit Zoomfaktor
- Distanz := -x/2 / tan(degtorad(alpha/2))/Zoomfaktor;
- glTranslatef(0,0,Distanz);
- // Rotation gem. Scrollbars
- glRotatef(-ScrollBar1.Position,1,0,0);
- glRotatef(-ScrollBar2.Position,0,1,0);
- glRotatef(-ScrollBar3.Position,0,0,1);
- // Quadrat zentrisch zeichnen
- glBegin(GL_Quads);
- glColor3f(1, 1, 1);
- glVertex3f(-x/2,-x/2,0);
- glVertex3f(x/2,-x/2,0);
- glVertex3f(x/2,x/2,0);
- glVertex3f(-x/2,x/2,0);
- glend;
- // Bildschirmposition rechte untere Ecke ermitteln
- objx := x/2;
- objy := -x/2;
- objz := 0;
- glGetDoublev(GL_MODELVIEW_MATRIX, @modelmatrix);
- glGetDoublev(GL_PROJECTION_MATRIX, @projMatrix);
- glGetIntegerV(GL_VIEWPORT, @viewport);
- gluProject(objx,objy,objz,modelmatrix,projmatrix,viewport,@winx,@winy,@winz);
- // Info-Labels beschreiben
- Label1.caption := 'wx: ' + floattostr(winx);
- Label2.caption := 'wy: ' + floattostr(winy);
- Label3.caption := 'Fakt: ' + floattostr(Zoomfaktor);
- Label4.caption := 'Dist: ' + floattostr(Distanz);
- // Anpassung Zoomfaktor an Panelhöhe
- Zoomfaktor := (Panel1.Height/2)/((Panel1.Height/2) - winy);
- // Wenn Objekt zu breit dann Anpassung Zoomfaktor
- if (winx > (Panel1.Width)) then ZoomFaktor := ZoomFaktor * (Panel1.Width/2)/((Panel1.Width/2) + winx);
- // Schleifenzähler dekrementieren
- dec(Flagcounter);
- // Nur zeichnen wenn Render 2x durchlaufen um 'Pumpen' zu vermeiden
- if FlagCounter = 0 then SwapBuffers(DC);
- end;
- {***************************************************************************}
- { Programmende }
- {***************************************************************************}
- end.