Einzelnen Beitrag anzeigen

MarkusUhl

Registriert seit: 20. Jun 2006
35 Beiträge
 
#75

Re: Snake für die Schule programmieren,Pause;Highscoures ein

  Alt 3. Jul 2006, 15:06
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.
  Mit Zitat antworten Zitat