|
Registriert seit: 12. Nov 2011 121 Beiträge |
#1
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. |
![]() |
Ansicht |
![]() |
![]() |
![]() |
ForumregelnEs 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
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
![]() |
![]() |