var
Form1: TForm1;
FormBlocks:
Array[0..Round(SizeX/BlockSizeX)]
of Array [0..Round(SizeY/BlockSizeY)]
of Integer;
// Map Farben
FormSettings:
Record // Sonstige Optionen
cRGB: TcRGB;
end;
FallingObject:
Record // Fallendes Objekt
pX, pY: Single;
aType: Integer;
end;
ObjType:
Array[1..7]
of Record
pX, pY:
Array[1..4]
of Single;
ALengthX, ALengthY: Integer;
cRGB: TcRGB;
end;
implementation
{$R *.dfm}
// Rot, Grün, Blau in TcRGB umwandeln
function GetRGB(cRed, cGreen, cBlue: Single): TcRGB;
begin
Result.cRed := cRed;
Result.cGreen := cGreen;
Result.cBlue := cBlue;
end;
// Block zeichnen
procedure DrawBlock(cRGB: TcRGB; pX, pY: Single);
begin
glBegin(GL_QUADS);
glColor3f(cRGB.cRed, cRGB.cGreen, cRGB.cBlue);
glVertex3f(pX-BlockSizeX/2, pY-BlockSizeY/2, 0);
glVertex3f(pX+BlockSizeX/2, pY-BlockSizeY/2, 0);
glVertex3f(pX+BlockSizeX/2, pY+BlockSizeY/2, 0);
glVertex3f(pX-BlockSizeX/2, pY+BlockSizeY/2, 0);
glEnd;
end;
// Viewport und Größer der map einstellen
procedure TForm1.SetSizeOptions;
begin
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
glViewPort(Unusable_Margin_X, Unusable_Margin_Y, ClientWidth, ClientHeight);
glOrtho(0, SizeX, 0, SizeY, -128, 128);
glMatrixMode(GL_MODELVIEW);
glLoadIdentity;
end;
// Rendern
procedure TForm1.Render(Sender: TObject;
var Done: Boolean);
var
i1, i2: Integer;
begin
SetSizeOptions;
For i1 := 0
to Round(SizeX/BlockSizeX)
do // Hintergrund für Tetris Färben
For i2 := 0
to Round(SizeY/BlockSizeY)
do
If FormBlocks[i1][i2] = 0
then
DrawBlock(FormSettings.cRGB, i1*BlockSizeX, i2*BlockSizeY)
else if FormBlocks[i1][i2] = 1
then
DrawBlock(ObjType[FallingObject.aType].cRGB, i1*BlockSizeX, i2*BlockSizeY);
SwapBuffers(
DC);
Done := False;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
i: Integer;
begin
// OpenGL initialisieren
InitOpenGL;
DC := GetDC(
Handle);
RC := CreateRenderingContext(
DC, [opDoubleBuffered], 32, 24, 0, 0, 0, 0);
ActivateRenderingContext(
DC, RC);
// Alle Blöcke löschen
FillChar(FormBlocks, SizeOf(FormBlocks), 0);
// Hintergrundfarbe einstellen
FormSettings.cRGB := GetRGB(0.3, 0.3, 1);
// Viewport und Größe der map einstellen
SetSizeOptions;
// Dauerhaft Rendern
Application.OnIdle := Render;
// Block erstellen
FallingObject.aType := 1;
FallingObject.pX := SizeX/2-BlockSizeX*ObjType[FallingObject.aType].ALengthX/2;
FallingObject.pY := SizeY-20;
For i := 1
to 4
do // Block aussehen angeben
FormBlocks
[Round(FallingObject.pX/BlockSizeX+ObjType[FallingObject.aType].pX[i])]
[Round(FallingObject.pY/BlockSizeY+ObjType[FallingObject.aType].pY[i])]
:= 1;
// Block-Daten einstellen
// -- Type 1 -- //
ObjType[1].cRGB := GetRGB(0, 1, 0);
// Farbe
ObjType[1].ALengthX := 4;
// Länge
ObjType[1].ALengthY := 1;
// Länge
ObjType[1].pX[1] := 0;
// Aussehen
ObjType[1].pX[2] := 1;
ObjType[1].pX[3] := 2;
ObjType[1].pX[4] := 3;
ObjType[1].pY[1] := 0;
ObjType[1].pY[2] := 0;
ObjType[1].pY[3] := 0;
ObjType[1].pY[4] := 0;
// -- Type 2 -- //
ObjType[2].cRGB := GetRGB(1, 1, 0);
ObjType[2].ALengthX := 3;
// Länge
ObjType[2].ALengthY := 2;
// Länge
ObjType[2].pX[1] := 0;
ObjType[2].pX[2] := 1;
ObjType[2].pX[3] := 1;
ObjType[2].pX[4] := 2;
ObjType[2].pY[1] := 0;
ObjType[2].pY[2] := 0;
ObjType[2].pY[3] := 1;
ObjType[2].pY[4] := 0;
end;
procedure TForm1.FormResize(Sender: TObject);
begin
// Viewport und Größer der map einstellen
SetSizeOptions;
end;
end.