Thema: Delphi Pac-Man Hilfe

Einzelnen Beitrag anzeigen

Popov
(Gast)

n/a Beiträge
 
#33

AW: Pac-Man Hilfe

  Alt 12. Apr 2015, 12:55
Es gibt tonnenweise bessere Alternativen als das im Projekt von TE:
Delphi-Quellcode:
var
  StringGridErsatz: array[0..23, 0..23] of String;

procedure FillStringGrid;
var
  sl: TStringList;
  x, y: Integer;
begin
  sl := TStringList.Create;
  try
    //Nur ein Beispiel. Alternativ als Textdatei laden
    sl.Add('111111111111111111111111');
    sl.Add('100000000001000000000001');
    sl.Add('101110111001001111011101');
    sl.Add('101110111000001111011101');
    sl.Add('100000000000000000000001');
    sl.Add('101110110111111001011101');
    sl.Add('100000110001000001000001');
    sl.Add('111110111101001111011111');
    sl.Add('000010110000000001010000');
    sl.Add('000010110111011101010000');
    sl.Add('111110110100000101011111');
    sl.Add('000000000100000100000000');
    sl.Add('111110100111111101011111');
    sl.Add('000010100000000001010000');
    sl.Add('000010100111110001010000');
    sl.Add('111110000001000000011111');
    sl.Add('100000111001001111000001');
    sl.Add('100110000000000000011101');
    sl.Add('100010100111110011010001');
    sl.Add('111010100001000011010111');
    sl.Add('100000100001000011000001');
    sl.Add('101111111101011111111101');
    sl.Add('100000000000000000000001');
    sl.Add('111111111111111111111111');

    for y := 0 to 23 do
      for x := 0 to 23 do
        StringGridErsatz[x, y] := Copy(sl[y], x + 1, 1);
  finally
    sl.Free;
  end;
end;

procedure FeldMauer(Canvas: TCanvas; x, y: Integer);
const
  w = 21;
begin
  Canvas.Brush.Color := clMaroon;
  Canvas.Pen.Color := clMaroon;
  Canvas.Rectangle(x * w, y * w, x * w + w, y * w + w);
end;

procedure FeldLeer(Canvas: TCanvas; x, y: Integer);
const
  w = 21;
begin
  Canvas.Brush.Color := clWhite;
  Canvas.Pen.Color := clWhite;
  Canvas.Rectangle(x * w, y * w, x * w + w, y * w + w);
end;

procedure FeldSetzen(Canvas: TCanvas; x, y: Integer);
const
  w = 21;
begin
  if StringGridErsatz[x, y] = '0then
    FeldLeer(Canvas, x, y)
  else FeldMauer(Canvas, x, y);
end;

procedure FeldKorrektur(Canvas: TCanvas);
const
  w = 21;
var
  x, y: Integer;
begin
  for y := 0 to 23 do
    for x := 0 to 23 do
      FeldSetzen(Canvas, x, y);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  FillStringGrid;
  FeldKorrektur(Canvas);
end;
  Mit Zitat antworten Zitat