AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Programmieren allgemein Snake für die Schule programmieren,Pause;Highscoures einbaun
Thema durchsuchen
Ansicht
Themen-Optionen

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

Offene Frage von "MarkusUhl"
Ein Thema von MarkusUhl · begonnen am 20. Jun 2006 · letzter Beitrag vom 18. Sep 2006
 
MarkusUhl

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

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
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 19:23 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz