Projekt Probleme: Zeitmessung und Highscore

[Swagger Jackin]

Delphi-Quellcode:

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.

[edit=Phoenix] Delphi-Tag geschlossen. Mfg, Phoenix[/edit]