Maximale Stack Größe reicht nicht

[kub]

Guten Morgen.

Ich habe die neue Funktion von Himitsu ausprobiert. Hier werden einzelne große Flächen in vertikale Streifen aufgeteilt. Den Fehler habe ich nicht gefunden. Ein Durchlauf dauert hier bei meinem Bild ca. 300 Millisekunden.

Danach habe ich noch einmal die Idee von jfheins aufgegriffen und meine Funktion umgeschrieben und iterativ mit einem Array gearbeitet. Das geht wunderbar und ist sogar noch schneller als der rekursive Ansatz.

Im Moment brauche ich nur die Daten der gefundenen Bereiche und das so schnell wie möglich. Wenn einmal gefordert ist, dass ich die Bereiche im Bild anzeigen muss, werde ich wahrscheinlich noch mal auf Himitsus Ansatz zurückkommen.

Falls jemanden die Funktion interessiert:
Die Funktionen für den Zugriff auf die Pixel sind Teil einer anderen Klasse, die ich hier aber nicht veröffentlichen kann.

Delphi-Quellcode:

var
  Points: Array of TPoint;

procedure init;
begin  
  ImgWidth:= Image.Width;
  ImgHeight:= Image.Height;
  //Array größe = 4*Pixelanzahl, da im worst case auf jedes Pixel von jeder Seite zugegriffen wird.
  SetLength(Points,4*ImgWidth*ImgHeight);
end;

procedure SearchBlob;
var
  x,y: integer;
  MeanX, MeanY: double;
  index: integer;
  ListCount: integer;
  count: integer;
  s: string;
  imgo:pointer;
begin
  For Y := 0 to ImgHeight - 1 do
  begin
    For X := 0 to ImgWidth - 1 do
    begin
      if GetGrayVal(x,y) < Threshold) then
      Begin
        index:=0;
        ListCount:= 0;
        MeanX:= 0;
        MeanY:= 0;
        count:= 0;
        //Startpunkt in Liste aufnehmen
        Points[ListCount].X:= x;
        Points[ListCount].Y:= y;
        //Liste abarbeiten
        Repeat
          //Wenn Pixel dunkel, dann Position aufnehmen und umgebende Punke in die Liste aufnehmen
          if GetGrayVal(Points[index].X,Points[index].Y) <= Threshold) then
          begin
            MeanX:= MeanX + Points[index].X;
            MeanY:= MeanY + Points[index].Y;
            inc(Count);
            GrayVal[Points[index].X][Points[index].Y]:= 255;
            //umgebende Punke zur Liste hinzufügen
            if (Points[index].x < ImgWidth-1) then
            begin
              inc(ListCount);
              Points[ListCount].X:= Points[index].X + 1;
              Points[ListCount].Y:= Points[index].Y;
            end;
            if (Points[index].x > 0) then
            begin
              inc(ListCount);
              Points[ListCount].X:= Points[index].X - 1;
              Points[ListCount].Y:= Points[index].Y;
            end;
            if (Points[index].y < ImgHeight-1) then
            begin
              inc(ListCount);
              Points[ListCount].X:= Points[index].X;
              Points[ListCount].Y:= Points[index].Y + 1;
            end;
            if (Points[index].y > 0) then
            begin
              inc(ListCount);
              Points[ListCount].X:= Points[index].X;
              Points[ListCount].Y:= Points[index].Y - 1;
            end;
          end;
          inc(index);
        Until index >= ListCount;
        //zu kleine Flächen ignorieren
        if Count > 100 then
        begin
          MeanX:= MeanX/Count;
          MeanY:= MeanY/Count;
          s:= 'Position: X=' + FormatFloat('0.0',MeanX)
                 + ' ; Y=' + FormatFloat('0.0',MeanY)
                 + ' ; S=' + IntToStr(Count);
          ResultList.Add(s);
        end;
      end;
    end;
  end;
end;

Damit ist mein Problem gelöst. Vielen Dank an alle für Eure Hilfe!!

Gruß
Thomas

[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.

[kub]

@Himitsu
Es handelt sich um ein 8Bit Graustufen bmp. Beim Kunden hängt eine Monochromkamera am Rechner, deren Bilder ich auswerte.
Das Ausgabeformat deiner Funktion finde ich gut. Deine neue Version funktioniert. Für meine jetzige Anwendung ist sie aber nicht schnell genug. Bei dem Bild im Anhang dauert die Ausführung bei mir ca. 900ms. Trotzdem danke