Ini coding untuk membuat histogram pengolahan citra dengan menggunakan delphi....
unit HistogramUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, TeEngine, Series, ExtCtrls, TeeProcs, Chart;
type
THistogramForm = class(TForm)
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormPaint(Sender: TObject);
private
{ Private declarations }
MaxCount:Integer;
HistogramGray:Array[0..255]of Integer;
HistogramRed:Array[0..255]of Integer;
HistogramGreen:Array[0..255]of Integer;
HistogramBlue:Array[0..255]of Integer;
public
{ Public declarations }
procedure ShowHistogram(Image:TImage);
end;
var
HistogramForm: THistogramForm;
implementation
{$R *.dfm}
procedure THistogramForm.ShowHistogram(Image:TImage);
var
i,j:integer;
pixelPointer:PByteArray;
begin
try
begin
for i:=0 to 255 do
begin
HistogramGray[i]:=0;
HistogramRed[i]:=0;
HistogramGreen[i]:=0;
HistogramBlue[i]:=0;
end;
if Image.Picture.Bitmap.PixelFormat=pf8bit then
begin
for i:=0 to Image.Height-1 do
begin
pixelPointer:=Image.Picture.Bitmap.ScanLine[i];
for j:=0 to Image.Width-1 do
begin
Inc(HistogramGray[pixelPointer[j]]);
end;
end;
MaxCount:=0;
for i:=0 to 255 do
if HistogramGray[i]>MaxCount then
MaxCount:=HistogramGray[i];
end;
if Image.Picture.Bitmap.PixelFormat=pf24bit then
begin
for i:=0 to Image.Height-1 do
begin
pixelPointer:=Image.Picture.Bitmap.ScanLine[i];
for j:=0 to Image.Width-1 do
begin
Inc(HistogramBlue[pixelPointer[3*j]]);
Inc(HistogramGreen[pixelPointer[3*j+1]]);
Inc(HistogramRed[pixelPointer[3*j+2]]);
end;
end;
for i:=0 to 255 do
begin
if HistogramRed[i]>MaxCount then
MaxCount:=HistogramRed[i];
if HistogramGreen[i]>MaxCount then
MaxCount:=HistogramGreen[i];
if HistogramBlue[i]>MaxCount then
MaxCount:=HistogramBlue[i];
end;
end;
Canvas.MoveTo(10, 160);;
Canvas.Pen.Color:=clBlack;
for i:=0 to 255 do
Canvas.LineTo(10+i,
160-round(150*HistogramGray[i]/MaxCount));
Canvas.Pen.Color:=clRed;
Canvas.MoveTo(10, 160);
for i:=0 to 255 do
Canvas.LineTo(10+i,
160-(round(150*HistogramRed[i]/MaxCount)));
Canvas.Pen.Color:=clGreen;
Canvas.MoveTo(10, 160);
for i:=0 to 255 do
Canvas.LineTo(10+i,
160-(round(150*HistogramGreen[i]/MaxCount)));
Canvas.Pen.Color:=clBlue;
Canvas.MoveTo(10, 160);
for i:=0 to 255 do
Canvas.LineTo(10+i,
160-(round(150*HistogramBlue[i]/MaxCount)));
end;
except
Free; //free the histogram form if an exception happens
ShowMessage('Cannot complete the operation');
end;
end;
procedure THistogramForm.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Free;
end;
procedure THistogramForm.FormPaint(Sender: TObject);
var
i:integer;
begin
Canvas.MoveTo(10, 160);;
Canvas.Pen.Color:=clBlack;
for i:=0 to 255 do
Canvas.LineTo(10+i,
160-round(150*HistogramGray[i]/MaxCount));
Canvas.Pen.Color:=clRed;
Canvas.MoveTo(10, 160);
for i:=0 to 255 do
Canvas.LineTo(10+i,
160-(round(150*HistogramRed[i]/MaxCount)));
Canvas.Pen.Color:=clGreen;
Canvas.MoveTo(10, 160);
for i:=0 to 255 do
Canvas.LineTo(10+i,
160-(round(150*HistogramGreen[i]/MaxCount)));
Canvas.Pen.Color:=clBlue;
Canvas.MoveTo(10, 160);
for i:=0 to 255 do
Canvas.LineTo(10+i,
160-(round(150*HistogramBlue[i]/MaxCount)));
end;
end.
unit MainUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ExtDlgs, Menus;
type
TMainForm = class(TForm)
MainMenu1: TMainMenu;
File1: TMenuItem;
Open1: TMenuItem;
Save1: TMenuItem;
CLose1: TMenuItem;
Exit1: TMenuItem;
OpenPictureDialog1: TOpenPictureDialog;
SavePictureDialog1: TSavePictureDialog;
StatusBar1: TStatusBar;
Image1: TMenuItem;
Histogram1: TMenuItem;
procedure Open1Click(Sender: TObject);
procedure Save1Click(Sender: TObject);
procedure Histogram1Click(Sender: TObject);
procedure CLose1Click(Sender: TObject);
procedure Exit1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
uses ImageUnit, ActiveX, HistogramUnit;
{$R *.dfm}
procedure TMainForm.Open1Click(Sender: TObject);
var
formatInfo:string;
begin
if OpenPictureDialog1.Execute then
begin
Application.CreateForm(TImageForm, ImageForm);
ImageForm.Image1.Picture.LoadFromFile(
OpenPictureDialog1.FileName);
ImageForm.ClientHeight:=
ImageForm.Image1.Picture.Height;
ImageForm.ClientWidth:=
ImageForm.Image1.Picture.Width;
case (ImageForm.Image1.Picture.Bitmap.PixelFormat) of
pf1bit : formatInfo:='Binary';
pf8bit : formatInfo:='Gray scale';
pf24bit: formatInfo:='True color';
end;
StatusBar1.SimpleText:= OpenPictureDialog1.FileName +' '+
IntToStr(ImageForm.Image1.Picture.Width) + 'x'+
IntToStr(ImageForm.Image1.Picture.Height) + ' '+
formatInfo;
end;
end;
procedure TMainForm.Save1Click(Sender: TObject);
begin
try
begin
if SavePictureDialog1.Execute then
TImageForm(ActiveMDIChild).Image1.Picture.SaveToFile(
SavePictureDialog1.FileName);
end
except
ShowMessage('Cannot complete the operation');
end;
end;
procedure TMainForm.Histogram1Click(Sender: TObject);
begin
if ImageForm<>nil then
begin
ImageForm:=TImageForm(ActiveMDIChild);
try
begin
Application.CreateForm(THistogramForm,HistogramForm);
HistogramForm.ShowHistogram(ImageForm.Image1);
end;
except
HistogramForm.Free;
ShowMessage('Cannot complete the operation');
end;
end;
end;
procedure TMainForm.CLose1Click(Sender: TObject);
begin
try
ActiveMDIChild.Close;
except
ShowMessage('Cannot complete the operation');
end;
end;
procedure TMainForm.Exit1Click(Sender: TObject);
begin
Close;
end;
initialization
OleInitialize(nil);
finalization
OleUninitialize
end.
hasil yang akan didapat untuk coding diatas...
1 komentar:
Posting Komentar