Maximale Stack Größe reicht nicht

[himitsu]

Zitat von wicht:

Bin mir jetzt nicht ganz sicher

Na da hast'e vollkommen Recht.


hmmmmm, bei M.bmp = dein Bild von Seite 1
und M2.bmp Ergebnis (damit man was besser sieht, wurde an LastArea gedreht)
aber irgendwie hab ich Probleme mit diesem blöden FloddFill und die schrottige OH ist da garkeine Hilfe, da dort absolut nix drinsteht in D2010 .

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;

  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 := C;
              Map.Canvas.FloodFill(X, Y, C2, 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, 85);  //Inc(LastArea);
          If LastArea = $01000000 Then Raise EOverflow.Create('too many areas');
          MLine[X] := 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.

Vorteil hierbei ist allerdings, daß man nur einmal suchen lassen muß und dann gleich alle Felder gefunden werden.