Einzelnen Beitrag anzeigen

bernhard_LA

Registriert seit: 8. Jun 2009
Ort: Bayern
1.138 Beiträge
 
Delphi 11 Alexandria
 
#1

Kreise und Linien Erkennen , jetzt mit FMX (LINUX)

  Alt 11. Jun 2020, 16:06
ich versuche mich gerade ein einer Portierung des VCL Projekts zur Kreis und Linien Erkennung https://sourceforge.net/projects/houghtransforma/
von VCL auf FMX

die Funktion IsPixel() prüft ob der Mittelwert aus r,g,b-Kanal größer als ein Schwellwert ist und gibt dafür ein true / false zurück.
Unter VCL gehts perfekt, Schnell ( < Sekunde) , die FMX
Variante rechnet ca. 10 min .... und vermutlich noch nicht mal richtig


Delphi-Quellcode:
{$IFDEF  FRAMEWORK_VCL}

function IsPixel(xpos, ypos: integer; aBitmap: TBitMap;
  ThresHold: integer): boolean;
var
  p: pbyteArray;
  r, g, b, mean: integer;
begin

  aBitmap.PixelFormat := pf24bit;

  if (ypos <= aBitmap.Height - 1) and (xpos <= aBitmap.Width - 1) then

  begin
    p := aBitmap.ScanLine[ypos];

    r := p[3 * xpos];
    g := p[3 * xpos + 1];
    b := p[3 * xpos + 2];
    mean := ((round(r) + round(g) + round(b)) div 3);

    if (mean > ThresHold) then
      result := true
    else
      result := false;

  end
  else
  begin
    result := false
  end;

end;

{$ENDIF}
{$IFDEF  FRAMEWORK_FMX}

function IsPixel(xpos, ypos: integer; aBitmap: TBitMap;
  ThresHold: integer): boolean;
var
  r, g, b, mean: integer;

  bitdata: TBitmapData;

  C: TAlphaColor;
begin
  if (aBitmap.Map(TMapAccess.Read, bitdata)) then
    try

      C := bitdata.GetPixel(xpos, ypos);

      r := TAlphaColorRec(C).r;
      g := TAlphaColorRec(C).g;
      b := TAlphaColorRec(C).b;

      mean := round((r + g + b) / 3);

      if (mean > ThresHold) then
        result := true
      else
        result := false;

    finally
      aBitmap.Unmap(bitdata);
    end;
end;

{$ENDIF}
  Mit Zitat antworten Zitat