Bagaimana dengan Listing pemrograman delphi menggunakan Procedure, Function dan Array?
Design Form seperti ini :
Listing Program diatas dapat dilihat dibawah ini.. Cekidooot!!!
unit Uarray;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons;
type
TForm4 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
menu: TListBox;
nomer: TEdit;
makanan: TEdit;
harga: TEdit;
jumlah: TEdit;
total: TEdit;
bclose: TBitBtn;
new: TBitBtn;
procedure FormCreate(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure menuClick(Sender: TObject);
procedure newClick(Sender: TObject);
procedure jumlahKeyPress(Sender: TObject; var Key: Char);
procedure nomerKeyPress(Sender: TObject; var Key: Char);
procedure bcloseClick(Sender: TObject);
private
{ Private declarations }
public
procedure bersih;
function ttl(h,j:real):real;
{ Public declarations }
end;
var
Form4: TForm4;
menumakanan:array[1..10] of string;
implementation
{$R *.dfm}
Procedure TForm4.bersih;
begin
nomer.Clear;
makanan.Clear;
harga.Clear;
jumlah.Clear;
total.Clear;
end;
function TForm4.ttl(h,j:real):real;
begin
ttl:=h*j;
end;
procedure TForm4.FormCreate(Sender: TObject);
begin
menumakanan[1]:='Nasi Goreng';
menumakanan[2]:='Bakso';
menumakanan[3]:='Spagheti';
menumakanan[4]:='Mie Ayam';
menumakanan[5]:='Sate Ayam';
menumakanan[6]:='Sate Kambing';
menumakanan[7]:='Steak';
bersih;
end;
procedure TForm4.FormActivate(Sender: TObject);
var i :integer;
begin
nomer.SetFocus;
makanan.Enabled:=false;
harga.Enabled:=false;
for i:= 1 to 10 do
menu.Items.Append(menumakanan[i]);
end;
procedure TForm4.menuClick(Sender: TObject);
begin
makanan.Text:=menu.Items[menu.Itemindex];
case menu.ItemIndex of
0: harga.text:= '7000';
1: harga.text:= '5000';
2: harga.Text:= '12000';
3: harga.Text:= '4500';
4: harga.Text:= '7500';
5: harga.Text:= '9000';
6: harga.text:= '25000';
end;
jumlah.SetFocus;
end;
procedure TForm4.newClick(Sender: TObject);
begin
bersih;
nomer.SetFocus;
end;
procedure TForm4.jumlahKeyPress(Sender: TObject; var Key: Char);
var h,j,totalhrg:real;
begin
if key= #13 then
begin
total.Font.Size:=12;
total.Font.Color:=clblue;
h := strtofloat(harga.text);
j := strtofloat(jumlah.Text);
totalhrg:=ttl(h,j);
total.Text :=floattostr(totalhrg);
end;
end;
procedure TForm4.nomerKeyPress(Sender: TObject; var Key: Char);
begin
if key = #13 then
menu.SetFocus;
end;
procedure TForm4.bcloseClick(Sender: TObject);
begin
if application.MessageBox('Anda Yakin akan keluar','Informasi',mb_yesno)=idyes then
close;
end;
end.
Selasa, 23 April 2013
Perulangan Delphi
Sebelumnya, Silahkan Design Form dibawah ini terlebih dahulu...
Nah sekarang listingnya bisa dilihat dibawah ini:
unit Ulang2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons;
type
TForm2 = class(TForm)
GroupBox1: TGroupBox;
Label1: TLabel;
item: TEdit;
bok: TButton;
Label2: TLabel;
Label3: TLabel;
tanggal: TEdit;
faktur: TEdit;
lbarang: TListBox;
GroupBox2: TGroupBox;
lharga: TListBox;
total: TEdit;
Label4: TLabel;
bclose: TBitBtn;
blagi: TBitBtn;
procedure FormCreate(Sender: TObject);
procedure blagiClick(Sender: TObject);
procedure bokClick(Sender: TObject);
procedure bcloseClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
procedure TForm2.FormCreate(Sender: TObject);
begin
DateSeparator := '-';
ShortDateFormat := 'mm/dd/yyyy';
tanggal.Text := 'Hari ini ' + DateToStr(Date);
end;
procedure TForm2.blagiClick(Sender: TObject);
begin
item.Text :='';
faktur.Text :='';
lbarang.Clear;
lharga.Clear;
total.Text :='';
end;
procedure TForm2.bokClick(Sender: TObject);
var
inputnama : string;
inputharga : string;
i : integer;
j : integer;
harga : real;
begin
harga := 0;
j := 0;
j:= strtoint(item.Text);
if j <= 0 then
begin
showmessage('Data Tidak boleh lebih kecil dari Nol');
exit;
end
else
begin
lbarang.Clear;
lharga.Clear;
for i := 1 to j do
begin
inputnama := inputbox('Input','Ketikan Nama Barang','');
inputharga := inputbox('Input','Ketikan Harga Barang','');
lbarang.Items.Add(inputnama) ;
lharga.Items.Add(inputharga);
harga := harga + strtofloat(inputharga);
end;
end;
total.Text := floattostr(harga);
end;
procedure TForm2.bcloseClick(Sender: TObject);
begin
close;
end;
end.
Senin, 15 April 2013
Percabangan Delphi TOKO SERABI
Tugas minggu ini, Mahasiswa mengerjakan Percabangan Toko Serabi
Perhatikan ya Ketentuan dalam Pembuatan Listing Tersebut :
2. Input Jumlah Beli, Jika Jumlah beli lebih dari 10 maka Diskon 1%
dari Harga dikali dengan jumlah Beli, Selain itu tidak mendapat Diskon
3. Es Juice dengan Harga 7000 dan Es Teh Manis dengan harga 2500
4. Makan Ditempat Gratis dan Delivery Bayar 5000
5. Klik Hitung Maka Akan tampil Total bayar= Keseluruhan Biaya
6. Input uang Bayar makan tampil Uang Kembali
Jika Uang Bayar kurang dari Total maka tampil pesan,
" Uang Bayar Anda Kurang" .. Uang Kembali tidak muncul
dan Kursor kembali ke Uang Bayar.
Uang Kembali = Uang Bayar - Total Bayar
7. Klik Bersih untuk membersihkan Seluruh Text
8. Klik Exit untuk keluar dari program
Dan ini pembahasan atas listing Program Percabangan Diatas:
unit tokoserabi;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm3 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
jenis: TComboBox;
nama: TEdit;
isi: TListBox;
Label5: TLabel;
harga: TEdit;
Label6: TLabel;
jumbel: TEdit;
Label7: TLabel;
diskon: TEdit;
GroupBox1: TGroupBox;
jus: TCheckBox;
teh: TCheckBox;
mjus: TEdit;
mteh: TEdit;
GroupBox2: TGroupBox;
rditempat: TRadioButton;
rdelivery: TRadioButton;
tempat: TEdit;
bhitung: TButton;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
totbay: TEdit;
ubay: TEdit;
ukem: TEdit;
blagi: TButton;
bexit: TButton;
procedure FormCreate(Sender: TObject);
procedure jenisClick(Sender: TObject);
procedure rditempatClick(Sender: TObject);
procedure rdeliveryClick(Sender: TObject);
procedure jusClick(Sender: TObject);
procedure tehClick(Sender: TObject);
procedure isiClick(Sender: TObject);
procedure jumbelKeyPress(Sender: TObject; var Key: Char);
procedure bhitungClick(Sender: TObject);
procedure ubayKeyPress(Sender: TObject; var Key: Char);
procedure bexitClick(Sender: TObject);
procedure blagiClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form3: TForm3;
implementation
{$R *.dfm}
procedure TForm3.FormCreate(Sender: TObject);
begin
jenis.Items.Add('A');
jenis.Items.Add('B');
jenis.Items.Add('C');
end;
procedure TForm3.jenisClick(Sender: TObject);
begin
If jenis.Text ='A' then
begin
nama.Text:='Serabi Manis';
isi.Clear;
isi.Items.Add('Coklat+Keju+Susu');
isi.Items.Add('Pandan+Keju+Pisang');
isi.Items.Add('Coklat+Keju+Pandan');
end
Else
If jenis.Text ='B' then
begin
nama.Text:='Serabi Gurih';
isi.Clear;
isi.Items.Add('Keju+Kacang+Ayam');
isi.Items.Add('Keju+Corned+Telor');
end
Else
begin
nama.Text:='Serabi Pedas';
isi.Clear;
isi.Items.Add('Keju+Ayam+Sosis');
isi.Items.Add('Keju+Oncom+Telor');
end
end;
procedure TForm3.rditempatClick(Sender: TObject);
begin
tempat.Text:='0';
end;
procedure TForm3.rdeliveryClick(Sender: TObject);
begin
tempat.Text :='5000';
end;
procedure TForm3.jusClick(Sender: TObject);
begin
if jus.Checked =true then
mjus.Text:='7000'
else
mjus.Text :='0';
end;
procedure TForm3.tehClick(Sender: TObject);
begin
if teh.Checked =true then
mteh.Text:='2500'
else
mteh.Text :='0';end;
procedure TForm3.isiClick(Sender: TObject);
begin
if jenis.Text ='A' then
begin
if isi.ItemIndex =0 then
harga.Text :='5000'
else if isi.ItemIndex=1 then
harga.Text :='5500'
else if isi.ItemIndex=2 then
harga.Text :='6000'
end
Else if jenis.Text ='B' then
begin
if isi.ItemIndex =0 then
harga.Text :='6500'
else if isi.ItemIndex=1 then
harga.Text :='7000'
end
Else
begin
if isi.ItemIndex =0 then
harga.Text :='7000'
else if isi.ItemIndex=1 then
harga.Text :='5500'
end
end;
procedure TForm3.jumbelKeyPress(Sender: TObject; var Key: Char);
var a,b,c:real;
d:integer;
begin
If key=#13 then
begin
a:=strtofloat(harga.Text);
b:=strtofloat(jumbel.Text);
c:=(a*b)*0.01;
if b>10 then
begin
diskon.Text :=floattostr(c);
end
Else
begin
diskon.Text :='0';
end;
end;
end;
procedure TForm3.bhitungClick(Sender: TObject);
var a,b,c,d,e,f,h:real;
begin
a:=strtofloat(harga.Text);
b:=strtofloat(mjus.Text);
c:=strtofloat(mteh.Text);
d:=strtofloat(tempat.Text);
e:=strtofloat(jumbel.Text);
f:=strtofloat(diskon.Text);
h:=(a*e)+b+c+d-f;
totbay.Text :=floattostr(h);
ubay.SetFocus;
end;
procedure TForm3.ubayKeyPress(Sender: TObject; var Key: Char);
var a,b,c:real;
begin
If key=#13 then
begin
a:=strtofloat(ubay.Text);
b:=strtofloat(totbay.Text);
c:=a-b;
if a < b then
begin
messagedlg('Uang Bayar Anda Kurang! Rp. '+ floattostr(b-a),
mtconfirmation,[MBOK],0);
ubay.Text:='';
ubay.SetFocus;
end
else
begin
ukem.Text :=floattostr(c);
messagedlg('Terima Kasih ',mtconfirmation,[MBOK],0);
end;
end;
end;
procedure TForm3.bexitClick(Sender: TObject);
begin
if (application.MessageBox('Anda Yakin Akan Keluar ?','Informasi',MB_YESNO)=IDYES) then
close;
end;
procedure TForm3.blagiClick(Sender: TObject);
begin
jenis.Text :='';
nama.Text :='';
isi.Clear;
harga.Text :='';
jumbel.Text :='';
diskon.Text :='';
mjus.Text :='';
mteh.Text :='';
jus.Checked:= False;
teh.Checked:= False;
rditempat.Checked :=False;
rdelivery.Checked :=False;
tempat.Text :='';
totbay.Text :='';
ubay.Text :='';
ukem.Text :='';
end;
end.
Percabangan Delphi ( Rumah Sakit Bakti Insan )
Bagaimana dengan Percabangan Rumah Sakit ini?
Liatlah ketentuannya :
1. Gunakan perintah IF, untuk mencari Nama dokter, Spesialis dan Biaya ketika Kode
Dokter dipilih (klik)
Kode Dokter Nama Dokter Spesialis Biaya Periksa
DRD01 dr Oka Penyakit Dalam 2000000
DRJ02 dr Yondra Gangguan Jiwa 1500000
DRM03 dr Wulan Mata 1000000
2. Gunakan Perintah IF , untuk mencari nama obat dan harga obat ketika Kode Obat
diinput lalu diEnter.
Kode Obat Nama Obat Harga Obat
B001 Paracetamol Rp. 10.000
B002 Paratusin Rp. 12.000
B003 Amoxilin Rp. 15.000
3. Total bayar didapat dari harga Obat + harga Dokter.
4. Uang bayar diinput, ketika dienter maka Uang Kembali keluar.
5. Tombol bersih untuk membersihkan seluruh objek.
6. Tombol Keluar untuk keluar dari form.
Terus Bagaimana Dengan Listingnya? Perhatikan !!
unit UBaktiInsan;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm2 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
edokter: TEdit;
cdokter: TComboBox;
espesialis: TEdit;
ebiaya: TEdit;
GroupBox1: TGroupBox;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
eobat: TEdit;
eharga: TEdit;
btotal: TButton;
etotal: TEdit;
Label9: TLabel;
Label10: TLabel;
eubay: TEdit;
eukem: TEdit;
bkeluar: TButton;
bbersih: TButton;
cobat: TEdit;
procedure FormCreate(Sender: TObject);
procedure cdokterClick(Sender: TObject);
procedure cobatKeyPress(Sender: TObject; var Key: Char);
procedure btotalClick(Sender: TObject);
procedure eubayKeyPress(Sender: TObject; var Key: Char);
procedure bkeluarClick(Sender: TObject);
procedure bbersihClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
procedure TForm2.FormCreate(Sender: TObject);
begin
cdokter.Items.Add('DRD01');
cdokter.Items.Add('DRJ02');
cdokter.Items.Add('DRM03');
end;
procedure TForm2.cdokterClick(Sender: TObject);
begin
If cdokter.Text ='DRD01' then
begin
edokter.Text :='dr. Oka';
espesialis.Text :='Penyakit Dalam';
ebiaya.Text:='2000000'
end
Else
If cdokter.Text ='DRJ02' then
begin
edokter.Text :='dr. Yondra';
espesialis.Text :='Gangguan Jiwa';
ebiaya.Text:='1500000'
end
Else
begin
edokter.Text :='dr. Wulan';
espesialis.Text :='Mata';
ebiaya.Text:='1000000'
end
end;
procedure TForm2.cobatKeyPress(Sender: TObject; var Key: Char);
begin
If key=#13 then
If cobat.Text ='B001' then
begin
eobat.Text :='Paracetamol';
eharga.Text :='10000'
end
Else
If cobat.Text ='B002' then
begin
eobat.Text :='Paratusin';
eharga.Text :='12000'
end
Else
If cobat.Text ='B003' then
begin
eobat.Text :='Amoxilin';
eharga.Text :='15000'
end
Else
begin
showmessage('KODE OBAT TIDAK ADA !! ');
cobat.Text :='';
end
end;
procedure TForm2.btotalClick(Sender: TObject);
var a,b,c:real;
begin
a:=strtofloat(eharga.Text);
b:=strtofloat(ebiaya.Text);
c:=a+b;
etotal.Text:=floattostr(c);
eubay.SetFocus;
end;
procedure TForm2.eubayKeyPress(Sender: TObject; var Key: Char);
var a,b,c:real;
begin
If key=#13 then
begin
a:=strtofloat(eubay.Text);
b:=strtofloat(etotal.Text);
c:=a-b;
if a < b then
begin
messagedlg('Uang Bayar Anda Kurang! Rp. '+ floattostr(b-a),mtconfirmation,[MBOK],0);
eubay.Text:='';
eubay.SetFocus;
end
else
begin
eukem.Text :=floattostr(c);
messagedlg('Terima Kasih ',mtconfirmation,[MBOK],0);
end;
end;
end;
procedure TForm2.bkeluarClick(Sender: TObject);
begin
if (application.MessageBox('Anda Yakin Akan Keluar ?','Informasi',MB_YESNO)=IDYES) then
close;
end;
procedure TForm2.bbersihClick(Sender: TObject);
begin
cdokter.Text:='';
edokter.Text:='';
espesialis.Text:='';
eobat.Text:='';
ebiaya.Text:='';
cobat.Text:='';
eharga.Text:='';
etotal.Text:='';
eubay.Text:='';
eukem.Text:='';
end;
end.
Percabangan Delphi
Ketentuan Dari soal ini adalah :
1. Nama Pegawai diinput sendiri.
2. Isi dari Combo Jabatan adalah ’Direktur’ , ’Manager’ , ’Karyawan’.
3. Ketentuan Gaji pokok diambil dari Jabatan sebagai berikut :
3. Ketentuan Gaji pokok diambil dari Jabatan sebagai berikut :
Jabatan Gaji Pokok
Direktur 5000000
Manager 2000000
Karyawan 1000000
Direktur 5000000
Manager 2000000
Karyawan 1000000
4. Tunjangan Status diperoleh dari jenis status :
Jika Status Karyawan ‘Tetap’ maka Tunjangan 30% dari Gaji Pokok
Jika Status Karyawan ‘Honorer’ maka Tunjangan 10% dari Gaji Pokok
Jika Status Karyawan ‘Honorer’ maka Tunjangan 10% dari Gaji Pokok
5. Button Hitung untuk menghitung nilai Gaji Bersih = Gaji Pokok + Tunjangan
6. Button Isi Data Lagi maka seluruh edit text kosong
Dan berikut Listingnya :
unit UNusaIndah;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
enama: TEdit;
ejabatan: TComboBox;
epokok: TEdit;
GroupBox1: TGroupBox;
rtetap: TRadioButton;
rhonorer: TRadioButton;
Label4: TLabel;
etunjangan: TEdit;
btotal: TButton;
Label5: TLabel;
ebersih: TEdit;
blagi: TButton;
bclose: TButton;
procedure FormCreate(Sender: TObject);
procedure ejabatanClick(Sender: TObject);
procedure rtetapClick(Sender: TObject);
procedure rhonorerClick(Sender: TObject);
procedure btotalClick(Sender: TObject);
procedure blagiClick(Sender: TObject);
procedure bcloseClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
ejabatan.Items.Add('Direktur');
ejabatan.Items.Add('Manager');
ejabatan.Items.Add('Karyawan');
end;
procedure TForm1.ejabatanClick(Sender: TObject);
begin
if ejabatan.Text ='Direktur' then
epokok.Text :='5000000'
else if ejabatan.Text ='Manager' then
epokok.Text :='2000000'
else
epokok.Text :='1000000';
end;
procedure TForm1.rtetapClick(Sender: TObject);
var a,hasil:real;
begin
if rtetap.Checked = true then
a:=strtofloat(epokok.Text);
hasil:=a*0.3;
etunjangan.Text :=floattostr(hasil)
end;
procedure TForm1.rhonorerClick(Sender: TObject);
var a,hasil:real;
begin
if rhonorer.Checked = true then
a:=strtofloat(epokok.Text);
hasil:=a*0.1;
etunjangan.Text :=floattostr(hasil)
end;
procedure TForm1.btotalClick(Sender: TObject);
var a,b,c:real;
begin
a:=strtofloat(epokok.Text);
b:=strtofloat(etunjangan.Text);
c:=a+b;
ebersih.Text :=floattostr(c);
end;
procedure TForm1.blagiClick(Sender: TObject);
begin
ejabatan.Text :='';
enama.Text :='';
epokok.Text :='';
ebersih.Text :='';
etunjangan.Text :='';
rtetap.Checked :=false;
rhonorer.Checked :=false;
end;
procedure TForm1.bcloseClick(Sender: TObject);
begin
if (application.MessageBox('Anda Yakin Akan Keluar ?','Informasi',MB_YESNO)=IDYES) then
close;
end;
end.
Dan berikut Listingnya :
unit UNusaIndah;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
enama: TEdit;
ejabatan: TComboBox;
epokok: TEdit;
GroupBox1: TGroupBox;
rtetap: TRadioButton;
rhonorer: TRadioButton;
Label4: TLabel;
etunjangan: TEdit;
btotal: TButton;
Label5: TLabel;
ebersih: TEdit;
blagi: TButton;
bclose: TButton;
procedure FormCreate(Sender: TObject);
procedure ejabatanClick(Sender: TObject);
procedure rtetapClick(Sender: TObject);
procedure rhonorerClick(Sender: TObject);
procedure btotalClick(Sender: TObject);
procedure blagiClick(Sender: TObject);
procedure bcloseClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
ejabatan.Items.Add('Direktur');
ejabatan.Items.Add('Manager');
ejabatan.Items.Add('Karyawan');
end;
procedure TForm1.ejabatanClick(Sender: TObject);
begin
if ejabatan.Text ='Direktur' then
epokok.Text :='5000000'
else if ejabatan.Text ='Manager' then
epokok.Text :='2000000'
else
epokok.Text :='1000000';
end;
procedure TForm1.rtetapClick(Sender: TObject);
var a,hasil:real;
begin
if rtetap.Checked = true then
a:=strtofloat(epokok.Text);
hasil:=a*0.3;
etunjangan.Text :=floattostr(hasil)
end;
procedure TForm1.rhonorerClick(Sender: TObject);
var a,hasil:real;
begin
if rhonorer.Checked = true then
a:=strtofloat(epokok.Text);
hasil:=a*0.1;
etunjangan.Text :=floattostr(hasil)
end;
procedure TForm1.btotalClick(Sender: TObject);
var a,b,c:real;
begin
a:=strtofloat(epokok.Text);
b:=strtofloat(etunjangan.Text);
c:=a+b;
ebersih.Text :=floattostr(c);
end;
procedure TForm1.blagiClick(Sender: TObject);
begin
ejabatan.Text :='';
enama.Text :='';
epokok.Text :='';
ebersih.Text :='';
etunjangan.Text :='';
rtetap.Checked :=false;
rhonorer.Checked :=false;
end;
procedure TForm1.bcloseClick(Sender: TObject);
begin
if (application.MessageBox('Anda Yakin Akan Keluar ?','Informasi',MB_YESNO)=IDYES) then
close;
end;
end.
Langganan:
Postingan (Atom)