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:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DGLOpenGL, StdCtrls, ExtCtrls;

type
  TMyQuad = record
    px, py, pz  : Single;  //Mittelpunkt
    sx, sy     : Single;  //Größe
    rx, ry, rz  : Single;  //Drehung
    nameID      : Integer;
  end;

  TForm1 = class(TForm)
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormDestroy(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    DC                                : HDC;  //Handle auf Zeichenfläche
    RC                                : HGLRC;//Rendering Context
    procedure SetupGL;
    procedure Init;
    procedure IdleHandler(Sender: TObject; var Done: Boolean);
    procedure Render;
    procedure ErrorHandler;
    procedure DrawMyQuad(q: TMyQuad);
    procedure CreateMyQuad(var mq: TMyQuad; _px,_py,_pz,_sx,_sy,_rx,_ry,_rz: Single);
    function GetNextNameID: Integer;
    function Selection(xs, ys: Integer) : integer;
  end;

const
  NearClipping = 1;
  FarClipping  = 1000;
  MaxDrawTime  = 20;

var
  Form1             : TForm1;
  viewangle         : Single = 45.0;
  FPS,
  StartTime,
  DrawTime,
  TimeCount,
  FrameCount        : Integer;
  myQuads           : Array[0..5] of TMyQuad;
  nextNameId        : Integer = 1;


implementation

{$R *.dfm}

function TForm1.GetNextNameID: Integer;
begin
 result := nextNameID;
 inc(nextNameID);
end;

procedure TForm1.CreateMyQuad(var mq: TMyQuad; _px,_py,_pz,_sx,_sy,_rx,_ry,_rz: Single);
begin
 with mq do begin
   px := _px; py := _py; pz := _pz;
   sx := _sx; sy := _sy;
   rx := _rx; ry := _ry; rz := _rz;
   nameId := GetNextNameID;
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 DC:= GetDC(Handle);
 if not InitOpenGL then begin
    ShowMessage('OpenGL kann nicht initialisiert werden. Programm wird beeendet');
    Application.Terminate;
 end;
 RC:= CreateRenderingContext(   DC,
                                [opDoubleBuffered],
                                32,
                                24,
                                0,0,0,
                                0);
  ActivateRenderingContext(DC, RC);
  Application.OnIdle := IdleHandler;
  SetupGL;
  Init;
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
  CreateMyQuad(myQuads[0], -1.5, 0, 0, 1, 1, 0, 0, 0);
  CreateMyQuad(myQuads[1], 0, 0, -1, 1, 1, 0, 0, 0);
  CreateMyQuad(myQuads[2], 1.5, 0, 0, 1, 1, 0, 0, 0);
  CreateMyQuad(myQuads[3], 0, 1.5, 0, 1, 1, 0, 0, 0);
  CreateMyQuad(myQuads[4], 0, 0, 1, 1, 1, 0, 0, 0);
  CreateMyQuad(myQuads[5], 0, -1.5, 0, 1, 1, 0, 0, 0);
end;

procedure TForm1.Render;
var i: Integer;
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
 
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  gluPerspective(viewangle, ClientWidth/ClientHeight, NearClipping, FarClipping);
 
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;

  // cam translations
  glTranslatef(0, 0, -6);
  glRotated(30, 0, 1, 1);

  // name stuff
  glInitNames;
  glPushName(0);


  for i := 0 to High(myQuads) do
   DrawMyQuad(myQuads[i]);


  // name für den hintergrund
  glLoadName(0);

  SwapBuffers(DC);
end;

procedure TForm1.DrawMyQuad(q: TMyQuad);
begin
  glPushMatrix;

  glTranslatef(q.px, q.py, q.pz);

  glRotated(q.rx, 1, 0, 0);
  glRotated(q.ry, 0, 1, 0);
  glRotated(q.rz, 0, 0, 1);

  glLoadName(q.nameID);

  glBegin(GL_QUADS);
    glColor3f(1, 0, 0); glVertex3f(-(q.sx/2), -(q.sy/2), 0);
    glColor3f(0, 1, 0); glVertex3f( (q.sx/2), -(q.sy/2), 0);
    glColor3f(0, 0, 1); glVertex3f(( q.sx/2),  (q.sy/2), 0);
    glColor3f(1, 1, 0); glVertex3f(-(q.sx/2),  (q.sy/2), 0);
  glEnd;
  glPopMatrix;
end;

procedure TForm1.IdleHandler(Sender: TObject; var Done: Boolean);
begin
  StartTime:= GetTickCount;
  Render;
  DrawTime:= GetTickCount - StartTime;
  Inc(TimeCount, DrawTime);
  Inc(FrameCount);

  if DrawTime < MaxDrawTime then
    Sleep(MaxDrawTime - DrawTime);
 
  if TimeCount >= 1000 then begin
    FPS:= FrameCount;
    TimeCount:= TimeCount - 1000;
    FrameCount:= 0;
    ErrorHandler;
  end;
 
  Done:= false;
end;

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

procedure TForm1.FormResize(Sender: TObject);
var tmpBool : Boolean;
begin
 glViewport(0, 0, ClientWidth, ClientHeight);
 glMatrixMode(GL_PROJECTION);
 glLoadIdentity;
 gluPerspective(viewangle, 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;

function TForm1.Selection(xs, ys: 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
 
  glMatrixMode(GL_PROJECTION);                //In den Projektionsmodus
  glRenderMode(GL_SELECT);                    //In den Selectionsmodus schalten
  glPushMatrix;                               //Um unsere Matrix zu sichern
  glLoadIdentity;                             //Und dieselbige wieder zurückzusetzen
 
  gluPickMatrix(xs, viewport[3]-ys, 1.0, 1.0, viewport);
  gluPerspective(viewangle, ClientWidth/ClientHeight, NearClipping, FarClipping);
 
  render;                                     //Die Szene zeichnen
  glMatrixMode(GL_PROJECTION);                //Wieder in den Projektionsmodus
  glPopMatrix;                                //und 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;
 
  if getroffen=High(GLUInt) 
    then Result := -1
    else Result := getroffen;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;  Shift: TShiftState; X, Y: Integer);
begin
 Form1.Caption := IntToStr(x) + ' | ' + IntToStr(y) + ' :  ' + IntToStr(Selection(x, y));
end;

end.					

1:
2:
3:
4:
5:
6:
7:
8:

var puffer: Array[0..2] of Byte;
begin
  Render;
  glReadPixels(x, y, 1, 1, GL_RGB, GL_UNSIGNED_BYTE, @puffer);

  Form1.Caption := IntToStr(x) + '|' + IntToStr(y) + ' :  ' +  IntToStr(puffer[0])
                    + ', ' + IntToStr(puffer[1]) + ', ' + IntToStr(puffer[2]);
end;