Einzelnen Beitrag anzeigen

Popov
(Gast)

n/a Beiträge
 
#27

AW: Schiffe versenken programmieren

  Alt 12. Jan 2014, 17:19
Ich hab hier ein Ansatz, ein Spielfeld. Benötigt wird eine PaintBox. Das habe ich mal für Tic Tac Toe erstellt. Ich hab es nur auf 12 Felder erweitert. Das Feld ist simpel und die Ansteuerung ist simpel. Vielleicht bringt es dich auf eine Idee.
Delphi-Quellcode:
const
  MaxFelder = 12;

//Breite der Zelle
function CellWidth(Canvas: TCanvas): Integer;
begin
  with Canvas do
    Result := (ClipRect.Right - ClipRect.Left) div (MaxFelder + 1);
end;

//Höhe der Zelle
function CellHeight(Canvas: TCanvas): Integer;
begin
  with Canvas do
    Result := (ClipRect.Bottom - ClipRect.Top) div (MaxFelder + 1);
end;

//Rect-Bereich der Zelle
function CellRect(Canvas: TCanvas; x, y: Integer): TRect;
begin
  with Canvas do
    Result := Rect(x * CellWidth(Canvas), y * CellHeight(Canvas),
      (x + 1) * CellWidth(Canvas), (y + 1) * CellHeight(Canvas));
end;

//Text in Zelle mittig plazieren (horizontal und vertikal)
procedure CellRectText(Canvas: TCanvas; x, y: Integer; Text: String);
var
  a, b: Integer;
begin
  with Canvas do
  begin
    //Vermittelt Text in Höhe und Breite
    a := (CellWidth(Canvas) div 2) - (TextWidth(Text) div 2);
    b := (CellHeight(Canvas) div 2) - (TextHeight(Text) div 2);

    with Canvas do
      TextRect(CellRect(Canvas, x, y), (x * CellWidth(Canvas)) + a, (y * CellHeight(Canvas)) + b, Text);
  end;
end;

procedure DrawMatrix(Canvas: TCanvas);
var
  x, y: Integer;
  s: String;
begin
  with Canvas do
  begin
    Font.Color := clBlack;
    Font.Style := [] + [fsBold];

    //X-Koordinaten-Beschriftung zeichnen (1, 2, 3, ...)
    y := 0;
    for x := 1 to MaxFelder do
    begin
      s := IntToStr(x);
      CellRectText(Canvas, x, y, s);
    end;

    //Y-Koordinaten-Beschriftung zeichnen (A, B, C, ...)
    x := 0;
    for y := 1 to MaxFelder do
    begin
      s := Chr(y + 64); //64 ist das Ascii-Zeichen für @, ein Zeichen vor A
      CellRectText(Canvas, x, y, s);
    end;

    //Beispiel
    CellRectText(Canvas, 3, 5, 'X');
    CellRectText(Canvas, 6, 9, 'X');
    CellRectText(Canvas, 4, 7, 'O');


    //Gitter zeichnen
    Canvas.Brush.Style := bsClear;
    for x := 1 to MaxFelder do
      for y := 1 to MaxFelder do
      begin
        Pen.Color := clGray;

        Rectangle(CellRect(Canvas, x, y));
      end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  with PaintBox1 do
    DrawMatrix(Canvas);
end;
  Mit Zitat antworten Zitat