Program Rumah Sakit dengan DELPHI 7

Membuat Program Rumah Sakit " Bakti Josua " Dengan Delphi

• Video

 

http://www.youtube.com/watch?v=2SXcu3MVMjo 

Ketentuan Soal :

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	2.000.000
DRJ02	Dr Yondra	Gangguan Jiwa	150.000
DRM03	Dr Wulan	Mata	1.000.000

Gunakan perintah “if” untuk mencari nama obat dan harga obat ketika kode obat diinput lalu di enter..

Kode Obat	Nama Obat	Harga Obat
B001	Paracetamol	10.000
B002	Paratusin	12.000
B003	Amoxilin	15.000

Total bayar didapat dari harga Obat + Harga Dokter (buat fungsi untuk menghitung total.).

Uang bayar diinput, ketika di enter maka uang kembali keluar.

Tombol bersih untuk membersihkan seluruh objek (buat procedure bersih).

Tombol keluar untuk keluar dari form (harus menggunakan message box).

• Form Awal
  
  
  
  
• Form Berjalan
  
  
  
• Listing Code
  
   
  unit Quis;
  
  interface
  
  uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, StdCtrls, Buttons, ExtCtrls;
  
  type
    TForm1 = class(TForm)
      Image1: TImage;
      Ltanggal: TLabel;
      Label2: TLabel;
      Label13: TLabel;
      Label14: TLabel;
      Panel1: TPanel;
      Label3: TLabel;
      Label4: TLabel;
      Label5: TLabel;
      Label6: TLabel;
      CMBkddokter: TComboBox;
      Enmdokter: TEdit;
      Espesialis: TEdit;
      Ebiaya: TEdit;
      Pembayaran: TGroupBox;
      Label7: TLabel;
      Label8: TLabel;
      Label9: TLabel;
      Etotal: TEdit;
      Eppn: TEdit;
      Etotbar: TEdit;
      BBhitung: TBitBtn;
      GroupBox1: TGroupBox;
      Label10: TLabel;
      Label11: TLabel;
      Label12: TLabel;
      Ekdobat: TEdit;
      Enmobat: TEdit;
      Ehrgobat: TEdit;
      Euangbyr: TEdit;
      Euangkmbli: TEdit;
      BBtotal: TBitBtn;
      BBEXIT: TBitBtn;
      Ljam: TLabel;
      Timer1: TTimer;
      Lnama: TLabel;
      Lnim: TLabel;
      Lkeles: TLabel;
      Timer2: TTimer;
      procedure FormCreate(Sender: TObject);
      procedure CMBkddokterChange(Sender: TObject);
      procedure EkdobatKeyPress(Sender: TObject; var Key: Char);
      procedure EkdobatClick(Sender: TObject);
      procedure BBhitungClick(Sender: TObject);
      procedure EuangbyrKeyPress(Sender: TObject; var Key: Char);
      procedure BBEXITClick(Sender: TObject);
      procedure BBtotalClick(Sender: TObject);
      procedure Timer1Timer(Sender: TObject);
      procedure Timer2Timer(Sender: TObject);
    private
      { Private declarations }
    public
      { Public declarations }
      procedure bersih;
      procedure hitung;
    end;
  
  var
    Form1: TForm1;
    biayaP,biayaO,total,PPN,totbar,uangbar,uangkem : real ;
  
  implementation
  
  {$R *.dfm}
  
  procedure TForm1.FormCreate(Sender: TObject);
  begin
  BorderStyle:=bsDialog;
  CMBkddokter.Items.add ('DRD01');
  CMBkddokter.items.add ('DRJ02');
  CMBkddokter.items.Add('DRM03');
  CMBkddokter.Text:= 'Pilih Kode';
  Ekdobat.Text:='Pilih Kode';
  Enmdokter.Enabled:=False;
  Espesialis.Enabled:=False;
  Ebiaya.Enabled:=false;
  Enmobat.Enabled:=False;
  Ehrgobat.enabled:=false;
  
  end;
  
  procedure TForm1.CMBkddokterChange(Sender: TObject);
  begin
  if CMBkddokter.Text='DRD01' then
  begin
  Enmdokter.Text := 'Dr Oka' ;
  ebiaya.Text := '2000000';
  espesialis.Text := 'Penyakit Dalam' ;
  
  end
  
  else if CMBkddokter.Text='DRJ02' then
  begin
  Enmdokter.Text:= 'Dr Yondra';
  Ebiaya.Text := '150000'   ;
  Espesialis.Text := 'Gangguan Jiwa';
  
  end
  
  else if CMBkddokter.Text='DRM03' then
  begin
  enmdokter.Text := 'Dr Wulan';
  ebiaya.Text := '1000000' ;
  Espesialis.Text := 'Mata';
  end   ;
  end;
  
  
  procedure TForm1.EkdobatKeyPress(Sender: TObject; var Key: Char);
  begin
  
   if (key=#13) then
   if (Ekdobat.Text='B001') or (Ekdobat.Text='b001') then
   begin
   Enmobat.Text:= 'Paracetamol';
   Ehrgobat.Text:= '10000';
   BBhitung.SetFocus;
   end
   else if (Ekdobat.Text='B002')  or (Ekdobat.Text='b002')then
   begin
   Enmobat.Text :='Paratusin';
   Ehrgobat.Text:='12000';
   BBhitung.SetFocus;
   end
   else if (Ekdobat.Text='B003') or (Ekdobat.Text='b003') then
   begin
   Enmobat.Text:='Amoxilin';
   Ehrgobat.Text:='15000';
   BBhitung.SetFocus;
   end;
  end;
  
  procedure TForm1.EkdobatClick(Sender: TObject);
  begin
  Ekdobat.Text:='';
  end;
  
  procedure TForm1.BBhitungClick(Sender: TObject);
  begin
    hitung;
  end;
  
  procedure TForm1.EuangbyrKeyPress(Sender: TObject; var Key: Char);
  begin
  if (key=#13) then
  uangbar:= StrToInt(Euangbyr.Text);
  uangkem:= uangbar-totbar ;
  Euangkmbli.Text:= Format('%m',[uangkem])  ;
  Etotbar.Text:= Format('%m',[totbar]);
  end;
  
  procedure TForm1.BBEXITClick(Sender: TObject);
  begin
  if (Application.MessageBox('anda ingin keluar dari program?','konfirmasi',MB_YESNO or MB_ICONQUESTION or MB_DEFBUTTON1)= IDYES) then close;
  end;
  
  procedure TForm1.BBtotalClick(Sender: TObject);
  begin
  bersih
  
  
  end;
  
  procedure TForm1.Timer1Timer(Sender: TObject);
  begin
  Ltanggal.Caption:=FormatDateTime('dd/mm/yyyy',date);
  Ljam.Caption:=FormatDateTime('hh:mm:ss',time);
  end;
  
  procedure TForm1.Timer2Timer(Sender: TObject);
  var
  a1,a2,a3,b1,b2,b3,c1,c2,c3 : string;
  begin
  a1:= Lnama.Caption;
  a2:= Lnim.Caption;
  a3:= Lkeles.Caption;
  b1:= copy(a1,1,1);
  c1:= copy (a1,2,length(a1));
  b2:= copy (a2,2,1);
  c2:= copy (a2,2,length(a2));
  b3:= copy (a3,1,1);
  c3:= copy (a3,2,length(a3));
  Lnama.Caption:= c1+b1;
  Lnim.Caption:=c2+b2;
  Lkeles.Caption:=c3+b3;
  end;
  
  procedure TForm1.bersih;
  begin
  CMBkddokter.Text:='Kode Dokter';
  Enmdokter.Clear;
  Espesialis.clear;
  Ebiaya.Clear;
  Etotal.Clear;
  Eppn.Clear;
  Etotbar.Clear;
  Ekdobat.Text:= 'Kode Obat';
  Enmobat.Clear;
  Ehrgobat.Clear;
  Euangbyr.Clear;
  Euangkmbli.Clear;
  end;
  
  procedure TForm1.hitung;
  begin
  biayaP:= StrToInt(Ebiaya.Text);
  biayaO:= StrToInt(Ehrgobat.Text);
  total:= biayaP + biayaO ;
  Etotal.Text:= Format('%m',[total]);
  PPN:= (total * 0.1) ;
  Eppn.Text:= Format('%m',[ppn]) ;
  totbar:= total + PPN;
  Etotbar.Text:= Format('%m',[totbar]);
  euangbyr.setfocus;
  end;
  
  end.

Program Kasir Cuci Helem

Ini tugas ke 5 DELPHI, dengan sedikit Kreatifitas, Modifikasi dan Penambahan Form

•  Form Awal

• Form Hitung

  

  

• Form Bersih

• Form Keluar

Berikut "Listing Code" nya

  private

    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
harga,total,lama,wangi : real;
implementation

uses Math;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
BorderStyle:=bsDialog;
CMBjenis.Items.add ('Full Face');
CMBjenis.Items.add ('Half Face');
CMBjenis.Text:='Pilih Helem';
Eharga.Enabled:=False;
Etotal.Enabled:=False;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
Ltanggal.Caption:=FormatDateTime('dd/mm/yyyy',date);
Ljam.Caption:=FormatDateTime('hh:mm:ss',time);
end;

procedure TForm1.CMBjenisChange(Sender: TObject);
begin
if (CMBjenis.Text='Full Face') then harga := 30000
else if (CMBjenis.Text='Half Face') then harga := 25000
else;
Eharga.Text :=FormatFloat('#,#',harga );
end;

procedure TForm1.BTNhariClick(Sender: TObject);
begin
if (BTNhari.Checked=true) then lama := 10000;
Ehari.Text := FormatFloat('#,#',lama);
Ejam.Text:='';
end;

procedure TForm1.CwangiClick(Sender: TObject);
begin
if (Cwangi.Checked=true) then wangi := 6000;
Ewangi.Text:= FormatFloat('#,#', wangi);
if (Cwangi.Checked=False) then Ewangi.Text:= '';
end;
          
procedure TForm1.BBbersihClick(Sender: TObject);
begin
Enama.Text:='';
Eharga.Text:='';
Ejam.Text:='';
Ehari.Text:='';
Ewangi.Text:='';
Etotal.Text:='';
CMBjenis.Text:='Jenis Helem';
BTNjam.Checked:=False;
BTNhari.Checked:=False;
Cwangi.Checked:=False;
Enama.SetFocus;
end;

procedure TForm1.BBhitungClick(Sender: TObject);
begin
If (Enama.text='')then
begin
Application.MessageBox('Nama harus di isi.','EROR',MB_OK or MB_ICONEXCLAMATION);
Exit;
end;
if BTNjam.Checked = True then total := harga + lama;
if BTNhari.Checked= True then total := harga + lama;
if Cwangi.Checked = true then total := total + 6000;
Etotal.Text := Format('%m', [total]) ;
end;

procedure TForm1.BTNjamClick(Sender: TObject);
begin
if (BTNjam.Checked=True) then lama := 20000;
Ejam.Text := FormatFloat('#,#',lama);
Ehari.Text :='';
end;


procedure TForm1.BBkeluarClick(Sender: TObject);
begin
if (Application.MessageBox('Tekan Tombol OK Untuk Keluar','EXIT',MB_OKCANCEL or MB_ICONQUESTION or MB_DEFBUTTON1)=ID_OK) then close;
end;

{tambahan}

procedure TForm1.TteksTimer(Sender: TObject);
var
a1,a2,a3,b1,b2,b3,c1,c2,c3 : string;
begin
a1:= Lnama.Caption;
a2:= Lnim.Caption;
a3:= Lkls.Caption;
b1:= copy(a1,1,1);
c1:= copy (a1,2,length(a1));
b2:= copy (a2,1,1);
c2:= copy (a2,2,length(a2));
b3:= copy (a3,1,1);
c3:= copy (a3,2,length(a3));
Lnama.Caption:= c1+b1;
Lnim.Caption:=c2+b2;
Lkls.Caption:=c3+b3;
end;

end.

PERULANGAN

Berikut adalah form "PERULANGAN"
Merupakan kontrol program yang digunakan untuk suatu proses yang akan berjalan terus
menerus. Kondisi perulangan merupakan proses berjalannya program secara terus menerus dan
akan berhenti ketika proses mendapatkan kondisi yang sudah ditentukan.

1. Ketentuan logika Program
   
   • Pada saat form dijalankan maka Tanggal akan keluar secara otomatis
   • No Faktur dan Total item yang dibeli diinput sendiri
   • Tombol OK diklik maka akan keluar kotak pesan (Input box) untuk menginput nama barang dan harga barang yang dibeli. Begitu seterusnya sampai kondisi dari total item terpenuhi.
   • Total Penjualan diperoleh dari penjumlahan harga barang yang dibeli.
   • Tombol Isi data lagi diberikan untuk mengulang pembelian.
   • Close untuk menutup Form
     
2. Properties dan Form
   
   • Properties
   
   
   
   
   • Form Input Nama Barang
     
   
   
   
   •  Form Input Harga Barang
     
   
   
   •  Form Isi Data Lagi
     
     
   • Form Close
   
   
   
   
3. Listing Code
   
   procedure TForm1.FormCreate(Sender: TObject);
   begin
   DateSeparator:='-';
   ShortDateFormat :='mm/dd/yyyy';
   Etgl.Text:= DateToStr(Date);
   end;
   
   procedure TForm1.BlagiClick(Sender: TObject);
   begin
   Eitem.Text:='';
   Efaktur.Text:='';
   Lnama.Clear;
   Lharga.Clear;
   Etotal.Text:='';
   end;
   
   procedure TForm1.BcloseClick(Sender: TObject);
   begin
   if(Application.MessageBox('Yakin Mau udah mau keluar?','Mau keluar',MB_YESNO or MB_ICONQUESTION or MB_DEFBUTTON2)=IDYES)then close;
   end;
   
   
   procedure TForm1.BokClick(Sender: TObject);
   var
   inputnama : string ;
   inputharga:string ;
   i : integer ;
   j : integer ;
   hrg : real ;
   harga : real ;
   
   begin
   harga:=0;
   j:=0;
   j:=StrToInt(Eitem.Text);
   if j<= 0 then
   
   begin
   ShowMessage('Data tidak boleh lebih kecil dari Nol');
   exit;
   end
   else
   
   begin
   for i := 1 to j do
   
   begin
   inputnama := InputBox('INput','Ketik Nama Barang','');
   inputharga := InputBox('INput','Ketik Harga Barang','');
   Lnama.Items.Add(inputnama);
   Lharga.Items.Add(inputharga);
   {Lharga.Items.Text:= Format('%m',[]);  }
   harga:= harga + StrToFloat(inputharga);
   end;
   end;
   Etotal.Text:=FloatToStr(harga);
   Etotal.Text:=Format('%m',[harga]);
   end;
   
   
   procedure TForm1.EitemKeyPress(Sender: TObject; var Key: Char);
   begin
   if (key = #13) then Bok.Click;
   end;
   
   end.

OPERATOR ARITMATIKA, LOGIKA DAN PERBANDINGAN

• FORM AWAL

•  FORM PERBANDINGAN

  

• FORM ARITMATIKA

 

• FORM EXIT 

 

LISTING CODE  :

procedure TForm1.BttambahClick(Sender: TObject);
var
nilai1,nilai2:integer;
hsl:real;
begin
nilai1:=StrToInt(Edit1.Text);
nilai2:=StrToInt(edit2.Text);
hsl:=nilai1+nilai2;
edit3.Text:=FloatToStr(hsl);
end;

procedure TForm1.BtminusClick(Sender: TObject);
begin
n1:=StrToInt(edit1.Text);
n2:=StrToInt(edit2.Text);
hasil:=n1-n2;
edit3.Text:=FloatToStr(hasil);

end;

procedure TForm1.BtbagiClick(Sender: TObject);
begin
edit3.Text:=FloatToStr(StrToInt(edit1.Text)/StrToInt(edit2.Text))
end;

procedure TForm1.BtkaliClick(Sender: TObject);
begin
Edit3.Text:=FloatToStr(StrToInt(edit1.Text)*StrToInt(edit2.Text))
end;

procedure TForm1.BtlebihClick(Sender: TObject);
var
n3:Boolean;
begin
n1:=StrToInt(Edit1.Text);
n2:=StrToInt(edit2.Text);
n3:=n1>n2;
edit3.Text:=BoolToStr(n3);

end;

procedure TForm1.BtkurangClick(Sender: TObject);
var
n3:Boolean;
begin
n1:=StrToInt(Edit1.Text);
n2:=StrToInt(Edit2.Text);
n3:=n1<n2;
Edit3.Text:=BoolToStr(n3);

end;

procedure TForm1.BtsmdgnClick(Sender: TObject);
var
n3:Boolean;

begin
n1:=StrToInt(edit1.Text);
n2:=StrToInt(Edit2.Text);
n3:=n1=n2;
Edit3.Text:=BoolToStr(n3);
end;

procedure TForm1.BttdksamaClick(Sender: TObject);
var
n3:Boolean;
begin
n1:=StrToInt(Edit1.Text);
n2:=StrToInt(Edit2.Text);
n3:=n1<>n2;
Edit3.Text:=BoolToStr(n3);

end;

procedure TForm1.BtandClick(Sender: TObject);
var
n3:Boolean;
begin
n1:=StrToInt(Edit1.Text);
n2:=StrToInt(edit2.Text);
n3:=(n1>n2)AND(n1>5);
edit3.Text:=BoolToStr(n3);
end;

procedure TForm1.BtorClick(Sender: TObject);
var
n3:Boolean;
begin
n1:=StrToInt(Edit1.Text);
n2:=StrToInt(Edit2.Text);
n3:=(n1>n2)OR(n1>5);
edit3.Text:=booltostr(n3);

end;

procedure TForm1.BtxorClick(Sender: TObject);
var
n3:boolean;
begin
n1:=strtoint(edit1.text);
n2:=strtoint(edit2.text);
n3:=(n1>n2)XOR(n1>5);
edit3.Text:=booltostr(n3);

end;

procedure TForm1.BtclearClick(Sender: TObject);
begin
edit1.Text:='';
edit2.Text :='';
edit3.Text:='';
end;

procedure TForm1.BtexitClick(Sender: TObject);
begin
messagedlg
('yakin mau keluar...?',mterror,[mbok],0);
close;
end;

end.

Konversi Karakter ke Ascii (chr)

Fungsi ini digunakan untuk mengkonversi kode Acsii menjad huruf.
Bentuk Umum => Chr (Karakter)

Berikut contohnya :

Listing Codenya adalah :

procedure TForm1.BokClick(Sender: TObject);
var
angka : integer;

begin
angka := strtoint(Eangka.text);
Ehuruf.text:=chr(angka);
end;

procedure TForm1.BexitClick(Sender: TObject);
begin
close;
end;

end.








Simple bukan

" OPERATOR STRING "

" LANGKAH-LANGKAH MEMBUAT OPERATOR STRING 

GABUNG, HAPUS, PANJANG KATA (LENGHT), CARI (POS) DAN COPY " 

• Menggabungkan String

Menggabungkan string adalah proses merangkai dua karakter atau lebih menjadi satu
kalimat atau kata yang baru. Operator string yang dikenal dalam Bahasa Delphi adalah
operator dengan simbol '+' (plus).

• Menghapus Teks

Prosedur standart ini digunakan untuk menghapus atau mengurangi sebagian atau
seluruh karakter terhadap string atau teks.

Bentuk umum penulisan => Delete(teks, index, jumlah)

Delete adalah prosedur standart yang digunakan untuk menghapus teks. Teks
merupakan kalimat atau string yang akan dihapau, Index menunjukan posisi awal yang
akan dihapus. Jumlah menunjukan jumlah karakter yang akan dihapus.

• Mencari Panjang teks (length)

fungsi ini digunakan untuk menghitung panjang atau jumlah karakter dari suatu teks
atau kalimat. Dalam menghitung jumlah karakter dalam suatu teks spasi akan dibaca
sebagai satu karakter. Sebagai catatan hasil yang diperoleh dari perhitungan adalah
bilangan bulat positif.
Bentuk Umum => Length (teks) ;

• Mencari Karakter Pada Teks (POS)

Fungsi ini digunakan untuk mencari letak atau posisi suatu karakter dari suatu nilai
string. Nilai yang dihasilkan adalah berupa byte.
Bentuk Umum => Pos (sustr, string);

• Mengkopi String (Copy)

Fungsi ini digunakan untuk mencetak ulang string atau karakter sebanyak huruf yang
dipilih dengan posisi karakter awal sudah ditentukan.

Bentuk Umum => Copy (teks, index, jumlah);

Penulisan awal diawali dengan perintah copy, dengan diikuti teks yang ditunjukan
teks. Awal pengambilan ditunjukkan dengan index, dan jumlah karakter yang akan
ditulis ulang ditunjukan dengan perintah jumlah.


"LISTING CODE"


procedure TForm1.BgabungClick(Sender: TObject);
var
depan:string[20];tengah:string[20];
akhir:string[20];gabung:string[65];
  nama:string;

begin
depan:=edepan.Text;
tengah:=etengah.Text;
akhir:=eakhir.Text;
gabung:=depan+' '+tengah+' '+akhir;
elengkap.text:=gabung;
  nama:=elengkap.Text;
  epanjang2.Text:=inttostr(length(nama));
end;

procedure TForm1.BOKClick(Sender: TObject);
var
karakter : string ;
pos, jumlah : integer ;
Nama:string;

begin
karakter := elengkap.text;
pos:= strtoint (eurut.Text);
jumlah:= strtoint (ejumlah.Text);
delete (karakter,pos,jumlah);
ehasil.text:= karakter;

    nama:=ehasil.text;
    Epanjang.Text:=inttostr(length(nama));

end;

procedure TForm1.BcloseClick(Sender: TObject);
begin
Close;
end;

procedure TForm1.BcariClick(Sender: TObject);
var
karakter:string;
kar:string;
hasil:integer;

begin
karakter:=elengkap.text;
kar:=ecari.text;
hasil:=pos(kar,karakter);
Eposisi.text:=inttostr(hasil)

end;

procedure TForm1.BcopyClick(Sender: TObject);
var
karakter : string;
begin
karakter:=ehasil.Text;
ecopy1.Text:=copy(karakter,1,4);
ecopy2.Text:=copy(karakter,8,4);
end;

end.

Membuat Program Persegi Panjang dengan Delphi

• Langkah Membuat Program LUAS dan KELILING PERSEGI PANJANG

Kali ini saya akan membuat Program untuk mencari LUAS dan KELILING PERSEGI PANJANG dengan menggunakan applikasi BORLAN DELPHI 7 langkah-langkahnya sangat lah mudah

1. Kita terlebih dahulu membuat Form seperti di bawah ini :
   
   
   
    buat semenarik mungkin sesuai kereasi sobat.
   
   
2. Setelah selesai lalu kita masuk ke Listing Codenya, dengan cara double klik pada tombol "HITUNG", lalu masukan code seperti di bawah ini : 
   
3.   Setelah selesai menuliskan Listing Code diatas program sudah dapat di RUN. Dengan cara klik tombol seperti di bawah ini, atau tekan F9.
   
4.  Jika Listing Code nya tidak ada yang eror maka akan muncul seperti gambar di bawah ini :