Source Code :
unit Gray;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, TeEngine, Series, TeeProcs, Chart;
type
TForm1 = class(TForm)
Button1: TButton;
OpenPictureDialog1: TOpenDialog;
Image1: TImage;
Button2: TButton;
Image2: TImage;
Chart1: TChart;
Series1: TAreaSeries;
Button3: TButton;
Image3: TImage;
Button4: TButton;
Chart2: TChart;
Series2: TAreaSeries;
Button5: TButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Button6: TButton;
Image4: TImage;
Label4: TLabel;
Button7: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
gambar:TBitmap;
HistogramG:array[0..256] of integer;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
if not OpenPictureDialog1.Execute then exit else
begin
gambar := TBitmap.Create;
gambar.LoadFromFile(OpenPictureDialog1.FileName);
end;
gambar.PixelFormat := pf8bit;
Image1.Picture.Bitmap := gambar;
end;
procedure TForm1.Button2Click(Sender: TObject);
var gray, r, g, b:byte;
i, j:integer;
warna:Tcolor;
begin
image2.Picture.Assign(image1.Picture);
for i:=1 to image2.Picture.Height-1 do
begin
for j:=1 to image2.Picture.Width-1 do
begin
warna := image2.Canvas.Pixels[i,j];
r:=GetRValue(warna);
g:=GetGValue(warna);
b:=GetBValue(warna);
{gray:= round((r+g+b) / 3);}
gray := round(0.299*r + 0.587*g + 0.114*b);
image2.Canvas.Pixels[i,j] := RGB(gray,gray,gray);
end;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
var k, q, i, j, indeks, fm:integer;
Gdata:PByteArray;
begin
for k:=0 to 255 do
begin
HistogramG[k] := 0;
end;
for i:=0 to image2.Picture.Width-1 do
begin
Gdata := image2.Picture.Bitmap.ScanLine[i];
for j:=0 to image2.Picture.Height-1 do
begin
Inc(HistogramG[Gdata[j]]);
end;
end;
fm := 0;
for indeks:=0 to 255 do
begin
if HistogramG[indeks] > fm then
fm := HistogramG[indeks];
end;
Series1.Clear;
for q:=1 to 256 do
begin
Series1.AddXY(q,HistogramG[q],'',clGray);
end;
end;
function ByteRange (r:double) : byte;
begin
if r<0 then ByteRange:=0
else if r>255 then ByteRange:=255
else ByteRange:=Round(r);
end;
procedure TForm1.Button4Click(Sender: TObject);
var
x,y,i:integer; ClrGray:byte;
Freq, NewColor: array [0..255] of longint;
TotFreq, ImgSize: longint;
begin
image3.Picture.Assign(image2.Picture);
for i:=0 to 255 do Freq[i]:=0;
{ hitung frekuensi tiap warna }
for x:=0 to Image3.Picture.Width-1 do
for y:=0 to Image3.Picture.Height-1 do
begin
ClrGray := image3.Canvas.Pixels[x,y];
Inc(Freq[ClrGray]);
end;
{ hitung pixel baru }
TotFreq := 0;
ImgSize := Image3.Picture.Width * Image3.Picture.Height;
for i:=0 to 255 do
begin
Inc(TotFreq, Freq[i]);
NewColor[i] := Round((255*TotFreq/ImgSize)-1);
end;
for x:=0 to Image3.Picture.Width-1 do
begin
for y:=0 to Image3.Picture.Height-1 do
begin
ClrGray := image3.Canvas.Pixels[x,y];
ClrGray := ByteRange(NewColor[ClrGray]);
Image3.Canvas.Pixels[x,y] := RGB (ClrGray,ClrGray,ClrGray);
end;
end;
end;
procedure TForm1.Button5Click(Sender: TObject);
var k, q, i, j, indeks, fm:integer;
Gdata:PByteArray;
begin
for k:=0 to 255 do
begin
HistogramG[k] := 0;
end;
for i:=0 to image3.Picture.Width-1 do
begin
Gdata := image3.Picture.Bitmap.ScanLine[i];
for j:=0 to image3.Picture.Height-1 do
begin
Inc(HistogramG[Gdata[j]]);
end;
end;
fm := 0;
for indeks:=0 to 255 do
begin
if HistogramG[indeks] > fm then
fm := HistogramG[indeks];
end;
Series2.Clear;
for q:=1 to 256 do
begin
Series2.AddXY(q,HistogramG[q],'',clGray);
end;
end;
procedure TForm1.Button6Click(Sender: TObject);
var
histogram: array[0..255] of longint;
PH: PByteArray;
TotalMean, Variance, maxVariance, zero, first:real;
i,k,j: integer;
p: PByteArray;
Q: PByteArray;
threshold: byte;
area: longint;
begin
image4.Picture.Assign(image3.Picture);
for i:=0 to 255 do
begin
histogram[i]:=0;
end;
for i:=0 to (image4.Picture.Height-1) do
begin
PH:=image3.Picture.Bitmap.ScanLine[i];
for j:= 0 to (image4.Picture.Width-1) do
begin
inc(histogram[PH[j]]);
end;
end;
//compute otsu method
threshold:=0;
totalMean := 0;
maxVariance := 0;
first:= 0;
zero := 0;
area := image4.Picture.Height * image4.Picture.Width;
for k:= 0 to 255 do
TotalMean := TotalMean + (k * histogram[k] / area);
for k:= 0 to 255 do
begin
zero := zero + (histogram[k] / area);
first := first + (k * histogram[k] / area);
variance := totalMean * zero - first;
if ((zero <> 0) and (zero <> 1)) then
begin
variance := (variance * variance) / (zero * (1 - zero));
if (maxVariance < variance) then
begin
maxVariance := variance;
threshold := k;
end;
end;
for i:=0 to image4.Picture.Height-1 do
begin
P:= image4.Picture.Bitmap.ScanLine[i];
Q:= image3.Picture.Bitmap.ScanLine[i];
for j:=0 to image4.Picture.Width-1 do
if Q[j] > threshold then
P[j] := 255
else
P[j] := 0;
end;
end;
end;
procedure TForm1.Button7Click(Sender: TObject);
begin
image1.Destroy();
image2.Destroy();
image3.Destroy();
image4.Destroy();
series1.Clear;
series2.Clear;
end;
end.
Link Download
Link 1
Link 2