unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, dglOpenGL, glText, Textures, StdCtrls, ExtCtrls;
type
TMainForm =
class(TForm)
Timer1: TTimer;
Timer2: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormKeyDown(Sender: TObject;
var Key: Word;
Shift: TShiftState);
procedure Timer2Timer(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Timer3Timer(Sender: TObject);
private
{ Private declarations }
procedure Render(Sender: TObject;
var Done: Boolean);
function Selection : integer;
public
{ Public declarations }
DC: HDC;
RC: HGLRC;
myPalette: HPALETTE;
end;
TRecBorder =
Record
RLeft, RRight, RBot, RTop: Integer;
end;
procedure ErrorMsg
(Msg:
String; MsgTitle:
String = '
Error!');
const
RecBorder: TRecBorder = (RLeft: 10; RRight: 0;
RBot : 10; RTop : 10);
SizeX = 640;
SizeY = 480;
ObjWidth = 100;
ObjHeight = 100;
dir_LEFT = 0;
dir_RIGHT = 1;
dir_Max = 1;
ManWidth = 100;
ManHeight = 100;
var
MainForm: TMainForm;
PlaneTex, ManTex: glUInt;
SelPlane:
Record
pX, pY: Single;
Direction: 0..1;
end;
Player:
Record
pX, pY: Single;
end;
Options:
Record
Speed: Integer;
CanClick: Boolean;
clicksHitted, clicksMissed, clicksTotal: Integer;
end;
xs, ys: Integer;
implementation
{$R *.dfm}
procedure SetupPixelFormat;
var hHeap: THandle;
nColors, i: Integer;
lpPalette : PLogPalette;
byRedMask, byGreenMask, byBlueMask: Byte;
nPixelFormat: Integer;
pfd: TPixelFormatDescriptor;
begin
FillChar(pfd, SizeOf(pfd), 0);
with pfd
do begin
nSize := sizeof(pfd);
// Länge der pfd-Struktur
nVersion := 1;
// Version
dwFlags := PFD_DRAW_TO_WINDOW
or PFD_SUPPORT_OPENGL
or
PFD_DOUBLEBUFFER;
// Flags
iPixelType:= PFD_TYPE_RGBA;
// RGBA Pixel Type
cColorBits:= 24;
// 24-bit color
cDepthBits:= 32;
// 32-bit depth buffer
iLayerType:= PFD_MAIN_PLANE;
// Layer Type
end;
nPixelFormat:= ChoosePixelFormat(MainForm.DC, @pfd);
SetPixelFormat(MainForm.DC, nPixelFormat, @pfd);
// Farbpalettenoptimierung wenn erforderlich
DescribePixelFormat(MainForm.DC, nPixelFormat,
sizeof(TPixelFormatDescriptor),pfd);
if ((pfd.dwFlags
and PFD_NEED_PALETTE) <> 0)
then begin
nColors := 1
shl pfd.cColorBits;
hHeap := GetProcessHeap;
lpPalette:= HeapAlloc
(hHeap,0,sizeof(TLogPalette)+(nColors*sizeof(TPaletteEntry)));
lpPalette^.palVersion := $300;
lpPalette^.palNumEntries := nColors;
byRedMask := (1
shl pfd.cRedBits) - 1;
byGreenMask:= (1
shl pfd.cGreenBits) - 1;
byBlueMask := (1
shl pfd.cBlueBits) - 1;
for i := 0
to nColors - 1
do begin
lpPalette^.palPalEntry[i].peRed :=
(((i
shr pfd.cRedShift)
and byRedMask) *255)
DIV byRedMask;
lpPalette^.palPalEntry[i].peGreen:=
(((i
shr pfd.cGreenShift)
and byGreenMask)*255)
DIV byGreenMask;
lpPalette^.palPalEntry[i].peBlue :=
(((i
shr pfd.cBlueShift)
and byBlueMask) *255)
DIV byBlueMask;
lpPalette^.palPalEntry[i].peFlags:= 0;
end;
MainForm.myPalette := CreatePalette(lpPalette^);
HeapFree(hHeap, 0, lpPalette);
if (MainForm.myPalette <> 0)
then begin
SelectPalette(MainForm.DC, MainForm.myPalette, False);
RealizePalette(MainForm.DC);
end;
end;
end;
function TMainForm.Selection : integer;
var
Puffer :
array[0..256]
of GLUInt;
Viewport :
{array[0..3] of Integer}TVector4i;
Treffer,i : Integer;
Z_Wert : GLUInt;
Getroffen : GLUInt;
tmpBool: Boolean;
begin
glGetIntegerv(GL_VIEWPORT, @viewport);
//Die Sicht speichern
glSelectBuffer(256, @Puffer);
//Den Puffer zuordnen
glRenderMode(GL_SELECT);
//In den Selectionsmodus schalten
glmatrixmode(gl_projection);
//In den Projektionsmodus
glPushMatrix;
//Um unsere Matrix zu sichern
glLoadIdentity;
//Und dieselbige wieder zurückzusetzen
gluPickMatrix(xs, viewport[3]-ys, 1.0, 1.0, viewport);
gluPerspective(45.0, ClientWidth/ClientHeight, 1, 100);
render(Self, tmpBool);
//Die Szene zeichnen
glmatrixmode(gl_projection);
//Wieder in den Projektionsmodus
glPopMatrix;
//um 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;
Result := getroffen;
end;
// Procedure to send an error message
procedure ErrorMsg
(Msg:
String; MsgTitle:
String = '
Error!');
begin
Application.MessageBox(PChar(Msg), PChar(MsgTitle),
MB_OK
or MB_ICONERROR);
end;
// Procedure to create a texture quad
procedure DrawQuad(pX, pY: Single; pWidth, pHeight: Integer);
begin
glBegin(GL_QUADS);
glTexCoord2f(0, 0); glVertex2f(pX, pY);
glTexCoord2f(1, 0); glVertex2f(pX+pWidth, pY);
glTexCoord2f(1, 1); glVertex2f(pX+pWidth, pY+pHeight);
glTexCoord2f(0, 1); glVertex2f(pX, pY+pHeight);
glEnd;
end;
// Procedure to set the opengl sizes
procedure SetSizes;
begin
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
glViewPort(0, 0, MainForm.ClientWidth, MainForm.ClientHeight);
glOrtho(0, SizeX, 0, SizeY, -128, 128);
glMatrixMode(GL_MODELVIEW);
glLoadIdentity;
end;
// Procedure to create a new plane
procedure NewPlane;
begin
If (SelPlane.Direction <> 0)
and (SelPlane.Direction <> 1)
then
SelPlane.Direction := Random(dir_MAX+1)
else
SelPlane.Direction := Integer(
not Bool(SelPlane.Direction));
Case SelPlane.Direction
of
dir_LEFT: SelPlane.pX := SizeX;
dir_RIGHT: SelPlane.pX := 0;
end;
SelPlane.pY := Random(SizeY-ObjHeight*2-ManHeight)+ObjHeight+ManHeight;
end;
// ==========================================================
// TMainForm
// ==========================================================
procedure TMainForm.FormCreate(Sender: TObject);
begin
DC:= GetDC(
Handle);
//SetupPixelFormat;
RC:= CreateRenderingContext(
DC, [opDoubleBuffered],
32, 24, 0, 0, 0, 0);
ActivateRenderingContext(
DC, RC);
glEnable(GL_DEPTH_TEST);
glLoadIdentity;
SetSizes;
glClearColor(1, 1, 1, 0);
glEnable(GL_CULL_FACE);
glEnable(GL_TEXTURE_2D);
glEnable(GL_ALPHA_TEST);
glAlphaFunc(GL_GREATER, 0.1);
Application.OnIdle := Render;
LoadTexture('
Raumschiff.tga', PlaneTex, False);
LoadTexture('
Schütze.tga', ManTex, False);
NewPlane;
Options.Speed := 20;
Options.CanClick := True;
Options.clicksHitted := 0;
Options.clicksMissed := 0;
Options.clicksTotal := 0;
Player.pX := 0;
Player.pY := 0;
end;
// Procedure to render all things
procedure TMainForm.Render(Sender: TObject;
var Done: Boolean);
var
CanClickText:
String;
begin
glClear(GL_COLOR_BUFFER_BIT
or GL_DEPTH_BUFFER_BIT);
SetSizes;
glPrint(10, SizeY-15, '
Speed : '+IntToStr(Options.Speed), 0, 0, 0);
glPrint(10, SizeY-35, '
Hits : '+IntToStr(Options.clicksHitted), 0.3, 1, 0.3);
glPrint(10, SizeY-55, '
Missed : '+IntToStr(Options.clicksMissed), 1, 0.3, 0.3);
glPrint(10, SizeY-75, '
Total : '+IntToStr(Options.clicksTotal), 0, 0, 0);
CanClickText := '
You can'#10'
t hit it now!';
If not Options.CanClick
then
glPrint(SizeX
div 2 - Canvas.TextWidth(CanClickText)
div 2, SizeY-95, CanClickText, 1, 0, 0);
glPushMatrix;
glLoadName(1);
glTranslatef(SelPlane.pX, SelPlane.pY, 0);
Case SelPlane.Direction
of
dir_LEFT: glRotatef(90*1, 0, 0, 1);
dir_RIGHT: glRotatef(90*3, 0, 0, 1);
end;
glBindTexture(GL_TEXTURE_2D, PlaneTex);
DrawQuad(0,0,ObjWidth,ObjHeight);
glPopMatrix;
glPushMatrix;
glLoadName(2);
glTranslatef(Player.pX, Player.pY, 0);
glBindTexture(GL_TEXTURE_2D, ManTex);
DrawQuad(0,0,ManWidth,ManHeight);
glPopMatrix;
SwapBuffers(
DC);
Done := False;
end;
procedure TMainForm.FormResize(Sender: TObject);
begin
SetSizes;
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
DeactivateRenderingContext;
DestroyRenderingContext(RC);
ReleaseDC(
Handle,
DC);
end;
procedure TMainForm.Timer1Timer(Sender: TObject);
begin
Case SelPlane.Direction
of
dir_LEFT: SelPlane.pX := SelPlane.pX - Options.Speed;
dir_RIGHT: SelPlane.pX := SelPlane.pX + Options.Speed;
end;
If ((SelPlane.Direction = dir_LEFT)
and
(SelPlane.pX <= 0-ObjWidth))
or
((SelPlane.Direction = dir_RIGHT)
and
(SelPlane.pX >= SizeX+ObjWidth))
then NewPlane;
end;
procedure TMainForm.FormKeyDown(Sender: TObject;
var Key: Word;
Shift: TShiftState);
begin
If Key = VK_F1
then
Timer1.Enabled :=
not Timer1.Enabled;
If Timer1.Enabled
then
begin
Options.CanClick := False;
Timer2.Enabled := False;
Timer2.Enabled := True;
end;
end;
procedure TMainForm.Timer2Timer(Sender: TObject);
begin
Options.CanClick := True;
Timer2.Enabled := False;
end;
procedure TMainForm.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
If not Options.CanClick
then Exit;
xs := x;
ys := y;
If Selection<>-1
then
begin
ShowMessage(IntToStr(Selection));
Inc(Options.clicksHitted);
end
else
Inc(Options.clicksMissed);
Inc(Options.clicksTotal);
If Options.clicksTotal
mod 20 = 0
then
Inc(Options.Speed, 5);
end;
procedure TMainForm.Timer3Timer(Sender: TObject);
begin
BorderStyle := bsNone;
WindowState := wsMaximized;
end;
end.