unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtDlgs, Menus, StdCtrls, ExtCtrls, Spin;
type
TRGBTripleArray = array[0..10000] of TRGBTriple;
PRGBTripleArray = ^TRGBTripleArray;
T3x3FloatArray = array[0..2] of array[0..2] of Extended;
TDeteksi = class(TForm)
Image1: TImage;
Label1: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Edit5: TEdit;
Edit6: TEdit;
Edit7: TEdit;
Edit8: TEdit;
Edit9: TEdit;
ComboBox1: TComboBox;
Edit10: TEdit;
Button1: TButton;
MainMenu1: TMainMenu;
File1: TMenuItem;
Open1: TMenuItem;
SaveAs1: TMenuItem;
Save1: TMenuItem;
N1: TMenuItem;
Exit1: TMenuItem;
Edit11: TMenuItem;
Undo1: TMenuItem;
Reset1: TMenuItem;
OpenPictureDialog1: TOpenPictureDialog;
SavePictureDialog1: TSavePictureDialog;
procedure Open1Click(Sender: TObject);
procedure EditChange(Sender : TObject);
procedure Exit1Click(Sender: TObject);
procedure SaveAs1Click(Sender: TObject);
procedure Save1Click(Sender: TObject);
procedure Undo1Click(Sender: TObject);
procedure Reset1Click(Sender: TObject);
procedure Edit9Change(Sender: TObject);
procedure Edit8Change(Sender: TObject);
procedure Edit7Change(Sender: TObject);
procedure Edit6Change(Sender: TObject);
procedure Edit5Change(Sender: TObject);
procedure Edit4Change(Sender: TObject);
procedure Edit3Change(Sender: TObject);
procedure Edit2Change(Sender: TObject);
procedure Edit10Change(Sender: TObject);
procedure Edit1Change(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ComboBox1Select(Sender: TObject);
procedure SetMask(a1, a2, a3, a4, a5, a6, a7, a8, a9 : Extended ; ABias : integer);
function Convolve(ABitmap : TBitmap ; AMask : T3x3FloatArray ; ABias : integer) : TBitmap;
private
Mask : T3x3FloatArray;
Bias : integer;
UndoBitmap : TBitmap;
{ Private declarations }
public
{ Public declarations }
end;
var
Deteksi: TDeteksi;
implementation
{$R *.dfm}
procedure TDeteksi.EditChange(Sender : TObject);
Var
LTag : byte;
LValue : Extended;
begin
LTag := TEdit(Sender).Tag;
if (TEdit(Sender).Text = '') or (TEdit(Sender).Text = '-')
then LValue := 0
else LValue := StrToFloat(TEdit(Sender).Text);
if LTag = 9 then begin
if (LValue > 255) or (Frac(LValue) <> 0) then begin
ShowMessage('the bias has to be a whole number between -255 and 255');
Exit;
end;
Bias := trunc(LValue);
Exit;
end;
Mask[LTag mod 3, LTag div 3] := LValue;
end;
procedure TDeteksi.SetMask(a1, a2, a3, a4, a5, a6, a7, a8, a9 : Extended ; ABias : integer);
begin
Edit1.Text := FloatToStr(a1);
Edit2.Text := FloatToStr(a2);
Edit3.Text := FloatToStr(a3);
Edit4.Text := FloatToStr(a4);
Edit5.Text := FloatToStr(a5);
Edit6.Text := FloatToStr(a6);
Edit7.Text := FloatToStr(a7);
Edit8.Text := FloatToStr(a8);
Edit9.Text := FloatToStr(a9);
Edit10.Text := IntToStr(ABias);
end;
procedure TDeteksi.Open1Click(Sender: TObject);
begin
if not OpenPictureDialog1.Execute then Exit;
Image1.Picture.Bitmap.LoadFromFile(OpenPictureDialog1.FileName);
SaveAs1.Enabled := True;
Save1.Enabled := True;
Reset1.Enabled := True;
end;
procedure TDeteksi.Exit1Click(Sender: TObject);
begin
Close;
end;
procedure TDeteksi.SaveAs1Click(Sender: TObject);
begin
if not SavePictureDialog1.Execute then Exit;
Image1.Picture.Bitmap.SaveToFile(SavePictureDialog1.FileName);
end;
procedure TDeteksi.Save1Click(Sender: TObject);
begin
Image1.Picture.Bitmap.SaveToFile(OpenPictureDialog1.FileName);
end;
procedure TDeteksi.Undo1Click(Sender: TObject);
begin
Image1.Picture.Bitmap.Width := UndoBitmap.Width;
Image1.Picture.Bitmap.Height := UndoBitmap.Height;
Image1.Canvas.Draw(0, 0, UndoBitmap);
Undo1.Enabled := False;
end;
procedure TDeteksi.Reset1Click(Sender: TObject);
begin
Image1.Picture.Bitmap.LoadFromFile(OpenPictureDialog1.FileName);
end;
procedure TDeteksi.Edit9Change(Sender: TObject);
Var
LTag : byte;
LValue : Extended;
begin
LTag := TEdit(Sender).Tag;
if (TEdit(Sender).Text = '') or (TEdit(Sender).Text = '-')
then LValue := 0
else LValue := StrToFloat(TEdit(Sender).Text);
if LTag = 9 then begin
if (LValue > 255) or (Frac(LValue) <> 0) then begin
ShowMessage('the bias has to be a whole number between -255 and 255');
Exit;
end;
Bias := trunc(LValue);
Exit;
end;
Mask[LTag mod 3, LTag div 3] := LValue;
end;
procedure TDeteksi.Edit8Change(Sender: TObject);
Var
LTag : byte;
LValue : Extended;
begin
LTag := TEdit(Sender).Tag;
if (TEdit(Sender).Text = '') or (TEdit(Sender).Text = '-')
then LValue := 0
else LValue := StrToFloat(TEdit(Sender).Text);
if LTag = 9 then begin
if (LValue > 255) or (Frac(LValue) <> 0) then begin
ShowMessage('the bias has to be a whole number between -255 and 255');
Exit;
end;
Bias := trunc(LValue);
Exit;
end;
Mask[LTag mod 3, LTag div 3] := LValue;
end;
procedure TDeteksi.Edit7Change(Sender: TObject);
Var
LTag : byte;
LValue : Extended;
begin
LTag := TEdit(Sender).Tag;
if (TEdit(Sender).Text = '') or (TEdit(Sender).Text = '-')
then LValue := 0
else LValue := StrToFloat(TEdit(Sender).Text);
if LTag = 9 then begin
if (LValue > 255) or (Frac(LValue) <> 0) then begin
ShowMessage('the bias has to be a whole number between -255 and 255');
Exit;
end;
Bias := trunc(LValue);
Exit;
end;
Mask[LTag mod 3, LTag div 3] := LValue;
end;
procedure TDeteksi.Edit6Change(Sender: TObject);
Var
LTag : byte;
LValue : Extended;
begin
LTag := TEdit(Sender).Tag;
if (TEdit(Sender).Text = '') or (TEdit(Sender).Text = '-')
then LValue := 0
else LValue := StrToFloat(TEdit(Sender).Text);
if LTag = 9 then begin
if (LValue > 255) or (Frac(LValue) <> 0) then begin
ShowMessage('the bias has to be a whole number between -255 and 255');
Exit;
end;
Bias := trunc(LValue);
Exit;
end;
Mask[LTag mod 3, LTag div 3] := LValue;
end;
procedure TDeteksi.Edit5Change(Sender: TObject);
Var
LTag : byte;
LValue : Extended;
begin
LTag := TEdit(Sender).Tag;
if (TEdit(Sender).Text = '') or (TEdit(Sender).Text = '-')
then LValue := 0
else LValue := StrToFloat(TEdit(Sender).Text);
if LTag = 9 then begin
if (LValue > 255) or (Frac(LValue) <> 0) then begin
ShowMessage('the bias has to be a whole number between -255 and 255');
Exit;
end;
Bias := trunc(LValue);
Exit;
end;
Mask[LTag mod 3, LTag div 3] := LValue;
end;
procedure TDeteksi.Edit4Change(Sender: TObject);
Var
LTag : byte;
LValue : Extended;
begin
LTag := TEdit(Sender).Tag;
if (TEdit(Sender).Text = '') or (TEdit(Sender).Text = '-')
then LValue := 0
else LValue := StrToFloat(TEdit(Sender).Text);
if LTag = 9 then begin
if (LValue > 255) or (Frac(LValue) <> 0) then begin
ShowMessage('the bias has to be a whole number between -255 and 255');
Exit;
end;
Bias := trunc(LValue);
Exit;
end;
Mask[LTag mod 3, LTag div 3] := LValue;
end;
procedure TDeteksi.Edit3Change(Sender: TObject);
Var
LTag : byte;
LValue : Extended;
begin
LTag := TEdit(Sender).Tag;
if (TEdit(Sender).Text = '') or (TEdit(Sender).Text = '-')
then LValue := 0
else LValue := StrToFloat(TEdit(Sender).Text);
if LTag = 9 then begin
if (LValue > 255) or (Frac(LValue) <> 0) then begin
ShowMessage('the bias has to be a whole number between -255 and 255');
Exit;
end;
Bias := trunc(LValue);
Exit;
end;
Mask[LTag mod 3, LTag div 3] := LValue;
end;
procedure TDeteksi.Edit2Change(Sender: TObject);
Var
LTag : byte;
LValue : Extended;
begin
LTag := TEdit(Sender).Tag;
if (TEdit(Sender).Text = '') or (TEdit(Sender).Text = '-')
then LValue := 0
else LValue := StrToFloat(TEdit(Sender).Text);
if LTag = 9 then begin
if (LValue > 255) or (Frac(LValue) <> 0) then begin
ShowMessage('the bias has to be a whole number between -255 and 255');
Exit;
end;
Bias := trunc(LValue);
Exit;
end;
Mask[LTag mod 3, LTag div 3] := LValue;
end;
procedure TDeteksi.Edit10Change(Sender: TObject);
Var
LTag : byte;
LValue : Extended;
begin
LTag := TEdit(Sender).Tag;
if (TEdit(Sender).Text = '') or (TEdit(Sender).Text = '-')
then LValue := 0
else LValue := StrToFloat(TEdit(Sender).Text);
if LTag = 9 then begin
if (LValue > 255) or (Frac(LValue) <> 0) then begin
ShowMessage('the bias has to be a whole number between -255 and 255');
Exit;
end;
Bias := trunc(LValue);
Exit;
end;
Mask[LTag mod 3, LTag div 3] := LValue;
end;
procedure TDeteksi.Edit1Change(Sender: TObject);
Var
LTag : byte;
LValue : Extended;
begin
LTag := TEdit(Sender).Tag;
if (TEdit(Sender).Text = '') or (TEdit(Sender).Text = '-')
then LValue := 0
else LValue := StrToFloat(TEdit(Sender).Text);
if LTag = 9 then begin
if (LValue > 255) or (Frac(LValue) <> 0) then begin
ShowMessage('the bias has to be a whole number between -255 and 255');
Exit;
end;
Bias := trunc(LValue);
Exit;
end;
Mask[LTag mod 3, LTag div 3] := LValue;
end;
procedure TDeteksi.Button1Click(Sender: TObject);
begin
if not Save1.Enabled then Exit;
if (Image1.Picture.Bitmap.Width < 3) or (Image1.Picture.Bitmap.Height < 3) then begin ShowMessage('the image is too small to perform convolution on'); Exit; end; UndoBitmap.Width := Image1.Picture.Bitmap.Width; UndoBitmap.Height := Image1.Picture.Bitmap.Height; UndoBitmap.Canvas.Draw(0, 0, Image1.Picture.Bitmap); Undo1.Enabled := True; Image1.Picture.Bitmap := Convolve(Image1.Picture.Bitmap, Mask, Bias); end; procedure TDeteksi.FormCreate(Sender: TObject); begin Edit1.Tag := 0; Edit2.Tag := 1; Edit3.Tag := 2; Edit4.Tag := 3; Edit5.Tag := 4; Edit6.Tag := 5; Edit7.Tag := 6; Edit8.Tag := 7; Edit9.Tag := 8; Edit10.Tag := 9; // bias SetMask(1, 1, 1, 1, 1, 1, 1, 1, 1, 0); UndoBitmap := TBitmap.Create; UndoBitmap.PixelFormat := pf24bit; end; procedure TDeteksi.ComboBox1Select(Sender: TObject); begin if ComboBox1.ItemIndex = 0 then // edge detection SetMask(-1, -1, -1, -1, 8, -1, -1, -1, -1, 0); if ComboBox1.ItemIndex = 1 then // vertical edge detection SetMask( 0, 0, 0, -1, 2, -1, 0, 0, 0, 0); if ComboBox1.ItemIndex = 2 then // horizontal edge detection SetMask( 0, -1, 0, 0, 2, 0, 0, -1, 0, 0); end; function TDeteksi.Convolve(ABitmap : TBitmap ; AMask : T3x3FloatArray ; ABias : integer) : TBitmap; Var LRow1, LRow2, LRow3, LRowOut : PRGBTripleArray; LRow, LCol : integer; LNewBlue, LNewGreen, LNewRed : Extended; LCoef : Extended; begin LCoef := 0; for LRow := 0 to 2 do for LCol := 0 to 2 do LCoef := LCoef + AMask[LCol, LRow]; if LCoef = 0 then LCoef := 1; Result := TBitmap.Create; Result.Width := ABitmap.Width - 2; Result.Height := ABitmap.Height - 2; Result.PixelFormat := pf24bit; LRow2 := ABitmap.ScanLine[0]; LRow3 := ABitmap.ScanLine[1]; for LRow := 1 to ABitmap.Height - 2 do begin LRow1 := LRow2; LRow2 := LRow3; LRow3 := ABitmap.ScanLine[LRow + 1]; LRowOut := Result.ScanLine[LRow - 1]; for LCol := 1 to ABitmap.Width - 2 do begin LNewBlue := (LRow1[LCol-1].rgbtBlue*AMask[0,0]) + (LRow1[LCol].rgbtBlue*AMask[1,0]) + (LRow1[LCol+1].rgbtBlue*AMask[2,0]) + (LRow2[LCol-1].rgbtBlue*AMask[0,1]) + (LRow2[LCol].rgbtBlue*AMask[1,1]) + (LRow2[LCol+1].rgbtBlue*AMask[2,1]) + (LRow3[LCol-1].rgbtBlue*AMask[0,2]) + (LRow3[LCol].rgbtBlue*AMask[1,2]) + (LRow3[LCol+1].rgbtBlue*AMask[2,2]); LNewBlue := (LNewBlue / LCoef) + ABias; if LNewBlue > 255 then LNewBlue := 255;
if LNewBlue < 0 then LNewBlue := 0; LNewGreen := (LRow1[LCol-1].rgbtGreen*AMask[0,0]) + (LRow1[LCol].rgbtGreen*AMask[1,0]) + (LRow1[LCol+1].rgbtGreen*AMask[2,0]) + (LRow2[LCol-1].rgbtGreen*AMask[0,1]) + (LRow2[LCol].rgbtGreen*AMask[1,1]) + (LRow2[LCol+1].rgbtGreen*AMask[2,1]) + (LRow3[LCol-1].rgbtGreen*AMask[0,2]) + (LRow3[LCol].rgbtGreen*AMask[1,2]) + (LRow3[LCol+1].rgbtGreen*AMask[2,2]); LNewGreen := (LNewGreen / LCoef) + ABias; if LNewGreen > 255 then LNewGreen := 255;
if LNewGreen < 0 then LNewGreen := 0; LNewRed := (LRow1[LCol-1].rgbtRed*AMask[0,0]) + (LRow1[LCol].rgbtRed*AMask[1,0]) + (LRow1[LCol+1].rgbtRed*AMask[2,0]) + (LRow2[LCol-1].rgbtRed*AMask[0,1]) + (LRow2[LCol].rgbtRed*AMask[1,1]) + (LRow2[LCol+1].rgbtRed*AMask[2,1]) + (LRow3[LCol-1].rgbtRed*AMask[0,2]) + (LRow3[LCol].rgbtRed*AMask[1,2]) + (LRow3[LCol+1].rgbtRed*AMask[2,2]); LNewRed := (LNewRed / LCoef) + ABias; if LNewRed > 255 then LNewRed := 255;
if LNewRed < 0 then LNewRed := 0; LRowOut[LCol-1].rgbtBlue := trunc(LNewBlue); LRowOut[LCol-1].rgbtGreen := trunc(LNewGreen); LRowOut[LCol-1].rgbtRed := trunc(LNewRed); end; end; end; end.
DETEKSI TEPI
KOMPRESI GAMBAR DENGAN DELPHI
Kompresi Citra adalah aplikasi Kompresi data yang dilakukan terhadap citra digital dengan tujuan untuk mengurangi redundansi dari data-data yang terdapat dalam citra sehingga dapat disimpan atau ditransmisikan secara efisien. Teknik Kompresi Citra ada 2:
1. Lossy Compression
• Ukuran file citra menjadi lebih kecil dengan menghilangkan beberapa informasi dalam citra asli.
• Teknik ini mengubah detail dan warna pada file citra menjadi lebih sederhana tanpa terlihat perbedaan yang mencolok dalam pandangan manusia, sehingga ukurannya menjadi lebih kecil.
2. Loseless Compression
• Biasanya digunakan pada citra foto atau image lain yang tidak terlalu memerlukan detail citra, dimana kehilangan bit rate foto tidak berpengaruh pada citra
• Beberapa teknik loseless:
× Color reduction: untuk warna-warna tertentu yang mayoritas dimana informasi warna disimpan dalam color palette.
× Chroma subsampling: teknik yang memanfaatkan fakta bahwa mata manusia merasa brightness (luminance) lebih berpengaruh daripada warna (chrominance) itu sendiri, maka dilakukan pengurangan resolusi warna dengan disampling ulang. Biasanya digunakan pada sinyal YUV.
Cara menbuat programnya :
1. Siapkan program diatas / sebelumnya (program Delphi histogram pada bahasan sebelumnya).
2. Buka form MainForm (tekan Shift+F12), tambahkan Kompres pada MainMenu1 di dalam Image. Dan isikan prosedur.
3. Buat Form baru, beri caption form dengan kompresi gambar
4. Tambahkan 3 Button atau BitBtn, masing masing dengan nama Kompresi, open, exit.
5. Dan beri prosedur sebagai berikut :
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Buttons, StdCtrls, ExtDlgs, ExtCtrls;
type
TForm1 = class(TForm)
OpenPictureDialog1: TOpenPictureDialog;
BitBtn1: TBitBtn;
Kompresi: TSpeedButton;
Image1: TImage;
Button1: TButton;
procedure KompresiClick(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
gambar:Tbitmap;
awal:Tbitmap;
akhir:Tbitmap;
implementation
{$R *.dfm}
procedure TForm1.KompresiClick(Sender: TObject);
var b,c,a : integer;
x, digit : byte;
temp,temp2 : PByteArray;
begin
awal := TBitmap.Create;
gambar := TBitmap.Create;
gambar.LoadFromFile(OpenPictureDialog1.filename);
awal.assign(gambar);
Form1.Caption:='Image Processing - '+ExtractFileName(OpenPictureDialog1.Filename);
gambar.PixelFormat := Pf24bit;
gambar.SaveToFile('Hasilkompres.bmp');
for c:=0 to gambar.Height-1 do
begin
temp := gambar.ScanLine[c];
temp2 := awal.Scanline[c];
b:=0;x:=b;digit:=0;
repeat
temp2[x]:=round(0.25*(temp[b+digit]+temp[b-digit]+temp[b])/3);
inc(b,3);x:=x+1;
until b >= 3*gambar.Width-1;
end;
a:=round((gambar.Width-1)/3);
awal.pixelformat:=pf8bit;
for c:=0 to gambar.Height-1 do
begin
temp := gambar.ScanLine[c];
temp2 := awal.Scanline[c];
b:=0;x:=b;
repeat
temp[x]:=round(temp2[b]);
inc(b,1);x:=x+1;
until b >= a;
end;
gambar.PixelFormat := Pf8bit;
Image1.Picture.Bitmap := gambar;
gambar.SaveToFile('Hasilkompres.bmp');
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
if not OpenPictureDialog1.Execute then exit else
begin
gambar := TBitmap.Create;
gambar.LoadFromFile(OpenPictureDialog1.filename);
Form1.Caption:='Image Processing - '+ExtractFileName(OpenPictureDialog1.Filename);
end;
Image1.Picture.Bitmap := gambar;
kompresi.Enabled:=true;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
close;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
kompresi.Enabled:=false;
end;
end.
BRIGHTNESS DENGAN DELPHI
Untuk merubah suatu kecerahan pada gambar kiat membutuh suatu operasi pada Delphi, yaitu dengan menggunakan tiga ScrollBar (TScrollBar), yang setiap ScrollBar nya digunakan untuk mengatur kecerahan pada setiap elemen warna. Cara membuat :
1. Siapkan program diatas / sebelumnya (program Delphi histogram pada bahasan
sebelumnya).
2. Buat Form baru.
3. Ubah nama Form tersebut dengan nama BrightnessForm.
4. Buat prosedur di bawah ini deng events OnClose.
procedure TBrightnessForm.FormClose(Sender: TObject;
var Action:TCloseAction);
begin
Action:=caFree;
end;
5. Buat 3 label beri masing-masing dengan caption Merah, Biru, Hijau.
6. Tambahkan tiga komponen scroll bar dan beri nama Nama untuk RedScrollBar,
GreenScrollBar, dan BlueScrollBar. Letakan di samping label.
7. Tambahkan 2 tombol Caption Ok dan cancel/batal. Dan simapan dengan nama
Brightness.
8. Masuk pada pengkodingan BrightnessForm (tekan F12). Tambahkan prosedur ExtCtrlspada uses. Sehingga menjadi :
uses
ExtCtrls, Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms,Dialogs, StdCtrls
9. Tulis prosedur SetBrightness di bagian implementation
procedure TBrightnessForm.SetBrightness(Image: TImage);
begin
try
begin
TemporaryImage:=Image;
OriginalImage:=TImage.Create(self);
OriginalImage.Picture.Bitmap.Assign(Image.Picture.Bitmap);
end;
except
begin
Free;
ShowMessage('Dilarang 2 Pemrosesan');
end;
end;
end;
10. Isikan prosedur di bawah pada komponen RedScrollBar
procedure TBrightnessForm.RedScrollBarChange(Sender: TObject);
var
a,b:Integer;
temp:integer;
pixelPointer:PByteArray;
originalPixelPointer:PByteArray;
begin
try
begin
if TemporaryImage.Picture.Bitmap.PixelFormat=pf24bit then
for a:=0 to TemporaryImage.Picture.Height-1 do
begin
pixelPointer:=TemporaryImage.Picture.Bitmap.ScanLine[a];
originalPixelPointer:=OriginalImage.Picture.Bitmap.ScanLine[a];
for b:=0 to TemporaryImage.Picture.Width-1 do
begin
temp:=originalPixelPointer[3*b+2]+ RedScrollBar.Position;
if temp<0 then temp:=0;
if temp>255 then temp:=255;
pixelPointer[3*b+2]:=temp;
end;
end;
if TemporaryImage.Picture.Bitmap.PixelFormat=pf8bit then
for a:=0 to TemporaryImage.Picture.Height-1 do
begin
pixelPointer:=TemporaryImage.Picture.Bitmap.ScanLine[a];
originalPixelPointer:=OriginalImage.Picture.Bitmap.ScanLine[a];
for b:=0 to TemporaryImage.Picture.Width-1 do
begin
temp:=originalPixelPointer[b]+ RedScrollBar.Position;
if temp<0 then temp:=0;
if temp>255 then temp:=255;
pixelPointer[b]:=temp;
BlueScrollBar.Position:=RedScrollBar.Position;
GreenScrollBar.Position:=RedScrollBar.Position;
end;
end;
TemporaryImage.Refresh;
end;
except
begin
Free;
ShowMessage('Dilarang 2 Pemrosesan');
end;
end;
end;
11. Isikan prosedur di bawah pada komponen BlueScrollBar
procedure TBrightnessForm.BlueScrollBarChange(Sender: TObject);
var
a,b:Integer;
temp:integer;
pixelPointer:PByteArray;
originalPixelPointer:PByteArray;
begin
try
begin
if TemporaryImage.Picture.Bitmap.PixelFormat=pf24bit then
for a:=0 to TemporaryImage.Picture.Height-1 do
begin
pixelPointer:=TemporaryImage.Picture.Bitmap.ScanLine[a];
originalPixelPointer:=OriginalImage.Picture.Bitmap.ScanLine[a];
for b:=0 to TemporaryImage.Picture.Width-1 do
begin
temp:=originalPixelPointer[3*b]+ BlueScrollBar.Position;
if temp<0 then temp:=0;
if temp>255 then temp:=255;
pixelPointer[3*b]:=temp;
end;
end;
if TemporaryImage.Picture.Bitmap.PixelFormat=pf8bit then
for a:=0 to TemporaryImage.Picture.Height-1 do
begin
pixelPointer:=TemporaryImage.Picture.Bitmap.ScanLine[a];
originalPixelPointer:=OriginalImage.Picture.Bitmap.ScanLine[a];
for b:=0 to TemporaryImage.Picture.Width-1 do
begin
temp:=originalPixelPointer[b]+ BlueScrollBar.Position;
if temp<0 then temp:=0;
if temp>255 then temp:=255;
pixelPointer[b]:=temp;
RedScrollBar.Position:=BlueScrollBar.Position;
GreenScrollBar.Position:=BlueScrollBar.Position;
end;
end;
TemporaryImage.Refresh;
end;
except
begin
Free;
ShowMessage('Dilarang 2 Pemrosesan');
end;
end;
end;
procedure TBrightnessForm.GreenScrollBarChange(Sender: TObject);
var
a,b:Integer;
temp:integer;
pixelPointer:PByteArray;
originalPixelPointer:PByteArray;
begin
try
begin
if TemporaryImage.Picture.Bitmap.PixelFormat=pf24bit then
for a:=0 to TemporaryImage.Picture.Height-1 do
begin
pixelPointer:=TemporaryImage.Picture.Bitmap.ScanLine[a];
originalPixelPointer:=OriginalImage.Picture.Bitmap.ScanLine[a];
for b:=0 to TemporaryImage.Picture.Width-1 do
begin
temp:=originalPixelPointer[3*b+1]+ GreenScrollBar.Position;
if temp<0 then temp:=0;
if temp>255 then temp:=255;
pixelPointer[3*b+1]:=temp;
end;
end;
if TemporaryImage.Picture.Bitmap.PixelFormat=pf8bit then
for a:=0 to TemporaryImage.Picture.Height-1 do
begin
pixelPointer:=TemporaryImage.Picture.Bitmap.ScanLine[a];
originalPixelPointer:=OriginalImage.Picture.Bitmap.ScanLine[a];
for b:=0 to TemporaryImage.Picture.Width-1 do
begin
temp:=originalPixelPointer[b]+ GreenScrollBar.Position;
if temp<0 then temp:=0;
if temp>255 then temp:=255;
pixelPointer[b]:=temp;
RedScrollBar.Position:=GreenScrollBar.Position;
BlueScrollBar.Position:=GreenScrollBar.Position;
end;
end;
TemporaryImage.refresh;
end;
except
begin
Free;
ShowMessage('Dilarang 2 Pemrosesan');
end;
end;
end;
13. Isi komponen Button Ok, dengan menggunakan prosedur : begin
Applied:=true;
Close();
end;
14. Isi komponen Button Cancel, dengan menggunakan prosedur : procedure TBrightnessForm.CancelButtonClick(Sender: TObject);
begin
Applied:=false;
Close;
end; 15. Isikan prosedur pada Events Onclose, dengan prosedur : procedure TBrightnessForm.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
if Applied=false then
TemporaryImage.Picture.Bitmap.Assign(
OriginalImage.Picture.Bitmap);
Action:=caFree;
end;
16. Buka form MainForm (tekan Shift+F12), tambahkan Brightness pada MainMenu1 di dalam Edit Image. Dan isikan prosedur procedure TMainForm.Brightness1Click(Sender: TObject);
begin
if ImageForm<>nil then
begin
ImageForm:=TImageForm(ActiveMDIChild);
try
begin
Application.CreateForm(TBrightnessForm,BrightnessForm);
Brightnessform.SetBrightness(ImageForm.Image1);
end;
except
BrightnessForm.Free;
ShowMessage('Gambar Belum Terbuka');
end;
end;
end;
HASIL PROGRAM DI ATAS
Baca Semua...
Langganan:
Komentar (Atom)
