Materi Grafika Komputer

Wayan Firdaus Mahmudy

Program Diploma III Manajemen Informatika & Teknik Komputer Fakultas Matematika dan Ilmu Pengetahuan Alam Universitas Brawijaya Malang Grafika Komputer - Sept 2004

1

Bab 1.

Fungsi Primitif dan Dasar-Dasar Operasi Grafik pada Delphi

1

Bab 2.

Kurva

9

Bab 3.

Interpolasi

19

Bab 4.

Fractal Garis

26

Bab 5.

Fractal Bidang Kompleks

33

Bab 6.

Obyek 2D

43

Bab 7.

Obyek 3D

52

Bab 8.

Dasar-Dasar Pengolahan Citra Digital

60

Grafika Komputer - Sept 2004

2

Bab

1

Fungsi Primitif dan Dasar-Dasar Operasi Grafik pada Delphi

Tujuan • •

Mengambar bentuk-bentuk garis, persegi dan elips menggunakan fungsi standar Delphi pada komponen PaintBox. Membuat fungsi primitif untuk menggambar garis dan elips.

Latihan 1.1 Pada latihan ini dikenalkan fungsi-fungsi standar Delphi untuk penggambaran garis, persegi dan lingkaran. Rancangan tampilan dibuat sebagai berikut:

PaintBox1

Isi event sebagai berikut: Unit1.PAS 01 … 02 type 03 TForm1 = class(TForm) 04 PaintBox1: TPaintBox; 05 ButtonGaris: TButton; 06 ButtonHapus: TButton; 07 ButtonLingkaran: TButton; Grafika Komputer - Sept 2004

1

08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51

ButtonKotak: TButton; ButtonKeluar: TButton; procedure ButtonKeluarClick(Sender: TObject); procedure ButtonHapusClick(Sender: TObject); procedure ButtonGarisClick(Sender: TObject); procedure ButtonKotakClick(Sender: TObject); procedure ButtonLingkaranClick(Sender:TObject); end; … procedure TForm1.ButtonKeluarClick(Sender:TObject); begin Close; end; procedure TForm1.ButtonHapusClick(Sender: TObject); begin PaintBox1.Refresh; end; procedure TForm1.ButtonGarisClick(Sender: TObject); var i:integer; begin PaintBox1.Canvas.Pen.Color := clRed; for i:=1 to 40 do begin PaintBox1.Canvas.MoveTo (0,0); PaintBox1.Canvas.LineTo (PaintBox1.Width,10*i); end; end; procedure TForm1.ButtonKotakClick(Sender: TObject); var i:integer; x1,x2,y1,y2:integer; begin PaintBox1.Canvas.Pen.Color := clRed; x1 := 0; x2 := PaintBox1.Width-1; y1 := 0; y2 := PaintBox1.Height-1; for i:=1 to 8 do begin PaintBox1.Canvas.Rectangle (x1,y1,x2,y2); Inc (x1,15); Inc (y1,10); Dec (x2,15); Dec (y2,10); end;

Grafika Komputer - Sept 2004

2

52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69

end; procedure TForm1.ButtonLingkaranClick(Sender: TObject); var i:integer; x1,x2,y1,y2:integer; begin PaintBox1.Canvas.Pen.Color := clBlue; x1 := 0; x2 := PaintBox1.Width-1; y1 := 0; y2 := PaintBox1.Height-1; for i:=1 to 8 do begin PaintBox1.Canvas.Ellipse (x1,y1,x2,y2); Inc (x1,15); Inc (y1,10); Dec (x2,15); Dec (y2,10); end; end;

Jika program dijalankan dan ButtonGaris diklik akan dihasilkan tampilan sebagai berikut:

Tampilan pada PaintBox untuk button lainnya adalah sebagai berikut:

Grafika Komputer - Sept 2004

3

Setelah program di atas dijalankan cobalah untuk mengganti event untuk ButtonLingkaran dengan mengubah cara penggambaran lingkaran dimulai dari lingkaran terkecil ke lingkaran terbesar. 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16

procedure TForm1.ButtonLingkaranClick(Sender: TObject); var i:integer; x1,x2,y1,y2:integer; begin PaintBox1.Canvas.Pen.Color := clBlue; PaintBox1.Canvas.Brush.Style := bsClear; x1 := PaintBox1.Width div 2 - 5 ; x2 := x1 + 5; y1 := PaintBox1.Height div 2 - 5; y2 := y1 + 5; for i:=1 to 8 do begin PaintBox1.Canvas.Ellipse (x1,y1,x2,y2); Dec (x1,15); Dec (y1,10); Inc (x2,15); Inc (y2,10); end;

Grafika Komputer - Sept 2004

4

17

end;

Jika pada bagian modifikasi baris 6 yang berisi PaintBox1.Canvas.Brush.Style := bsClear;

dihapus, apa yang terjadi pada tampilan program, mengapa ?

Tugas Modifikasi tampilan program di atas sehinga tampilan untuk kotak dan lingkaran menjadi sebagai berikut:

Latihan 1.2 Pada latihan ini dibuat fungsi primitif untuk menggambar garis dan elips. Desain tampilan hampir sama dengan Latihan 1.1. Jika program dijalankan dan ButtonGaris diklik akan dihasilkan tampilan sebagai berikut:

Grafika Komputer - Sept 2004

5

Jika ButtonEllipse diklik akan dihasilkan tampilan sebagai berikut:

Isi event sebagai berikut: Unit1.PAS 01 … 02 type 03 TForm1 = class(TForm) 04 PaintBox1: TPaintBox; 05 ButtonGaris: TButton; 06 ButtonHapus: TButton; 07 ButtonEllipse: TButton; 08 ButtonKeluar: TButton; 09 procedure ButtonKeluarClick(Sender: TObject); 10 procedure ButtonHapusClick(Sender: TObject); 11 procedure ButtonGarisClick(Sender: TObject); 12 procedure ButtonEllipseClick(Sender: TObject); 13 end; 14 15 var 16 Form1: TForm1; 17 18 implementation 19 20 {$R *.DFM} 21 procedure Line (Canvas:TCanvas; 22 x1,y1,x2,y2:integer; Clr:TColor); 23 24 var 25 dx,dy,steps,k : integer; Grafika Komputer - Sept 2004

6

26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69

xinc,yinc,x,y : real; begin dx := x2-x1; dy := y2-y1; if Abs(dx)>Abs(dy) then steps := abs(dx) else steps := abs(dy); xinc := dx/steps; yinc := dy/steps; x := x1; y := y1; Canvas.Pixels[Round(x),Round(y)] := Clr; for k:=1 to steps do begin x := x + xinc; y := y + yinc; Canvas.Pixels[Round(x),Round(y)] := Clr; end; end; procedure Ellipse (Canvas:TCanvas; x1,y1,x2,y2:integer; Clr:TColor); var x,y,xc,yc,a,b,aa,bb,xx:real; begin xc := (x2-x1) / 2 + x1 - 1; yc := (y2-y1) / 2 + y1 - 1; a := Abs(x2-x1)/2; b := Abs(y2-y1)/2; aa := Sqr (a); bb := Sqr (b); x := 0; while x<=a do begin xx := Sqr(x); y := Sqrt (bb*(1-xx/aa)); Canvas.Pixels[Round(xc+x),Round(yc+y)] Canvas.Pixels[Round(xc+x),Round(yc-y)] Canvas.Pixels[Round(xc-x),Round(yc+y)] Canvas.Pixels[Round(xc-x),Round(yc-y)] x := x + 1; end;

Grafika Komputer - Sept 2004

:= := := :=

Clr; Clr; Clr; Clr;

7

70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103

end; procedure TForm1.ButtonKeluarClick(Sender:TObject); begin Close; end; procedure TForm1.ButtonHapusClick(Sender: TObject); begin PaintBox1.Refresh; end; procedure TForm1.ButtonGarisClick(Sender: TObject); var w,h:integer; begin w := PaintBox1.Width; h := PaintBox1.Height; Line (PaintBox1.Canvas, 0,0, w, 0, clRed); Line (PaintBox1.Canvas, 0,0, w, h, clRed); Line (PaintBox1.Canvas, 0,0, 0, h, clRed); Line (PaintBox1.Canvas, w,h, w-160,h-50,clBlue); end; procedure TForm1.ButtonEllipseClick(Sender:TObject); var i:integer; x1,x2,y1,y2:integer; begin x1 := 1; x2 := PaintBox1.Width-2; y1 := 1; y2 := PaintBox1.Height-2; Ellipse (PaintBox1.Canvas, x1,y1,x2,y2, clRed); Ellipse (PaintBox1.Canvas, x1+60,y1+10, x2-60,y2-10, clGreen); end;

Tugas Modifikasi program di atas sehingga tampilan elips tidak terputus.

Grafika Komputer - Sept 2004

8

Bab

2

Kurva

Tujuan Mengambar bentuk-bentuk kurva pada sistem koordinat kartesius dan polar.

Latihan 2.1 Susun project untuk menggambar kurva sinus dengan tampilan sebagai berikut:

Anda harus menambahkan komponen non visual ColorDialog yang digunakan untuk mengatur warna kurva yang dihasilkan. Isi event sebagai berikut: Unit1.PAS 01 type 02 TForm1 = class(TForm) 03 PaintBox1: TPaintBox; 04 ColorDialog1: TColorDialog; 05 ButtonHapus: TButton; 06 ButtonKeluar: TButton; 07 ButtonSin: TButton; 08 ButtonWarna: TButton; Grafika Komputer - Sept 2004

9

09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52

procedure procedure procedure procedure procedure end;

FormCreate(Sender: TObject); ButtonKeluarClick(Sender: TObject); ButtonHapusClick(Sender: TObject); ButtonSinClick(Sender: TObject); ButtonWarnaClick(Sender: TObject);

var Form1: TForm1; Clr: TColor; implementation {$R *.DFM} const DeltaX = 0.5; Periode = 4; // fungsi yang akan digambar function Func (x:real):real; begin x := x/180 * PI; Result := Sin (Periode*x); end; // x1,x2,y1,y2 menunjukkan nilai koordinat // pada bidang cartesius // x1 : nilai koordinat paling kiri pada PaintBox // x2 : nilai koordinat paling kanan pada PaintBox // y1 : nilai koordinat paling bawah pada PaintBox // y2 : nilai koordinat paling atas pada PaintBox procedure GambarKurva (var PB:TPaintBox; x1,y1,x2,y2:real; Clr:TColor); var xs,ys,x,y:real; W,H:integer; begin PB.Canvas.Pen.Color := Clr; W := PB.Width; H := PB.Height; PB.Canvas.Rectangle(0,0,W,H); x := x1; y := Func (x); xs := (x-x1)/(x2-x1) * W; ys := H - (y-y1)/(y2-y1)*H;

Grafika Komputer - Sept 2004

10

53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87

PB.Canvas.MoveTo (Round(xs),Round(ys)); repeat x := x + DeltaX; y := Func (x); xs := (x-x1)/(x2-x1) * W; ys := H - (y-y1)/(y2-y1)*H; PB.Canvas.LineTo(Round(xs),Round(ys)); until x>=x2; end; procedure TForm1.FormCreate(Sender: TObject); begin Clr := clBlack; end; procedure TForm1.ButtonKeluarClick(Sender:TObject); begin Close; end; procedure TForm1.ButtonHapusClick(Sender: TObject); begin PaintBox1.Refresh; end; procedure TForm1.ButtonSinClick(Sender: TObject); begin GambarKurva (PaintBox1, 0,-2,360,2, Clr); end; procedure TForm1.ButtonWarnaClick(Sender: TObject); begin if ColorDialog1.Execute then Clr := ColorDialog1.Color; end;

Pengembangan Modifikasi program di atas dengan membuat nilai DeltaX, Periode, x1, x2, y1, y2 bisa diinputkan saat program berjalan dengan menggunakan komponen Edit.

Grafika Komputer - Sept 2004

11

Latihan 2.2 Project ini hampir sama dengan Latihan 2.1 dengan tambahan beberapa kurva lain.

Perhatikan fungsi kurva yang akan digambar dimasukkan sebagai parameter pada procedure GambarKurva. Unit1.PAS 01 type 02 TForm1 = class(TForm) 03 PaintBox1: TPaintBox; 04 ButtonHapus: TButton; 05 ButtonKeluar: TButton; 06 ButtonSin: TButton; 07 ButtonSinCos: TButton; 08 ButtonPoli: TButton; 09 procedure ButtonKeluarClick(Sender: TObject); 10 procedure ButtonHapusClick(Sender: TObject); 11 procedure ButtonSinClick(Sender: TObject); 12 procedure ButtonSinCosClick(Sender: TObject); 13 procedure ButtonPoliClick(Sender: TObject); 14 end; 15 16 var 17 Form1: TForm1; 18 19 implementation Grafika Komputer - Sept 2004

12

20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63

{$R *.DFM} const DeltaX = 0.5; Periode = 3; type TFuncX = function (x:real) : real; {$F+} function SinX (x:real):real; begin x := x/180 * PI; SinX := Sin(Periode*x); end; function SinCosX (x:real):real; begin x := x/180*PI; SinCosX := Sin(2*x) + Cos(x); end; function Poli (x:real):real; begin Poli := 0.5*x*x*x - 2*x*x + x ; end; {$F-} procedure GambarKurva (FuncX:TFuncX; x1,y1,x2,y2:real; var PaintBox1:TPaintBox); var xs,ys,x,y:real; W,H:integer; begin W := PaintBox1.Width; H := PaintBox1.Height; PaintBox1.Canvas.Rectangle(0,0,W,H); x := x1; y := FuncX(x); xs := (x-x1)/(x2-x1) * W; ys := H - (y-y1)/(y2-y1)*H; PaintBox1.Canvas.MoveTo(Round(xs),Round(ys)); repeat x := x + DeltaX; y := FuncX(x);

Grafika Komputer - Sept 2004

13

64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93

xs := (x-x1)/(x2-x1) * W; ys := H - (y-y1)/(y2-y1)*H; PaintBox1.Canvas.LineTo(Round(xs),Round(ys)); until x>=x2; end; procedure TForm1.ButtonKeluarClick(Sender:TObject); begin Close; end; procedure TForm1.ButtonHapusClick(Sender: TObject); begin PaintBox1.Refresh; end; procedure TForm1.ButtonSinClick(Sender: TObject); begin GambarKurva (SinX, 0,-2,360,2, PaintBox1); end; procedure TForm1.ButtonSinCosClick(Sender:TObject); begin GambarKurva (SinCosX, 0,-2,360,2, PaintBox1); end; procedure TForm1.ButtonPoliClick(Sender: TObject); begin GambarKurva (Poli, -5,-150,10,150, PaintBox1); end;

Pengembangan Seperti pada latihan sebelumnya modifikasi program di atas dengan membuat nilai DeltaX, Periode, x1, x2, y1, y2 bisa diinputkan saat program berjalan dengan menggunakan komponen Edit. Tambahkan juga pengatur warna kurva seperti pada latihan sebelumnya.

Grafika Komputer - Sept 2004

14

Latihan 2.3 Susun project untuk menggambar kurva dalam koordinat polar dengan tampilan sebagai berikut:

Isi event sebagai berikut: Unit1.PAS 01 type 02 TForm1 = class(TForm) 03 PaintBox1: TPaintBox; 04 ButtonHapus: TButton; 05 ButtonKeluar: TButton; 06 ButtonLingkaran: TButton; 07 ButtonSinus: TButton; 08 ButtonSinCos: TButton; 09 procedure ButtonKeluarClick(Sender: TObject); 10 procedure ButtonHapusClick(Sender: TObject); 11 procedure ButtonLingkaranClick(Sender: TObject); procedure ButtonSinusClick(Sender: TObject); 12 procedure ButtonSinCosClick(Sender: TObject); 13 end; 14 15 16 var 17 Form1: TForm1; 18 19 implementation Grafika Komputer - Sept 2004

15

20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63

{$R *.DFM} type TFuncT = function (t:real) : real; {$F+} function Lingkaran (t:real) : real; begin Lingkaran := 5 end; function Sinus (t:real) : real; begin t := t/180 * PI; Sinus := Abs(5*Sin(t)); end; function SinCos (t:real):real; begin t := t/180 * PI; SinCos:= Abs(10*Sin(4*Cos(4*t))); end; {$F-} procedure KonversiKoordinat (t,r:real; var x,y:real); begin x := r * Cos (t/180*PI); y := r * Sin (t/180*PI); end; procedure GambarKurva (FuncT:TFuncT; t1,t2,dt, x1,y1,x2,y2:real; var PaintBox1:TPaintBox); var xs,ys,t,x,y:real; W,H:integer; begin W := PaintBox1.Width; H := PaintBox1.Height; PaintBox1.Canvas.Rectangle(0,0,W,H); t := t1; KonversiKoordinat (t, FuncT(t), x,y); xs := (x-x1)/(x2-x1) * W; ys := H - (y-y1)/(y2-y1)*H; PaintBox1.Canvas.MoveTo(Round(xs),Round(ys));

Grafika Komputer - Sept 2004

16

64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100

repeat t := t + dt; KonversiKoordinat (t, FuncT(t), x,y); xs := (x-x1)/(x2-x1) * W; ys := H - (y-y1)/(y2-y1)*H; PaintBox1.Canvas.LineTo(Round(xs),Round(ys)); until t>=t2; end; procedure TForm1.ButtonKeluarClick(Sender:TObject); begin Close; end; procedure TForm1.ButtonHapusClick(Sender: TObject); begin PaintBox1.Refresh; end; procedure TForm1.ButtonLingkaranClick(Sender: TObject); begin GambarKurva (Lingkaran, 0,360,1, -10,-10,10,10, PaintBox1); end; procedure TForm1.ButtonSinusClick(Sender: TObject); begin GambarKurva (Sinus, 0,360,1, -10,-10,10,10, PaintBox1); end; procedure TForm1.ButtonSinCosClick(Sender:TObject); begin GambarKurva (SinCos, 0,360,1, -10,-10,10,10, PaintBox1); end;

Grafika Komputer - Sept 2004

17

Pengembangan Cobalah untuk mengganti fungsi Lingkaran sebagai berikut: 01 02 03 04 05 06 07 08

function Lingkaran (t:real) : real; begin case Round(t) of 0..90, 180..270, 360 : Lingkaran := 5 else Lingkaran := 8; end; end;

Jika ButtonLingkaran diklik maka dihasilkan tampilan sebagai berikut:

Lakukan modifikasi fungsi Lingkaran untuk menghasilkan tampilan sebagai berikut:

Grafika Komputer - Sept 2004

18

Bab

3

Interpolasi

Tujuan Menggambar kurva hasil interpolasi beberapa titik.

Latihan 3 Pada project ini digunakan metode Interpolasi Newton Umum Beda Terbagi untuk menghubungkan titik-titik yang ditulis pada StringGrid. Metode interpolasi Newton ditulis pada unit INBT dan tidak dibahas secara matematis. Sebagai panduan untuk menentukan posisi titik pada PaintBox digunakan event OnMouseMove untuk menampilkan pada sebuah label posisi x dan y dari kursor pada PaintBox.

Isi event sebagai berikut: Unit1.PAS 01 type 02 TForm1 = class(TForm) 03 PaintBox1: TPaintBox; Grafika Komputer - Sept 2004

19

04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47

ButtonHapus: TButton; ButtonKeluar: TButton; ButtonPlot: TButton; ButtonKurva: TButton; StringGrid1: TStringGrid; LabelPos: TLabel; procedure FormCreate(Sender: TObject); procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer); procedure ButtonKeluarClick(Sender: TObject); procedure ButtonHapusClick(Sender: TObject); procedure ButtonPlotClick(Sender: TObject); procedure ButtonKurvaClick(Sender: TObject); end; var Form1: TForm1; implementation {$R *.DFM} uses INBT; var Newton: TIntNewton; procedure TForm1.FormCreate(Sender: TObject); begin StringGrid1.Cells [0,0] := ' X '; StringGrid1.Cells [1,0] := ' Y '; Newton := TIntNewton.Create; end; procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer); begin LabelPos.Caption := 'X='+IntToStr(x)+ ' Y='+IntToStr(y); end; procedure TForm1.ButtonKeluarClick(Sender:TObject); begin Close;

Grafika Komputer - Sept 2004

20

48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91

end; procedure TForm1.ButtonHapusClick(Sender: TObject); begin PaintBox1.Refresh; PaintBox1.Canvas.Rectangle (0,0, PaintBox1.Width, PaintBox1.Height); end; procedure TForm1.ButtonPlotClick(Sender: TObject); var i,x,y:integer; begin { gambar titik asal } PaintBox1.Canvas.Pen.Color := clBlue; for i:=1 to StringGrid1.RowCount do if (StringGrid1.Cells[0,i]<>'') and (StringGrid1.Cells[1,i]<>'') then begin x := StrToInt (StringGrid1.Cells[0,i]); y := StrToInt (StringGrid1.Cells[1,i]); PaintBox1.Canvas.Ellipse (x-2,y-2,x+2,y+2); end; end; procedure TForm1.ButtonKurvaClick(Sender: TObject); var x,y:real; i:TIndex; begin Newton.Clear; for i:=1 to StringGrid1.RowCount do if (StringGrid1.Cells[0,i]<>'') and (StringGrid1.Cells[1,i]<>'') then begin x := StrToFloat (StringGrid1.Cells[0,i]); y := StrToFloat (StringGrid1.Cells[1,i]); Newton.Add (x,y); end; x := Newton.GetX (1); y := Newton.GetY (1); PaintBox1.Canvas.Pen.Color := clRed; PaintBox1.Canvas.MoveTo (Round(x), Round(y)); while x
Grafika Komputer - Sept 2004

21

92 93 94 95

x := x + 1; y := Newton.Yint(x); end; end;

INBT.PAS unit INBT; 01 02 { Interpolasi Newton Umum Beda Terbagi } 03 04 interface 05 06 const 07 MAXDATA = 20; 08 09 type 10 TIndex = 0..MAXDATA; 11 TFloat = real; 12 TArray1 = array [1..MAXDATA] of TFloat; 13 TArray2 = array [1..MAXDATA, 0..MAXDATA] of 14 TFloat; 15 16 TIntNewton = class 17 private 18 DataX : TArray1; 19 DataY : TArray2; 20 nData : TIndex; 21 public 22 constructor Create; 23 destructor Destroy; 24 25 procedure Clear; 26 procedure Add (x,y:TFloat); 27 28 function GetNumData : TIndex; 29 function Xmin : TFloat; 30 function Xmax : TFloat; 31 function GetX (i:integer) : TFloat; 32 function GetY (i:integer) : TFloat; 33 function Yint (Xi:TFloat) : TFloat; 34 end; 35 36 implementation 37 Grafika Komputer - Sept 2004

22

38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81

constructor TIntNewton.Create; begin Clear; end; destructor TIntNewton.Destroy; begin end; procedure TIntNewton.Clear; begin nData := 0; end; procedure TIntNewton.Add (x,y:TFloat); begin Inc (nData); DataX[nData] := x; DataY[nData,0] := y; end; function TIntNewton.GetNumData : TIndex; begin GetNumData := nData; end; function TIntNewton.Xmin : TFloat; begin Xmin := DataX[1]; end; function TIntNewton.Xmax : TFloat; begin Xmax := DataX[nData]; end; function TIntNewton.GetX (i:integer) : TFloat; begin GetX := DataX[i]; end; function TIntNewton.GetY (i:integer) : TFloat; begin

Grafika Komputer - Sept 2004

23

82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125

GetY := DataY[i,0]; end; // mencari perkiraan nilai Y pada posisi X function TIntNewton.Yint (Xi:TFloat) : TFloat; var i,j:TIndex; Yi, TotX : TFloat; N : TIndex; X : TArray1; Y : TArray2; begin N := nData; X := DataX; Y := DataY; if (Xi<=X[1]) or (Xi>=X[N]) then begin Yint := 0; Exit; end; i:=1; while X[i]<Xi do Inc(i); j := i-1; N := N - j + 1; for i:=1 to N do begin X[i] := X[i+j-1]; Y[i,0] := Y[i+j-1, 0] end; { hitung beda } for j:=1 to N-1 do for i:=1 to N-j do Y[i,j] := (Y[i+1,j-1] - Y[i,j-1]) / (X[i+j]-X[i]); TotX := (Xi-X[1]); Yi := Y[1,0]; for i:=1 to N-1 do begin Yi := Yi + TotX * Y[1,i]; TotX := TotX * (Xi-X[i+1]);

Grafika Komputer - Sept 2004

24

126 127 128 129 130

end; Yint := Yi; end; end.

Pengembangan Modifikasi program di atas sebagai berikut: -

Tambahkan satu buton untuk menghapus isi StringGrid.

-

Tambahkan fasilitas sehingga user bisa menambahkan titik pada StringGrid dengan mengklik pada PaintBox dan sekaligus menampilkan plot titik.

Grafika Komputer - Sept 2004

25

Bab

4

Fractal Garis

Tujuan Menggambar berbagai macam fractal garis.

Latihan 4 Susun project untuk menggambar fractal garis dengan contoh tampilan sebagai berikut (Quadric Koch orde 5):

Contoh fractal lain (kurva C orde 10) yang dihasilkan adalah:

Grafika Komputer - Sept 2004

26

Perhatikan dalam unit berikut event untuk empat buton penggambar fractal mengarah ke satu procedur. Unit1.PAS 01 type TForm1 = class(TForm) 02 PaintBox1: TPaintBox; 03 ButtonClear: TButton; 04 BitBtnClose: TBitBtn; 05 ButtonTriKoch: TButton; 06 ButtonQuaKoch: TButton; 07 ButtonKurvaC: TButton; 08 ButtonLayangLayang: TButton; 09 10 SpinEditOrde: TSpinEdit; 11 SpinEditArah: TSpinEdit; 12 SpinEditPanjang: TSpinEdit; 13 SpinEditX: TSpinEdit; 14 SpinEditY: TSpinEdit; 15 LabelFractal: TLabel; 16 Label1: TLabel; 17 Label2: TLabel; 18 Label3: TLabel; 19 Label4: TLabel; 20 Label5: TLabel; 21 procedure FormCreate(Sender: TObject); 22 procedure PaintBox1MouseMove(Sender: TObject; 23 Shift: TShiftState; X,Y: Integer); 24 procedure ButtonClearClick(Sender: TObject); 25 procedure ButtonDrawFractalClick(Sender:TObject); 26 end; 27 28 29 var 30 Form1: TForm1; 31 32 implementation 33 {$R *.DFM} 34 35 uses Fractal; 36 37 procedure TForm1.FormCreate(Sender: TObject); 38 begin 39 PtrPaintBox := @PaintBox1; 40 end; Grafika Komputer - Sept 2004

27

41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84

procedure TForm1.PaintBox1MouseMove(Sender:TObject; Shift: TShiftState; X,Y: Integer); begin Caption := 'Fractal Generator X, Y : ' + IntToStr(X) + ',' + IntToStr(Y); end; procedure TForm1.ButtonClearClick(Sender: TObject); begin PaintBox1.Refresh; end; procedure TForm1.ButtonDrawFractalClick(Sender:TObject); var x,y,Orde,Arah,Panjang:integer; begin x := SpinEditX.Value; y := SpinEditY.Value; PaintBox1.Canvas.MoveTo (x,y); Orde := SpinEditOrde.Value; Arah := SpinEditArah.Value; Panjang := SpinEditPanjang.Value; if Sender=ButtonTriKoch then begin LabelFractal.Caption := 'Triadic Koch'; TriadicKoch (Orde, Arah, Panjang); end else if Sender=ButtonQuaKoch then begin LabelFractal.Caption := 'Quadric Koch'; QuadricKoch (Orde, Arah, Panjang); end else if Sender=ButtonKurvaC then begin LabelFractal.Caption := 'Kurva C'; KurvaC (Orde, Arah, Panjang); end else if Sender=ButtonLayangLayang then begin LabelFractal.Caption := 'Layang-Layang'; LayangLayang (Orde, Arah, Panjang); end; end;

Grafika Komputer - Sept 2004

28

Unit berikut berisi prosedur penggambar beberapa fractal. Fractal Quadric Koch dan Kurva C tidak ditulis dan anda harus melengkapi sendiri. Fractal.PAS 01 unit Fractal; 02 03 interface 04 05 uses WinTypes, ExtCtrls; 06 07 08 var PtrPaintBox : ^TPaintBox; 09 10 11 procedure TriadicKoch (Orde:byte; Arah,Panjang:real); 12 procedure QuadricKoch (Orde:byte; Arah,Panjang:real); 13 procedure KurvaC (Orde:byte; Arah,Panjang:real); 14 procedure LayangLayang (Orde:byte; Arah,Panjang:real); 15 16 implementation 17 18 procedure LineRel (dx,dy:integer); 19 var Point:TPoint; 20 begin Point := PtrPaintBox^.Canvas.PenPos; 21 PtrPaintBox^.Canvas.LineTo (Point.X+dx, Point.Y+dy); 22 23 end; 24 25 procedure TriadicKoch (Orde:byte; Arah,Panjang:real); 26 var dX,dY:integer; 27 begin if Orde>0 then 28 29 begin 30 TriadicKoch (Orde-1,Arah,Panjang/3); 31 Arah := Arah+60; 32 TriadicKoch (Orde-1,Arah,Panjang/3); 33 Arah := Arah-120; 34 TriadicKoch (Orde-1,Arah,Panjang/3); 35 Arah := Arah+60; 36 TriadicKoch (Orde-1,Arah,Panjang/3); 37 end 38 else 39 begin 40 dX := Round(Panjang*Cos(Arah/180*PI)); Grafika Komputer - Sept 2004

29

41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81

dY := Round(Panjang*Sin(Arah/180*PI)); LineRel (dX,dY); end; end; procedure QuadricKoch (Orde:byte; Arah,Panjang:real); begin … end; procedure KurvaC (Orde:byte; Arah,Panjang:real); begin … end; procedure LayangLayang (Orde:byte; Arah,Panjang:real); var dX,dY:integer; begin if Orde>0 then begin LayangLayang (Orde-1,Arah,Panjang/2); Arah := Arah+45; LayangLayang (Orde-1,Arah,Panjang/2); Arah := Arah-90; LayangLayang (Orde-1,Arah,Panjang/2); Arah := Arah-90; LayangLayang (Orde-1,Arah,Panjang/2); Arah := Arah-90; LayangLayang (Orde-1,Arah,Panjang/2); Arah := Arah+45; LayangLayang (Orde-1,Arah,Panjang/2); end else begin dX := Round(Panjang*Cos(Arah/180*PI)); dY := Round(Panjang*Sin(Arah/180*PI)); LineRel (dX,dY); end; end; end.

Grafika Komputer - Sept 2004

30

Berikut ini contoh gambar fractal Triadic dan Quadric Koch untuk tiap orde: Orde

Triadic Koch

Quadric Koch

0

1

2

3

4

5

Grafika Komputer - Sept 2004

31

Berikut ini contoh gambar fractal C dan Layang-Layang untuk tiap orde: Orde

Kurva C

Layang-Layang

0 1

2

3

4

5

Pengembangan Cobalah definisikan fractal buatan anda sendiri dan tambahkan ke program.

Grafika Komputer - Sept 2004

32

Bab

5

Fractal Bidang Kompleks

Tujuan Menggambar berbagai macam fractal dalam bidang kompleks.

Latihan 5 Susun project untuk menggambar fractal bidang kompleks dengan struktur menu sebagai berikut: File

Open Save Draw Mandelbrot Julia

: menampilkan isi file bmp : menyimpan gambar fractal ke file bmp : menggambar fractal Mandelbrot : menggambar fractal Julia

Untuk bisa menampilkan dan menyimpan gambar digunakan komponen Image untuk menggantikan PaintBox. Contoh tampilan jika dipilih Draw – Mandelbrot.

Grafika Komputer - Sept 2004

33

Contoh tampilan jika dipilih Draw – Julia.

Isi event sebagai berikut: Unit1.PAS 01 type 02 TForm1 = class(TForm) 03 MainMenu1: TMainMenu; 04 MenuFile: TMenuItem; 05 MenuFileOpen: TMenuItem; 06 MenuFileSave: TMenuItem; 07 MenuDraw: TMenuItem; 08 MenuDrawMandelbrot: TMenuItem; 09 MenuDrawJulia: TMenuItem; 10 Image1: TImage; 11 OpenDialog1: TOpenDialog; 12 SaveDialog1: TSaveDialog; 13 14 procedure FormCreate(Sender: TObject); 15 procedure MenuFileOpenClick(Sender: TObject); 16 procedure MenuFileSaveClick(Sender: TObject); 17 procedure MenuDrawMandelbrotClick(Sender: TObject); 18 procedure MenuDrawJuliaClick(Sender: TObject); 19 end; 20 var 21 Form1 : TForm1; 22 23 implementation 24 25 {$R *.DFM} Grafika Komputer - Sept 2004

34

26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69

uses Palets, FrtCmp, Complex; var Parameter: TParCmpFrt; Palet: TPalet; procedure TForm1.FormCreate(Sender: TObject); begin Palet := TPalet.Create (64); Parameter.C := TComplex.Create (0,0); end; procedure TForm1.MenuFileOpenClick(Sender:TObject); begin if OpenDialog1.Execute then Image1.Picture.LoadFromFile (OpenDialog1.FileName); end; procedure TForm1.MenuFileSaveClick(Sender:TObject); var FileName:string; begin if SaveDialog1.Execute then begin FileName := SaveDialog1.FileName; if ExtractFileExt(FileName)='' then FileName:=FileName+'.bmp'; Image1.Picture.SaveToFile (FileName); end; end; procedure TForm1.MenuDrawMandelbrotClick(Sender:TObject);

begin with Parameter do begin xMin := -2; xMax := 1; yMin := -1.5; yMax := 1.5; MaxIteration := 64; MaxMagnitude := 4.0; end; MandelbrotDraw (Parameter, Palet, Image1);

Grafika Komputer - Sept 2004

35

70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85

end; procedure TForm1.MenuDrawJuliaClick(Sender: TObject); begin with Parameter do begin xMin := -0.2; xMax := 0.2; yMin := 0.5; yMax := 0.9; MaxIteration := 64; MaxMagnitude := 1000; C.Init (0.6, 0.8); end; JuliaDraw (Parameter, Palet, Image1); end;

Unit berikut berisi prosedur penggambar fractal bidang kompleks. FrctCmp.PAS 01 unit FrtCmp; 02 03 interface 04 05 uses 06 Complex, Palets, ExtCtrls; 07 08 procedure MandelbrotDraw (Par:TParCmpFrT; 09 var Palet:TPalet; var Image:TImage); 10 procedure JuliaDraw (Par:TParCmpFrT; 11 var Palet:TPalet; var Image:TImage); 12 13 implementation 14 15 procedure MandelbrotDraw (Par:TParCmpFrT; 16 var Palet:TPalet; var Image:TImage); 17 var x,y:integer; dX,dY:real; Z:TComplex; 18 Color:byte; 19 Width,Height:integer; 20 begin 21 Width := Image.Width; 22 Height := Image.Height; Grafika Komputer - Sept 2004

36

23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66

dX := (Par.XMax-Par.XMin) / Width; dY := (Par.YMax-Par.YMin) / Height; Z := TComplex.Create (0,0); for x:=0 to Width-1 do begin for y:=0 to Height-1 do with Par do begin Z.Init (0,0); C.Init (XMin+x*dX, YMax-y*dY); Color := 0; while (Color<MaxIteration) and (Z.Magnitude<MaxMagnitude) do begin Inc (Color); Z.Mul (Z,Z); Z.Add (Z,C); end; Image.Canvas.Pixels[x,y] := Palet[Color]; end; Image.Repaint; end; end; procedure JuliaDraw (Par:TParCmpFrT; var Palet:TPalet; var Image:TImage); var x,y:integer; dX,dY:real; Z:TComplex; Color:byte; Width,Height:integer; begin Width := Image.Width; Height := Image.Height; dX := (Par.XMax-Par.XMin) / Width; dY := (Par.YMax-Par.YMin) / Height; Z := TComplex.Create (0,0); for x:=0 to Width-1 do begin for y:=0 to Height-1 do with Par do begin Z.Init (XMin+x*dX, YMax-y*dY); Color := 0; while (Color<MaxIteration) and (Z.Magnitude<MaxMagnitude) do

Grafika Komputer - Sept 2004

37

67 68 69 70 71 72 73 74 75 76 77 78 79

begin Inc (Color); Z.Mul (Z,Z); Z.Add (Z,C); end; Image.Canvas.Pixels[x,y] := Palet[Color]; end; Image.Repaint; end; end; begin end.

Unit berikut mengatur palet warna yang dipakai dalam menggambar fractal. Palet.PAS 01 unit Palets; 02 03 interface 04 05 uses Graphics, Complex; 06 07 08 type 09 { parameters of complex fractal } 10 TParCmpFrt = record 11 xMin, xMax, yMin, yMax : real; 12 MaxIteration : byte; 13 MaxMagnitude : real; 14 C : TComplex; 15 end; 16 17 TRecPalet = record 18 19 Red, Green, 20 Blue : byte; 21 dR, dG, dB : integer; 22 23 end; 24 TPalet = class 25 private 26 27 DataPalet : array [0..255] of TColor; Grafika Komputer - Sept 2004

38

28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71

Palet : TRecPalet; function GetColor (idx:byte) : TColor; public constructor Create (MaxColor:byte); procedure Init (MaxColor:byte; SP:TRecPalet); procedure InitDefault (MaxColor:byte); property Color [idx:byte]:TColor read GetColor; default; end; IMPLEMENTATION constructor TPalet.Create (MaxColor:byte); begin InitDefault (MaxColor); end; procedure TPalet.Init (MaxColor:byte; SP:TRecPalet); var i,R,G,B : byte; begin R:=SP.Red; G:=SP.Green; B:=SP.Blue; for i:=0 to MaxColor-1 do begin DataPalet[i] := R + 256*G + 256*256*B; R:=R+SP.dR; G:=G+SP.dG; B:=B+SP.dB; end; DataPalet[MaxColor] := 0; end; procedure TPalet.InitDefault (MaxColor:byte); var SP:TRecPalet; begin SP.Red:=0; SP.Green:=200; SP.Blue:=100; SP.dR:=30; SP.dG:=-30; SP.dB:=50; Init (MaxColor, SP); end; function TPalet.GetColor (idx:byte) : TColor; begin

Grafika Komputer - Sept 2004

39

72 73 74 75 76

Result := DataPalet[idx]; end; begin end.

Unit berikut berisi implementasi operasi bilangan kompleks. Complex.PAS 01 unit Complex; 02 03 INTERFACE 04 05 type 06 TComplex = class 07 private 08 re,im : real; 09 public 10 constructor Create (r,i:real); 11 destructor Destroy; 12 13 procedure Init (r,i:real); 14 function Magnitude : real; 15 procedure Con; 16 procedure Add (A,B:TComplex); 17 procedure Sub (A,B:TComplex); 18 procedure Mul (A,B:TComplex); 19 procedure Divi (A,B:TComplex); 20 end; 21 22 23 IMPLEMENTATION 24 25 constructor TComplex.Create (r,i:real); 26 begin Init (r,i); 27 28 end; 29 30 destructor TComplex.Destroy; 31 begin 32 end; 33 34 procedure TComplex.Init (r,i:real); 35 begin Grafika Komputer - Sept 2004

40

36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79

re:=r; im:=i; end; function TComplex.Magnitude : real; begin Result := re*re + im*im; end; procedure TComplex.Con; begin im := -im; end; procedure TComplex.Add (A,B:TComplex); var _re,_im:real; begin _re := A.re + B.re; _im := A.im + B.im; Init (_re,_im); end; procedure TComplex.Sub (A,B:TComplex); var _re,_im:real; begin _re := A.re - B.re; _im := A.im - B.im; Init (_re,_im); end; procedure TComplex.Mul (A,B:TComplex); var _re,_im:real; begin _re := (A.re * B.re) - (A.im * B.im); _im := (A.re * B.im) + (A.im * B.re); Init (_re,_im); end; procedure TComplex.Divi (A,B:TComplex); var Bc, C : TComplex; sq : real; begin Bc := B; BC.Con; C.Mul (A,Bc);

Grafika Komputer - Sept 2004

41

80 81 82 83 84 85 86

sq := Sqr(B.re) + Sqr(B.im); re := C.re / sq; im := C.im / sq; end; begin end.

Pengembangan Lakukan modifikasi sebagai berikut: -

Tambahkan menu untuk mengatur parameter penggambaran fractal dalam record TParCmpFrt.

-

Tambahkan menu untuk mengatur palet warna.

Grafika Komputer - Sept 2004

42

Bab

6

Obyek 2D

Tujuan Melakukan transformasi obyek dua dimensi.

Latihan 6 Susun project untuk trasformasi obyek 2D dengan tampilan sebagai berikut:

ButtonLoad dan ButtonSave di atas digunakan untuk mengambil dan meyimpan data koordinat obyek 2D bukan gambarnya.

Grafika Komputer - Sept 2004

43

Isi event sebagai berikut: Unit1.PAS type 01 TForm1 = class(TForm) 02 PaintBox1: TPaintBox; 03 OpenDialog1: TOpenDialog; 04 SaveDialog1: TSaveDialog; 05 06 BitBtnLoad: TBitBtn; 07 BitBtnSave: TBitBtn; 08 BitBtnClear: TBitBtn; 09 BitBtnClose: TBitBtn; 10 11 GroupBox1: TGroupBox; 12 GroupBox2: TGroupBox; 13 GroupBox3: TGroupBox; 14 GroupBox4: TGroupBox; 15 GroupBox5: TGroupBox; 16 17 CheckBoxCenter: TCheckBox; 18 19 EditScalingDX: TEdit; 20 EditScalingDY: TEdit; 21 EditAngle: TEdit; 22 EditShearingdX: TEdit; 23 EditShearingdY: TEdit; 24 25 ButtonViewCenter: TButton; 26 ButtonScaling: TButton; 27 ButtonRotation: TButton; 28 ButtonReflectionX: TButton; 29 ButtonReflectionY: TButton; 30 ButtonShearing: TButton; 31 32 Label1: TLabel; 33 Label2: TLabel; 34 Label3: TLabel; 35 Label4: TLabel; 36 Label5: TLabel; 37 procedure FormCreate(Sender: TObject); 38 procedure BitBtnLoadClick(Sender: TObject); 39 procedure BitBtnSaveClick(Sender: TObject); 40 procedure BitBtnClearClick(Sender: TObject); 41 Grafika Komputer - Sept 2004

44

42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85

procedure procedure procedure procedure procedure procedure end;

ButtonViewCenterClick(Sender: TObject);

ButtonScalingClick(Sender: TObject); ButtonRotationClick(Sender: TObject); ButtonReflectionXClick(Sender: TObject); ButtonReflectionYClick(Sender: TObject); ButtonShearingClick(Sender: TObject);

var Form1: TForm1; implementation {$R *.DFM} uses OB2D; var Object2D : TObject2D; procedure TForm1.FormCreate(Sender: TObject); begin Object2D := TObject2D.Create; end; procedure TForm1.BitBtnLoadClick(Sender: TObject); begin if OpenDialog1.Execute then begin Object2D.Load (OpenDialog1.FileName); Caption := 'Obyek 2 Dimensi - ' + ExtractFileName(OpenDialog1.FileName); end; Object2D.Draw(CheckBoxCenter.Checked,PaintBox1); end; procedure TForm1.BitBtnSaveClick(Sender: TObject); begin if SaveDialog1.Execute then Object2D.Save (SaveDialog1.FileName); end;

Grafika Komputer - Sept 2004

45

86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129

procedure TForm1.BitBtnClearClick(Sender: TObject); begin PaintBox1.Refresh; end; procedure TForm1.ButtonViewCenterClick(Sender:TObject); begin Object2D.Draw (true, PaintBox1); end; procedure TForm1.ButtonScalingClick(Sender:TObject); begin Object2D.Scaling ( StrToFloat(EditScalingDX.text), StrToFloat(EditScalingDY.text)); Object2D.Draw (CheckBoxCenter.Checked, PaintBox1); end; procedure TForm1.ButtonRotationClick(Sender: TObject); begin Object2D.Rotation (StrToFloat(EditAngle.text)); Object2D.Draw (CheckBoxCenter.Checked, PaintBox1); end; procedure TForm1.ButtonReflectionXClick(Sender:TObject);

begin Object2D.Reflection (true,false); Object2D.Draw (CheckBoxCenter.Checked, PaintBox1); end; procedure TForm1.ButtonReflectionYClick(Sender:TObject);

begin Object2D.Reflection (false,true); Object2D.Draw (CheckBoxCenter.Checked, PaintBox1); end; procedure TForm1.ButtonShearingClick(Sender: TObject); var fx,fy:real; begin fx := StrToFloat (EditShearingDX.text); fy := StrToFloat (EditShearingDY.text); Object2D.Shearing (fx, fy); Object2D.Draw (CheckBoxCenter.Checked, PaintBox1); end;

Grafika Komputer - Sept 2004

46

Unit berikut berisi struktur data beserta operasinya dari obyek 2D. OB2D.PAS unit OB2D; 01 02 interface 03 04 uses ExtCtrls; 05 06 const 07 MAX_VERTEX = 30; 08 09 type 10 TVertex = record 11 x,y : real; 12 end; 13 14 TIndex = 0..MAX_VERTEX; 15 16 TObject2D = class 17 private 18 nVertexs : byte; 19 Vertexs : array [1..MAX_VERTEX] of TVertex; 20 public 21 constructor Create; 22 destructor Destroy; 23 24 procedure Draw (Centered:boolean; 25 var PB:TPaintBox); 26 procedure Load (FileName:string); 27 procedure Save (FileName:string); 28 procedure Translation (dx,dy:real); 29 procedure Scaling (dx,dy:real); 30 procedure Rotation (t:real); 31 procedure Shearing (dx,dy:real); 32 procedure Reflection (rx,ry:boolean); 33 procedure Center (x1,y1,x2,y2:real); 34 end; 35 36 implementation 37 38 constructor TObject2D.Create; 39 begin 40 nVertexs := 0; 41 Grafika Komputer - Sept 2004

47

42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85

end; destructor TObject2D.Destroy; begin end; procedure TObject2D.Draw (Centered:boolean; var PB:TPaintBox); var i:TIndex; begin PB.Refresh; if Centered then Center (0,0,PB.Width-1,PB.Height-1); i := nVertexs; with Vertexs[i] do PB.Canvas.MoveTo (Round(x), Round(y)); for i:=1 to nVertexs do with Vertexs[i] do PB.Canvas.LineTo (Round(x), Round(y)); end; procedure TObject2D.Load (FileName:string); var i:TIndex; F:TextFile; begin AssignFile (F,FileName); Reset(F); ReadLn (F, nVertexs); for i:=1 to nVertexs do ReadLn(F, Vertexs[i].x, Vertexs[i].y); CloseFile (F); end; procedure TObject2D.Save (FileName:string); var i:TIndex; F:TextFile; begin AssignFile (F,FileName); ReWrite (F); WriteLn(F, nVertexs); for i:=1 to nVertexs do WriteLn(F, Vertexs[i].x,' ',Vertexs[i].y); CloseFile (F); end; procedure TObject2D.Translation (dx,dy:real);

Grafika Komputer - Sept 2004

48

86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129

var i:TIndex; begin for i:=1 to nVertexs do begin Vertexs[i].x := Vertexs[i].x + dx; Vertexs[i].y := Vertexs[i].y + dy; end; end; procedure TObject2D.Scaling (dx,dy:real); var i:TIndex; begin for i:=1 to nVertexs do begin Vertexs[i].x := Vertexs[i].x * dx; Vertexs[i].y := Vertexs[i].y * dy; end; end; procedure TObject2D.Rotation (t:real); var i:TIndex; x,y:real; begin t := t/180*PI; for i:=1 to nVertexs do begin x := Vertexs[i].x; y := Vertexs[i].y; Vertexs[i].x := x * Cos(t) - y * Sin(t); Vertexs[i].y := x * Sin(t) + y * Cos(t); end; end; procedure TObject2D.Shearing (dx,dy:real); var i:TIndex; begin for i:=1 to nVertexs do Vertexs[i].x := Vertexs[i].x + Vertexs[i].y * dx; for i:=1 to nVertexs do Vertexs[i].y := Vertexs[i].y + Vertexs[i].x * dy; end; procedure TObject2D.Reflection (rx,ry:boolean);

Grafika Komputer - Sept 2004

49

130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160

var i:TIndex; begin if rx then for i:=1 to nVertexs do Vertexs[i].y := -Vertexs[i].y; if ry then for i:=1 to nVertexs do Vertexs[i].x := -Vertexs[i].x; end; procedure TObject2D.Center (x1,y1,x2,y2:real); var i:TIndex; MinX,MinY,MaxX,MaxY,dx,dy:real; begin MinX := Vertexs[1].x; MinY := Vertexs[1].y; MaxX := Vertexs[1].x; MaxY := Vertexs[1].y; for i:=2 to nVertexs do begin if Vertexs[i].x<MinX then MinX:=Vertexs[i].x; if Vertexs[i].y<MinY then MinY:=Vertexs[i].y; if Vertexs[i].x>MaxX then MaxX:=Vertexs[i].x; if Vertexs[i].y>MaxY then MaxY:=Vertexs[i].y; end; dx := ((x2-x1) - (MaxX-MinX)) / 2 - MinX; dy := ((y2-y1) - (MaxY-MinY)) / 2 - MinY; Translation (dx,dy); end; begin end.

Berikut ini contoh struktur obyek 2D yang disimpan dalam file dengan ekstensi 2D. Baris pertama menunjukkan banyaknya titik/vertek dan baris berikutnya menunjukan pasangan nilai x dan y.

5 25 10 10 40 40

10 30 60 60 30

Grafika Komputer - Sept 2004

50

Pengembangan -

Tambahkan fasilitas untuk mengatur warna dan ketebalan garis untuk mengambar obyek,

-

Tambahkan fasilitas untuk menyimpan obyek dalam bentuk file bmp.

Grafika Komputer - Sept 2004

51

Bab

7

Obyek 3D

Tujuan Melakukan transformasi obyek tiga dimensi.

Latihan 7 Susun project untuk trasformasi obyek 3D dengan tampilan sebagai berikut:

Isi event sebagai berikut: Unit1.PAS 01 type 02 TForm1 = class(TForm) 03 Image1: TImage; 04 OpenDialog1: TOpenDialog; 05 SaveDialog1: TSaveDialog; 06 GroupBox1: TGroupBox; 07 GroupBox2: TGroupBox; Grafika Komputer - Sept 2004

52

08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51

BitBtnClose: TBitBtn; BitBtnLoad: TBitBtn; BitBtnSave: TBitBtn; BitBtnClear: TBitBtn; ButtonRotateX: TButton; ButtonRotateY: TButton; ButtonRotateZ: TButton; ButtonResize: TButton; EditAngle: TEdit; EditResize: TEdit; Label3: TLabel; procedure FormCreate(Sender: TObject); procedure BitBtnLoadClick(Sender: TObject); procedure BitBtnSaveClick(Sender: TObject); procedure BitBtnClearClick(Sender: TObject); procedure ButtonRotateClick(Sender: TObject); procedure ButtonResizeClick(Sender: TObject); end; var Form1: TForm1; implementation {$R *.DFM} uses OB3D; var Object3D : TObject3D; procedure TForm1.FormCreate(Sender: TObject); begin Image1.Canvas.Rectangle (0,0, Image1.Width,Image1.Height); Object3D := TObject3D.Create; end; procedure TForm1.BitBtnLoadClick(Sender: TObject);

Grafika Komputer - Sept 2004

53

52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95

begin if OpenDialog1.Execute then begin Object3D.Load (OpenDialog1.FileName); Object3D.DrawOnXY (Image1,0,0, Image1.Width,Image1.Height); end; end; procedure TForm1.BitBtnSaveClick(Sender: TObject); begin if SaveDialog1.Execute then Object3D.Save (SaveDialog1.FileName); end; procedure TForm1.BitBtnClearClick(Sender: TObject); begin Image1.Canvas.Rectangle (0,0, Image1.Width,Image1.Height); end; procedure TForm1.ButtonRotateClick(Sender: TObject); var a:real; begin a := StrToFloat(EditAngle.text); case (Sender as TButton).Tag of 1 : Object3D.RotateX (a); 2 : Object3D.RotateY (a); 3 : Object3D.RotateZ (a); end; Image1.Canvas.Rectangle (0,0, Image1.Width,Image1.Height); Object3D.DrawOnXY (Image1,0,0, Image1.Width,Image1.Height); end; procedure TForm1.ButtonResizeClick(Sender: TObject); begin Object3D.Resize (StrToFloat(EditResize.text)); Image1.Canvas.Rectangle (0,0, Image1.Width,Image1.Height); Object3D.DrawOnXY (Image1,0,0, Image1.Width,Image1.Height); end;

Grafika Komputer - Sept 2004

54

Unit berikut berisi struktur data beserta operasinya dari obyek 3D. Lengkapi procedure Save. OB3D.PAS unit OB3D; 01 02 interface 03 04 uses 05 ExtCtrls; 06 07 const 08 MAX_VERTEX = 30; 09 MAX_FACE = 20; 10 MAX_VERTEX_PER_FACE = 20; 11 12 type 13 TVertex = record 14 x,y,z : real; 15 end; 16 17 TObject3D = class 18 private 19 nVertexs, 20 nFaces : byte; 21 Vertex : array [1..MAX_VERTEX] of TVertex; 22 Face : array [1..MAX_FACE, 23 1..MAX_VERTEX_PER_FACE] of byte; 24 nVertexFace : array [1..MAX_FACE] of byte; 25 26 public 27 constructor Create; 28 destructor Destroy; 29 30 procedure Load (FileName:string); 31 procedure Save (FileName:string); 32 procedure Normal (var Lx,Ly,Lz:real); 33 procedure DrawOnXY (var Image:TImage; 34 x1,y1,x2,y2:integer); 35 procedure RotateX (T:real); 36 procedure RotateY (T:real); 37 procedure RotateZ (T:real); 38 procedure ReSize (S:real); 39 end; 40 Grafika Komputer - Sept 2004

55

41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84

IMPLEMENTATION constructor TObject3D.Create; begin nVertexs := 0; nFaces := 0; end; destructor TObject3D.Destroy; begin end; procedure TObject3D.Load (FileName:string); var FL:TextFile; i,j:byte; begin AssignFile(FL,FileName); Reset(FL); ReadLn(FL, nVertexs, nFaces); ReadLn(FL); for i:=1 to nVertexs do with Vertex[i] do ReadLn(FL, x,y,z); ReadLn(FL); for i:=1 to nFaces do begin Read(FL,nVertexFace[i]); for j:=1 to nVertexFace[i] do Read(FL, Face[i,j]); Face[i,nVertexFace[i]+1] := Face[i,1]; ReadLn(FL); end; CloseFile(FL); end; procedure TObject3D.Save (FileName:string); begin … … end; procedure TObject3D.Normal (var Lx,Ly,Lz:real); var i:byte; MinX,MinY,MinZ:real; begin MinX := Vertex[1].x;

Grafika Komputer - Sept 2004

56

85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128

MinY := Vertex[1].y; MinZ := Vertex[1].z; for i:=2 to nVertexs do begin if Vertex[i].x < MinX then MinX := Vertex[i].x; if Vertex[i].y < MinY then MinY := Vertex[i].y; if Vertex[i].z < MinZ then MinZ := Vertex[i].z; end; Lx:=0; Ly:=0; Lz:=0; for i:=1 to nVertexs do begin Vertex[i].x := Vertex[i].x - MinX; Vertex[i].y := Vertex[i].y - MinY; Vertex[i].z := Vertex[i].z - MinZ; if Vertex[i].x > Lx then Lx := Vertex[i].x; if Vertex[i].y > Ly then Ly := Vertex[i].y; if Vertex[i].z > Lz then Lz := Vertex[i].z; end; end; procedure TObject3D.DrawOnXY (var Image:TImage; x1,y1,x2,y2:integer); var i,j:byte; xa,xb,ya,yb:integer; Lx,Ly,Lz:real; MarginX,MarginY:integer; begin Normal (Lx,Ly,Lz); MarginX := Round((x2-x1+1)-Lx) div 2; MarginY := Round((y2-y1+1)-Ly) div 2; for i:=1 to nFaces do for j:=1 to nVertexFace[i] do begin xa := Round (Vertex[Face[i,j]].x) + MarginX; xb := Round (Vertex[Face[i,j+1]].x) + MarginX; ya := Round (Vertex[Face[i,j]].y) + MarginY; yb := Round (Vertex[Face[i,j+1]].y) + MarginY; Image.Canvas.MoveTo (xa,ya); Image.Canvas.LineTo (xb,yb);

Grafika Komputer - Sept 2004

57

129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172

end; end; procedure TObject3D.RotateX (T:real); var i:byte; yy,zz:real; begin T := T/180*PI; for i:=1 to nVertexs do with Vertex[i] do begin yy := y*Cos(T) + z*Sin(T); zz := -y*Sin(T) + z*Cos(T); y:=yy; z:=zz; end; end; procedure TObject3D.RotateY (T:real); var i:byte; xx,zz:real; begin T := T/180*PI; for i:=1 to nVertexs do with Vertex[i] do begin xx := x*Cos(T) + z*Sin(T); zz := -x*Sin(T) + z*Cos(T); x:=xx; z:=zz; end; end; procedure TObject3D.RotateZ (T:real); var i:byte; xx,yy:real; begin T := T/180*PI; for i:=1 to nVertexs do with Vertex[i] do begin xx := x*Cos(T) + y*Sin(T); yy := -x*Sin(T) + y*Cos(T); x:=xx; y:=yy; end; end; procedure TObject3D.ReSize (S:real); var i:byte;

Grafika Komputer - Sept 2004

58

173 174 175 176 177 178 179 180 181 182

begin for i:=1 to nVertexs do begin Vertex[i].x := Vertex[i].x * S; Vertex[i].y := Vertex[i].y * S; Vertex[i].z := Vertex[i].z * S; end; end; end.

Berikut ini contoh struktur obyek 3D yang disimpan dalam file dengan ekstensi 3D. Baris pertama menunjukkan banyaknya vertek dan face. Pada bagian VERTEX terdapat pasangan nilai x, y dan z. Pada bagian FACE kolom pertama menunjukkan banyaknya vertex yang menyusun face dan kolom berikutnya menunjukan nomer vertex penyusun face tersebut.

5 5 VERTEX 0 0 0 0 50 0 50 50 0 50 0 0 25 25 40 FACE 4 1 2 3 4 3 1 2 5 3 2 3 5 3 3 4 5 3 4 1 5 Pengembangan -

Tambahkan fasilitas untuk mengatur warna dan ketebalan garis untuk mengambar obyek,

-

Tambahkan fasilitas untuk menyimpan obyek dalam bentuk file bmp.

-

Tambahkan fasilitas transformasi lainnya seperti pada program untuk 2D.

Grafika Komputer - Sept 2004

59

Bab

8

Dasar-Dasar Pengolahan Citra Digital

Tujuan Melakukan pengolahan citra digital.

Latihan 8 Susun project untuk mengolah citra digital (format bmp) dengan tampilan utama (FormMain) sebagai berikut: BitBtnUndo

Panel1

FormImg Panel2

Gauge1

Pengaturan komponen dalam FormMain sebagai berikut: Component Form

Panel

• • • • •

Grafika Komputer - Sept 2004

Property Name Caption Color FormStyle Name

• • • • •

Value FormMain MyImage 1.0 clWhite fsMDIForm Panel1 60

Panel

BitBtn Gauge

• • • • • • • • •

Align Caption Name Align Caption Name Glyph Name Align

• • • • • • • • •

alTop ‘’ (kosong) Panel2 alBottom ‘’ (kosong) BitBtnUndo Gauge1 alRight

Dalam FormMain terdapat form anak (FormImg) dengan pengaturan komponen sebagai berikut: Component Form Image

Property • Name • FormStyle • Name

Value • FormImg • fsMDIChild • Image1

Dalam FormMain terdapat juga komponen non visual OpenPictureDialog, SavePictureDialog dan MainMenu. Struktur menu program dalam MainMenu sebagai berikut: File Open Image Save Image As Image Convert to Grayscale Invert Color Lightening Exit Isi event dalam FormMain dan dan FormImg sebagai berikut: F_Main.PAS 01 type 02 TFormMain = class(TForm) 03 MainMenu1: TMainMenu; 04 MenuFile: TMenuItem; 05 MenuFileOpen: TMenuItem; 06 MenuFileSave: TMenuItem; 07 MenuImage: TMenuItem; 08 MenuImageGrayscale: TMenuItem; Grafika Komputer - Sept 2004

61

09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52

MenuImageInvertColor: TMenuItem; MenuImageLighten: TMenuItem; MenuExit: TMenuItem; Panel1: TPanel; Panel2: TPanel; ImageBuffer: TImage; Gauge1: TGauge; BitBtnUndo: TBitBtn; OpenPictureDialog1: TOpenPictureDialog; SavePictureDialog1: TSavePictureDialog; procedure FormShow(Sender: TObject); procedure MenuFileOpenClick(Sender: TObject); procedure MenuFileSaveClick(Sender: TObject); procedure MenuExitClick(Sender: TObject); procedure MenuImageClick(Sender: TObject); procedure BitBtnUndoClick(Sender: TObject); end; var FormMain: TFormMain; implementation {$R *.DFM} uses F_Img, F_Light, ImgProc; procedure TFormMain.FormShow(Sender: TObject); var s:string; begin FormImg.Left := 2; FormImg.Top := 2; GetDir (0, s); OpenPictureDialog1.InitialDir := s; SavePictureDialog1.InitialDir := s; end; procedure TFormMain.MenuExitClick(Sender:TObject); begin Close; end;

Grafika Komputer - Sept 2004

62

53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91

procedure TFormMain.MenuFileOpenClick(Sender: TObject); begin if OpenPictureDialog1.Execute then begin FormImg.OpenImage(OpenPictureDialog1.FileName); MenuFileSave.Enabled := true; MenuImage.Enabled := true; end; end; procedure TFormMain.MenuFileSaveClick(Sender:TObject); begin if SavePictureDialog1.Execute then begin FormImg.Image1.Picture.SaveToFile (SavePictureDialog1.FileName); FormImg.Caption := ExtractFileName (SavePictureDialog1.FileName); end; end; procedure TFormMain.MenuImageClick(Sender:TObject); begin ImageBuffer.Picture.Graphic := FormImg.Image1.Picture.Graphic; FormImg.Image1.Canvas.Pen.Mode := pmCOPY; if Sender=MenuImageGrayscale then ImgConvertToGrayscale (FormImg.Image1, Gauge1) else if Sender=MenuImageInvertColor then ImgInvertColor (FormImg.Image1, Gauge1) else if Sender=MenuImageLighten then FormLighten.ShowModal; end; procedure TFormMain.BitBtnUndoClick(Sender:TObject); begin FormImg.Image1.Picture.Graphic := ImageBuffer.Picture.Graphic; end;

Grafika Komputer - Sept 2004

63

F_Img.PAS 01 type 02 TFormImg = class(TForm) 03 Image1: TImage; 04 public 05 procedure OpenImage (FileName: string); 06 end; 07 08 var 09 FormImg: TFormImg; 10 11 implementation 12 13 uses F_main,ImgProc; 14 15 {$R *.DFM} 16 17 procedure TFormImg.OpenImage (FileName: string); 18 begin 19 Caption := ExtractFileName (FileName); 20 Image1.Picture.LoadFromFile (FileName); 21 WindowState := wsNormal; 22 ClientWidth := Image1.Width; 23 ClientHeight := Image1.Height; 24 end;

Menu Convert to Grayscale dan Invert Color menghasilkan citra berikut:

Convert Grayscale

Grafika Komputer - Sept 2004

Invert Color

64

Menu Lightening menampilkan FormLighten sebagai berikut: SpinEditUpDown

ButtonGoLD EditBrightnessFac

tor

ButtonGoBrightnes s

Isi event dalam FormLighten sebagai berikut: F_Light.PAS 01 type 02 TFormLighten = class(TForm) 03 GroupBox1: TGroupBox; 04 GroupBox2: TGroupBox; 05 GroupBox3: TGroupBox; 06 RadioButtonBrightMul: TRadioButton; 07 RadioButtonBrightPow: TRadioButton; 08 09 SpinEditUpDown: TSpinEdit; 10 EditBrightnessFactor: TEdit; 11 12 ButtonGoLD: TButton; 13 ButtonGoBrightness: TButton; 14 BitBtnClose: TBitBtn; 15 BitBtnUndo: TBitBtn; 16 17 CheckBoxR: TCheckBox; 18 CheckBoxG: TCheckBox; 19 CheckBoxB: TCheckBox; 20 Label1: TLabel; 21 Label2: TLabel; 22 procedure ButtonGoLDClick(Sender: TObject); 23 procedure ButtonGoBrightnessClick(Sender:TObject); Grafika Komputer - Sept 2004

65

24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67

procedure BitBtnUndoClick(Sender: TObject); end; var FormLighten: TFormLighten; implementation uses F_Img, F_Main, ImgProc; {$R *.DFM} procedure TFormLighten.ButtonGoLDClick(Sender:TObject); var r,g,b: integer; begin r:=0; g:=0; b:=0; if CheckBoxR.Checked then r := SpinEditUpDown.Value; if CheckBoxG.Checked then g := SpinEditUpDown.Value; if CheckBoxB.Checked then b := SpinEditUpDown.Value; ImgAdd (FormImg.Image1, r,g,b, FormMain.Gauge1); end; procedure TFormLighten.ButtonGoBrightnessClick (Sender:TObject); var r,g,b: real; begin r:=1; g:=1; b:=1; if CheckBoxR.Checked then r := StrToFloat(EditBrightnessFactor.Text); if CheckBoxG.Checked then g := StrToFloat(EditBrightnessFactor.Text); if CheckBoxB.Checked then b := StrToFloat(EditBrightnessFactor.Text); if RadioButtonBrightMul.Checked then ImgMul (FormImg.Image1, r,g,b, FormMain.Gauge1) else ImgPow (FormImg.Image1, r,g,b, FormMain.Gauge1) end;

Grafika Komputer - Sept 2004

66

68 69 70 71 72

procedure TFormLighten.BitBtnUndoClick(Sender:TObject); begin FormImg.Image1.Picture.Graphic := FormMain.ImageBuffer.Picture.Graphic; end;

Beberapa citra hasil proses dalam FormLighten adalah sebagai berikut:

Lighten -50

Lighten 50

Brightness Multiply 1.5

Brightness Power 1.3

Semua procedure pengolahan citra diletakkan dalam unit ImgProc. ImgProc.PAS 01 unit ImgProc; 02 03 interface 04 05 uses 06 WINPROCS, Graphics, ExtCtrls, Gauges; Grafika Komputer - Sept 2004

67

07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50

function RgbToGray (Clr:TColor) : byte; function ByteRange (r:double) : byte; procedure ImgConvertToGrayscale ( var Image1:TImage; var Gauge:TGauge); procedure ImgInvertColor (var Image1:TImage; var Gauge:TGauge); procedure ImgAdd (var Image1:TImage; dr,dg,db:integer; var Gauge:TGauge); procedure ImgMul (var Image1:TImage; mr,mg,mb:real; var Gauge:TGauge); procedure ImgPow (var Image1:TImage; pr,pg,pb:real; var Gauge:TGauge); implementation const PercentR = 0.299; PercentG = 0.587; PercentB = 0.114; function ByteRange (r:double) : byte; begin if r<0 then ByteRange:=0 else if r>255 then ByteRange:=255 else ByteRange:=Round(r); end; function Pow (x,n:double) : double; begin if x=0 then Pow := 0 else Pow := Exp (n*Ln(x)); end; procedure GaugeStart (var Gauge:TGauge; n:longint); begin Gauge.MaxValue := n; Gauge.Progress := 0; end; procedure GaugeStop (var Gauge:TGauge);

Grafika Komputer - Sept 2004

68

51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94

begin Gauge.Progress := Gauge.MaxValue; end; procedure GaugeProgress (var Gauge:TGauge; var Image1:TImage; n:longint); begin if n mod 20 = 0 then begin Image1.Repaint; Gauge.Progress := n; end; end; function RgbToGray (Clr:TColor) : byte; var r,g,b:byte; begin r := GetRValue(Clr); g := GetGValue(Clr); b := GetBValue(Clr); RgbToGray := ByteRange (r*PercentR + g*PercentG + b*PercentB); end; procedure ImgConvertToGrayscale ( var Image1:TImage; var Gauge:TGauge); var x,y:integer; Clr:TColor; ClrGray:byte; begin GaugeStart (Gauge, Image1.Width-1); for x:=0 to Image1.Width-1 do begin for y:=0 to Image1.Height-1 do begin Clr := Image1.Canvas.Pixels[x,y]; ClrGray := RgbToGray (Clr); Image1.Canvas.Pixels[x,y] := RGB (ClrGray,ClrGray,ClrGray); end; GaugeProgress (Gauge, Image1, x); end; GaugeStop (Gauge); end; procedure ImgInvertColor (var Image1:TImage;

Grafika Komputer - Sept 2004

69

95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138

var Gauge:TGauge); var x,y:integer; Clr:TColor; r,g,b:byte; begin GaugeStart (Gauge, Image1.Width-1); for x:=0 to Image1.Width-1 do begin for y:=0 to Image1.Height-1 do begin Clr := Image1.Canvas.Pixels[x,y]; r := 255 - GetRValue(Clr); g := 255 - GetGValue(Clr); b := 255 - GetBValue(Clr); Image1.Canvas.Pixels[x,y] := RGB (r,g,b); end; GaugeProgress (Gauge, Image1, x); end; GaugeStop (Gauge); end; procedure ImgAdd (var Image1:TImage; dr,dg,db:integer; var Gauge:TGauge); var x,y:integer; Clr:TColor; r,g,b:byte; begin GaugeStart (Gauge, Image1.Width-1); for x:=0 to Image1.Width-1 do begin for y:=0 to Image1.Height-1 do begin Clr := Image1.Canvas.Pixels[x,y]; r := ByteRange (GetRValue(Clr) + dr); g := ByteRange (GetGValue(Clr) + dg); b := ByteRange (GetBValue(Clr) + db); Image1.Canvas.Pixels[x,y] := RGB (r,g,b); end; GaugeProgress (Gauge, Image1, x); end; GaugeStop (Gauge); end; procedure ImgMul (var Image1:TImage; mr,mg,mb:real; var Gauge:TGauge); var x,y:integer; Clr:TColor; r,g,b:byte;

Grafika Komputer - Sept 2004

70

139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177

begin GaugeStart (Gauge, Image1.Width-1); for x:=0 to Image1.Width-1 do begin for y:=0 to Image1.Height-1 do begin Clr := Image1.Canvas.Pixels[x,y]; r := ByteRange (GetRValue(Clr) * mr); g := ByteRange (GetGValue(Clr) * mg); b := ByteRange (GetBValue(Clr) * mb); Image1.Canvas.Pixels[x,y] := RGB (r,g,b); end; GaugeProgress (Gauge, Image1, x); end; GaugeStop (Gauge); end; procedure ImgPow (var Image1:TImage; pr,pg,pb:real; var Gauge:TGauge); var x,y:integer; Clr:TColor; r,g,b:byte; begin GaugeStart (Gauge, Image1.Width-1); for x:=0 to Image1.Width-1 do begin for y:=0 to Image1.Height-1 do begin Clr := Image1.Canvas.Pixels[x,y]; r := ByteRange (Pow (GetRValue(Clr), pr)); g := ByteRange (Pow (GetGValue(Clr), pg)); b := ByteRange (Pow (GetBValue(Clr), pb)); Image1.Canvas.Pixels[x,y] := RGB (r,g,b); end; GaugeProgress (Gauge, Image1, x); end; GaugeStop (Gauge); end; end.

Grafika Komputer - Sept 2004

71