Nadesłany przez Tomasz Lubiński, 12 października 2005 01:00
Kod przedstawiony poniżej przedstawia główną część rozwiązania problemu.Pobierz pełne rozwiązanie.
Jeżeli nie odpowiada Ci sposób formatowania kodu przez autora skorzystaj z pretty printer'a i dostosuj go automatycznie do siebie.
Histogram_d - wyrownanie/Unit1.pas:
//Histogram - wyrównanie histogramu //(c) 2005 Tomasz Lubinski //www.algorytm.org unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, OleCtrls, chartfx3, jpeg, ExtCtrls, StdCtrls, TeeProcs, TeEngine, Chart, Series, ComCtrls; type LUTType = Array[0..255] of Double; TForm1 = class(TForm) Button1: TButton; ObrazKolorowy: TImage; Histogram1: TChart; Series1: TLineSeries; Series2: TLineSeries; Series3: TLineSeries; ObrazMono: TImage; Histogram2: TChart; LineSeries1: TLineSeries; Chart3: TChart; LineSeries2: TLineSeries; WynikKolorowy: TImage; WynikMono: TImage; Series4: TLineSeries; Series5: TLineSeries; Series6: TLineSeries; procedure Button1Click(Sender: TObject); procedure UpdateLUT(D: LUTType; var LUT: LUTType; series: Integer); private { Private declarations } public { Public declarations } end; var Form1: TForm1; LUTr, LUTg, LUTb, LUTgray: LUTType; implementation {$R *.DFM} procedure TForm1.Button1Click(Sender: TObject); var i, j, rvalue, gvalue, bvalue, grayvalue: Integer; sumR, sumG, sumB, sumGray: Double; numberOfPixels: Double; r, g, b, gray: Array [0..255] of Double; Dr, Dg, Db, Dgray: LUTType; color: TColor; begin for i := 0 to 255 do begin r[i] := 0; g[i] := 0; b[i] := 0; gray[i] := 0; end; //oblicz dystrybuante for i := 0 to ObrazKolorowy.Width-1 do for j := 0 to ObrazKolorowy.Height-1 do begin color := ObrazKolorowy.Canvas.Pixels[i,j]; r[GetRValue(color)] := r[GetRValue(color)] + 1; g[GetGValue(color)] := g[GetGValue(color)] + 1; b[GetBValue(color)] := b[GetBValue(color)] + 1; color := ObrazMono.Canvas.Pixels[i,j]; gray[GetRValue(color)] := gray[GetRValue(color)] + 1; end; numberOfPixels := (ObrazMono.Width) * (ObrazMono.Height); sumR := 0; sumG := 0; sumB := 0; sumGray := 0; for i := 0 to 255 do begin sumR := sumR + r[i]/numberOfPixels; sumG := sumG + g[i]/numberOfPixels; sumB := sumB + b[i]/numberOfPixels; sumGray := sumGray + gray[i]/numberOfPixels; Dr[i] := sumR; Dg[i] := sumG; Db[i] := sumB; Dgray[i] := sumGray; end; //przelicz tablice LUT, tak by wyrownac histogram updateLUT(Dr, LUTr, 1); updateLUT(Dg, LUTg, 2); updateLUT(Db, LUTb, 3); updateLUT(Dgray, LUTgray, 0); for i := 0 to 255 do begin r[i] := 0; g[i] := 0; b[i] := 0; gray[i] := 0; end; for i := 0 to ObrazKolorowy.Width-1 do for j := 0 to ObrazKolorowy.Height-1 do begin color := ObrazKolorowy.Canvas.Pixels[i,j]; rvalue := GetRValue(color); gvalue := GetGValue(color); bvalue := GetBValue(color); //zmien wartosc wedlug tablicy LUT color := Round(LUTr[rvalue]) + (Round(LUTg[gvalue]) shl 8) + (Round(LUTb[bvalue]) shl 16); //oblicz histogram WynikKolorowy.Canvas.Pixels[i,j] := color; r[GetRValue(color)] := r[GetRValue(color)] + 1; g[GetGValue(color)] := g[GetGValue(color)] + 1; b[GetBValue(color)] := b[GetBValue(color)] + 1; end; Histogram1.SeriesList.Series[0].Clear; Histogram1.SeriesList.Series[1].Clear; Histogram1.SeriesList.Series[2].Clear; Histogram1.SeriesList.Series[0].AddArray(r); Histogram1.SeriesList.Series[1].AddArray(g); Histogram1.SeriesList.Series[2].AddArray(b); for i := 0 to ObrazMono.Width-1 do for j := 0 to ObrazMono.Height-1 do begin color := ObrazMono.Canvas.Pixels[i,j]; grayvalue := GetRValue(color); //zmien wartosc wedlug tablicy LUT color := Round(LUTgray[grayvalue]) + (Round(LUTgray[grayvalue]) shl 8) + (Round(LUTgray[grayvalue]) shl 16); //oblicz histogram WynikMono.Canvas.Pixels[i,j] := color; gray[GetRValue(color)] := gray[GetRValue(color)] + 1; end; Histogram2.SeriesList.Series[0].Clear; Histogram2.SeriesList.Series[0].AddArray(gray); end; //przelicz nowe wartosci tablicy LUT //wyswietl wartosci tablicy LUT procedure TForm1.UpdateLUT(D: LUTType; var LUT: LUTType; series: Integer); var i: Integer; D0min: double; begin //znajdz pierwszą niezerową wartosc dystrybuanty i := 0 ; while D[i] = 0 do i := i + 1; D0min := D[i]; for i := 0 to 255 do LUT[i] := Round(((D[i] - D0min) / (1 - D0min)) * (256 - 1)) ; Chart3.SeriesList.Series[series].Clear; Chart3.SeriesList.Series[series].AddArray(LUT); end; end.