Dasar Grafik

Dasar grafik procedure TForm1.PrepareDraw; begin Image1.Canvas.Pen.Color := PanelColor.Color; Image1.Canvas.Pen.Width := SpinEditTebal.Value; case RadioGroupBrush.ItemIndex of 0 : Image1.Canvas.Brush.Style := bsSolid; 1 : Image1.Canvas.Brush.Style := bsClear; end; end; procedure TForm1.ButtonGarisClick(Sender: TObject); var i,x1,y1,x2,y2:integer; begin PrepareDraw; x1:=0; y1:=0; x2:=Image1.Width-1; y2:=0; for i:=1 to 60 do begin Image1.Canvas.MoveTo (x1,y1); Image1.Canvas.LineTo (x2,y2); x1 := x1 + 10; y2 := y2 + 10; end; end; procedure TForm1.ButtonSegi4Click(Sender: TObject); var i,x1,y1,x2,y2:integer; begin PrepareDraw; x1:=0; y1:=0; x2:=Image1.Width-1; y2:=Image1.Height-1; for i:=1 to 20 do begin Image1.Canvas.Rectangle (x1,y1,x2,y2); x1 := x1 + 10; y1 := y1 + 10; x2 := x2 - 10; y2 := y2 - 10; end; end; procedure TForm1.ButtonHapusClick(Sender: TObject); begin Image1.Canvas.Brush.Style := bsSolid; Image1.Canvas.Pen.Color := clWhite; Image1.Canvas.Rectangle (0,0,Image1.Width-1,Image1.Height-1); end; procedure TForm1.PanelColorClick(Sender: TObject); begin if ColorDialog1.Execute then PanelColor.Color := ColorDialog1.Color; end;

procedure TForm1.ButtonEllipseClick(Sender: TObject); var i,x1,y1,x2,y2:integer; begin PrepareDraw; x1:=0; y1:=0; x2:=Image1.Width-1; y2:=Image1.Height-1; for i:=1 to 20 do begin Image1.Canvas.Ellipse (x1,y1,x2,y2); x1 := x1 + 10; y1 := y1 + 10; x2 := x2 - 10; y2 := y2 - 10; end; end; Kurva function MyFunc (x:real) : real; begin x := x/180 * PI; Result := Sin (x); end; function XScreen (x,xMin,xMax,W:real) : real; begin Result := (x-xMin)/(xMax-xMin) * W; end; function YScreen (y,yMin,yMax,H:real) : real; begin Result := H - (y-yMin)/(yMax-yMin)*H; end; procedure DrawFunction (var Img:TImage; xMin,xMax,yMin,yMax:real); var x,y,xs,ys:real; begin x := xMin; y := MyFunc (x); xs := XScreen (x,xMin,xMax,Img.Width); ys := YScreen (y,yMin,yMax,Img.Height); Img.Canvas.MoveTo (Round(xs),Round(ys)); while x<=xMax do begin y := MyFunc (x); xs := XScreen (x,xMin,xMax,Img.Width); ys := YScreen (y,yMin,yMax,Img.Height); Img.Canvas.LineTo (Round(xs),Round(ys)); x := x + 0.1; Img.Repaint; end; end; procedure TForm1.ButtonSinClick(Sender: TObject); begin PrepareDraw; DrawFunction (Image1, 0,720, -1.5,1.5); end;

Interpolasi Parabola var nPoint: integer; geser:boolean; iPoint: integer; procedure CalculateCoeff (x1,y1,x2,y2,x3,y3:real; var a,b,c:real); var AA,BB:real; begin AA := x1*x1-x3*x3; BB := x1*x1-x2*x2; b := (BB*(y1-y3) - AA*(y1-y2)) / (BB*(x1-x3) - AA*(x1-x2)); a := ((y1-y2) - b*(x1-x2)) / (x1*x1x2*x2); c := y1 - a*x1*x1 - b*x1; end; procedure TForm1.FormShow(Sender: TObject); begin nPoint := 0; sg.RowCount := {nPoint +} 1; sg.Cells[1,0] := 'x'; sg.Cells[2,0] := 'y'; PrepareDraw; end; procedure TForm1.PrepareDraw; begin Image1.Canvas.Pen.Color := PanelColor.Color; Image1.Canvas.Pen.Width := SpinEditTebal.Value; end; procedure TForm1.ButtonHapusClick(Sender: TObject); begin Image1.Canvas.Brush.Style := bsSolid; Image1.Canvas.Pen.Color := clWhite; Image1.Canvas.Rectangle (0,0,Image1.Width,Image1.Height); {*}if not geser then begin nPoint := 0; sg.RowCount := nPoint + 1; end; PrepareDraw; end; procedure TForm1.PanelColorClick(Sender: TObject); begin if ColorDialog1.Execute then PanelColor.Color := ColorDialog1.Color; end; function MyFunc (a,b,c,x:real) : real; begin Result := a*x*x + b*x + c; end; procedure DrawFunction (var Img:TImage; a,b,c:real);

var x,y:real; begin x := 0; y := MyFunc (a,b,c, x); Img.Canvas.MoveTo (Round(x),Round(y)); while x<=Img.Width do begin y := MyFunc (a,b,c, x); Img.Canvas.LineTo Round(x),Round(y)); x := x + 1; Img.Repaint; end; end; procedure TForm1.ButtonDrawClick(Sender: TObject); var a,b,c:real; begin PrepareDraw; with sg do CalculateCoeff (StrToFloat(Cells[1,1]), StrToFloat(Cells[2,1]), StrToFloat(Cells[1,2]), StrToFloat(Cells[2,2]), StrToFloat(Cells[1,3]), StrToFloat(Cells[2,3]), a,b,c); DrawFunction (Image1, a,b,c); end; procedure TForm1.ButtonSaveClick(Sender: TObject); begin if SavePictureDialog1.Execute then Image1.Picture.SaveToFile (SavePictureDialog1.FileName); end; procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var i:integer; begin Inc (nPoint); if nPoint=4 then begin // cek kena titik ? geser := false; for i:=1 to 3 do if (x>StrToFloat(sg.cells[1,i])-3) and (x<StrToFloat(sg.cells[1,i])+3) and (y>StrToFloat(sg.cells[2,i])-3) and (y<StrToFloat(sg.cells[2,i])+3) then begin geser := true; iPoint := i; nPoint := 3; Exit; end; ButtonHapusClick(Sender); nPoint := 1; end;

sg.RowCount := nPoint sg.Cells[0,nPoint] := sg.Cells[1,nPoint] := sg.Cells[2,nPoint] := Image1.Canvas.Ellipse 2,x+2,y+2);

+ 1; IntToStr(nPoint); IntToStr(x); IntToStr(y); (x-2,y-

if nPoint=3 then ButtonDrawClick(Sender); end; procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var i:integer; begin if geser then begin sg.cells[1,iPoint] := IntToStr(x); sg.cells[2,iPoint] := IntToStr(y); ButtonHapusClick(Sender); {*} for i:=1 to 3 do Image1.Canvas.Ellipse (strtoint(sg.cells[1,i])2,strtoint(sg.cells[2,i])2,strtoint(sg.cells[1,i])+2,strtoint(sg.c ells[2,i])+2); ButtonDrawClick(Sender); end; end; Grafik Sinus 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; function LingkaranA (t:real) : real; begin case Round(t) of 0..90, 180..270, 360 : LingkaranA := 5 else LingkaranA := 8; end; end; function LingkaranB (t:real) : real; begin case Round(t) of 0,15,30,45,60,75,90,105,120,135,150,165 ,180,195,210,225,240,255,270,285,300,315, 330,345,360 : result := 5 else result := 8; end;

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 Image1:TImage); var xs,ys,t,x,y:real; W,H:integer; begin W := Image1.Width; H := Image1.Height; Image1.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; Image1.Canvas.MoveTo(Round(xs),Round (ys)); repeat t := t + dt; KonversiKoordinat (t, FuncT(t), x,y); xs := (x-x1)/(x2-x1) * W; ys := H - (y-y1)/(y2-y1)*H; Image1.Canvas.LineTo(Round(xs) ,Round(ys)); until t>=t2; end; procedure TForm1.Button6Click(Sender: TObject); begin Image1.Canvas.Rectangle(0,0,Image1.Width ,Image1.Height ); Image1.Refresh; end; procedure TForm1.Button1Click(Sender: TObject); begin GambarKurva (Lingkaran, 0,360,1, -10,10,10,10,Image1); end; procedure TForm1.Button4Click(Sender: TObject); begin GambarKurva (Sinus, 0,360,1, -10,10,10,10,Image1); end; procedure TForm1.Button5Click(Sender: TObject); begin GambarKurva (SinCos, 0,360,1, -10,10,10,10,Image1); end; procedure TForm1.Button2Click(Sender: TObject); begin

GambarKurva (LingkaranA, 0,360,1, -10,10,10,10,Image1); end; procedure TForm1.Button3Click(Sender: TObject); begin GambarKurva (LingkaranB, 0,360,1, -10,10,10,10,Image1); end; Fraktal Complex constructor TComplex.Create (r,i:real); begin Init (r,i); end; destructor TComplex.Destroy; begin end; procedure TComplex.Init (r,i:real); begin 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 := C.Mul sq := re := im :=

B; BC.Con; (A,Bc); Sqr(B.re) + Sqr(B.im); C.re / sq; C.im / sq;

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

KurvaC (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; 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; procedure MandelbrotDraw (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 (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, YMaxy*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 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 Result := DataPalet[idx]; end; 3D procedure TObject3D.Normal (var Lx,Ly,Lz:real); var i:byte; MinX,MinY,MinZ:real; begin MinX := Vertex[1].x; 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); 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; 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;