Einzelnen Beitrag anzeigen

borstenei

Registriert seit: 12. Nov 2011
121 Beiträge
 
#1

Frosch hüpfen

  Alt 12. Mai 2012, 23:03
Delphi-Version: 2010
Nicht gleich lachen!
Mir ist gestern eine Exceldatei untergekommen...Frosch_hüpfen...ohne viel Worte...
Ich habe versucht das ganze mal per Delphi zu gestalten...es funktioniert.
Aber hier stellt sich mir wieder mal die Frage ist das so effektiv was ich da mache...sicher der fertigen exe sieht man(n) das Ergebniss nicht an
aber hat das Hand und Fuss ?
Ich verbrauche hier unzählige Zeilen für die Auswertung...das sollte doch bestimmt auch anders gehen?
Delphi-Quellcode:
unit frosch1;

interface

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

type
  TForm1 = class(TForm)
    Zuege: TLabel;
    Zeit: TLabel;
    Timer1: TTimer;
    Neu: TButton;
    Shape1: TShape;
    Shape2: TShape;
    Shape3: TShape;
    Shape4: TShape;
    Shape5: TShape;
    Shape6: TShape;
    Shape7: TShape;
    Bravo: TLabel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Shape3MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Shape5MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Shape2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Shape1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Shape6MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Shape7MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure NeuClick(Sender: TObject);
    procedure Shape4MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    procedure auswerten;
    procedure neuzeichnen;
    { Public-Deklarationen }
  end;

type
  FarbenBasis = Array[0..6]of TColor;

var
  Form1: TForm1;
  FarbenWork : FarbenBasis;
  clicken,laufzeit : Integer;
const
Farben : FarbenBasis =(clGreen,clGreen,clGreen,clBtnFace,clRed,clRed,clRed);
EndZuStand : Array[0..6]of TColor =(clRed,clRed,clRed,clBtnFace,clGreen,clGreen,clGreen);


implementation

{$R *.dfm}

function SekToStr(sec: integer) : string ;
 var
 sek,min,h : Integer;
 begin
   sek := sec mod 60;
   min := (sec div 60) mod 60;
   h := sec div 3600;
   result := IntToStr(h)+'h '+IntToStr(min)+'min '+IntToStr(sek)+ 'sek ';
 end;

procedure TForm1.FormCreate(Sender: TObject);
begin
clicken := 0;
FarbenWork := Farben;
neuzeichnen;
end;

procedure TForm1.NeuClick(Sender: TObject);
begin
Timer1.Enabled := False;
laufzeit:= 0;
Zuege.Caption :='Anzahl der Züge : ';
Zeit.Caption :='Benötigte Zeit : ';
clicken := 0;
Bravo.Visible := False;
FarbenWork := Farben;
neuzeichnen

end;

procedure TForm1.auswerten; //vergleichen
var
x,i:Integer;
begin

i:= 0;
for x := 0 to 6 do
if FarbenWork[x] = EndZuStand[x] then //ist und soll vergleichen
inc(i);
if i = 7 then
begin
Bravo.Visible := True;
Timer1.Enabled := False;
end;
end;

procedure TForm1.neuzeichnen;
var
x:Integer;
begin
for x := 0 to 6 do
(FindComponent('Shape' + IntToStr(x+1))as TShape).Brush.Color := FarbenWork[x];

for x := 0 to 6 do
if(FindComponent('Shape' + IntToStr(x+1))as TShape).Brush.Color = clred then
 (FindComponent('Label' + IntToStr(x+1))as TLabel).Caption:= 't';
for x := 0 to 6 do
if(FindComponent('Shape' + IntToStr(x+1))as TShape).Brush.Color = clGreen then
 (FindComponent('Label' + IntToStr(x+1))as TLabel).Caption:= 'u';
for x := 0 to 6 do
if(FindComponent('Shape' + IntToStr(x+1))as TShape).Brush.Color = clBtnFace then
 (FindComponent('Label' + IntToStr(x+1))as TLabel).Caption:= '';
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
inc(laufzeit);
Zuege.Caption :='Anzahl der Züge : ' + IntToStr(clicken);
Zeit.Caption :='Benötigte Zeit : '+sekToStr(laufzeit);
end;

procedure TForm1.Shape1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if (FarbenWork[0] = clGreen)and (FarbenWork[1] = clBtnFace) then //nach rechts 1+
    begin
    FarbenWork[0]:= clBtnFace;
    FarbenWork[1]:= clGreen;
    if Timer1.Enabled = False then
    Timer1.Enabled := True;
    inc(clicken);
    end;
if (FarbenWork[0] = clGreen)and (FarbenWork[1] <> clBtnFace) and (FarbenWork[2] = clBtnFace) then //nach rechts 2+
    begin
    FarbenWork[2]:= clGreen;
    FarbenWork[0]:= clBtnFace;
    if Timer1.Enabled = False then
    Timer1.Enabled := True;
    inc(clicken);
    end;

neuzeichnen;
auswerten;
end;

procedure TForm1.Shape2MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if (FarbenWork[1] = clGreen)and (FarbenWork[2] = clBtnFace) then //nach rechts 1+
    begin
    FarbenWork[1]:= clBtnFace;
    FarbenWork[2]:= clGreen;
    if Timer1.Enabled = False then
    Timer1.Enabled := True;
    inc(clicken);
    end;
if (FarbenWork[1] = clGreen)and (FarbenWork[2] <> clBtnFace) and (FarbenWork[3] = clBtnFace) then //nach rechts 2+
    begin
    FarbenWork[3]:= clGreen;
    FarbenWork[1]:= clBtnFace;
    if Timer1.Enabled = False then
    Timer1.Enabled := True;
    inc(clicken);
    end;
if (FarbenWork[1] = clRed)and (FarbenWork[0] = clBtnFace) then //nach links 1-
    begin
    FarbenWork[1]:= clBtnFace;
    FarbenWork[0]:= clRed;
    if Timer1.Enabled = False then
    Timer1.Enabled := True;
    inc(clicken);
    end;

neuzeichnen;
auswerten;

end;

procedure TForm1.Shape3MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if (FarbenWork[2] = clGreen)and (FarbenWork[3] = clBtnFace) then //nach rechts 1+
    begin
    FarbenWork[2]:= clBtnFace;
    FarbenWork[3]:= clGreen;
    if Timer1.Enabled = False then
    Timer1.Enabled := True;
    inc(clicken);
    end;
if (FarbenWork[2] = clGreen)and (FarbenWork[3] <> clBtnFace) and (FarbenWork[4] = clBtnFace) then //nach rechts 2+
    begin
    FarbenWork[4]:= clGreen;
    FarbenWork[2]:= clBtnFace;
    if Timer1.Enabled = False then
    Timer1.Enabled := True;
    inc(clicken);
    end;
if (FarbenWork[2] = clRed)and (FarbenWork[1] = clBtnFace) then //nach links 1-
    begin
    FarbenWork[2]:= clBtnFace;
    FarbenWork[1]:= clRed;
    inc(clicken);
    end;
if (FarbenWork[2] = clRed)and (FarbenWork[1] <> clBtnFace) and (FarbenWork[0] = clBtnFace) then //nach links 2+
    begin
    FarbenWork[0]:= clRed;
    FarbenWork[2]:= clBtnFace;
    if Timer1.Enabled = False then
    Timer1.Enabled := True;
    inc(clicken);
    end;

neuzeichnen;
auswerten;
end;

procedure TForm1.Shape4MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if (FarbenWork[3] = clGreen)and (FarbenWork[4] = clBtnFace) then //nach rechts 1+
    begin
    FarbenWork[3]:= clBtnFace;
    FarbenWork[4]:= clGreen;
    if Timer1.Enabled = False then
    Timer1.Enabled := True;
    inc(clicken);
    end;
if (FarbenWork[3] = clGreen)and (FarbenWork[4] <> clBtnFace) and (FarbenWork[5] = clBtnFace) then //nach rechts 2+
    begin
    FarbenWork[5]:= clGreen;
    FarbenWork[3]:= clBtnFace;
    if Timer1.Enabled = False then
    Timer1.Enabled := True;
    inc(clicken);
    end;
if (FarbenWork[3] = clRed)and (FarbenWork[2] = clBtnFace) then //nach links 1-
    begin
    FarbenWork[3]:= clBtnFace;
    FarbenWork[2]:= clRed;
    if Timer1.Enabled = False then
    Timer1.Enabled := True;
    inc(clicken);
    end;

if (FarbenWork[3] = clRed)and (FarbenWork[2] <> clBtnFace) and (FarbenWork[1] = clBtnFace) then //nach links 2+
    begin
    FarbenWork[1]:= clRed;
    FarbenWork[3]:= clBtnFace;
    if Timer1.Enabled = False then
    Timer1.Enabled := True;
    inc(clicken);
    end;

neuzeichnen;
auswerten;
end;

procedure TForm1.Shape5MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 if (FarbenWork[4] = clRed)and (FarbenWork[3] = clBtnFace) then //nach links 1-
    begin
    FarbenWork[4]:= clBtnFace;
    FarbenWork[3]:= clRed;
    if Timer1.Enabled = False then
    Timer1.Enabled := True;
    inc(clicken);
    end;
if (FarbenWork[4] = clRed)and (FarbenWork[3] <> clBtnFace) and (FarbenWork[2] = clBtnFace) then //nach links 2-
    begin
    FarbenWork[2]:= clRed;
    FarbenWork[4]:= clBtnFace;
    if Timer1.Enabled = False then
    Timer1.Enabled := True;
    inc(clicken);
    end;
if (FarbenWork[4] = clGreen)and (FarbenWork[5] = clBtnFace) then //nach rechts 1+
    begin
    FarbenWork[4]:= clBtnFace;
    FarbenWork[5]:= clGreen;
    if Timer1.Enabled = False then
    Timer1.Enabled := True;
    inc(clicken);
    end;

if (FarbenWork[4] = clGreen)and (FarbenWork[5] <> clBtnFace) and (FarbenWork[6] = clBtnFace) then //nach rechts 2-
    begin
    FarbenWork[6]:= clGreen;
    FarbenWork[4]:= clBtnFace;
    if Timer1.Enabled = False then
    Timer1.Enabled := True;
    inc(clicken);
    end;

neuzeichnen;
auswerten;
end;

procedure TForm1.Shape6MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 if (FarbenWork[5] = clRed)and (FarbenWork[4] = clBtnFace) then //nach links 1-
    begin
    FarbenWork[5]:= clBtnFace;
    FarbenWork[4]:= clRed;
    if Timer1.Enabled = False then
    Timer1.Enabled := True;
    inc(clicken);
    end;
if (FarbenWork[5] = clRed)and (FarbenWork[4] <> clBtnFace) and (FarbenWork[3] = clBtnFace) then //nach links 2-
    begin
    FarbenWork[3]:= clRed;
    FarbenWork[5]:= clBtnFace;
    if Timer1.Enabled = False then
    Timer1.Enabled := True;
    inc(clicken);
    end;
 if (FarbenWork[5] = clGreen)and (FarbenWork[6] = clBtnFace) then //nach rechts 1+
    begin
    FarbenWork[5]:= clBtnFace;
    FarbenWork[6]:= clGreen;
    if Timer1.Enabled = False then
    Timer1.Enabled := True;
    inc(clicken);
    end;

neuzeichnen;
auswerten;
end;

procedure TForm1.Shape7MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 if (FarbenWork[6] = clRed)and (FarbenWork[5] = clBtnFace) then //nach links 1-
    begin
    FarbenWork[6]:= clBtnFace;
    FarbenWork[5]:= clRed;
    if Timer1.Enabled = False then
    Timer1.Enabled := True;
    inc(clicken);
    end;
if (FarbenWork[6] = clRed)and (FarbenWork[5] <> clBtnFace) and (FarbenWork[4] = clBtnFace) then //nach links 2-
    begin
    FarbenWork[4]:= clRed;
    FarbenWork[6]:= clBtnFace;
    if Timer1.Enabled = False then
    Timer1.Enabled := True;
    inc(clicken);
    end;

neuzeichnen;
auswerten;
end;



end.
Angehängte Dateien
Dateityp: rar Frosch.rar (343,1 KB, 23x aufgerufen)
  Mit Zitat antworten Zitat