Snake für die Schule programmieren,Pause;Highscoures einbaun

[MarkusUhl]

wie genau nun? das Programm muss heute fertig werden...

[Namenloser]

hmm, also ich würde das anders machen.

Ich würde statt der Buttons ganz einfach panels (Oder Images?) nehmen, bei denen dürfte es das fokus-problem nicht geben.

[MarkusUhl]

Hallo, da die zeit wegläuft ist das auch egal.. hab es schon anderes gelöst...

nun nur noch ein problem... ich will ne highscore, und zwar soll sich ein pop up fesnter öffnen wo ich den namen eingeben kann. dieser name soll dann in einer datei abgespeichert werden. für die pros hier sicherlich kein prolem..

[DGL-luke]

Zitat von DGL-luke:

[...]Zu InputQuery und InputBox sollten dir die code completion und die OH genug sagen.

ansonsten:

Delphi-Quellcode:

type THighScore = record
  name: string[255];
  score: Integer;
end;

procedure Save(fname: string; data: array of THighScore);
var fs: TFileStream;
    i: Integer;
begin
  fs := TFileStream.Create(fname, fmOpencreate);
  fs.writebuffer(data[0],length(data) * sizeof(THighScore);
  fs.Free;
end;

function Load(fname:string): array of THighScore
var fs: TFileStream;
begin
  fs := TFileStream.Create(fname, fmOpenRead);
  setlength(Result, fs.size div sizeof(THighScore));
  fs.ReadBuffer(data[0], length(data) * sizeof(THighScore);)
end;

Aber nur weil du unter Zeitdruck bist, normalerweise könnte man sich das locker selber erarbeiten!
(nicht getestet)

[MarkusUhl]

Ich finde den fehler einfach nicht. Es ging einmal, dann hab ich so lange rumprobiert und nun bekomm ich es nicht mehr hin... hoffe im dem roten steck irgendwo der fehler..

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

const
  farben: Array [0..2] of TColor=(clWhite, clLime, clRed);
  stufen: Array [0..2] of Cardinal=(200, 100, 50);
  raster = 7;
  breite = 65;
  hoehe = 45;
  Langsam = 250;
  Mittel = 100;
  Schnell = 50;

type
  TForm1 = class(TForm)
    Spielfeld: TPaintBox;
    Timer1: TTimer;
    BStart: TButton;
    BOben: TButton;
    BLinks: TButton;
    BRechts: TButton;
    BUnten: TButton;
    PEnde: TButton;
    BPause: TButton;
    BWeiter: TButton;
    PLeicht: TButton;
    PSchwer: TButton;
    PMittel: TButton;
    Label1: TLabel;
    Label2: TLabel;
    procedure BStartClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure BObenClick(Sender: TObject);
    procedure BLinksClick(Sender: TObject);
    procedure BRechtsClick(Sender: TObject);
    procedure BUntenClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure PEndeClick(Sender: TObject);
    procedure BPauseClick(Sender: TObject);
    procedure BWeiterClick(Sender: TObject);
    procedure PLeichtClick(Sender: TObject);
    procedure PMittelClick(Sender: TObject);
    procedure PSchwerClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    
  private
    { Private-Deklarationen }
    map: Array [0..breite] of Array [0..hoehe] of Integer;
    kopf,
    richtung,
    punkt: TPoint;
    punkte: Integer;
    laenge: Integer;
    ende,
    rand,
    gebissen: Boolean;
    name, rekord:string;
     datei:textfile;
    procedure enable_buttons(status: Boolean);
    procedure spiel_ende;
    procedure neuer_punkt;
    procedure paint_map;
    procedure calc_snake;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
implementation

{$R *.dfm}

procedure TForm1.enable_buttons(status: Boolean);
begin
  BOben.Enabled := status;
  BRechts.Enabled := status;
  BLinks.Enabled := status;
  BUnten.Enabled := status;
  BPause.Enabled := status;
  BWeiter.Enabled := status;
  PLeicht.Enabled := status;
  PMittel.Enabled := status;
  PSchwer.Enabled := status;
end;

procedure TForm1.spiel_ende;
begin
  ende := True;
  Timer1.Enabled := False;
  BPause.Enabled:=False;
  BWeiter.Enabled:=False;
  PLeicht.Enabled:=False;
  PMittel.Enabled:=False;
  PSchwer.Enabled:=False;
  enable_buttons(False);
  BStart.Enabled := True;

/////Neuer Rekord - ANFANG/////
if rekord < inttostr(punkte) then begin //es wird geprüft, ob neue punktezahl höher als rekord
name := InputBox(' Neuer Rekord', 'Dein Name (ohne Leertaste)', ''); //wenn ja wird nach neuem rekordnamen gefragt (wird in var name gelesen)
assignfile (datei, 'rekord.txt'); //file initialisieren
rewrite (datei); //file öffnen und wiederbeschreiben
writeln (datei, name); //variable name in 1. zeile schreiben
writeln(datei, punkte); //variable pnukte in 2. zeile schreiben
closefile (datei); //file schließen

assignfile (datei, 'rekord.txt'); //wieder einlesen (s.u.)
reset (datei);
readln (datei, name);
readln (datei,rekord);
closefile (datei);
end;
/////Neuer Rekord - Ende/////

end;

Delphi-Quellcode:

procedure TForm1.neuer_punkt;
begin
  punkt := Point(Random(breite), Random(hoehe));
  while map[punkt.X, punkt.Y]<>0 do
    punkt := Point(Random(breite), Random(hoehe));
  map[punkt.X,punkt.Y] := -1;
end;

procedure TForm1.paint_map;
var
  i, j: Integer;
  color: TColor;
begin
  for i := 0 to breite do
    for j := 0 to hoehe do
    begin
      case map[i, j] of
        -1: color := farben[1];
         0: color := farben[0];
      else
        color := farben[2];
      end;
      Spielfeld.Canvas.Brush.Color:=color;
      Spielfeld.Canvas.FillRect(Rect(i*raster, j*raster, (i+1)*raster, (j+1)*raster));
    end;
end;

procedure TForm1.calc_snake;
var
  i, j: Integer;
begin
  for i := 0 to breite do
    for j := 0 to hoehe do
      if map[i, j]>0 then
        Dec(map[i, j]);
  Inc(kopf.X, richtung.X);
  Inc(kopf.Y, richtung.Y);
  if (kopf.X<0) or (kopf.X>breite) or (kopf.Y<0) or (kopf.Y>hoehe) then
  begin
    spiel_ende;
    ShowMessage('Nicht den Rand berühen!');
    ShowMessage('Du hast '+IntToStr(punkte)+' Punkte erreicht');
  end;
  if (map[kopf.X, kopf.Y]>0) and (not ende) then
  begin
    spiel_ende;
    ShowMessage('Nicht in den Schwanz beißen!');
    ShowMessage('Du hast '+IntToStr(punkte)+' Punkte erreicht')
  end;
  if (kopf.X=punkt.X) and (kopf.Y=punkt.Y) then
  begin
    Inc(laenge);
    neuer_punkt;
    if Timer1.Interval = Langsam then
  Punkte := Punkte + 3
else 
if Timer1.Interval = Mittel then
  Punkte := Punkte + 8
else
if Timer1.Interval = Schnell then
  Punkte := Punkte + 12;
  end;
  map[kopf.X, kopf.Y] := laenge;

Label2.Caption := 'Aktueller Punktestand: ' + IntToStr(Punkte);
end;

procedure TForm1.BStartClick(Sender: TObject);
var
  i, j: Integer;
begin
  punkte:=0;
  BStart.Enabled := False;
  for i:=0 to breite do
    for j:=0 to hoehe do
      map[i, j] := 0;
  kopf := Point(1, 1);
  laenge := 5;
  richtung := Point(0, 1);
  map[kopf.X, kopf.Y] := laenge;
  neuer_punkt;
  paint_map;
  enable_buttons(True);
  ende := False;
  Timer1.Enabled := true;
  Timer1.Interval := Mittel;
Form1.PLeicht.Visible:=false;
Form1.PMittel.Visible:=false;
Form1.PSchwer.Visible:=true;
Form1.BOben.Visible:=true;
Form1.BLinks.Visible:=true;
Form1.BRechts.Visible:=true;
Form1.BUnten.Visible:=true;
Form1.BPause.Visible:=true;
Form1.BWeiter.Visible:=false;
Form1.Label1.Visible:=true;

/////Alter Rekord einlesen - ANFANG/////
If FileExists('rekord.txt') Then begin //es wird geprüft ob rekord datenbank vorhanden ist
assignfile (datei, 'rekord.txt'); //file wird initialisiert
reset (datei); //file öffnen
readln (datei, name); //1. zeile in variable name lesen
readln (datei,rekord); //2. zeile in variable rekord lesen
closefile (datei); //datei schließen
end
else begin //wenn rekord datenbank nicht gefunden wird neue erstellt
assignfile (datei, 'rekord.txt'); //file erstellen (initialisieren)
rewrite (datei); //file offnen und wiederbeschreiben
writeln (datei, 'NoName'); //Noname in 1. Zeile schreiben (Name)
writeln (datei,'10'); //10 in 2. Zeile schreiben (Punkte)
closefile (datei); //datei schließen

assignfile (datei, 'rekord.txt'); //wieder lesen (s.o.)
reset (datei);
readln (datei, name);
readln (datei,rekord);
closefile (datei);

end;
/////Alter Rekord einlesen - Ende/////

Delphi-Quellcode:

end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  calc_snake;
  if not ende then
    paint_map;
end;

procedure TForm1.BObenClick(Sender: TObject);
begin
  if richtung.Y=0 then
    richtung := Point(0, -1);
end;

procedure TForm1.BLinksClick(Sender: TObject);
begin
  if richtung.X=0 then
    richtung := Point(-1, 0);
end;

procedure TForm1.BRechtsClick(Sender: TObject);
begin
  if richtung.X=0 then
    richtung := Point(1, 0);
end;

procedure TForm1.BUntenClick(Sender: TObject);
begin
  if richtung.Y=0 then
    richtung := Point(0, 1);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Randomize;
end;

procedure TForm1.PEndeClick(Sender: TObject);
begin
halt;
end;

procedure TForm1.BPauseClick(Sender: TObject);
begin
Timer1.Enabled := False;
Form1.BPause.Visible:=false;
Form1.BWeiter.Visible:=true;
PLeicht.Enabled:=False;
PMittel.Enabled:=False;
PSchwer.Enabled:=False;
BOben.Enabled:=False;
BLinks.Enabled:=False;
BRechts.Enabled:=False;
BUnten.Enabled:=False;



end;

procedure TForm1.BWeiterClick(Sender: TObject);
begin
Timer1.Enabled := True;
Form1.BPause.Visible:=true;
Form1.BWeiter.Visible:=false;
PLeicht.Enabled:=true;
PMittel.Enabled:=true;
PSchwer.Enabled:=true;
BOben.Enabled:=true;
BLinks.Enabled:=true;
BRechts.Enabled:=true;
BUnten.Enabled:=true;
end;

procedure TForm1.PLeichtClick(Sender: TObject);
begin
Timer1.Interval := Langsam;
calc_snake;
  if not ende then
    paint_map;
Form1.PLeicht.Visible:=false;
Form1.PMittel.Visible:=true;
Form1.PSchwer.Visible:=false;
end;

procedure TForm1.PMittelClick(Sender: TObject);
begin
Timer1.Interval := Mittel;
calc_snake;
  if not ende then
    paint_map;
Form1.PLeicht.Visible:=false;
Form1.PMittel.Visible:=false;
Form1.PSchwer.Visible:=true;
end;

procedure TForm1.PSchwerClick(Sender: TObject);
begin
Timer1.Interval := Schnell;
calc_snake;
  if not ende then
    paint_map;
Form1.PLeicht.Visible:=true;
Form1.PMittel.Visible:=false;
Form1.PSchwer.Visible:=false;
end;


procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case key of
    VK_Left  : BLinksClick(Sender);
    VK_Right : BRechtsClick(Sender);
    VK_Up    : BObenClick(Sender);
    VK_Down  : BUntenClick(Sender);
    VK_PAUSE : BPauseClick(Sender);
    VK_Escape : Close;
  end;
BOben.Enabled:=false;
BUnten.Enabled:=false;
BLinks.Enabled:=false;
BRechts.Enabled:=false;
  end;

end.

der der komplette qt.

[DGL-luke]

hmm... du machst das ziemlcih kompliziert, ich finde aber keinen fehler. Was genau funktioniert denn nicht?

Am einfachsten wäre das wohl über Ini-Dateien:

Delphi-Quellcode:

uses Inifiles;

procedure TrySetNewHighscore(score: Integer; fname: TFileName);
var ini: TIniFile;
    highscore : Integer;
    username: string;
begin
  ini := TIniFIle.Create(fname);
  highscore := ini.ReadInteger('highscore','highscore',0);
  if score > highscore then
    begin
      username := InputBox('HighScore!','Bitte gib deinen Namen ein');
      if username <> '' then
        ini.WriteInteger('highscore','highscore',score);
        ini.WriteString('highscore','name',username);
    end;
  ini.Free;
end;

procedure GetHighscore(fname: TFileName; var score: Integer; var username: string);
begin
  ini := TIniFIle.Create(fname);
  score := ini.ReadInteger('highscore','highscore',0);
  username := ini.ReadString('highscore','name',''); 
  ini.Free;
end;

Das sind erheblich weniger Codezeilen als bei dir, und damit weniger fehlerträchtig.

[MarkusUhl]

Sorry das versteht ich wieder nicht. Ich habs nun hinbekommen. Es ist fertig. Danke an euch allen die mir geholfen haben. Ich denke ich wähle Informatik ab, so ein scheiß----

[DGL-luke]

Ich glaube nicht, dass mir irgendein Kurs so leichtfallen wird wie Info... jammerschade, dass das hier in BY zum Zusatzangebot gehört...

Delphi ist echt ein gutes Tool, du bist zu beglückwünchen, dass ihr damit arbeitet. In Java wär das noch viel hässlicher.
Lass dich nicht abschrecken von Anfangsschwierigkeiten! Gute Tutorials zu Delphi findest du bei www.dsdt.info/tutorials , unter anderem auch über ini-dateien, und ein ganzes buch unter http://de.wikibooks.org/wiki/Delphi .

[TaIPaN]

Hi Leute^^ habe auch mal eine Frage zu Snake... (mal wieder )
Also wir haben in der Schule unglücklicherweise einen kleinen Anfang zu Snake bekommen der blöderweise vollkommen anders aussieht,
wie alles was bisher zu diesem Thema hier erörtert wurde, weswegen ich nun das Problem habe, dass ich leider durch lesen der sourcecodes auch nicht weiter komme...
ALso meine Schlange kann:
1. Fressen(Apfel)
2. Durch Wände gehen(findich cooler wie dabei zu sterben^^)
3. Score wird gezählt
4. Richtungswechsel wie Rechts==>Links, Hoch==>Runter gehn nich

Mein großes Problem ist: Ich bekomme es einfach nicht gebacken, dass meine Schlange beim Fressen eines Apfels länger wird.
Deswegen wollte ich diejenigen die Ahnung haben darum bitten sich meinen Versuch mal anzuschaun und mir zu sagen was ich falsch mache wies richtig geht oder mir einfach einen kleinen Denkanstoß geben^^
Wie ich sehe sind hier ja eindeutig Leute dies echt sau gut drauf haben und würde mich daher echt über eine hilfreiche Antwort freun...


Bin leider wie man sieht alles andere als begabt und hocke nun schon seid mehreren Tagen hilflos vor Delphi und komme einfach nicht weiter... 2Spielermodus, Highscore etc. stelle ich mir da ja um einiges einfacher vor...aber hier bin ich einfach nur aufgeschmissen...

Für die Unordnung die durch exzessives Rumprobiern entstanden ist im Sourcecode willich mich schonmal im Voraus entschuldigen^^

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  Trichtung = (Hoch,Runter,Links,Rechts);

  TSpielfeld = class(TForm)
    Bild: TImage;
    Timer1: TTimer;
    Panel1: TPanel;
    Label1: TLabel;
    m_start: TMemo;
    l_start: TLabel;
    b_start: TButton;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure b_startClick(Sender: TObject);
    end;

 tsnake = class
  x,y:array[1..100] of integer;
  vx,vy,r,laenge:integer;
  farbe:tcolor;
  richtung:trichtung;
  procedure init(fneu:tcolor; xneu, yneu, vxneu, vyneu, rneu:integer);
  procedure zeigedich;
  procedure bewegedich;
  procedure wachsen;
  end;

 tapfel = class
  x,y,r,score:integer;
  farbe:tcolor;
  procedure ini; overload;
  procedure ini(fneu:tcolor; xneu, yneu, rneu:integer); overload;
  procedure zeigediche;
  procedure fressen;
  end;


var
  Spielfeld: TSpielfeld;
   snake    : Tsnake;
   apfel    : Tapfel;
   big      : bool;
implementation

{$R *.dfm}


// -------------------------------------------------------------------------- //
// alle Prozeduren, die ausschließlich mit "Snake" zu tun haben
// -------------------------------------------------------------------------- //
procedure tsnake.init(fneu:tcolor; xneu, yneu, vxneu, vyneu, rneu:integer);
begin
  laenge:= 1;
  farbe:= fneu;
  x[laenge]    := xneu;
  y[laenge]    := yneu;
  vx   := vxneu;
  vy   := vyneu;
  r    := rneu;

end;

procedure tsnake.zeigedich;
var i:integer;
begin
  Spielfeld.Bild.Canvas.Brush.Color:=Farbe;
  for i:=1 to snake.laenge do
  begin
  Spielfeld.Bild.Canvas.Rectangle(x[i], y[i], x[i]+2*r, y[i]+2*r);
  end;
end;

procedure tsnake.bewegedich;
begin

  case snake.richtung of
  Links: begin //Links
    snake.vx:=-1;
    snake.vy:= 0;
    end;

Hoch: begin //Hoch
    snake.vx:= 0;
    snake.vy:= -1;
    end;

Rechts: begin //Rechts
    snake.vx:= 1;
    snake.vy:= 0;
    end;

Runter: begin //Runter
    snake.vx:= 0;
    snake.vy:= 1;
    end;
  end;

  //Bewegungsberechnung
  x[1] := x[1] + 2*r*vx;
  y[1] := y[1] + 2*r*vy;

  if (x[1]>Spielfeld.Bild.Width-2*r) then
  begin
    x[1] := 0;
  end;

  if x[1]<0 then
  begin
    x[1] := Spielfeld.Bild.Width-2*r;
   end;

  if (y[1] > Spielfeld.Bild.Height-2*r) then
  begin
    y[1] := 0;
  end;

  if y[1] < 0 then
  begin
    y[1] := Spielfeld.Bild.Height-2*r;
  end;

end;

//wachsen
procedure Tsnake.wachsen;
var i:integer;
begin
laenge:= laenge +1;
spielfeld.Label2.Caption:='Länge : ' + inttostr(laenge);
//Array erweitern
for i:=1 to laenge do
  begin
  x[i+1]:=x[i];
  y[i+1]:=y[i];
  Spielfeld.Bild.Canvas.Rectangle(x[i], y[i], x[i]+2*r, y[i]+2*r);


  end;
end;

procedure TSpielfeld.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case key of
27:close;

37: begin //Links
    if snake.richtung <> Rechts then snake.richtung:=Links;
    end;
38: begin //Hoch
    if snake.richtung <> Runter then snake.richtung:=Hoch;
    end;
39: begin //Rechts
    if snake.richtung <> Links then snake.richtung:=Rechts;
    end;
40: begin //Runter
    if snake.richtung <> Hoch then snake.richtung:=Runter;
    end;
end;
end;

// -------------------------------------------------------------------------- //
// Alle Prozeduren, die ausschließlich mit "Apfel" zu tun haben
// -------------------------------------------------------------------------- //

procedure tapfel.ini;
begin
  farbe:= clGreen;
  x    := Random(30)*20;
  y    := Random(20)*20;
  r    := 10;
end;

procedure tapfel.ini(fneu:tcolor; xneu, yneu, rneu:integer);
begin                                       //
  farbe:= fneu;
  x    := xneu;
  y    := yneu;
  r    := rneu;
end;


procedure tapfel.zeigediche;                //
begin
  Spielfeld.Bild.Canvas.Brush.Color:=clGreen;
  Spielfeld.Bild.Canvas.ellipse(x, y, x+2*r, y+2*r);
end;

procedure tapfel.fressen;
begin

if (x = snake.x[1]) and (y = snake.y[1]) then

    begin
      score:= score +1;
      spielfeld.label1.caption:='Score : ' + inttostr(score);
      apfel.zeigediche;
      apfel.ini;
      apfel.zeigediche;
      big:= true;
    end;
end;
// -------------------------------------------------------------------------- //
// Durch diese Prozedur wird das Spiel gestartet und der Anfangsbildschirm ausgeblendet
// -------------------------------------------------------------------------- //
procedure TSpielfeld.b_startClick(Sender: TObject);
begin
l_start.Visible:=false;
b_start.Visible:=false;
m_start.Visible:=false;
panel1.Visible:=true;
bild.Visible:=true;
end;

// -------------------------------------------------------------------------- //
// Diese Prozedur bringt die Bewegungs- und Fressprozeduren in Gang(regelmäßig
// -------------------------------------------------------------------------- //

procedure TSpielfeld.Timer1Timer(Sender: TObject);
begin
//spielfeld.Timer1.Enabled:=false;

                   //
snake.zeigedich;
snake.bewegedich;
snake.zeigedich;
apfel.fressen;
if big = true then
begin
snake.wachsen;
big:= false;
end;
//spielfeld.Timer1.Enabled:=true;
end;

// -------------------------------------------------------------------------- //
// Alles was von Anfang an existieren soll ist hier aufgeführt
// -------------------------------------------------------------------------- //

procedure TSpielfeld.FormCreate(Sender: TObject);
begin                                //
  with bild.Canvas do
  begin
  pen.Width:=5;
  Brush.Color:=clWhite;
  Brush.Style:=bsSolid;
  Pen.Width:=2;
  Pen.Mode:=pmNOTXOR;

  Rectangle(0,0,Bild.width,Bild.Height);
  end;

  snake.init(clRed, Random(30)*20, Random(20)*20,0,0,10);
  snake.zeigedich;
  apfel.ini;
  apfel.zeigediche;
end;

initialization                      //
  randomize;
  snake := tsnake.Create;
  apfel := tapfel.Create;
  big:= false;
end.

In Hoffnung auf hilf- und lehrreiche Antwort(en)

mfg Taipi

[inherited]

Neue frage, neuer Thread