Proses Variabel, Logika, Looping dan Operasional Form

Contoh pertama:

//nilai awal

procedure tform1.cmulaiclick(sender:tobject);

begin

tlm.text:=’’;

thk.text:=’’;

tjumlah.text:=’’;

tlm.setfocus() // fokus

end;

procedure tform1.formcreate(sender:tobject);

begin

tjumlah.enabled:=false; //tidah aktif

tjumlah.color:=clbtnface; //warna form standar

end;

procedure tform1.thkchange(sender:tobject);

var sjml:string[30];

tsem:integer;

slm,shk,sjumlah:single;

begin

val(tlm.text, slm, tsem); //konversi dari huruf ke angka

val(thk.text, shk, tsem); //konversi dari huruf ke angka

sjumlah:=slm*shk;

str(sjumlah:30:0,sjml); //konversi dari angka ke huruf

tjumlah.text:=sjml; //menyimpan nilai ke text

end;

procedure tform1.cbatal(sender:tobject);

begin

formcreate(sender); // menjalankan formcreate

tlm.setfocus(); // fokus

end;

procedure tform1.cselesai(sender:tobject);

begin

application.terminate; //menutup aplikasi atau close; //menutup form

end;

Contoh kedua:

procedure tform1.thkchange(sender:tobject);

var sjml, sds, sbyr :string[30];

tsem:integer;

slm,shk,sjumlah,sdis,sbayar:single;

begin

val(tlm.text, slm, tsem); //konversi dari huruf ke angka

val(thk.text, shk, tsem); //konversi dari huruf ke angka

sjumlah:=slm*shk;

str(sjumlah:30:0,sjml); //konversi dari angka ke huruf

tjumlah.text:=sjml; //menyimpan nilai ke text

//syarat kondisi if

If sjumlah>=100000 then

Sdis:=sjumlah*0.1

Else

Sdis:=0; //akhir kondisi if

Sbayar:=sjumlah-sdis;

Str(sdis:30:0,sds);

Str(sbayar:30:0,sbyr);

Tdis.text:=sds;

Tbayar.text:=sbyr;

end;

Contoh ketiga:

procedure tform1.thkchange(sender:tobject);

var sjml, sds, skdis, sbyr :string[30];

tsem:integer;

slm,shk,sjumlah,sdis,sbayar:single;

begin

val(tlm.text, slm, tsem); //konversi dari huruf ke angka

val(thk.text, shk, tsem); //konversi dari huruf ke angka

sjumlah:=slm*shk;

str(sjumlah:30:0,sjml); //konversi dari angka ke huruf

tjumlah.text:=sjml; //menyimpan nilai ke text

//syarat kondisi if

If sjumlah>=100000 then

begin

Sdis:=sjumlah*0.1;

Skdis:=’dapat diskon’;

end

Else

begin

Sdis:= 0;

Skdis:=’tak dapat diskon’;

End; //akhir kondisi if

Sbayar:=sjumlah-sdis;

Str(sdis:30:0,sds);

Str(sbayar:30:0,sbyr);

Tdis.text:=sds;

Tkdis.text:=skdis;

Tbayar.text:=sbyr;

end;

Contoh keempat: //IF , RADIO BUTTON ATAU CHECK BOX

procedure Tform1.thkChange(Sender: TObject);

var sjml, sds, skdis, sbyr :string[30];

tsem:integer;

slm,shk,sjumlah,sdis,sbayar:single;

begin

val(tlm.text, slm, tsem); //konversi dari huruf ke angka

val(thk.text, shk, tsem); //konversi dari huruf ke angka

sjumlah:=slm*shk;

str(sjumlah:30:0,sjml); //konversi dari angka ke huruf

tjumlah.text:=sjml; //menyimpan nilai ke text

//syarat kondisi if dengan radio button atau check box

If pil1.Checked=true then

Sdis:=sjumlah*0.1;

Else

If pil2.Checked=true then

Sdis:=sjumlah*0.2;

else

Sdis:= 0; //akhir kondisi if

If pil1.checked or pil2.checked then

Skdis:=’dapat diskon’;

Else

Skdis:=’tak dapat diskon’; //akhir kondisi if

Sbayar:=sjumlah-sdis;

Str(sdis:30:0,sds);

Str(sbayar:30:0,sbyr);

Tdis.text:=sds;

Tkdis.text:=skdis;

Tbayar.text:=sbyr;

end;

Contoh kelima: //CASE OF

procedure Tform1.thkChange(Sender: TObject);

var sjml, sds, skdis, sbyr :string[30];

tsem:integer;

spil:byte;

slm,shk,sjumlah,sdis,sbayar:single;

begin

val(tlm.text, slm, tsem); //konversi dari huruf ke angka

val(thk.text, shk, tsem); //konversi dari huruf ke angka

sjumlah:=slm*shk;

str(sjumlah:30:0,sjml); //konversi dari angka ke huruf

tjumlah.text:=sjml; //menyimpan nilai ke text

val(tpil.Text,spil,tsem);

//syarat kondisi case

case spil of

1:begin

pil1.Checked:=true;

Sdis:=sjumlah*0.1;

end;

Else

begin

pil2.Checked:=true;

Sdis:=0;

End; //akhir kondisi case

end;

if pil1.Checked then

skdis:=’dapat diskon’

else

skdis:=’tak dapat diskon’;

Sbayar:=sjumlah-sdis;

Str(sdis:30:0,sds);

Str(sbayar:30:0,sbyr);

Tdis.text:=sds;

Tkdis.text:=skdis;

Tbayar.text:=sbyr;

end;

Contoh keenam: //FOR TO DO

procedure Tform1.tposisiChange(Sender: TObject);

var Tsem, A, Ss, I, F, Sposisi : integer;

Tss : string[30];

Begin

Val(Tposisi.text, Sposisi, Tsem);

If Sposisi<1 then

Ss:=0

Else

If Sposisi=1 then

Ss:=1

Else

Begin

A:=2;

Ss:=1;

F:=2;

For I:=2 to Sposisi Do

Begin

F:=F*A;

Ss:=Ss+(F-1);

End;

End;

Str(Ss:30,Tss);

Ts.text:=Tss;

End;

Contoh ketujuh: //WHILE DO

procedure Tform1.tposisiChange(Sender: TObject);

var Tsem, A, Ss, I, F, Sposisi : integer;

Tss : string[30];

Begin

Val(Tposisi.text, Sposisi, Tsem);

If Sposisi<1 then

Ss:=0

Else

If Sposisi=1 then

Ss:=1

Else

Begin

A:=2;

Ss:=1;

F:=2;

I:=2;

While I<=Sposisi Do

Begin

F:=F*A;

Ss:=Ss+(F-1);

I:=I+1;

End;

End;

Str(Ss:30,Tss);

Ts.text:=Tss;

End;

Contoh kedelapan: //REPEAT

procedure Tform1.tposisiChange(Sender: TObject);

var Tsem, A, Ss, I, F, Sposisi : integer;

Tss : string[30];

Begin

Val(Tposisi.text, Sposisi, Tsem);

If Sposisi<1 then

Ss:=0

Else

If Sposisi=1 then

Ss:=1

Else

Begin

A:=2;

Ss:=1;

F:=2;

I:=2;

Repeat

F:=F*A;

Ss:=Ss+(F-1);

I:=I+1;

Until I=Sposisi

End;

Str(Ss:30,Tss);

Ts.text:=Tss;

End;

Contoh kesembilan: //COMBOBOX

Procedure tform1.formcreate(sender:tobject);

Begin

Cmbjnsukr.items.clear;

Cmbjnsukr.items.append(‘M’);

Cmbjnsukr.items.append(‘CM’);

Cmbjnsukr.onchange:=Edhrgkonv.onchange; // perubahan pada objek

End;

Procedure tform1.edpanjangchange(sender:tobject);

Var

Lebar, panjang, luas, hrgkonv:single;

Kode:integer;

Begin

If UPPERCASE(cmbjnsukr.text)=’M’ then

hrgkonv:=100

Else

If UPPERCASE(cmbjnsukr.text)=’CM’ then

hrgkonv:=1

Else

begin

Cmbjnsukr.selectall;

Cmbjnsukr.setfocus;

End;

Edhrgkonv.text:=format(‘%8.0n’,[hrgkonv]); // format desimal

Val(edpanjang.text, panjang, kode);

Val(edlebar.text, lebar, kode);

Val(edhrgkonv.text, hrgkonv, kode);

Luas:=(panjang*lebar)*(lebar*hrgkonv);

Edluas.text:=format(‘%20.0n’,[luas]);

End;

Contoh kesepuluh: // SCROLLBAR

Procedure tform1.SBPLchange(sender:tobject);

Begin

Edpl.text:=format(‘%18.0n’,[sbpl.position/100);

End;

Procedure tform1.formcreate(sender:tobject);

Begin

Sbpl.min:=0;

Sbpl.max:=100000;

Sbpl.smallchange:=100;

Sbpl.largechange:=1000;

End;

Contoh kesebelas: //SIMPAN

Procedure tform1.cbatalclick(sender:tobject);

Begin

Formcreate(sender);

Edkdbrg.setfocus();

End;

Procedure tform1.csimpanclick(sender:tobject);

Var

Mreorder, mqty, kode : integer;

Begin

Val(edqty.text, mqty, kode);

Val(edreorder.text, mreorder, kode);

Tbbarang.append; // nama dari table1.name

Tbbarang[‘kdbrg’]:=edkdbrg.text;

Tbbarang[‘nmbrg’]:=ednmbrg.text;

Tbbarang[‘qty’]:=mqty;

Cbatalclick(sender);

End;

Procedure tform1.edkdbrgchange(sender:tobject);

Var

Ada:boolean;

Mreorder, mqty : single;

Begin

If LENGTH(edkdbrg.text)<20 then

Exit;

Ada:tbbarang.findkey([edkdbrg.text]);

If ada then

Begin

Beep;

Edkdbrg.focused;

Edkdbrg.selectall;

Ednmbrg.text:=tbbarang[‘nmbrg’];

Edjenis.text:=tbbarang[‘jenis’];

Mqty:=tbbarang[‘qty’];

Edqty.text:=format(‘%4.0n’, [Mqty]);

Exit;

End

Else

Begin

Showmessage(‘data barang tidak ada’);

Exit;

End;

Contoh keduabelas: //EDIT

Procedure tform1.ceditclick(sender:tobject);

Var

Mreorder, mqty, kode : integer;

Begin

Val(edqty.text, mqty, kode);

Val(edreorder.text, mreorder, kode);

Tbbarang.EDIT; // nama dari table1.name

Tbbarang[‘kdbrg’]:=edkdbrg.text;

Tbbarang[‘nmbrg’]:=ednmbrg.text;

Tbbarang[‘qty’]:=mqty;

Cbatalclick(sender);

End;

Contoh ketigabelas: //HAPUS

Procedure tform1.chapusclick(sender:tobject);

Begin

Tbbarang.DELETE; // nama dari table1.name

Cbatalclick(sender);

End;

Contoh keempatbelas: //CARI dan ditampilkan di GRID

Procedure tform1.ednmbrgchange(sender:tobject);

Begin

With Tbbarang do

Begin

Indexname:=’namabrg’;

Findnearest([ednmbrg.text]); //mencari nama barang

End;

End;

Contoh kelimabelas: //Mencetak & Lihat Layar Data Tabel

1. Merancang Bentuk Report
2. Membuat Qreport (File New, Report (QuickReport) )
3. Tempatkan Ttable
4. Atur report dengan mengklik ganda pada report
5. menampilkan report :
   1. Qrbarang.preview;
   2. Qrbarang.print ;

Contoh keenambelas: //Menginput data tabel hubungan (relasi)

Procedure tform1.formcreate(sender:tobject);

Var i:integer;

Begin

Edtotal.enabled:=true;

Ednmsup.enabled:=true;

Mtotal:=0;

Edtotal.text:=format(“%20.0m”, [mtotal]);

Ednonta.text:=””;

Edkdsup.text:=””;

Ednmsup.text:=””;

Edtglnota.text:=datetostr(now);

Tbstransb.first;

While not tbstransb.eof do

Begin

Tbstransb.delete;

End;

For i:=1 to 20 do

Begin

Tbstransb.append;

Tbstransb[‘kdbrg’]:=’’;

End;

Tbstransb.first;

Beep;

End;

Artinya:

Penentuan nilai awal pada saat form dimuat/dipanggil.

Procedure tform1.dbgstransbkeypress(sender:tobject;Var key:char);

Var ada:boolean;

Jmllama:single;

Jmlbaru:=single;

Begin

If not (key=chr(13)) then exit;

If dbgstransb.selectedindex>1 then begin end;

Artinya:

Event dilaksanakan pada saat user menekan tombol tertentu pada grid, jika tombol enter ditekan maka akan keluar dan jika user memilih field kunatiti beli,

harga beli, jumlah maka program akan tetap.

If dbgstransb.selectedindex=0 then // nama barang

Begin

Tbbarang.indexname:=’barang’;

TRY

Ada:=tbbarang.findkey([uppercase(tbstransb[‘nmbrg’])]);

EXCEPT

Dbgstransb.selectedindex:=1;

End;

Artinya:

Jika memilih field nmbrg maka akan diaktifkan file index dengan nama barang dan mencari data nama barang pada tabel barang, jika proses salah kursor akan difokus pada field kdbrg.

If ada then

Begin

Tbstransb.edit;

Trstransb[‘kdbrg’]:=tbbarang[‘kdbrg’];

Trstransb[‘nmbrg’]:=tbbarang[‘nmbrg’];

Beep;

Dbgstransb.selectedindex:=2;

End

Else

Dbgstransb.selectedindex:=1;

Exit;

End;

Artinya:

Jika kodebarang ketemu maka akan dilakukan proses edit kode barang dan nama barang ke tabel stransb dan kursor difokus ke field harga, tetapi jika kode barang tidak ditemukan maka difokus ke kodebrg.

If dbgstransb.selectedindex=1 then //kode barang

Begin

Tbbarang.indexname:=’’;

TRY

Ada:=tbbarang.findkey([uppercase(tbstransb[‘kdbrg’])]);

EXCEPT

Dbgstransb.selectedindex:=1;

Exit

End;

Artinya:

Jika pada objek grid dbgstransb diplih field kode barang, maka index file dikembalikan ke index kode barang, jika proses salah maka kursor akan difokus ke field kode barang.

If dbgstransb.selectedindex=2 then //harga beli

Begin

Jmllama:=tbstransb.fields[4].as float;

Tbstransb[‘jumlah’]:=tbstransb[‘hrgbeli’]*tbstransb[‘qtybeli’];

Jmlbaru:=tbstransb.fields[4].as float;

Mtotal:=mtotal+(jmlbaru-jmllama);

Edtotal.text:=format(‘%20.2m’, [mtotal]);

Dbgstransb.selectedindex:=3;

Exit

End;

If dbgstransb.selectedindex=3 then //kuantiti beli

Begin

Jmllama:=tbstransb.fields[4].as float;

Tbstransb[‘jumlah’]:=tbstransb[‘hrgbeli’]*tbstransb[‘qtybeli’];

Jmlbaru:=tbstransb.fields[4].as float;

Mtotal:=mtotal+(jmlbaru-jmllama);

Edtotal.text:=format(‘%20.2m’, [mtotal]);

Dbgstransb.selectedindex:=0;

Tbstransb.next;

End;

End; // end procedure

Artinya:

Jika field harga beli dipilih maka akan dihitung jumlah lama dan jumlah baru dari perhitungan harga beli dikali kuantiti beli, kemudian dihitung total dari perhitungan seluruh jumlah. Setelah itu kursor difokus pada field nama barang pada record berikutnya.

Procedure tform1.dbgstransbkeypress(sender:tobject;Var key:char);

Var cektgl:tdatetime;

Begin

TRY

Cektgl:=strtodate(edtglnota.text);

Edkdsup.setfocus;

EXCEPT

Showmessage(‘format tanggal : dd-mm-yyyy’);

Edtglnota.setfocus;

End;

End;

Artinya:

Jika format tanggal tidak sesuai maka difokus ke tanggal nota.

Procedure tform1.csimpanclick(sender:tobject);

Var ada:boolean;

Begin

Tbstransb.first;

Tbbarang.indexname:=’’;

While not tbstransb.eof do

Begin

Ada:=tbbarang.findkey([tbstransb[‘kdbrg’]]);

If ada then

TRY

Begin

Tbtransb.append;

Tbtransb[‘nonota’]:=ednonota.text;

Tbtransb[‘kdbrg’]:= Tbstransb[‘kdbrg’];

Tbtransb[‘qtybeli’]:= Tbstransb[‘qtybeli’];

Tbtransb[‘hrgrg’]:= Tbstransb[‘hrgbrg’];

End;

EXCEPT

Showmessage(‘ednonota.text+’ ,’+edtglnota.text+’,’+tbstransb[‘kdbrg’]

+chr(13)+’sudah ada !!!’);

End;

Tbstransb.next;

End;

Tbtransb.append;

Tbtransb[‘nonota’]:=ednonota.text;

Tbtransb[‘kdbrg’]:= Tbstransb[‘kdbrg’];

Tbtransb[‘qtybeli’]:= Tbstransb[‘qtybeli’];

Tbtransb[‘hrgrg’]:= Tbstransb[‘hrgbrg’];

Formcreate(sender);

End;

Artinya:

Untuk menyimpan dari tabel sementara stransb ke dalam tabel transb.

Procedure tform1.cbatalclick(sender:tobject);

Begin

Formcreate(sender);

End;

Artinya:

Untuk melakukan modul program formcreate.

Procedure tform1.edkdsupchange(sender:tobject);

Var ada:boolean;

Begin

If length(edkdsup.text)<9 then exit;

Ada:=tbsupplier.findkey([edkdsup.text]);

If ada then

Begin

Beep;

Ednmsup.text:=tbsupplier[‘nmsup’];

Dbgstransb.setfocus;

End;

End;

Artinya:

Jika edkdsup dirubah maka jika panjang < 9 digit akan keluar, jika tidak maka dicari di tabel supplier, jika ketemu akan ditampilkan nama supplier pada ednmsup dan kursor difokus ke grid dbgstransb.

Procedure tform1.enmbrgpress(sender:tobject;var key:char);

Begin

If key=chr(13) then

Begin

Tbstransb.edit;

Tbstransb[‘kdbrg’]:=tbbarang[‘kdbrg’];

Tbstransb[‘nmbrg’]:=tbbarang[‘nmbrg’];

Dbgstransb.setfocus;

Dbgstransb.selectedindex:=1;

End;

End;

Procedure tform1.enmbrgchange(sender:tobject;var key:char);

Begin

Tbbarang.index:=’barang’;

Tbbarang.findnearest([enmbrg.text]);

End;

Artinya:

Jika enmbrg dienter maka field kode barang dan nama barang akan diedit dan kursor difokus ke grid dbgstransb pada field kode barang.

Contoh ketujuhbelas: //SQL

Procedure tform1.btampilclick(sender:tobject);

Var mtotal:single;

Begin

TRY

Begin

Qutransb.sql.clear;

If length(edselect.text)=0 then

Qutransb.sql.add(‘select *’)

Else

Qutransb.sql.add(‘select ’+edselect.text);

Qutransb.sql.add(‘from ’+quotedstr(‘c:databorlandprogramtransb.db’));

If length(edwhere.text)>0 then

Qutransb.sql.add(‘where ’+edwhere.text);

If length(edorder.text)>0 then

Qutransb.sql.add(‘order by ’+edorder.text);

Qutransb.open;

Qutransb.first;

Mtotal:=0;

While not qutransb.eof do

Begin

Mtotal:=mtotal+(qutransb.fieldbyname(‘qtybeli’)asfloat* qutransb.fieldbyname(‘hrgbeli’)asfloat);

qutransb.next;

end;

qutransb.first;

edtotal.text:=format(‘%22.0m’, [mtota;]);

end;

EXCEPT

Begin

Beep;

Edtotal.text:=’’;

Showmessage(‘pernyataan sql salah !!!’);

End;

End;

End;

Procedure tform1.edselectchange(sender:tobject);

Begin

Btampil.default:=true;

End;

Procedure tform1.edwherechange(sender:tobject);

Begin

Btampil.default:=true;

End;

Procedure tform1.edorderchange(sender:tobject);

Begin

Btampil.default:=true;

End;

Contoh kedelapanbelas: //setup disk

Langkah:

1. Buat file .exe.
2. Pilih installshield express for delphi dan express for delphi.
3. Pilih a new setup project.
4. Tentukan project name, folder hasil dari setup, create.
5. Pilihan application information, setelah itu tentukan aplikasi, OK.
6. Tentukan komponen Specify installshield objects for delphi dan Specify components and files (tidak tidak terdapat borland delphi)
7. Klik disk builder dan klik bulid
8. Pilih copy to floppy atau pilih disk image kemudian copy selected disk image.