Nadesłany przez Tomasz Lubiński, 27 sierpnia 2008 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 - ekspozycja/Unit1.pas:
//Histogram - zmiana ekspozycji //(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 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; Edit1: TEdit; UpDown1: TUpDown; Label1: TLabel; WynikKolorowy: TImage; WynikMono: TImage; procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure UpdateLUT; procedure UpDown1Click(Sender: TObject; Button: TUDBtnType); private { Private declarations } public { Public declarations } end; var Form1: TForm1; LUT: Array[0..255] of Double; implementation {$R *.DFM} procedure TForm1.Button1Click(Sender: TObject); var i, j, rvalue, gvalue, bvalue, grayvalue: Integer; r, g, b, gray: Array [0..255] of Double; color: TColor; begin 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(LUT[rvalue]) + (Round(LUT[gvalue]) shl 8) + (Round(LUT[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(LUT[grayvalue]) + (Round(LUT[grayvalue]) shl 8) + (Round(LUT[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; //zainicjuj tablice LUT procedure TForm1.FormCreate(Sender: TObject); var i: Integer; begin for i := 0 to 255 do LUT[i] := i; UpdateLUT; end; //wyswietl wartosci tablicy LUT procedure TForm1.UpdateLUT(); begin Chart3.SeriesList.Series[0].Clear; Chart3.SeriesList.Series[0].AddArray(LUT); end; //zmień wartosc kontrastu i przelicz nowe wartosci tablicy LUT procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType); var i: Integer; a: double; begin a := StrToFloat(Edit1.Text); if Button = btNext then a := a + 0.05 else a := a - 0.05; if a < 0.05 then a := 0.05; Edit1.Text := FloatToStr(a); for i := 0 to 255 do if (a*i) > 255 then LUT[i] := 255 else LUT[i] := a*i; UpdateLUT; end; end.