L1 Lampiran 1. Kode Program Aplikasi Proyek_skripsi.dpr program proyek_skripsi; uses Forms, skrp in 'skrp.pas' {FormTampil}, Unit2 in 'Unit2.pas' {FormUtama}, Unit3 in 'Unit3.pas' {FormInput}; {$R *.res} begin Application.Initialize; Application.CreateForm(TFormUtama, FormUtama); Application.CreateForm(TFormTampil, FormTampil); Application.CreateForm(TFormInput, FormInput); Application.Run; end. skrp.pas unit skrp; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Math, ExtCtrls, ComCtrls; type TFormTampil = class(TForm) Memo1: TMemo; cmdExit: TButton; cmdInisial: TButton; cmdFull: TButton; Label1: TLabel; txtAlpha: TEdit; txtBeta: TEdit; txtW: TEdit; txtC1: TEdit; Label3: TLabel; Label4: TLabel; txtC2: TEdit;
L2 Label5: TLabel; Label6: TLabel; txtJum: TEdit; txtKendaraan: TEdit; Label7: TLabel; txtIterasi: TEdit; Label8: TLabel; Image1: TImage; cmdImage: TButton; Label2: TLabel; txtKap: TEdit; ProgressBar1: TProgressBar; Label9: TLabel; txtJarak: TEdit; procedure FormCreate(Sender: TObject); procedure cmdExitClick(Sender: TObject); procedure cmdInisialClick(Sender: TObject); procedure storebest(i: integer); procedure moveParticle(i: integer); procedure cek_fitness(i: integer); procedure cek_partikel(i: integer); procedure tukar(i: integer); procedure cmdFullClick(Sender: TObject); procedure inisialisasi(); function jarak(i,j: integer) : real; procedure cmdImageClick(Sender: TObject); private { Private declarations } public { Public declarations } end; Partikel = class rute : array of integer; urutan : array of integer; fit : real; biaya : array of real; velocity : array of real; lbest : array of integer; urutan_lbest : array of integer; biaya_lbest : array of real; kapasitas : array of real; kapasitas_lbest : array of real; fit_lbest : real; procedure inisial; procedure hitung_biaya; end;
L3
var FormTampil: TFormTampil; waktu : array of array of real; obyek: array of Partikel; c1,c2,w,alpha,beta: real; max_demand : real; max_jarak : real; kendaraan : integer; jmlNode : integer; gbest : array of integer; urutan_gbest : array of integer; biaya_gbest : array of real; kapasitas_gbest : array of real; fit_gbest : real; jmlPartikel : integer; cek : integer; max_iterasi : integer; jmlDemand : real; nosol : boolean; implementation uses unit2,unit3; {$R *.dfm} function TFormTampil.jarak(i,j: integer) : real; var x1,x2,y1,y2 : real; begin x1 := unit3.area[unit3.ptr[i]].x; x2 := unit3.area[unit3.ptr[j]].x; y1 := unit3.area[unit3.ptr[i]].y; y2 := unit3.area[unit3.ptr[j]].y; jarak := sqrt(power(x1-x2,2)+power(y1-y2,2)); end; procedure Partikel.inisial; var i : integer; acak : real; panjang : integer; begin panjang := length(rute); randomize;
L4
//inisialisasi urutan, velocity dan posisi partikel for i := 0 to panjang-1 do begin urutan[i] := i + 1; velocity[i] := (random(1001))/1000; acak := (random(1001))/1000; if acak > velocity[i] then rute[i] := 1 else rute[i] := 0; end; fit_lbest := high(integer); end; procedure Partikel.hitung_biaya; var i,j,k,l : integer; begin fit := 0; for i:=0 to kendaraan-1 do begin biaya[i]:=0; kapasitas[i]:=0; k:=0; for j:=i*jmlNode to ((i*jmlNode)+jmlNode-1) do begin if rute[j] = 1 then begin l:=urutan[j]-jmlNode*i; kapasitas[i]:=kapasitas[i]+unit3.area[unit3.ptr[l]].demand; biaya[i]:=biaya[i]+FormTampil.jarak(k,l); k:=l; end; end; biaya[i]:=biaya[i]+FormTampil.jarak(k,0); fit := fit + biaya[i]; end; end; procedure TFormTampil.inisialisasi(); var i : integer; begin //inisialisasi variabel alpha := strtofloat(txtAlpha.Text); beta := strtofloat(txtBeta.Text);
L5 w := strtofloat(txtW.Text); c1 := strtofloat(txtC1.Text); c2 := strtofloat(txtC2.Text); jmlPartikel := strtoint(txtJum.Text); kendaraan := strtoint(txtKendaraan.Text); max_iterasi := strtoint(txtIterasi.Text); setlength(obyek,jmlPartikel); setlength(waktu,jmlNode+1,jmlNode+1); //inisialisasi maksimum demand dan waktu yang diperbolehkan tiap rute max_demand := strtofloat(txtKap.Text); max_jarak := strtofloat(txtJarak.Text); //inisialisasi obyek for i := 0 to jmlPartikel-1 do begin obyek[i] := Partikel.Create; setlength(obyek[i].rute,jmlNode*kendaraan); setlength(obyek[i].urutan,jmlNode*kendaraan); setlength(obyek[i].biaya,kendaraan); setlength(obyek[i].velocity,jmlNode*kendaraan); setlength(obyek[i].urutan_lbest,jmlNode*kendaraan); setlength(obyek[i].lbest,jmlNode*kendaraan); setlength(obyek[i].biaya_lbest,kendaraan); setlength(obyek[i].kapasitas,kendaraan); setlength(obyek[i].kapasitas_lbest,kendaraan); end; //inisialisasi gbest setlength(gbest,jmlNode*kendaraan); setlength(urutan_gbest,jmlNode*kendaraan); setlength(biaya_gbest,kendaraan); setlength(kapasitas_gbest,kendaraan); fit_gbest := high(integer); end; procedure TFormTampil.FormCreate(Sender: TObject); begin memo1.Lines.Clear; //inisialisasi variabel txtAlpha.Text := '0.3'; txtbeta.Text := '0.7'; txtw.Text := '0.2'; txtc1.Text := '0.3'; txtc2.Text := '0.5';
L6 txtJum.Text := '30'; txtKap.Text := '7'; txtJarak.Text := '999'; txtKendaraan.Text := '2'; txtIterasi.Text := '100'; cek := 0; cmdFull.Enabled := false; cmdImage.Enabled := false; end; procedure TFormTampil.cmdExitClick(Sender: TObject); begin unit2.FormUtama.Show; formTampil.Hide; end; procedure TFormTampil.cmdInisialClick(Sender: TObject); var i : integer; k1,k2 : real; x,y : integer; panjang : integer; rg : TRect; begin memo1.lines.Clear; progressbar1.Smooth := true; //bersihkan kanvas rg.Top := 0; rg.Bottom := Image1.Height; rg.Left := 0; rg.Right := Image1.Width; Image1.Canvas.Brush.Color := clWhite; Image1.Canvas.FillRect(rg); Image1.Canvas.Brush.Color := clBlack; image1.Canvas.Font.Color := clBlack; inisialisasi(); k1 := alpha+beta; k2 := w+c1+c2; if (k1 = 1.0) and (k2 = 1.0) then begin for i:=0 to jmlNode do begin x := 370;
L7 y := 70; x := x+round(unit3.area[unit3.ptr[i]].x*25); y := y-round(unit3.area[unit3.ptr[i]].y*25); if i = 0 then begin image1.Canvas.Brush.Color := clRed; image1.Canvas.Ellipse(x-5,y-5,x+5,y+5); image1.Canvas.Brush.Color := clWhite; panjang := length(unit3.area[unit3.ptr[i]].nama); image1.Canvas.TextOut(x-panjang*3,y+6,unit3.area[unit3.ptr[i]].nama); end else begin image1.Canvas.Brush.Color := clBlack; image1.Canvas.Ellipse(x-4,y-4,x+4,y+4); image1.Canvas.Brush.Color := clWhite; panjang := length(unit3.area[unit3.ptr[i]].nama); if unit3.ptr[i] = 7 then begin x := x-30-panjang; y := y-5; end else if (unit3.ptr[i] = 8) then begin x := x+1; y := y+3; end else if (unit3.ptr[i] = 3) or (unit3.ptr[i] = 4) or (unit3.ptr[i] = 16) or (unit3.ptr[i] = 20) or (unit3.ptr[i] = 25) then begin x := x-panjang*3; y := y-20; end else if unit3.ptr[i] = 10 then begin x := x-panjang*2; y := y+5; end else if unit3.ptr[i] = 6 then begin x := x-panjang; y := y+5; end else begin x := x-panjang*3;
L8 y := y+5; end; image1.Canvas.TextOut(x,y,unit3.area[unit3.ptr[i]].nama); end; end; cmdFull.Enabled := true; end else MessageDlg('Alpha + Beta tidak sama dengan 1 atau W + C1 + C2 tidak sama dengan 1',mtWarning,[mbOK],0); end; procedure TFormTampil.storebest(i: integer); var j : integer; panjang : integer; begin panjang := length(obyek[i].rute); if obyek[i].fit < obyek[i].fit_lbest then begin //simpan nilai lbest obyek[i].fit_lbest := obyek[i].fit; for j:= 0 to panjang - 1 do begin obyek[i].lbest[j] := obyek[i].rute[j]; obyek[i].urutan_lbest[j] := obyek[i].urutan[j]; end; for j:=0 to kendaraan-1 do begin obyek[i].kapasitas_lbest[j] := obyek[i].kapasitas[j]; obyek[i].biaya_lbest[j] := obyek[i].biaya[j]; end; end; //jika nilai lbest lebih kecil dari gbest maka update nilai gbest if obyek[i].fit_lbest < fit_gbest then begin fit_gbest := obyek[i].fit_lbest; for j:= 0 to panjang - 1 do begin gbest[j] := obyek[i].lbest[j]; urutan_gbest[j] := obyek[i].urutan_lbest[j]; end; for j := 0 to kendaraan-1 do begin
L9 biaya_gbest[j] := obyek[i].biaya_lbest[j]; kapasitas_gbest[j] := obyek[i].kapasitas_lbest[j]; end; end; end; procedure TFormTampil.moveParticle(i: integer); var j : integer; panjang : integer; acak : real; vel_l : array of real; vel_g : array of real; begin randomize; setlength(vel_l,jmlNode*kendaraan); setlength(vel_g,jmlNode*kendaraan); panjang := length(obyek[i].velocity); for j := 0 to panjang-1 do begin //update velocity vel_l[j] := (alpha * obyek[i].lbest[j]) + (beta * (1-obyek[i].lbest[j])); vel_g[j] := (alpha * gbest[j]) + (beta * (1-gbest[j])); obyek[i].velocity[j] := (w * obyek[i].velocity[j]) + (c1 * vel_l[j]) + (c2 * vel_g[j]); //update posisi acak := (random(101))/100; if acak > obyek[i].velocity[j] then obyek[i].rute[j] := 1 else obyek[i].rute[j] := 0; end; cek_partikel(i); end; procedure TFormTampil.cek_fitness(i: integer); var j : integer; check : boolean; count : integer; begin randomize; count := 1; repeat cek_partikel(i); check:=true; obyek[i].hitung_biaya;
L 10 for j := 0 to kendaraan-1 do begin if obyek[i].biaya[j] > max_jarak then check := false; if obyek[i].kapasitas[j] > max_demand then check := false; end; if check = false then begin moveParticle(i); end; count := count + 1; if count > 1000 then begin nosol := true; Exit; end; until check = true; obyek[i].hitung_biaya; storebest(i); end; procedure TFormTampil.cmdFullClick(Sender: TObject); var i,j,k : integer; total,total1,total2 : real; route : string; counter : integer; temp : real; begin nosol := false; randomize(); memo1.Lines.Clear; //inisialisasi partikel inisialisasi(); total1 := alpha+beta; total2 := w+c1+c2; if (total1 = 1) and (total2 = 1) then begin for i := 0 to jmlPartikel-1 do begin obyek[i].inisial; obyek[i].hitung_biaya;
L 11 cek_fitness(i); if nosol = true then begin MessageDlg('Tidak ada solusi yang mungkin.'+#13+'Rubah nilai jumlah kendaraan atau maksimum kapasitas atau jarak maksimum',mtWarning,[mbOK],0); Exit; end; storebest(i); end; //jalankan iterasi i := 1; counter := 0; temp := 0; progressbar1.Position := 0; progressbar1.Max := max_iterasi; progressbar1.Step := 1; repeat for j := 0 to jmlPartikel-1 do begin moveParticle(j); obyek[j].hitung_biaya; nosol := false; cek_fitness(j); if nosol = true then begin obyek[i].inisial; obyek[j].hitung_biaya; cek_fitness(j); end; storebest(j); tukar(j); end; if temp = 0 then begin temp := fit_gbest; end else if temp > 0 then begin if fit_gbest < temp then begin temp := fit_gbest; counter := 0; end else counter := counter + 1; end;
L 12 i := i+1; progressbar1.StepIt; until (counter > 30) or (i > max_iterasi); progressbar1.Position := max_iterasi; //cetak biaya total:=0; for j := 0 to kendaraan-1 do begin total := total + biaya_gbest[j]; memo1.Lines.Add(format('jarak gbest kendaraan %0.2f',[j+1,biaya_gbest[j]])); memo1.Lines.Add(format('kapasitas gbest rute %0.2f',[j+1,kapasitas_gbest[j]])); memo1.Lines.Add(''); end; memo1.Lines.Add(format('jarak gbest adalah %0.2f',[total])); memo1.Lines.Add('');
ke-%d
adalah
ke-%d
adalah
for i:=0 to kendaraan-1 do begin if biaya_gbest[i] <> 0 then begin route := unit3.area[0].nama + ' - '; memo1.Lines.Add(format('Rute ke-%d :',[i+1])); for j := i*jmlNode to ((i+1)*jmlNode)-1 do begin if gbest[j] = 1 then begin k := urutan_gbest[j] - i*jmlNode; route := route + unit3.area[unit3.ptr[k]].nama + ' - '; end; end; route := route + unit3.area[0].nama; memo1.Lines.Add(route); memo1.Lines.Add(''); end else begin memo1.Lines.Add(format('Kendaraan ke-%d tidak diperlukan',[i+1])); memo1.Lines.Add(''); end; end; cmdImage.Enabled := true; end
L 13 else MessageDlg('Alpha + Beta tidak sama dengan 1 atau W + C1 + C2 tidak sama dengan 1',mtWarning,[mbOK],0); end; procedure TFormTampil.cek_partikel(i: integer); var j,k : integer; acak : integer; check,check2 : boolean; begin randomize(); if kendaraan = 1 then begin for j := 0 to jmlNode -1 do begin obyek[i].rute[j] := 1; end; end else begin for j:=0 to jmlNode-1 do begin check := false; check2 := false; if obyek[i].rute[j] = 0 then begin for k:=1 to kendaraan-1 do begin if obyek[i].rute[j+k*jmlNode] = 0 then check := true; if obyek[i].rute[j+k*jmlNode] = 1 then begin check := false; check2 := true; end; end; if check = true then begin acak := random(kendaraan); obyek[i].rute[j+acak*jmlNode] := 1; end; if check2 = true then begin acak:=random(kendaraan); for k:=0 to kendaraan-1 do begin
L 14 obyek[i].rute[j+k*jmlNode] := 0; end; obyek[i].rute[j+acak*jmlNode] := 1; end; end; if obyek[i].rute[j] = 1 then begin for k:=0 to kendaraan-1 do begin if obyek[i].rute[j+k*jmlNode] = 1 then check := true; end; if check = true then begin acak:=random(kendaraan); for k:=0 to kendaraan-1 do begin obyek[i].rute[j+k*jmlNode] := 0; end; obyek[i].rute[j+acak*jmlNode] := 1; end; end; end; end; end; procedure TFormTampil.tukar(i: integer); var j,k,l,m,n : integer; temp : integer; panjang : integer; urut,rute : array of integer; v : array of real; a : array of integer; tem : real; cost : array of real; cap : array of real; total1 : real; r : integer; del : real; check : boolean; begin panjang := length(obyek[i].urutan); setlength(rute,panjang); setlength(urut,panjang); setlength(v,panjang);
L 15 setlength(a,jmlNode); for j:=0 to panjang-1 do begin rute[j] := obyek[i].rute[j]; urut[j] := obyek[i].urutan[j]; v[j] := obyek[i].velocity[j]; end; r := 0; repeat for j:=0 to jmlNode-1 do begin repeat check := true; a[j] := random(jmlNode)+1; if j>0 then for k:=0 to j-1 do begin if a[j] = a[k] then check := false; end; until check = true; end; for j:=0 to kendaraan-1 do begin k := j*jmlNode; while k < (j+1)*jmlNode - 1 do begin if k = (j+1)*jmlNode then k := j*jmlNode; l := k-j*jmlNode; m := (j*jmlNode)+a[l]-1; n := (j*jmlNode)+a[l+1]-1; temp := urut[m]; urut[m] := urut[n]; urut[n] := temp; temp := rute[m]; rute[m] := rute[n]; rute[n] := temp; tem := v[m]; v[m] := v[n]; v[n] := tem; k := k + 2; end; end;
L 16 //hitung biaya temp setlength(cost,kendaraan); setlength(cap,kendaraan); check := true; total1 := 0; for j:=0 to kendaraan-1 do begin cost[j] := 0; cap[j] := 0; l:=0; for k:=j*jmlNode to ((j*jmlNode)+jmlNode-1) do begin if rute[k] = 1 then begin m:=urut[k]-jmlNode*j; cap[j]:=cap[j]+unit3.area[unit3.ptr[m]].demand; cost[j]:=cost[j]+jarak(l,m); l:=m; end; end; cost[j]:=cost[j]+jarak(l,0); if cap[j] > max_demand then check := false; if cost[j] > max_jarak then check := false; total1 := total1 + cost[j]; end; if check = true then begin del := total1 - obyek[i].fit; if del < 0 then begin for j:=0 to panjang-1 do begin obyek[i].rute[j] := rute[j]; obyek[i].urutan[j] := urut[j]; end; end; obyek[i].hitung_biaya; cek_fitness(i); storebest(i); end; r := r + 1; until r > 50;//jmlNode*5; end; procedure TFormTampil.cmdImageClick(Sender: TObject);
L 17 var i,j,k : integer; x,y,x1,y1 : integer; rg : TRect; panjang : integer; begin rg.Top := 0; rg.Bottom := Image1.Height; rg.Left := 0; rg.Right := Image1.Width; Image1.Canvas.Brush.Color := clWhite; Image1.Canvas.FillRect(rg); Image1.Canvas.Brush.Color := clBlack; for i:=0 to jmlNode do begin x := 370; y := 70; x := x+round(unit3.area[unit3.ptr[i]].x*25); y := y-round(unit3.area[unit3.ptr[i]].y*25); if i = 0 then begin image1.Canvas.Brush.Color := clRed; image1.Canvas.Ellipse(x-5,y-5,x+5,y+5); image1.Canvas.Brush.Color := clWhite; panjang := length(unit3.area[unit3.ptr[i]].nama); image1.Canvas.TextOut(x-panjang*3,y+6,unit3.area[unit3.ptr[i]].nama); end else begin image1.Canvas.Brush.Color := clBlack; image1.Canvas.Ellipse(x-4,y-4,x+4,y+4); image1.Canvas.Brush.Color := clWhite; panjang := length(unit3.area[unit3.ptr[i]].nama); if unit3.ptr[i] = 7 then begin x := x-30-panjang; y := y-5; end else if (unit3.ptr[i] = 8) then begin x := x+1; y := y+3; end else if (unit3.ptr[i] = 3) or (unit3.ptr[i] = 4) or (unit3.ptr[i] = 16) or (unit3.ptr[i] = 20) or (unit3.ptr[i] = 25) then begin
L 18 x := x-panjang*3; y := y-20; end else if unit3.ptr[i] = 10 then begin x := x-panjang*2; y := y+5; end else if unit3.ptr[i] = 6 then begin x := x-panjang; y := y+5; end else begin x := x-panjang*3; y := y+5; end; image1.Canvas.TextOut(x,y,unit3.area[unit3.ptr[i]].nama); end; end; for i:=0 to kendaraan-1 do begin image1.Canvas.Pen.Color := RGB(random(256),random(256),random(256)); x := 370; y := 70; image1.Canvas.MoveTo(x,y); for j := i*jmlNode to ((i+1)*jmlNode)-1 do begin if gbest[j] = 1 then begin x1 := 370; y1 := 70; k := urutan_gbest[j]-i*jmlNode; x1 := x1+round(unit3.area[unit3.ptr[k]].x*25); k := urutan_gbest[j]-i*jmlNode; y1 := y1-round(unit3.area[unit3.ptr[k]].y*25); image1.Canvas.LineTo(x1,y1); image1.Canvas.MoveTo(x1,y1); end; end; image1.Canvas.LineTo(x,y); MessageDlg(format('rute ke%d',[i+1]),mtInformation,[mbOK],0); end; image1.Canvas.Pen.Color := clBlack; end;
L 19
end. Unit2.pas unit Unit2; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Menus, StdCtrls, ExtCtrls; type TFormUtama = class(TForm) MainMenu1: TMainMenu; mmPSO: TMenuItem; mmPSOCalculate: TMenuItem; mmPSOQuit: TMenuItem; mmAbout: TMenuItem; Label1: TLabel; Label2: TLabel; Label3: TLabel; pAbout: TPanel; pAboutOK: TButton; Memo1: TMemo; mmPSOInput: TMenuItem; procedure mmPSOCalculateClick(Sender: TObject); procedure mmPSOQuitClick(Sender: TObject); procedure pAboutOKClick(Sender: TObject); procedure mmAboutClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure mmPSOInputClick(Sender: TObject); private { Private declarations } public { Public declarations } end; var FormUtama: TFormUtama; implementation uses skrp,unit3;
L 20 {$R *.dfm} procedure TFormUtama.mmPSOCalculateClick(Sender: TObject); begin skrp.FormTampil.show; formUtama.Hide; end; procedure TFormUtama.mmPSOQuitClick(Sender: TObject); begin if messageDlg('Anda yakin mau keluar ?',mtConfirmation,[mbYes,mbNo],0) = mrYes then application.Terminate; end; procedure TFormUtama.pAboutOKClick(Sender: TObject); begin pAbout.Hide; end; procedure TFormUtama.mmAboutClick(Sender: TObject); begin pAbout.Show; pAbout.BringToFront; pAbout.Align := alClient; pAboutOK.SetFocus; end; procedure TFormUtama.FormCreate(Sender: TObject); begin pAbout.Hide; mmPSOCalculate.Enabled := false; end; procedure TFormUtama.mmPSOInputClick(Sender: TObject); begin skrp.FormTampil.cmdFull.Enabled := false; skrp.FormTampil.cmdImage.Enabled := false; unit3.FormInput.show; formUtama.Hide; end; end. Unit3.pas
L 21 unit Unit3; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Math; type Node = class nama : string; x : real; y : real; demand : real; end; TFormInput = class(TForm) cmdExit: TButton; Button1: TButton; CheckBox1: TCheckBox; Label1: TLabel; CheckBox2: TCheckBox; CheckBox3: TCheckBox; CheckBox4: TCheckBox; CheckBox5: TCheckBox; CheckBox6: TCheckBox; CheckBox7: TCheckBox; CheckBox8: TCheckBox; CheckBox9: TCheckBox; CheckBox10: TCheckBox; CheckBox11: TCheckBox; CheckBox12: TCheckBox; CheckBox13: TCheckBox; CheckBox14: TCheckBox; CheckBox15: TCheckBox; CheckBox16: TCheckBox; CheckBox17: TCheckBox; CheckBox18: TCheckBox; CheckBox19: TCheckBox; CheckBox20: TCheckBox; CheckBox21: TCheckBox; CheckBox22: TCheckBox; CheckBox23: TCheckBox; CheckBox24: TCheckBox; CheckBox25: TCheckBox; CheckBox26: TCheckBox; CheckBox27: TCheckBox;
L 22 CheckBox28: TCheckBox; CheckBox29: TCheckBox; CheckBox30: TCheckBox; CheckBox31: TCheckBox; Edit1: TEdit; Edit2: TEdit; Edit3: TEdit; Edit4: TEdit; Edit5: TEdit; Edit6: TEdit; Edit7: TEdit; Edit8: TEdit; Edit9: TEdit; Edit10: TEdit; Edit11: TEdit; Edit12: TEdit; Edit13: TEdit; Edit14: TEdit; Edit15: TEdit; Edit16: TEdit; Edit17: TEdit; Edit18: TEdit; Edit19: TEdit; Edit20: TEdit; Edit21: TEdit; Edit22: TEdit; Edit23: TEdit; Edit24: TEdit; Edit25: TEdit; Edit26: TEdit; Edit27: TEdit; Edit28: TEdit; Edit29: TEdit; Edit30: TEdit; Edit31: TEdit; Label2: TLabel; Label3: TLabel; Label4: TLabel; Button2: TButton; procedure cmdExitClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); private { Private declarations } public
L 23 { Public declarations } end; var FormInput: TFormInput; counter : integer; area : array of node; ptr : array of integer; implementation uses unit2,skrp; {$R *.dfm} procedure TFormInput.cmdExitClick(Sender: TObject); begin unit2.FormUtama.Show; formInput.Hide; end; procedure TFormInput.FormCreate(Sender: TObject); var i : integer; begin skrp.jmlNode := 31; for i := 1 to 31 do TCheckBox(FindComponent('checkbox' + inttostr(i))).Checked := false; setlength(area,jmlNode+1); for i:=0 to jmlNode do begin area[i] := Node.Create; area[i].demand := 0; end; area[0].nama := 'Depot'; area[1].nama := 'Penjaringan'; area[2].nama := 'Tanjung Priok'; area[3].nama := 'Pademangan'; area[4].nama := 'Tambora'; area[5].nama := 'Kelapa Gading'; area[6].nama := 'Cempaka Putih'; area[7].nama := 'Senen'; area[8].nama := 'Sawah Besar'; area[9].nama := 'Taman Sari'; area[10].nama := 'Kemayoran';
L 24 area[11].nama := 'Kota'; area[12].nama := 'Tanah Abang'; area[13].nama := 'Johar Baru'; area[14].nama := 'Pulogadung'; area[15].nama := 'Duren Sawit'; area[16].nama := 'Jatinegara'; area[17].nama := 'Otista'; area[18].nama := 'Kramat Jati'; area[19].nama := 'Pasar Rebo'; area[20].nama := 'Tebet'; area[21].nama := 'Mampang'; area[22].nama := 'Pasar Minggu'; area[23].nama := 'Cilandak'; area[24].nama := 'Kebayoran Lama'; area[25].nama := 'Kebayoran Baru'; area[26].nama := 'Ciputat'; area[27].nama := 'Cengkareng'; area[28].nama := 'Kalideres'; area[29].nama := 'Grogol'; area[30].nama := 'Kebon Jeruk'; area[31].nama := 'Palmerah'; area[0].x := 0; area[0].y := 0; area[1].x := -6; area[1].y := 1; area[2].x := 0; area[2].y := 2; area[3].x := -3; area[3].y := 0; area[4].x := -6; area[4].y := -1; area[5].x := 2; area[5].y := -2; area[6].x := -1; area[6].y := -2.5; area[7].x := -2.5; area[7].y := -2.5; area[8].x := -3.5; area[8].y := -1.5; area[9].x := -4.6; area[9].y := -1.4; area[10].x := -2; area[10].y := -0.8; area[11].x := -4.4; area[11].y := -0.3; area[12].x := -5.5;
L 25 area[12].y := -3.2; area[13].x := -1.5; area[13].y := -3.4; area[14].x := 2.5; area[14].y := -3.6; area[15].x := 2.2; area[15].y := -6.8; area[16].x := -0.5; area[16].y := -6.2; area[17].x := -1.1; area[17].y := -6.9; area[18].x := -1; area[18].y := -9.5; area[19].x := -0.9; area[19].y := -11.2; area[20].x := -2.6; area[20].y := -7.4; area[21].x := -2.8; area[21].y := -8; area[22].x := -4.2; area[22].y := -10.3; area[23].x := -6; area[23].y := -11.1; area[24].x := -8.2; area[24].y := -7.6; area[25].x := -6.1; area[25].y := -7.4; area[26].x := -9; area[26].y := -13.2; area[27].x := -12; area[27].y := 0; area[28].x := -13.5; area[28].y := -0.9; area[29].x := -6.5; area[29].y := -1.9; area[30].x := -8.4; area[30].y := -4.3; area[31].x := -6.7; area[31].y := -5; end; procedure TFormInput.Button1Click(Sender: TObject); var cek : boolean; i : integer; begin
L 26 setlength(ptr,0); counter := 0; for i := 1 to 31 do begin if TCheckBox(FindComponent('checkbox' + inttostr(i))).Checked = true then counter := counter + 1; end; if counter = 0 then begin MessageDlg('Harap pilih daerah untuk pengiriman',mtWarning,[mbOK],0); end else begin skrp.jmlNode := counter; setlength(ptr,skrp.jmlNode+1); counter :=1; ptr[0] := 0; cek := false; for i := 1 to 31 do begin if TCheckBox(FindComponent('checkbox' + inttostr(i))).Checked = true then begin if TEdit(FindComponent('edit'+inttostr(i))).text <> '' then begin ptr[counter] := i; counter:=counter+1; cek := true; area[i].demand := strtofloat(TEdit(FindComponent('edit'+inttostr(i))).text); end else cek := false; end; end; if cek = true then begin MessageDlg('Input Berhasil...',mtInformation,[mbOK],0); unit2.FormUtama.mmPSOCalculate.Enabled := true; end else MessageDlg('Harap masukkan dipilih',mtWarning,[mbOK],0); end; end;
permintaan
procedure TFormInput.Button2Click(Sender: TObject); var
untuk
daerah
yang
L 27 i : integer; begin for i := 1 to 31 do begin TCheckBox(FindComponent('checkbox' + inttostr(i))).Checked := false; TEdit(FindComponent('edit'+inttostr(i))).Text := ''; end; end; end.
