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:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
| unit SSs;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,dglopengl, StdCtrls, ExtCtrls, glbitmap;
type
TForm1 = class(TForm)
Timer1: TTimer;
Image1: TImage;
Image2: TImage;
Image3: TImage;
Image4: TImage;
Image5: TImage;
Image6: TImage;
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Render;
procedure Timer1Timer(Sender: TObject);
procedure Drawsphere(dist,size: extended);
procedure rotateview;
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image3MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image4MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image5MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image6MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
private
x,quad: PGLUquadric;
public
end;
const
nearclipping = 1;
Farclipping = 1000;
const
Sunn = 1;
Marss = 2;
Earthh = 3;
Moonn = 4;
var
Form1: TForm1;
DC,RC:HDC;
Angle,i: extended;
BG,sun,earth,merc,moon,venus,mars,jupiter,saturn,uranus,neptune: tglbitmap2d;
move,r,l,f: extended;
xs,ys,roa,rob,roc,rod,
aimv,aimh,aimangley,aimanglex: extended;
mleft,mright,mdown,mup: boolean;
xx,q,w: integer;
implementation
{$R *.dfm}
procedure drawaim;
begin
glLineWidth(10);
glbegin(gl_line_strip);
glcolor3f(0,1,0);glvertex3f(-0.25,-0.25,18);
glcolor3f(0,1,0);glvertex3f(0.25,-0.25,18);
glcolor3f(0,1,0);glvertex3f(0.25,0.25,18);
glcolor3f(0,1,0);glvertex3f(-0.25,0.25,18);
glcolor3f(0,1,0);glvertex3f(-0.25,-0.25,18);
glend;
gltranslatef(aimh,aimv,0);
glLineWidth(5);
glbegin(gl_line_strip);
glcolor3f(0,1,0.3);glvertex3f(-0.25,-0.25,15);
glcolor3f(0,1,0.3);glvertex3f(0.25,-0.25,15);
glcolor3f(0,1,0.3);glvertex3f(0.25,0.25,15);
glcolor3f(0,1,0.3);glvertex3f(-0.25,0.25,15);
glcolor3f(0,1,0.3);glvertex3f(-0.25,-0.25,15);
glend;
end;
procedure tform1.rotateview;
begin
if xx < image2.Left then
begin
mleft := true;
mright := false;
end;
if xx > image2.Left then
if xx < image3.Left then
begin
mleft := false;
mright := false;
if aimh > 0 then aimh := aimh - 0.5;
if aimh < 0 then aimh := aimh + 0.5;
if aimangley > 0 then aimangley := aimangley - 1;
if aimangley < 0 then aimangley := aimangley + 1;
end;
if xx > image3.Left then
begin glcolor3f(1,1,1);
mleft := false;
mright := true;
end;
end;
procedure drawbg;
begin
bg.Bind();
glbegin(gl_quads);
glTexCoord2f(0,0); glvertex3f(-24,-13,-10);
gltexcoord2f(1,0); glvertex3f(24,-13,-10);
gltexcoord2f(1,1); glvertex3f(24,13,-10);
gltexcoord2f(0,1); glvertex3f(-24,13,-10);
glend;
end;
Procedure Tform1.Drawsphere(dist,size: extended);
begin
glTranslatef(dist, 0, 0);
glscalef(size,size,size);
glusphere(quad,1,50,50);
end;
Procedure TForm1.Render;
begin
if mleft = true then
begin
roa := roa + 0.8;
aimh := aimh - 0.5;
if aimh <= -1 then aimh := aimh + 0.5;
aimangley := aimangley - 1;
if aimangley <= -5 then aimangley := aimangley +1;
end;
if mright = true then
begin
rob := rob - 0.8;
aimh := aimh + 0.5;
if aimh >= 1 then aimh := aimh - 0.5;
aimangley := aimangley + 1;
if aimangley >= 5 then aimangley := aimangley -1;
end;
if mup = true then
begin
roc := roc + 0.8;
aimv := aimv + 0.5;
if aimv >= 1 then aimv := aimv - 0.5;
aimanglex := aimanglex - 0.5;
if aimanglex <= -2 then aimanglex := aimanglex +0.5;
end;
if mdown = true then
begin
rod := rod - 0.8;
aimv := aimv - 0.5;
if aimv <= -1 then aimv := aimv + 0.5;
aimanglex := aimanglex + 0.5;
if aimanglex >= 2 then aimanglex := aimanglex -0.5;
end;
if mup = false then
if mdown = false then
begin
if aimv > 0 then aimv := aimv - 0.5;
if aimv < 0 then aimv := aimv + 0.5;
if aimanglex > 0 then aimanglex := aimanglex - 0.5;
if aimanglex < 0 then aimanglex := aimanglex + 0.5;
end;
i := i +00.5;
Angle := angle + 0.01;
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
glloadidentity;
glcolor3f(1,0,0);
glInitNames;
glPushName(0);
gltranslatef(0,0,-20);
bg.Unbind();
glpushmatrix;
glrotatef(aimangley,0,1,0);
glrotatef(aimanglex,1,0,0);
drawaim;
glpopmatrix;
glrotatef(30,1,0,0);
glrotatef(roa,0,1,0);
glrotatef(rob,0,1,0);
glrotatef(roc,1,0,0);
glrotatef(rod,1,0,0);
glcolor3f(1,1,1);
glscalef(1,1,1);
glLoadName(Sunn);
gluQuadricTexture(quad,true);
sun.Bind();
glusphere(quad,1,50,50);
glpushmatrix;
glcolor3f(1,1,1);
glrotatef(200+angle,0,1,0);
merc.Bind;
Drawsphere(2.5,0.25);
glpopmatrix;
glpushmatrix;
glrotatef(100+angle,0,1,0);
venus.Bind;
Drawsphere(3.75,0.3);
glpopmatrix;
glPushMatrix;
glcolor3f(1,1,1);
glrotatef(50,0,1,0);
glrotatef(20,18,0,0);
earth.Bind;
DrawSphere(7,0.5);
glpushmatrix;
glcolor3f(1,1,1);
glrotatef(5+angle,0,1,0);
moon.bind;
drawsphere(2,0.5);
glpopmatrix;
glpopmatrix;
glrotatef(-30,1,0,0);
glscalef(100,100,100);
bg.Bind();
glcolor3f(1,1,1);
glusphere(quad,1,500,500);
swapbuffers(dc);
end;
function Selection : Integer;
var
SelectBuffer : array[0..512] of TGLUInt;
Viewport : TGLArrayi4;
Hits,i : Integer;
HitZValue : TGLUInt;
Hit : TGLUInt;
begin
glGetIntegerv(GL_VIEWPORT, @viewport);
glSelectBuffer(512, @SelectBuffer);
glRenderMode(GL_SELECT);
glInitNames;
glPushName(0);
glMatrixMode(GL_PROJECTION);
glPushMatrix;
glLoadIdentity;
gluPickMatrix(xs, viewport[3]-ys, 1.0, 1.0, viewport);
gluPerspective(45.0, form1.ClientWidth/form1.ClientHeight, 0.1, 1000);
form1.render;
glMatrixMode(GL_PROJECTION);
glPopMatrix;
Hits := glRenderMode(GL_RENDER);
Hit := High(TGLUInt);
HitZValue := High(TGLUInt);
for i := 0 to Hits-1 do
if SelectBuffer[(i*4)+1] < HitZValue then
begin
Hit := SelectBuffer[(i*4)+3];
HitZValue := SelectBuffer[(i*4)+1];
end;
Result := Hit;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
DC := GetDC(Handle);
RC:= CreateRenderingContext( DC,
[opDoubleBuffered],
32,
24,
0,0,0,
0);
ActivateRenderingContext(DC, RC);
glEnable(GL_DEPTH_TEST);
glViewport(0, 0, ClientWidth, ClientHeight);
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
gluPerspective(45.0, ClientWidth/ClientHeight, NearClipping, FarClipping);
glMatrixMode(GL_MODELVIEW);
x := glunewquadric;
quad := glunewquadric;
gltranslatef(0,0,-20);
BG:=TglBitmap2D.Create;
BG.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'space.bmp');
bg.GenTexture;
sun := tglbitmap2d.Create;
sun.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'sonne.bmp');
sun.GenTexture;
merc := tglbitmap2d.create;
merc.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'mercury.bmp');
merc.GenTexture;
earth := tglbitmap2d.Create;
earth.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'earth.bmp');
earth.GenTexture;
moon := tglbitmap2d.Create;
moon.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'moon.bmp');
moon.GenTexture;
venus := tglbitmap2d.Create;
venus.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'venus.bmp');
venus.GenTexture;
cursor := crnone;
end;
procedure TForm1.FormResize(Sender: TObject);
begin
glViewport(0, 0, ClientWidth, ClientHeight);
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
gluPerspective(45.0, ClientWidth/ClientHeight, NearClipping, FarClipping);
glMatrixMode(GL_MODELVIEW);
glLoadIdentity;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
DeactivateRenderingContext;
DestroyRenderingContext(RC);
ReleaseDC(Handle, DC);
bg.Unbind();
sun.Unbind();
merc.Unbind();
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
render;
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
mleft := true;
mright := false;
end;
procedure TForm1.Image2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
mleft := false;
mright := false;
end;
procedure TForm1.Image3MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
mright := true;
mleft := false;
end;
procedure TForm1.Image4MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
mup := true;
mdown := false;
xx := x;
rotateview;
end;
procedure TForm1.Image5MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
mdown := true;
mup := false;
xx := x;
rotateview;
end;
procedure TForm1.Image6MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
mdown := false;
mup := false;
xx := x;
rotateview;
end;
end. |
Narses
