Maximale Stack Größe reicht nicht

[himitsu]

Problem gefunden: Die Bytes der Farben liegen im Bitmap andersrum, als wie in TColor.

In welchem Format liegt eigentlich dein Bild vor?
(man sieht ja nicht, was sich hinter GetGrayVal versteckt)

Und das Map-Image hab ich vorwiegend als Ausgabeformat genutzt, weil es einfach nur "einfach" zu handhaben ist ... ein anderes Format wäre auch "leicht" realisierbar.

Delphi-Quellcode:

Uses Types, SysUtils, Graphics;

Procedure SearchAreas(Threshold: Byte; Image, Map: TBitMap);
  Function GetGray(Const C: TColor): Byte; //Inline;
    Begin
      Result := (C and $FF + (C shr 8) and $FF + (C shr 16) and $FF) div 3;
    End;

  Function SwapBytes(C: TColor): TColor; //Inline;
    Begin
      Result := (C and $0000FF) shl 16 or C and $00FF00 or (C and $FF0000) shr 16;
    End;

  Type TColorArr = packed Array[0..0] of TColor;

  Var LastArea, Xc, X, Y: Integer;
    C, C2: TColor;
    ILine, MLineB, MLine: ^TColorArr;

  Begin
    Image.PixelFormat := pf32bit;
    Map.PixelFormat := pf32bit;
    Map.Width  := Image.Width;
    Map.Height := Image.Height;
    Map.Canvas.Brush.Style := bsSolid;
    Map.Canvas.Brush.Color := 0;
    Map.Canvas.FillRect(Rect(0, 0, Map.Width, Map.Height));
    LastArea := 0;
    MLine := nil;
    Xc := Image.Width - 1;
    For Y := 0 to Image.Height - 1 do Begin
      MLineB := MLine;
      ILine  := Image.ScanLine[Y];
      MLine  := Map.ScanLine[Y];
      For X := 0 to Xc do
        If GetGray(ILine[X]) < Threshold Then Begin
          If Assigned(MLineB) Then C := MLineB[X] Else C := 0;
          If C <> 0 Then Begin
            MLine[X] := C;
            If X > 0 Then C2 := MLine[X - 1] Else C2 := 0;
            If (C2 <> 0) and (C2 <> C) Then Begin
              Map.Canvas.Brush.Color := SwapBytes(C2);
              Map.Canvas.FloodFill(X, Y, SwapBytes(C), fsSurface);
            End;
            Continue;
          End;

          If X > 0 Then C := MLine[X - 1] Else C := 0;
          If C <> 0 Then Begin
            MLine[X] := C;
            Continue;
          End;

          Inc(LastArea);
          If LastArea = $01000000 Then Raise EOverflow.Create('too many areas');
          MLine[X] := SwapBytes(LastArea);
        End;
    End;
    Map.PixelFormat := pf24bit;
  End;

Var I, M: TBitMap;

Begin
  I := TBitmap.Create;
  M := TBitmap.Create;
  I.LoadFromFile('M.bmp');
  SearchAreas(100, I, M);
  M.SaveToFile('M2.bmp');
  M.Free;
  I.Free;
End.

[edit]
hab mal ein kleines Testprojekt angehängt, welches einen etwas veränderten Code beinhaltet.