Bild mit StretchDraw in Zelle eines StringGrid einfügen

[felix00186]

Hallo!

Ich möchte mit Lazarus ein Minesweeper-Spiel programmieren. Dazu habe ich ein 9x9-StringGrid erstellt und in jede Zelle, in der eine Mine sein soll, ein 'M' geschrieben.
Danach wollte ich mit dem folgenden Programmcode in jede Zelle, in der ein 'M' steht, das Bild einer Mine mit dem StretchDraw-Befehl platzieren:

Delphi-Quellcode:

  bild:=TBitmap.create;
  bild.LoadFromFile(ExtractFilePath(ParamStr(0))+'Mine.bmp');
  for x:=0 to 8 do for y:=0 to 8 do if StringGrid1.cells[x,y]='M' then StringGrid1.Canvas.StretchDraw(StringGrid1.CellRect(x,y),bild);
  bild.free;

Wenn ich das Programm starte und das Spielfeld erstelle, blitzen kurz mal ein paar Minen auf, verschwinden aber sofort wieder.
Was habe ich hier falsch gemacht und wie ist es richtig? Ich bitte um Hilfe. Das gesamte Projekt (außer der exe-Datei) ist im Anhang.

Vielen Dank an alle!

[haentschman]

Moin...:P

Da du erst am Anfang bist, ein paar Tipps. So schlecht siehts nicht aus... :P

1. Ich habe den Quelltext mit einem Standardformatierer formatiert. Hier sieht man wo was fehlt.

Delphi-Quellcode:

unit Unit1;

{$mode objfpc}{$H+}

interface

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

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Panel1: TPanel;
    StringGrid1: TStringGrid;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;
  zuege: integer;

implementation

function Anz_Angrenzende_Minen(zeile, spalte: integer): integer;
begin
  with Form1.StringGrid1 do // Statt der Formvariable (Form1) entweder Self oder nix benutzen. // with soll man nicht mehr verwenden...also gewöhne dir es nicht an... :-)
  begin
    if not (cells[zeile, spalte] = 'M') then
    begin
      result := 0;
      try
        if cells[zeile - 1, spalte - 1] = 'M' then
          result := result + 1;
      except // leerer except Block 
      end;
      try
        if cells[zeile, spalte - 1] = 'M' then
          result := result + 1;
      except // leerer except Block 
      end;
      try
        if cells[zeile + 1, spalte - 1] = 'M' then
          result := result + 1;
      except // leerer except Block 
      end;
      try
        if cells[zeile - 1, spalte] = 'M' then
          result := result + 1;
      except
      end;
      try
        if cells[zeile + 1, spalte] = 'M' then
          result := result + 1;
      except // leerer except Block 
      end;
      try
        if cells[zeile - 1, spalte + 1] = 'M' then
          result := result + 1;
      except // leerer except Block 
      end;
      try
        if cells[zeile, spalte + 1] = 'M' then
          result := result + 1;
      except // leerer except Block 
      end;
      try
        if cells[zeile + 1, spalte + 1] = 'M' then
          result := result + 1;
      except // leerer except Block 
      end;
    end;
  end;
end;

procedure Setze_Minen;
var
  korrekt: boolean;
  i, x, y: integer;
begin
  repeat
    for x := 0 to 8 do
      for y := 0 to 8 do
        Form1.StringGrid1.cells[x, y] := ''; // Statt der Formvariable (Form1) entweder Self oder nix benutzen.
    korrekt := TRUE;
    for i := 1 to 10 do
    begin
      repeat
        x := Random(9);
        y := Random(9);
      until Form1.StringGrid1.Cells[x, y] = ''; // Statt der Formvariable (Form1) entweder Self oder nix benutzen.
      Form1.StringGrid1.Cells[x, y] := 'M'; // Statt der Formvariable (Form1) entweder Self oder nix benutzen.
    end;
    for x := 0 to 8 do
      for y := 0 to 8 do
        if Anz_Angrenzende_Minen(x, y) > 3 then
          korrekt := FALSE;
  until korrekt = TRUE; // ganz falsch, nie auf True prüfen. :-) besser:   "until korrekt" oder "until not korrekt" je nach dem was braucht
end;

procedure Zahlen_einfuegen;
var
  x, y, anz: integer;
begin
  for x := 0 to 8 do
    for y := 0 to 8 do
    begin
      with Form1.StringGrid1 do // Statt der Formvariable (Form1) entweder Self oder nix benutzen. // with soll man nicht mehr verwenden...also gewöhne dir es nicht an... :-)
      begin
        if not (cells[x, y] = 'M') then
        begin
          anz := Anz_Angrenzende_Minen(x, y);
          if anz > 0 then
            cells[x, y] := IntToStr(anz);
        end;
      end;
    end;
end;

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  StringGrid1.visible := FALSE;
  Label1.visible := FALSE;
  Panel1.visible := FALSE;
  randomize;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i, x, y, x1, x2, y1, y2, mine: integer;
  bild: TBitmap;
begin
  //Spiel starten
  Label1.visible := TRUE;
  Panel1.caption := '0';
  zuege := 0;
  Panel1.visible := TRUE;
  Setze_Minen;
  Zahlen_einfuegen;
  StringGrid1.visible := TRUE;
  //Minen
  bild := TBitmap.create;
  bild.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'Mine.bmp');
  mine := 1;
  for x := 0 to 8 do
    for y := 0 to 8 do
      if StringGrid1.cells[x, y] = 'M' then
        StringGrid1.Canvas.StretchDraw(StringGrid1.CellRect(x, y), bild);
  bild.free; // hier liegt dein Fehler :-)
end;

end.

Dein Fehler:
Du erzeugst das Bild und gibst es wieder frei. Du solltest dir eine Struktur ausdenken wo die Bilder liegen sollen. (TArray oder TObjectlist) Am Ende räumst du die "Liste" weg und gibst die Bilder frei.

:P

[felix00186]

Erst einmal danke für die Mühe!
Ich habe den Fehler korrigiert, leider wurde es immer noch nicht besser. An dem Bild konnte es nicht liegen, denn wenn ich einfach mit dem Rectangle-Befehl etwas auf die Canvas zeichnen wollte, ging das auch nicht.

Ich habe das Problem dann nach einigem Recherchieren so gelöst:

Delphi-Quellcode:

procedure TForm1.StringGrid1DrawCell(Sender: TObject; aCol, aRow: Integer;
  aRect: TRect; aState: TGridDrawState);
var x,y:integer;
begin
  //https://www.delphi-treff.de/tipps-tricks/komponenten/tstringgrid/bitmap-in-ein-stringgrid-zeichnen/
  for x:=0 to 8 do for y:=0 to 8 do
  begin
       if StringGrid1.Cells[x,y]='M' then
       begin
            StringGrid1.Canvas.StretchDraw(StringGrid1.CellRect(x,y),Image1.Picture.Bitmap);
       end;
  end;
end;

Das habe ich dann folgendermaßen aufgerufen:

Delphi-Quellcode:

StringGrid1.Invalidate;

Und siehe da: Es funktioniert!

[himitsu]

Solches Zeichnen muß natürlich immer in die Zeichenevents der jeweiligen Komponente, denn wenn sich diese Komponente neu Zeichnet, wird deines wieder überbmalt/gelöscht, wenn es nicht erneut draufgemalt wird.

Aber, du malst jetzt bei jeder einzelnen Zelle die Inhalte aller Zellen neu, obwohl du da nur den Inhalt dieser einen Zelle malen sollst.
> weg mit den For-Schleifen und nur die StringGrid1.Cells[aCol,aRow] in aRect rein malen.


PS: TDrawGrid

[HolgerX]

Hmm..

Zitat:

Zitat von haentschman (Beitrag 1358801)

Delphi-Quellcode:

 
  bild := TBitmap.create;
  bild.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'Mine.bmp');
  mine := 1;
  for x := 0 to 8 do
    for y := 0 to 8 do
      if StringGrid1.cells[x, y] = 'M' then
        StringGrid1.Canvas.StretchDraw(StringGrid1.CellRect(x, y), bild);
  bild.free; // hier liegt dein Fehler :-)
end;

end.

Dein Fehler:
Du erzeugst das Bild und gibst es wieder frei. Du solltest dir eine Struktur ausdenken wo die Bilder liegen sollen. (TArray oder TObjectlist) Am Ende räumst du die "Liste" weg und gibst die Bilder frei.

Da er das Bild auf dem Canvas des StringGrids malt (kopiert), MUSS er es sogar freigeben, da es ansonsten im Speicher liegen bleibt und dass bei jedem Neuzeichnen.

Generell müsste er die obige Routine immer im OnPaint des StringGrids aufrufen!


@felix00186

Ich würde Dir raten, ein TImage (oder PaintBox) statt des StringGrids zu nehmen und das ganze Spielfeld dort einmal malen und dann wirklich nur die Änderungen (Mienen) nachziehen.
Das Bitmap des Images wird durchs TImage immer wieder neu gemalt, wenn es notwendig ist.

Die Position des einzelnen Feldes lässt sich über OnClick mit X,Y errechnen.

Die Info, ob Miene oder nicht würde ich intern in einem Array ablegen.