Thema: Damespiel

Einzelnen Beitrag anzeigen

Benutzerbild von haentschman
haentschman

Registriert seit: 24. Okt 2006
Ort: Seifhennersdorf / Sachsen
5.387 Beiträge
 
Delphi 12 Athens
 
#7

AW: Damespiel

  Alt 28. Dez 2017, 16:28
Moin...

Weniger als nix muß du schon ausgeben.
https://www.embarcadero.com/de/produ.../free-download

Schau dir mal den Styleguide an. Das läßt sich deutlich besser lesen. https://www.delphi-treff.de/object-pascal/styleguide/

Weil Weihnachten ist mal formatiert:
Delphi-Quellcode:
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  Grids, Menus, StdCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    Label1: TLabel;
    Label2: TLabel;
    StringGrid1: TStringGrid;
    procedure FormCreate(Sender: TObject);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  private
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }
type
  Feld = array[1..8, 1..8] of Integer;

var
  a: Feld;
  zaehler: byte;
  Hoehe, Breite, testerX, testerY: Integer;
  dran: boolean;

procedure SpielFeld();
var
  i, j: Integer;
begin
  for i := 1 to 8 do
  begin
    for j := 1 to 8 do
    begin
      a[i, j] := 0;
      form1.stringgrid1.cells[i - 1, j - 1] := IntToStr(a[i, j]);
    end;
  end; // 0 = leere Felder (egal welche Farbe)


  for i := 1 to 8 do
  begin
    for j := 1 to 3 do
    begin
      if (i mod 2 = 0) xor (j mod 2 = 0) then
      begin
        a[i, j] := 1;
        form1.stringgrid1.cells[i - 1, j - 1] := IntToStr(a[i, j]);
      end;
    end;
  end; // 1 = weiße Spielsteine (2 ---> weiße Dame)

  for i := 1 to 8 do
  begin
    for j := 6 to 8 do
    begin
      if (i mod 2 = 0) xor (j mod 2 = 0) then
      begin
        a[i, j] := 3;
        form1.stringgrid1.cells[i - 1, j - 1] := IntToStr(a[i, j]);
      end;
    end;
  end; // 3 = schwarze Spielsteine (4 ---> schwarze Dame)

  Form1.Image1.Height := Hoehe * 8;
  Form1.Image1.Width := Breite * 8; // 8*8 Felder

  for i := 1 to 8 do
  begin
    for j := 1 to 8 do
    begin
      if (i mod 2 = 0) xor (j mod 2 = 0) then
      begin
        Form1.Image1.Canvas.Brush.Color := clblack;

        case a[i, j] of
          1:
            begin
              Form1.Image1.Canvas.Brush.Color := clBlue;
              Form1.Image1.Canvas.Ellipse((i - 1) * Breite, (j - 1) * Hoehe, (i) * Breite, (j) * Hoehe);
            end;
          3:
            begin
              Form1.Image1.Canvas.Brush.Color := clRed;
              Form1.Image1.Canvas.Ellipse((i - 1) * Breite, (j - 1) * Hoehe, (i) * Breite, (j) * Hoehe);
            end;
        end;
      end
      else
      begin
        Form1.Image1.Canvas.Brush.Color := clwhite;
        Form1.Image1.Canvas.Rectangle((i - 1) * Breite, (j - 1) * Hoehe, (i) * Breite, (j) * Hoehe);
      end;
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  zaehler := 0; // zählt wie oft Maus geklickt wurde
  dran := true; // Wer ist dran? 0 = unten; 1 = oben
  Hoehe := 40;
  Breite := 40;
  SpielFeld();
end;

procedure visual(i, j: Integer);
begin
  form1.stringgrid1.cells[i - 1, j - 1] := IntToStr(a[i, j]);
  form1.label1.caption := inttostr(i);
  form1.label2.caption := inttostr(j);

  case a[i, j] of
    0:
      begin
        Form1.Image1.Canvas.Brush.Color := clBlack;
        Form1.Image1.Canvas.Rectangle((i - 1) * Breite, (j - 1) * Hoehe, (i) * Breite, (j) * Hoehe);
      end;
    1:
      begin
        Form1.Image1.Canvas.Brush.Color := clBlue;
        Form1.Image1.Canvas.Ellipse((i - 1) * Breite, (j - 1) * Hoehe, (i) * Breite, (j) * Hoehe);
      end;
    3:
      begin
        Form1.Image1.Canvas.Brush.Color := clRed;
        Form1.Image1.Canvas.Ellipse((i - 1) * Breite, (j - 1) * Hoehe, (i) * Breite, (j) * Hoehe);

      end;
  end;
end;

procedure reset(i, j, testerX, testerY: Integer);
begin
  a[testerX, testerY] := 3;
  a[i, j] := 0;
end;

procedure test(i, j, testerX, testerY: Integer);
begin
  if (a[i, j] = 1) then
    showmessage('Ungültiger Zug');

  if (j = testerY - 1) and (i = 1 + testerX) or (i = testerX - 1) then
  begin
    // fehlt hier was?
  end
  else
  begin
    reset(i, j, testerX, testerY);
    showmessage('Ungültiger Zug');
  end;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  i, j: Integer;
begin

  i := X div 40 + 1;
  j := Y div 40 + 1;

  if dran = true then
  begin // wer dran ist
    if (zaehler = 0) and (a[i, j] = 3) then
    begin
      a[i, j] := 0;
      inc(zaehler);
      testerX := i; //Hilfsvariablen um über Gültigkeit in Procedure Test zu prüfen
      testerY := j;
    end
    else
      if (zaehler = 1) and (a[i, j] = 0) then
      begin
        a[i, j] := 3;
        dec(zaehler);
        //dran:=false;
        test(i, j, testerX, testerY);
      end;
  end
  else
    if (a[i, j] = 1) or (a[i, j] = 2) then
    begin
      showmessage('Nimm deinen eigenen Stein du Schummler!');
    end;

  form1.stringgrid1.cells[i - 1, j - 1] := IntToStr(a[i, j]);
  visual(i, j);
  refresh;
end;

end.

Geändert von haentschman (28. Dez 2017 um 17:21 Uhr)
  Mit Zitat antworten Zitat