Bild mit StretchDraw in Zelle eines StringGrid einfügen

[haentschman]

Moin...

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

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.