Nadesłany przez Tomasz Lubiński, 12 września 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 - gamma/Unit1.pas:
//Histogram - korekcja gamma
//(c) 2005 Tomasz Lubinski
//www.algorytm.org
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
OleCtrls, jpeg, ExtCtrls, StdCtrls, TeeProcs, TeEngine, Chart,
Series, ComCtrls, Math;
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 gamma i przelicz nowe wartosci tablicy LUT
procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);
var
i: Integer;
gamma: double;
begin
gamma := StrToFloat(Edit1.Text);
if Button = btNext then
gamma := gamma + 0.05
else
gamma := gamma - 0.05;
if gamma < 0.1 then
gamma := 0.1;
Edit1.Text := FloatToStr(gamma);
for i := 0 to 255 do
if (255 * Power(i/255, 1/gamma)) > 255 then
LUT[i] := 255
else
LUT[i] := 255 * Power(i/255, 1/gamma);
UpdateLUT;
end;
end.

