AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Multimedia Delphi Pixel gleicher Farbe zählen
Thema durchsuchen
Ansicht
Themen-Optionen

Pixel gleicher Farbe zählen

Ein Thema von dominikkv · begonnen am 22. Jun 2008 · letzter Beitrag vom 22. Jun 2008
Antwort Antwort
Seite 1 von 2  1 2      
dominikkv

Registriert seit: 30. Sep 2006
Ort: Gundelfingen
1.109 Beiträge
 
Delphi 2007 Professional
 
#1

Pixel gleicher Farbe zählen

  Alt 22. Jun 2008, 18:30
Hi

ich brauche von euch die schnellste Möglichkeit die Anzahl Pixel gleicher Farbe herauszufinden.
Ganz einfaches Beispiel:
Delphi-Quellcode:
type
  TColorArray = Array of TColor;
  TAnzahlArray = Array of Integer;

function CountColor(aBitmap: TBitmap; Colors: TColorArray ): TAnzahlArray ;
var
  I, J, K: Integer;
  Unten, Oben: Integer;
begin
  Unten := Low(Colors); // Um nacher nicht so oft die Funktionen zu benutzen
  Oben := High(Colors);

  SetLength(Result, Succ(Oben));

  for I := Unten to Oben do
    Result[I] := 0;

  for I := 0{oder 1?} to aBitmap.Width do
    for J := 0{oder 1?} to aBitmap.Height do
      for K := Unten to Oben do
        if aBitmap.Canvas.Pixels[I, J] = Color[K] then
          Inc(Result[K]);
end;

procedure bla;
var
  Colors: TColorArray;
  Anzahl: TAnzahlArray;
begin
  SetLength(Colors, 2);
  Colors[0] := clRed;
  Colors[1] := clBlue;
  Anzahl := CountColor(meinBitmap, Colors);
  showmessage(Format('%d Pixel sind Rot, %d Pixel sind Blau', [Anzahl[0], Anzahl[1]));
end;
Ich hoffe ihr versteht was ich meine. Ich bin mir sicher das geht noch schneller als bei meinem Beispiel...
Hat jemand von euch ne Idee?

mfg.Dominik
Dominik
Wer anderen eine Grube gräbt, hat ein Gruben-Grab-Gerät!
  Mit Zitat antworten Zitat
Apollonius

Registriert seit: 16. Apr 2007
2.325 Beiträge
 
Turbo Delphi für Win32
 
#2

Re: Pixel gleicher Farbe zählen

  Alt 22. Jun 2008, 18:35
Nimm TBitmap.Scanline.
Wer erweist der Welt einen Dienst und findet ein gutes Synonym für "Pointer"?
"An interface pointer is a pointer to a pointer. This pointer points to an array of pointers, each of which points to an interface function."
  Mit Zitat antworten Zitat
dominikkv

Registriert seit: 30. Sep 2006
Ort: Gundelfingen
1.109 Beiträge
 
Delphi 2007 Professional
 
#3

Re: Pixel gleicher Farbe zählen

  Alt 22. Jun 2008, 18:58
Zitat von Apollonius:
Nimm TBitmap.Scanline.
Ich kenne ScanLine zwar nicht, habe mal aber hier im Forum gesucht und das ist dabei rausgekommen:
Delphi-Quellcode:
type
  TColorArray = Array of TColor;
  TAnzahlArray = Array of Integer;
  TLine = Array[1..3] of Byte;

function CountColor(aBitmap: TBitmap; Colors: TColorArray): TAnzahlArray;
var
  I, J, K: Integer;
  Unten, Oben: Integer;
  Line: ^TLine;
begin
  Unten := Low(Colors); // Um nacher nicht so oft die Funktionen zu benutzen
  Oben := High(Colors);

  SetLength(Result, Succ(Oben));

  for I := Unten to Oben do
    Result[I] := 0;

  for I := 0{oder 1?} to aBitmap.Height do
    begin
      Line := aBitmap.ScanLine[I];
      for J := 0{oder 1?} to aBitmap.Width do
        for K := Unten to Oben do
          if Line[J] = Colors[K] then
            Inc(Result[K]);
    end;
end;
Leider kommt in der Zeile
if Line[J] = Colors[K] then eine AV. Wo ist mein Fehler?
Dominik
Wer anderen eine Grube gräbt, hat ein Gruben-Grab-Gerät!
  Mit Zitat antworten Zitat
Benutzerbild von Neutral General
Neutral General

Registriert seit: 16. Jan 2004
Ort: Bendorf
5.219 Beiträge
 
Delphi 10.2 Tokyo Professional
 
#4

Re: Pixel gleicher Farbe zählen

  Alt 22. Jun 2008, 19:12
Zitat von dominikkv:
Leider kommt in der Zeile
if Line[J] = Colors[K] then eine AV. Wo ist mein Fehler?
Mich wundert es, das der code überhautp compiliert...

Delphi-Quellcode:
if Line[J]{!}^{/!} = Colors[K] then // dereferenzieren nicht vergessen!
// ==>
if Array[1..3] of Byte = TColor then
// Das wird nichts oder?
Außerdem geht dein Array nur von 1-3 und nicht bis j (Das Bild wird wohl breiter als 3 Pixel sein )

Line^ enthält den RGB wert, des ersten Pixels der gescannten Reihe.

Delphi-Quellcode:
Line^[1] = Rot
Line^[2] = Grün
Line^[3] = Blau
Wenn du jetzt den nächsten Pixel haben willst, musst du den Zeiger nach jedem j-Schleifendurchlauf inkrementieren:

inc(Line); Der Vergleich wäre dann so möglich:

if RGB(line[1],line[2],line[3]) = Colors[k] then Ich hoffe du hast es ungefähr verstanden

Gruß
Neutral General
Michael
"Programmers talk about software development on weekends, vacations, and over meals not because they lack imagination,
but because their imagination reveals worlds that others cannot see."
  Mit Zitat antworten Zitat
marabu

Registriert seit: 6. Apr 2005
10.109 Beiträge
 
#5

Re: Pixel gleicher Farbe zählen

  Alt 22. Jun 2008, 19:24
Hallo Dominik,

bitte auch den Gültigkeitsbereich der Laufvariablen (off by one) beachten.

Grüße vom marabu
  Mit Zitat antworten Zitat
dominikkv

Registriert seit: 30. Sep 2006
Ort: Gundelfingen
1.109 Beiträge
 
Delphi 2007 Professional
 
#6

Re: Pixel gleicher Farbe zählen

  Alt 22. Jun 2008, 19:47
hey danke für eure Antworten

ich hab das nun so hingepfrimelt:
Delphi-Quellcode:
type
  TLine = TRGBTriple;

function TPaintEngine.CountColor(Colors: TColorArray): TAnzahlArray;
var
  I, J, K: Integer;
  Unten, Oben: Integer;
  Line: ^TLine;
begin
  Unten := Low(Colors); // Um nacher nicht so oft die Funktionen zu benutzen
  Oben := High(Colors);

  SetLength(Result, Succ(Oben));

  for I := Unten to Oben do
    Result[I] := 0;

  for I := 1 to fBuffer.Height - 1 do
    begin
      Line := fBuffer.ScanLine[I];
      for J := 1 to fBuffer.Width - 1 do
        begin
          for K := Unten to Oben do
            if RGB(line^.rgbtRed,line^.rgbtGreen,line^.rgbtBlue) = Colors[k] then
              Inc(Result[K]);
          Inc(Line);
        end;
    end;
end;
Ergebnis: braucht ca doppelt so viel Zeit wie die Methode über Pixels[I, J] und liefert zudem noch falsche Werte.
Dominik
Wer anderen eine Grube gräbt, hat ein Gruben-Grab-Gerät!
  Mit Zitat antworten Zitat
Benutzerbild von littleDave
littleDave

Registriert seit: 27. Apr 2006
Ort: München
556 Beiträge
 
Delphi 7 Professional
 
#7

Re: Pixel gleicher Farbe zählen

  Alt 22. Jun 2008, 20:14
Zitat von Neutral General:
Delphi-Quellcode:
Line^[1] = Rot
Line^[2] = Grün
Line^[3] = Blau
*ZONK*

In Bitmaps werden die RGB-Werte anders herum gespeichert (BGR):

Delphi-Quellcode:
Line^[1] = Blau
Line^[2] = Grün
Line^[3] = Rot
Jabber: littleDave@jabber.org
in case of 1 is 0 do external raise while in public class of object array else repeat until 1 is 0
  Mit Zitat antworten Zitat
Benutzerbild von Neutral General
Neutral General

Registriert seit: 16. Jan 2004
Ort: Bendorf
5.219 Beiträge
 
Delphi 10.2 Tokyo Professional
 
#8

Re: Pixel gleicher Farbe zählen

  Alt 22. Jun 2008, 20:17
Mist, ich war mir nichtmehr sicher
Michael
"Programmers talk about software development on weekends, vacations, and over meals not because they lack imagination,
but because their imagination reveals worlds that others cannot see."
  Mit Zitat antworten Zitat
dominikkv

Registriert seit: 30. Sep 2006
Ort: Gundelfingen
1.109 Beiträge
 
Delphi 2007 Professional
 
#9

Re: Pixel gleicher Farbe zählen

  Alt 22. Jun 2008, 20:37
Zitat von littleDave:
In Bitmaps werden die RGB-Werte anders herum gespeichert (BGR):

Delphi-Quellcode:
Line^[1] = Blau
Line^[2] = Grün
Line^[3] = Rot
Trotzdem falsche Werte:
Delphi-Quellcode:
type
  TLine = array [1..3] of Byte;

function CountColor(aBitmap: TBitmap; Colors: TColorArray): TAnzahlArray;
var
  I, J, K: Integer;
  Unten, Oben: Integer;
  Line: ^TLine;
begin
  Unten := Low(Colors); // Um nacher nicht so oft die Funktionen zu benutzen
  Oben := High(Colors);

  SetLength(Result, Succ(Oben));

  for I := Unten to Oben do
    Result[I] := 0;

  for I := 1 to aBitmap.Height - 1 do
    begin
      Line := aBitmap.ScanLine[I];
      for J := 1 to aBitmap.Width - 1 do
        begin
          for K := Unten to Oben do
            if RGB(line^[3],line^[2],line^[1]) = Colors[k] then
              Inc(Result[K]);
          Inc(Line);
        end;
    end;
end;
Dominik
Wer anderen eine Grube gräbt, hat ein Gruben-Grab-Gerät!
  Mit Zitat antworten Zitat
Benutzerbild von Neutral General
Neutral General

Registriert seit: 16. Jan 2004
Ort: Bendorf
5.219 Beiträge
 
Delphi 10.2 Tokyo Professional
 
#10

Re: Pixel gleicher Farbe zählen

  Alt 22. Jun 2008, 20:57
Hi,

... Ich weiß nicht genau was bei dir schief läuft. Ich habe mal selbst eine Funktion geschrieben, die, soweit ich sie getestet habe, funktioniert.

Ich hoffe ich werde nicht erschlagen weil ich fertigen Code poste.

Delphi-Quellcode:
TIntArray = Array of Integer;

function CountColors(bmp: TBitmap; Colors: Array of TColor): TIntArray;
var i,j,k: Integer;
    old: TPixelformat;
    x: PRGBQuad;
    tmp: TColor;
begin
  SetLength(Result,Length(Colors));
  old := bmp.PixelFormat; // Pixelformat sichern
  bmp.PixelFormat := pf32Bit; //Mit 32-Bit Bitmaps gehts schneller
  for i := 0 to bmp.Height-1 do
  begin
    x := bmp.ScanLine[i];
    for j:= 0 to bmp.Width-1 do
    begin
      tmp := RGB(x^.rgbRed,x^.rgbGreen,x^.rgbBlue);
      for k := 0 to High(Colors) do
        if Colors[k] = tmp then
          inc(Result[k]);
      inc(x);
    end;
  end;
  bmp.PixelFormat := old; // Altes Pixelformat wiederherstellen
end;
Gruß
Neutral General
Michael
"Programmers talk about software development on weekends, vacations, and over meals not because they lack imagination,
but because their imagination reveals worlds that others cannot see."
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 1 von 2  1 2      


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 16:25 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz