Frosch hüpfen

[Bummi]

Ein Optimierungsvorschlag ..

Delphi-Quellcode:

unit Unit2;

interface

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

type
  TPosState = (psgreenDirR, psRedDirL, psEmpty);
  TPosArray = Array [0 .. 6] of TPosState;

  TForm2 = class(TForm)
    PaintBox1: TPaintBox;
    Button1: TButton;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private-Deklarationen }
    FPosArray: TPosArray;
    FZuege, FStart: Cardinal;
    procedure InitArray;
  public
    { Public-Deklarationen }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

Procedure TForm2.InitArray;
var
  i: Integer;
begin
  Timer1.Enabled := False;
  Caption := '';
  FZuege := 0;
  FStart := 0;
  FPosArray[3] := psEmpty;
  for i := 0 to 2 do
  begin
    FPosArray[i] := psgreenDirR;
    FPosArray[4 + i] := psRedDirL;
  end;
  PaintBox1.Invalidate;
end;

procedure TForm2.Button1Click(Sender: TObject);
begin
  InitArray;
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  InitArray;
end;

procedure TForm2.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  idx: Integer;
  cnt: Integer;
begin
  idx := X div (PaintBox1.Width div 7);
  Timer1.Enabled := true;
  inc(FZuege);
  if FPosArray[idx] = psgreenDirR then
  begin
    if (idx < 6) and (FPosArray[idx + 1] = psEmpty) then
    begin
      FPosArray[idx + 1] := psgreenDirR;
      FPosArray[idx] := psEmpty;
      PaintBox1.Invalidate;
    end
    else if (idx < 5) and (FPosArray[idx + 2] = psEmpty) then
    begin
      FPosArray[idx + 2] := psgreenDirR;
      FPosArray[idx] := psEmpty;
      PaintBox1.Invalidate;
    end
  end
  else if FPosArray[idx] = psRedDirL then
  begin
    if (idx > 0) and (FPosArray[idx - 1] = psEmpty) then
    begin
      FPosArray[idx - 1] := psRedDirL;
      FPosArray[idx] := psEmpty;
      PaintBox1.Invalidate;
    end
    else if (idx > 1) and (FPosArray[idx - 2] = psEmpty) then
    begin
      FPosArray[idx - 2] := psRedDirL;
      FPosArray[idx] := psEmpty;
      PaintBox1.Invalidate;
    end
  end
end;

procedure TForm2.PaintBox1Paint(Sender: TObject);
var
  i: Integer;
  c: TCanvas;
  sgn: String;
  col: TColor;
  wd: Integer;
begin
  wd := PaintBox1.Width div 7;
  c := PaintBox1.Canvas;
  for i := 0 to 6 do
  begin
    case FPosArray[i] of
      psgreenDirR:
        begin
          col := clLime;
          sgn := '>';
        end;
      psRedDirL:
        begin
          col := clRed;
          sgn := '<';
        end;
    else
      begin
        col := Color;
        sgn := '';

      end;
    end;
    c.Brush.Style := bsSolid;
    c.Brush.Color := col;
    c.Rectangle(i * wd, 0, (i + 1) * wd, PaintBox1.Height);
    c.Brush.Style := bsClear;
    c.TextOut(i * wd, 0, sgn);
  end;
end;

Function Finished(Arr: TPosArray): Boolean;
begin
  Result := (Arr[0] = psRedDirL) and (Arr[1] = psRedDirL) and
    (Arr[2] = psRedDirL) and (Arr[4] = psgreenDirR) and (Arr[5] = psgreenDirR)
    and (Arr[6] = psgreenDirR);
end;

procedure TForm2.Timer1Timer(Sender: TObject);
begin
  if FStart = 0 then
    FStart := GetTickCount;
  if Finished(FPosArray) then
  begin
    Caption := Caption + ' FERTIG';
    Timer1.Enabled := False;
  end
  else
    Caption := Format('%d Züge in %d Sekunden',
      [FZuege, Round((GetTickCount - FStart) / 1000)]);
end;
end.