Laman

Selamat Datang Sahabat! Selamat ber-sharing Ilmu Komputer

Selasa, 23 April 2013

Array, Procedure and Function

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.

Perulangan Delphi

Nah sekarang kita akan membahas tentang Perulangan pada Delhpi.!!

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 : 
             Jabatan        Gaji Pokok
                 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
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.