Zrobić histogram bitmapy - szybciej i lepiej

0

Cześć, tworzę program, ktróry m.in. tworzy histogram bitmapy - w skali szarości.
Do testów używam dużej bitmapy: 1536 x 2048.
Mój kod jednak trochę czasu trwa. I coś jest nie tak.
Otóż z tego, co wiem, to skala szarości to kolory od 0 do 255.

Stworzyłem sobie nowy typ:

THistogram = array[0..255] of integer;

Elementy tablicy to poszczególne kolory, natomiast jej wartości mają przedstawiać ilość wystąpień, np:

HistArray[0] = 1039 - oznacza, że kolor 0 wystąpił 1039 razy.

Kod wypełniający tą tablicę wygląda tak:

procedure MakeHistogram(var HistArray: THistogram; Bitmap: TBitmap);
var
  i, j: integer;
begin
  for i:=1 to Bitmap.Height do
    for j:=1 to Bitmap.Width do
    begin
      HistArray[Bitmap.Canvas.Pixels[i, j]]:=HistArray[Bitmap.Canvas.Pixels[i, j]]+1;
    end;
end;

Okazuje się jednak, że jest tu jakiś błąd.
Ponieważ Bitmap.Canvas.Pixels[i, j] przyjmuje również wartości spoza zakresu.

Czemu tak jest?
I czy można operację tworzenia histogramu wykonać jakoś szybciej/lepiej?
(chodzi mi tylko o bitmapy w skali szarości)

0

Nie jestem pewny czy dobrze myslę ale zapewne Canvas pracuje w większej ilosci niż 256 kolorów, i twoja bitmapa w momencie wczytania jest konwertowana na ilosc kolorów w jakim działa canvas. tak więc jeżeli canvas działa w 16 bitach to kolor biały będzie miał wartość $FFFF czyli 65535, a nie wartośc z przedziału 0..255 jak oczekujesz

0

Dla gray scale R=G=B, pobierz jakąkolwiek składową piksela np GetRValue i będziesz miał wartość 0..255.

0

masz szybciej to już tylko asm chyba ;-P

procedure ZrobHistogram(var Histogram:THistogram;Bitmapa:TBitmap);
var
ByteWsk:^Byte;
H,V:Integer;
begin
Bitmapa.PixelFormat:=pf8bit; // zamieniam na 8 bitów (dla pewnosci)
for V:=0 to Bitmapa.Height-1 do
  begin
  ByteWsk:=Bitmapa.ScanLine[V];
  for H:=0 to Bitmapa.Width -1 do
    begin
  inc(Histogram[ByteWsk^]);
  inc(ByteWsk);
    end;
  end;
end;

0

Sorki zmień nagłówek na

 procedure ZrobHistogram(var Histogram:THistogram;const Bitmapa:TBitmap);

będzie jeszcze szybciej:) ;-P

0

Zapomniałem powiedziec
jesli zmienisz nagłówek to to daj na zewnątrz procedury a nie wewnątrz

Bitmapa.PixelFormat:=pf8bit; // zamieniam na 8 bitów (dla pewnosci)

0

piotrekdp(nielogowany) napisał(a)

Sorki zmień nagłówek na

 procedure ZrobHistogram(var Histogram:THistogram;const Bitmapa:TBitmap);

będzie jeszcze szybciej:) ;-P

Jak dla mnie zysk znikomy ;-P Zaleta taka, że wyraźnie zaznaczamy, że wartości parametru Bitmapa nie modyfikujemy w treści procedury (szkoda, że nie mamy takiej pewności co do zawartości obiektu :) ).

0

Piotrekdp - Twój kod działa faktycznie 2 razy szybciej od mojego, ale nie działa poprawnie. Tzn. wg niego np. na bitmapie, w której faktycznie jest ok. 25% koloru białego(255), nie ma w ogóle białego.

0

Piotrekdp napisał(a)

to niemozliwe program napewwno działa dobrze
być może zamieszałem ci coś z const'em bo jak dasz const to wtedy bitmapa nie zostanie przekonwertowana na 8 bitów i wskazanie bedzie błędne(przepisz tak jak powyżej)
ale zastrzegłem to wyżej :) ewentualnie można zrobić wersję na 24 bitową bitmapę ale jestem pewien że to jest poprawne

Nie robiłem z const.
Nie działa dobrze. Sprawdziłem to. Na 24 bity jeszcze nie próbowałem, zrobię to jutro.

0

Kurka testowałem na bitmapie z inną [aletą sorki za 10 min zrobie poprawny histograam :)

0

procedure ZrobHistogram(var Histogram:THistogram;Bitmapa:TBitmap);
var
TripleWsk:^TRgbTriple;
H,V:Integer;
begin
Bitmapa.PixelFormat:=pf24bit; // zamieniam na 24 bity (dla pewnosci)
for V:=0 to Bitmapa.Height-1 do
  begin
  TripleWsk:=Bitmapa.ScanLine[V];
  for H:=0 to Bitmapa.Width -1 do
    begin
  inc(Histogram[  TripleWsk.rgbtBlue ]);
  inc(TripleWsk);
    end;
  end;
end;

Test


procedure TForm1.FormCreate(Sender: TObject);
var
h,v:Integer;
PixWsk:^TRgbTriple;
begin

Bitmapa:=TBitmap.Create;
Bitmapa.Width:=255;
Bitmapa.Height :=10;
Bitmapa.PixelFormat:=Pf24bit;

for V:=0 to Bitmapa.Height -1 do
begin
PixWsk:=Bitmapa.ScanLine[V];
for H:=0 to Bitmapa.Width -1 do
begin
PixWsk^.rgbtBlue :=H;
PixWsk^.rgbtGreen :=H;
PixWsk^.rgbtRed :=H;
inc(PixWsk);
end;

end;
Image1.Canvas.Draw(0,0,Bitmapa);
ZrobHistogram(Histogram,Bitmapa);
Caption:=Inttostr(Histogram[0]);

Bitmapa.Free;