unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, Grids, ComCtrls, ExtCtrls, StdCtrls;
type
TForm1 =
class(TForm)
MainMenu1: TMainMenu;
Spiel1: TMenuItem;
NeuesSpiel1: TMenuItem;
N1: TMenuItem;
Beenden1: TMenuItem;
StatusBar1: TStatusBar;
Spielfeld: TStringGrid;
info1: TMenuItem;
Leiste: TStringGrid;
Zeit: TTimer;
Hilfe1: TMenuItem;
Info2: TMenuItem;
Optionen1: TMenuItem;
Steuerung1: TMenuItem;
Musik: TMenuItem;
Fortsetzen1: TMenuItem;
Stopp1: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
Sounds1: TMenuItem;
Leicht: TMenuItem;
N8: TMenuItem;
Mittel: TMenuItem;
N9: TMenuItem;
Schwer: TMenuItem;
N10: TMenuItem;
Highscore1: TMenuItem;
N2: TMenuItem;
Spielmodus1: TMenuItem;
Musik1: TMenuItem;
N11: TMenuItem;
Musik2: TMenuItem;
N12: TMenuItem;
Musik3: TMenuItem;
N13: TMenuItem;
Memories1: TMenuItem;
N14: TMenuItem;
SwaggerJackin1: TMenuItem;
procedure Beenden1Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure NeuesSpiel;
procedure SpielfeldDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure NeuesSpiel1Click(Sender: TObject);
procedure SpielfeldSelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
procedure GleicheFarbenFinden(x, y : integer);
procedure GleicheFarbenLoeschen;
procedure ZeitTimer(Sender: TObject);
procedure LeisteDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure Info2Click(Sender: TObject);
procedure Hilfe1Click(Sender: TObject);
procedure Highscore1Click(Sender: TObject);
procedure Steuerung1Click(Sender: TObject);
procedure Stopp1Click(Sender: TObject);
procedure Fortsetzen1Click(Sender: TObject);
procedure LeichtClick(Sender: TObject);
procedure MittelClick(Sender: TObject);
procedure SchwerClick(Sender: TObject);
procedure Spielmodus1Click(Sender: TObject);
procedure Musik1Click(Sender: TObject);
procedure Musik2Click(Sender: TObject);
procedure Musik3Click(Sender: TObject);
procedure Memories1Click(Sender: TObject);
procedure SwaggerJackin1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1 : TForm1;
Zellengroesse : integer = 30;
// legt die Zellengröße Zg x Zg
anzahlgleichfarbigerbloecke : integer;
Punkte : integer;
Runden : integer;
Kaestchen : integer;
// für Belegung der Leiste
LetzteZeile : boolean;
Classic : boolean;
start : TDatetime;
Level : integer;
PunkteEnde : integer;
implementation
uses Unit2, Unit3, Unit4, Unit5, Unit7, Unit6, Unit8, Unit10, Unit11, Unit12,
Unit13, Unit14;
{$R *.DFM}
{==============================================================================}
procedure TForm1.Beenden1Click(Sender: TObject);
begin
Application.Terminate;
end;
{==============================================================================}
procedure TForm1.FormActivate(Sender: TObject);
begin
Spielfeld.DefaultColWidth := Zellengroesse;
Spielfeld.DefaultRowHeight := Zellengroesse;
Spielfeld.ClientWidth := Spielfeld.ColCount*(Zellengroesse+Spielfeld.GridLineWidth);
Spielfeld.ClientHeight := Spielfeld.RowCount*(Zellengroesse+Spielfeld.GridLineWidth);
Leiste.DefaultColWidth := Zellengroesse;
Leiste.DefaultRowHeight := Zellengroesse;
Leiste.ClientWidth := Leiste.ColCount*(Zellengroesse+Leiste.GridLineWidth);
Leiste.ClientHeight := Leiste.RowCount*(Zellengroesse+Leiste.GridLineWidth);
// Statusbar im Verhältnis 1:3 teilen
StatusBar1.Panels[0].Width := StatusBar1.Width
div 2;
Form1.Width := Spielfeld.ClientWidth+12;
Form1.Height := Spielfeld.ClientHeight+80+Leiste.ClientHeight+30;
randomize;
NeuesSpiel;
Spielfeld.Enabled := false;
// bei Start Stillstand
Zeit.Enabled := false;
// Zeit anhalten sofort nach Start
Classic:= true;
end;
{==============================================================================}
procedure TForm1.NeuesSpiel;
var x,y,i : integer;
begin
for x := 0
to Spielfeld.ColCount-1
do
begin
i := random(4)+1;
// zufällige Anordnung der Kästchen
for y := Spielfeld.RowCount-i
to Spielfeld.RowCount-1
do
Spielfeld.Cells[x,y] := IntToStr(random(5));
// belegt alle Felder mit Farbe
for y := 0
to Spielfeld.RowCount-i-1
do
Spielfeld.Cells[x,y] := '
-1';
// belegt alle leeren Felder mit schwarz
end;
for x := 0
to Leiste.ColCount-1
do
Leiste.Cells[x,0] := IntToStr(random(5));
// zufällige Belegung der Leiste
//Spielfeld.Cells[0,0]:='4';
//Spielfeld.Cells[0,1]:='3';
Zeit.Enabled := true;
// Uhr anschalten
Zeit.Interval := 500;
Kaestchen := Spielfeld.ColCount;
LetzteZeile := false;
Spielfeld.Enabled := true;
if Classic=false
then Zeit.Interval := 100;
end;
{==============================================================================}
procedure TForm1.SpielfeldDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
if Spielfeld.Cells[ACol,Arow] <> '
-1'
then
case Spielfeld.Cells[ACol,Arow][1]
of
'
0' : Spielfeld.Canvas.Brush.Color := clRed;
'
1' : Spielfeld.Canvas.Brush.Color := clBlue;
'
2' : Spielfeld.Canvas.Brush.Color := clYellow;
'
3' : Spielfeld.Canvas.Brush.Color := clGreen;
'
4' : Spielfeld.Canvas.Brush.Color := clWhite;
else Spielfeld.Canvas.Brush.Color := clBLack;
// Farbe für "gelöscht"
end;
// endcase
Spielfeld.Canvas.Pen.Color := clBlack;
Spielfeld.Canvas.Rectangle(Rect);
end;
{==============================================================================}
procedure TForm1.LeisteDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
if Leiste.Cells[ACol,Arow] <> '
-1'
then
case Leiste.Cells[ACol,ARow][1]
of
'
0' : Leiste.Canvas.Brush.Color := clRed;
'
1' : Leiste.Canvas.Brush.Color := clBlue;
'
2' : Leiste.Canvas.Brush.Color := clYellow;
'
3' : Leiste.Canvas.Brush.Color := clGreen;
'
4' : Leiste.Canvas.Brush.Color := clWhite;
else Leiste.Canvas.Brush.Color := clBlack;
// Farbe für "gelöscht"
end;
// endcase
Leiste.Canvas.Pen.Color := clBlack;
Leiste.Canvas.Rectangle(Rect);
end;
{==============================================================================}
procedure TForm1.NeuesSpiel1Click(Sender: TObject);
begin
NeuesSpiel;
Statusbar1.Panels[0].Text := '
Punkte : 0';
Statusbar1.Panels[1].Text := '
Runden : 30';
// Statusbar1.Panels[2].Text := 'Level : 1';
// Level := 1;
Punkte := 0;
Runden := 30;
anzahlgleichfarbigerbloecke := 0;
Zeit.Enabled := true;
start := now;
end;
{============================================================================}
procedure TForm1.GleicheFarbenLoeschen;
var x,y ,i ,x1 : integer;
Lueckevorhanden,LeereZeile : boolean;
ZeileBloecke : integer;
begin
if anzahlGleichfarbigerbloecke > 1
then
begin // es gibt bloecke zu löschen
// zu löschende blöcke markieren
for x := 0
to Spielfeld.ColCount -1
do
for y := 0
to Spielfeld.RowCount -1
do
if StrToInt(Spielfeld.Cells[x,y]) > 4
then Spielfeld.Cells[x,y] := '
-1';
for x := 0
to Spielfeld.ColCount -1
do
begin
repeat
Lueckevorhanden := false;
// Lücke suchen
ZeileBloecke := -1;
// eine nicht existierende Zeilennummer
for y := 0
to Spielfeld.RowCount - 2
do
if (Spielfeld.Cells[x,y] <> '
-1')
and (Spielfeld.Cells[x,y+1]='
-1')
then
begin
ZeileBloecke := y;
Lueckevorhanden := true;
end;
if Lueckevorhanden
then
begin
while (ZeileBloecke < Spielfeld.RowCount -1)
and (Spielfeld.Cells[x,ZeileBloecke+1]='
-1')
do
begin
for y := ZeileBloecke
downto 0
do
begin
Spielfeld.Cells[x,y+1] :=Spielfeld.Cells[x,y];
Spielfeld.Cells[x,y] := '
-1';
end;
end;
end;
until not Lueckevorhanden;
end;
for x := 1
to Spielfeld.ColCount -2
do // ab den vollen Spalten anfangen zuzählen
begin
i := 0;
// Anzahl der leeren Kästchen
for y := 0
to Spielfeld.RowCount -1
do
begin
if Spielfeld.Cells[x,y] = '
-1'
then i := i+1;
// erhöhe die Kästchen um 1
end;
if i = Spielfeld.RowCount
// wenn die Spalte leer ist
then
begin
if x <= Spielfeld.ColCount/2
// wenn die Hälfte oder weniger mit Kaestchen belegt ist
then
begin
for x1 := x
downto 1
do // schieben alles nach links, welche Spalte frei ist
begin
for y := 0
to Spielfeld.RowCount-1
do
Spielfeld.Cells[x1,y] := Spielfeld.Cells[x1-1,y];
// Verschiebung Bloecke
end;
for y := 0
to Spielfeld.RowCount-1
do
Spielfeld.Cells[0,y] := '
-1';
// Übertragung Farben Bloecke
end
else
begin
for x1 := x
to Spielfeld.ColCount -2
do // schieben alles nach rechts, welche Spalte frei ist
begin
for y := 0
to Spielfeld.RowCount-1
do
Spielfeld.Cells[x1,y] := Spielfeld.Cells[x1+1,y];
// Verschiebung Bloecke
end;
for y := 0
to Spielfeld.RowCount-1
do
Spielfeld.Cells[Spielfeld.ColCount-1,y] := '
-1';
// Übertragung Farben der Bloecke
end;
end;
end;
end
else // keine Bloecke zu löschen
begin
for x := 0
to Spielfeld.ColCount -1
do
for y := 0
to Spielfeld.RowCount -1
do
if StrToInt(Spielfeld.Cells[x,y]) > 4
then Spielfeld.Cells[x,y] := IntToStr(StrToInt(Spielfeld.Cells[x,y])-5);
//alter wert wiederherstellen
end;
LeereZeile := true;
for x := 0
to Spielfeld.ColCount-1
do
begin
if Spielfeld.Cells[x,Spielfeld.RowCount-1] <> '
-1'
then LeereZeile := false;
end;
if LeereZeile = true
then Punkte := Punkte + 2000;
end;
{============================================================================}
procedure TForm1.GleicheFarbenFinden(x, y : integer);
var farbwert :
string;
begin
anzahlgleichfarbigerbloecke := anzahlgleichfarbigerbloecke+1;
// farbcode merken
farbwert := Spielfeld.Cells[x,y];
// zelle markieren
Spielfeld.Cells[x,y] := IntToStr(StrToInt(Spielfeld.Cells[x,y])+5);
// nördliche zelle testen
if y > 0
then
if Spielfeld.Cells[x,y-1] = farbwert
then GleicheFarbenFinden(x,y-1);
// östliche
if x < Spielfeld.ColCount - 1
then
if Spielfeld.Cells[x+1,y] = farbwert
then GleicheFarbenFinden(x+1,y);
// südliche
if y < Spielfeld.RowCount - 1
then
if Spielfeld.Cells[x,y+1] = farbwert
then GleicheFarbenFinden(x,y+1);
// westliche
if x > 0
then
if Spielfeld.Cells[x-1,y] = farbwert
then GleicheFarbenFinden(x-1,y);
end;
{==============================================================================}
procedure TForm1.SpielfeldSelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
var b, i : integer;
begin
anzahlgleichfarbigerbloecke := 0;
if Spielfeld.Cells[ACol,Arow] <> '
-1'
then GleicheFarbenFinden(ACol, ARow);
b := anzahlgleichfarbigerbloecke;
case b
of
0,1 : Punkte := Anzahlgleichfarbigerbloecke * 0 + Punkte;
2 : Punkte := Anzahlgleichfarbigerbloecke * 5 + Punkte;
3 : Punkte := Anzahlgleichfarbigerbloecke * 10 + Punkte;
4 : Punkte := Anzahlgleichfarbigerbloecke * 15 + Punkte;
5 : Punkte := Anzahlgleichfarbigerbloecke * 20 + Punkte;
6 : Punkte := Anzahlgleichfarbigerbloecke * 25 + Punkte;
7 : Punkte := Anzahlgleichfarbigerbloecke * 30 + Punkte;
else Punkte := Anzahlgleichfarbigerbloecke * 60 + Punkte;
end;
Statusbar1.Panels[0].Text := '
Punkte :' + IntToStr(Punkte);
GleicheFarbenLoeschen;
{ QuickRep1.Prepare;
i := QuickRep1.anzahlgleichfarbigerbloecke;
QuickRep1.Preview;
}
end;
{==============================================================================}
procedure TForm1.ZeitTimer(Sender: TObject);
var x,y : integer;
begin
if Kaestchen = Leiste.ColCount
// Leiste voll
then
begin
for x := 0
to Spielfeld.ColCount-1
do // für oberste Zeile
begin
if Spielfeld.Cells[x,0] <> '
-1'
then
begin
LetzteZeile := true;
// wenn Letzte Zeile belegt
Zeit.Enabled := false;
Spielfeld.Enabled := false;
PunkteEnde := Punkte;
Form8.ShowModal;
// öffnen Fenster mit Game Over
end;
if LetzteZeile = true
then break;
// beendet for-Schleife
end;
if LetzteZeile = false
then
begin
for y := 0
to Spielfeld.RowCount-1
do
begin
for x := 0
to Spielfeld.ColCount-1
do
Spielfeld.Cells[x,y] := Spielfeld.Cells[x,y+1];
// Spiel läuft weiter
end;
for x := 0
to Spielfeld.ColCount-1
do
Spielfeld.Cells[x,Spielfeld.RowCount-1] := Leiste.Cells[x,0];
// Leiste wird weiter übertragen
for x := 0
to Leiste.ColCount-1
do // leeren der Leiste
Leiste.Cells[x,0] := '
-1';
Kaestchen := 0;
Runden := Runden -1;
Statusbar1.Panels[1].Text := '
Runden :' + IntToStr(Runden);
if Runden = 0
then
begin
Zeit.Enabled := false;
Spielfeld.Enabled := false;
PunkteEnde := Punkte;
Form13.ShowModal;
Runden := 30;
if Level = Level+1
then
begin
Runden :=(Level-1)*5+30;
Zeit.Interval := 500;
Zeit.Interval := Zeit.Interval-10;
Zeit.Enabled := true;
Spielfeld.Enabled := true;
end;
end;
end;
end
else // füllen untere Leiste auf
begin
Leiste.Cells[Kaestchen,0] := IntToStr(random(5));
Kaestchen := Kaestchen+1;
end;
end;
{==============================================================================}
procedure TForm1.Info2Click(Sender: TObject);
begin
Form3.ShowModal;
end;
{==============================================================================}
procedure TForm1.Hilfe1Click(Sender: TObject);
begin
Form4.Show;
end;
{==============================================================================}
procedure TForm1.Highscore1Click(Sender: TObject);
begin
Form5.ShowModal;
end;
{==============================================================================}
procedure TForm1.Steuerung1Click(Sender: TObject);
begin
Form6.Show;
end;
{==============================================================================}
procedure TForm1.Stopp1Click(Sender: TObject);
begin
if Zeit.Enabled = true
// wenn Zeit läuft dann
then
begin
Zeit.Enabled := false;
// Programm stoppen/ Zeit anhalten
end;
if Spielfeld.Enabled = true
// wenn Oberfläche bedienbar
then
begin
Spielfeld.Enabled := false;
// Oberfläche deaktivieren
end;
end;
{==============================================================================}
procedure TForm1.Fortsetzen1Click(Sender: TObject);
begin
if Zeit.Enabled = false
// wenn Zeit nicht läuft dann
then
begin
Zeit.Enabled := true;
// Programm starten/Zeit laufen lassen
end;
if Spielfeld.Enabled = false
then
begin
Spielfeld.Enabled := true;
end;
end;
{==============================================================================}
procedure TForm1.LeichtClick(Sender: TObject);
begin
NeuesSpiel;
Zeit.Enabled := true;
// Uhr anschalten
Zeit.Interval := 500;
// Zeitintervall beträgt 700 Millisekunden
Statusbar1.Panels[1].Text := '
Runden : 30';
Runden := 30;
Leicht.Enabled := False;
// deaktiviert Leicht, da geladen
Mittel.Enabled := True;
Schwer.Enabled := True;
Statusbar1.Panels[0].Text := '
Punkte : 0';
Punkte := 0;
if Runden = 0
then
begin
Level :=Level+1;
Runden :=(Level-1)*5+30;
Zeit.Interval := Zeit.Interval-5;
end;
begin
if anzahlGleichfarbigerbloecke > 1
then
begin
GleicheFarbenLoeschen;
end;
end
end;
{==============================================================================}
procedure TForm1.MittelClick(Sender: TObject);
begin
NeuesSpiel;
Zeit.Enabled := true;
// Uhr anschalten
Zeit.Interval := 350;
// Zeitintervall beträgt 300 Millisekunden
Statusbar1.Panels[1].Text := '
Runden : 50';
Runden := 50;
Leicht.Enabled := True;
Mittel.Enabled := False;
// deaktiviert Mittel, da geladen
Schwer.Enabled := True;
Statusbar1.Panels[0].Text := '
Punkte : 0';
Punkte := 0;
end;
{==============================================================================}
procedure TForm1.SchwerClick(Sender: TObject);
begin
NeuesSpiel;
Zeit.Enabled := true;
// Uhr anschalten
Zeit.Interval := 200;
// Zeitintervall beträgt 100 Millisekunden
Statusbar1.Panels[1].Text := '
Runden : 70';
Runden := 70;
Leicht.Enabled := True;
Mittel.Enabled := True;
Schwer.Enabled := False;
// deaktiviert Schwer, da geladen
Statusbar1.Panels[0].Text := '
Punkte : 0';
Punkte := 0;
end;
{==============================================================================}
procedure TForm1.Spielmodus1Click(Sender: TObject);
begin
Zeit.Enabled := false;
Form9.ShowModal;
end;
{==============================================================================}
procedure TForm1.Musik1Click(Sender: TObject);
begin
Form7.ShowModal;
end;
{==============================================================================}
procedure TForm1.Musik2Click(Sender: TObject);
begin
Form11.ShowModal;
end;
{==============================================================================}
procedure TForm1.Musik3Click(Sender: TObject);
begin
Form12.ShowModal;
end;
{==============================================================================}
procedure TForm1.Memories1Click(Sender: TObject);
begin
Form2.ShowModal;
end;
{==============================================================================}
procedure TForm1.SwaggerJackin1Click(Sender: TObject);
begin
Form14.ShowModal;
end;
{==============================================================================}
end.