Hallo,

ich versuche noch immer aus einem TBitmap eine Karte
zu erstellen um so benachbarte Pixel einer Farbe
auf einem anderen BitMap auszugeben.
Das Bild ist lediglich schwarz/weiß.

Um das Ganze zu veranschaulichen hat mir Jemand
vor einer Weile folgendes Konsolen Programm geschickt:

zusammenfalten · markieren

Delphi-Quellcode:

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils;

const
  N = 5;
type
  TCoordinate = 1..N;
  TColour = '0'..'1';
  TImage = array [TCoordinate, TCoordinate] of TColour;

procedure Dump(const Image: TImage; const XX, YY: TCoordinate);
var X, Y: TCoordinate;
begin
  for X:=Low(X) to High(X)
  do begin
    for Y:=Low(Y) to High(Y)
    do begin
      if (X=XX) and (Y=YY)
      then Write('*')
      else Write(Image[X, Y]);
    end;
    WriteLn;
  end;
  WriteLn;
end;

procedure Fill
 (var Image: TImage;
  const X, Y: TCoordinate;
  const Colour: TColour);
var
  OldColour: TColour;
begin
  OldColour:=Image[X, Y];
  Image[X, Y]:=Colour;

  Dump(Image, X, Y);

  { Look left }
  if (Low(X)<X) and (Image[Pred(X), Y]=OldColour)
  then Fill(Image, Pred(X), Y, Colour);

  { Look right }
  if (X<High(X)) and (Image[Succ(X), Y]=OldColour)
  then Fill(Image, Succ(X), Y, Colour);

  { Look up }
  if (Low(Y)<Y) and (Image[X, Pred(Y)]=OldColour)
  then Fill(Image, X, Pred(Y), Colour);

  { Look down }
  if (Y<High(Y)) and (Image[X, Succ(Y)]=OldColour)
  then Fill(Image, X, Succ(Y), Colour);
end;

const
  Image : TImage
        = (('1', '1', '1', '0', '0'),
           ('1', '0', '0', '0', '1'),
           ('1', '0', '1', '1', '0'),
           ('0', '0', '1', '0', '0'),
           ('0', '1', '1', '0', '1')
          );
var
  NewImage: TImage;
begin
  NewImage:=Image;
  Fill(NewImage, (Pred(N+2)) div 2, (Pred(N+2)) div 2, '0');
end.

Das Alles möchte ich nun auf richtige Bitmaps projezieren.
Bisher sieht mein Versuch wie folgt aus, leider endet dieser
in einem Stack-Overflow in der Methode Fill();.
Hat Jemand vielleicht eine ruhige Minute und könnte sich das anschauen?

zusammenfalten · markieren

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TCoordinate = 1..300;
  TForm1 = class(TForm)
    Image1: TImage;
    Image2: TImage;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private-Deklarationen }
    CacheBitmap: TBitmap;
    MyImageMap: array [TCoordinate, TCoordinate] of integer;
    procedure Fill(X, Y: TCoordinate; Colour: integer);
    procedure BuildImageMap;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.BuildImageMap;
var
  TempBitmap: TBitmap;
  x, y: Integer;
  P: PRGBQuad; // definiert in Windows.pas
begin
  TempBitmap:= TBitMap.create;
  //MyImageMap:= MyImageMap;
  try
    TempBitmap.Assign(Image1.Picture);
    TempBitmap.PixelFormat:= pf32bit;

    for y:= 0 to TempBitmap.Height-1 do
    begin
      P:= TempBitmap.ScanLine[y];
      for x:= 0 to TempBitmap.Width-1 do
      begin
        if (P^.rgbRed = 0) and (P^.rgbGreen = 0) and (P^.rgbBlue = 0) then
          MyImageMap[X, Y]:= 1
        else
          MyImageMap[X, Y]:= 0;
      end;
    end;
  finally
    TempBitmap.Free;
  end;
end;

procedure TForm1.Fill(X, Y: TCoordinate; Colour: integer);
var OldColour: Integer;
begin
  OldColour:=MyImageMap[X, Y];
  MyImageMap[X, Y]:=Colour;

  //Dump(Image, X, Y);

  { Look left }
  if (Low(X)<X) and (MyImageMap[Pred(X), Y]=OldColour)
  then Fill(Pred(X), Y, Colour);

  { Look right }
  if (X<High(X)) and (MyImageMap[Succ(X), Y]=OldColour)
  then Fill(Succ(X), Y, Colour);

  { Look up }
  if (Low(Y)<Y) and (MyImageMap[X, Pred(Y)]=OldColour)
  then Fill(X, Pred(Y), Colour);

  { Look down }
  if (Y<High(Y)) and (MyImageMap[X, Succ(Y)]=OldColour)
  then Fill(X, Succ(Y), Colour);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  BuildImageMap;
  Fill((Pred(300+2)) div 2, (Pred(300+2)) div 2, 0);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  CacheBitmap:= TBitMap.create;
  CacheBitmap.PixelFormat:= pf32bit;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  CacheBitmap.Free;
end;

end.

MfG

Dein X und Y sind vom Typ Integer. Bei Low(X) gibt er dann -2.xxx.xxx.xxx aus, wodurch die Rekursion recht lange läuft. Genauso gibt High(X) 2.xxx.xxx.xxx aus. Du musst also entweder die Prüfung ändern, oder den Datentypen.

ich hatte den typ schon nachträglich auf TCoordinate geändert,
leider tritt der stack overflow noch immer auf.

markieren

Delphi-Quellcode:

type
  TCoordinate = 1..300;
  TForm1 = class(TForm)

...
procedure TForm1.Fill(X, Y: TCoordinate; Colour: integer);
begin
...

ich versteh auch nicht so wirklich woran das nun liegen könnte,
in dem konsolen programm funktioniert es ja auch und grundsätzlich
hab ich es ja 1:1 übernommen

ps: ich hab den code oben noch einmal aktualisiert

Zitat von endeffects:

Bisher sieht mein Versuch wie folgt aus, leider endet dieser
in einem Stack-Overflow in der Methode Fill();.
Hat Jemand vielleicht eine ruhige Minute und könnte sich das anschauen?

Der Ansatz über die Rekursion erfordert bei 300 x 300 Pixeln deutlich mehr Stackspeicher als die standardmäßigen 16KByte. Du solltest in den Linker-Optionen deines Projektes etwas spendabler sein. Irgendwann ist allerdings immer Schluss. Dann brauchst du einen intelligenteren Ansatz - ohne Rekursion.

Grüße vom marabu