Aus einem TBitMap eine "ImageMap" erstellen

[endeffects]

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:

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?

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

[jim_raynor]

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.

[endeffects]

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

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

[marabu]

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