Thema: Delphi Toleranzen von Farben

Einzelnen Beitrag anzeigen

BAMatze

Registriert seit: 18. Aug 2008
Ort: Berlin
759 Beiträge
 
Turbo Delphi für Win32
 
#11

Re: Toleranzen von Farben

  Alt 14. Mai 2009, 11:13
Deine Funktion sieht natürlich schöner aus, weil man die Farbe wechseln kann @DeddyH. Hab hier auch mal eine Funktion geschrieben gehabt, war schon fast fertig, als ich deine Post gesehen hab.

Hier mal meine Funktion:

Delphi-Quellcode:
procedure TForm1.Bildanalyse;
var i, j, AnzahlSchwPixel, PosOben, PosUnten, PosRechts, PosLinks, Anz, RefRValue,
    RefGValue, RefBValue, PCRValue, PCGValue, PCBValue: integer;
begin
  AnzahlSchwPixel := 0; //Anzahl der gefundenen schwarzen Pixel
  Anz := 0; // Anzahl der Schleifendurchgänge (reiner Kontrollwert für mich)
  // die Positionen für Unten und Rechts werden negativ gesetzt, da beim finden einer
  // dieser Grenzen immer ein positiver Wert eingetragen wird
  PosUnten := -1;
  PosRechts := -1;
  // die Psoitionen für Oben und Links werden übernatürlich groß gewählt, da somit eine
  // einfachere Prüfung durchgeführt werden kann.
  PosOben := 999;
  PosLinks := 999;
  Memo1.Clear;
  for i := 1 to FprivBMP.Width do
    begin
      for j := 1 to FprivBMP.Height do
        begin
          Anz := Anz + 1; // Kontrollwert erhöhen
          PCRValue := GetRValue(FprivBMP.Canvas.Pixels[i,j]);
          PCGValue := GetGValue(FprivBMP.Canvas.Pixels[i,j]);
          PCBValue := GetBValue(FprivBMP.Canvas.Pixels[i,j]);
          Memo1.Lines.Add('R ' + inttostr(PCRValue) + ',G ' + inttostr(PCGValue) + ', B ' + inttostr(PCBValue));
          if (PCRValue < 10) and
             (PCGValue < 10) and // Hier gehe ich jetzt mal davon aus, dass man den Wert der Farbe clBlack weiß.
             (PCBValue < 10) then
            begin
              AnzahlSchwPixel := AnzahlSchwPixel + 1;
              if j < PosOben then PosOben := j;
              if i > PosRechts then PosRechts := i;
              if j > PosUnten then PosUnten := j;
              if i < PosLinks then PosLinks :=i;
            end;
        end;
    end;
  Lbl_Oben.Caption := inttostr(PosOben);
  Lbl_Unten.Caption := inttostr(PosUnten);
  Lbl_Rechts.Caption := inttostr(PosRechts);
  Lbl_Links.Caption := inttostr(PosLinks);
  Lbl_Anzahl.Caption := inttostr(AnzahlSchwPixel);
  Lbl_Anz.Caption := inttostr(Anz);
end;
Funktioniert auch eignentlich gut. Nur PErformance ist aufgrund des Memos nicht so toll.
2. Account Sero
  Mit Zitat antworten Zitat