Pembuatan form pembelian dimana nantinya didalan form itu ada pemilihan tanggal, bulan dan tahun yang mana di buat dengan perulangan. Kemudian ada pemilihan kode barang dan diikuti dengan munculnya nama barang dan harga yang di mana merupakan metode percabangan.
Berikut tampilan seluruhnya
berikut design tampilan form
kode nya adalah
unit pembelian;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls;
type
{ TfrmPembelian }
TfrmPembelian = class(TForm)
cmbTanggal: TComboBox;
cmbBulan: TComboBox;
cmbTahun: TComboBox;
cmbKode: TComboBox;
Label9: TLabel;
txtJumlah: TEdit;
txtNota: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
txtNama: TEdit;
txtHarga: TEdit;
txtTotal: TEdit;
txtBayar: TEdit;
txtKembalian: TEdit;
procedure cmbBulanChange(Sender: TObject);
procedure cmbKodeChange(Sender: TObject);
procedure cmbTahunChange(Sender: TObject);
procedure cmbTanggalChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure txtBayarExit(Sender: TObject);
procedure txtBayarKeyPress(Sender: TObject; var Key: char);
procedure txtJumlahExit(Sender: TObject);
procedure txtJumlahKeyPress(Sender: TObject; var Key: char);
private
{ private declarations }
public
{ public declarations }
end;
var
frmPembelian: TfrmPembelian;
implementation
procedure TfrmPembelian.FormCreate(Sender: TObject);
var
i,j,l:integer;
begin
cmbtanggal.Items.Clear;
for i:=1 to 31 do
begin
cmbtanggal.Items.add(inttostr(i));
end;
cmbbulan.Items.clear;
for j:=1 to 12 do
begin
cmbbulan.items.Add(inttostr(j));
end;
cmbtahun.Items.clear;
for l:=2000 to 2999 do
begin
cmbtahun.items.Add(inttostr(l));
end;
end;
procedure TfrmPembelian.txtBayarExit(Sender: TObject);
begin
if txtbayar.Text='' then txtbayar.Text:='0'; //mengatasi error karena txtbayar belum diisi
if txttotal.Text='' then txttotal.Text:='0'; //error itu cuma terjadi di linux, kalau dijalankan di windows ga error
if strtofloat(txtbayar.Text) < strtofloat(txttotal.Text) then
MessageDlg('Maaf bayarnya kurang dari total.', mtInformation, [mbOK], 0)
else
txtkembalian.Text:=floattostr(strtofloat(txtbayar.Text)-strtofloat(txttotal.Text));
txtbayar.SetFocus;
end;
procedure TfrmPembelian.txtBayarKeyPress(Sender: TObject; var Key: char);
begin
if not ( Key in ['0'..'9', #8] ) then Key := #0;
end;
//jika txtjumlah tidak fokus atau kursor di tempat lain maka lakukan perkalian
procedure TfrmPembelian.txtJumlahExit(Sender: TObject);
begin
if txtjumlah.Text='' then
begin
MessageDlg('Maaf Jumlah pembelian belum diisi.', mtInformation, [mbOK], 0);
txtjumlah.SetFocus;
end
else
txttotal.Text:=floattostr(strtofloat(txtharga.Text)*strtofloat(txtjumlah.Text));
txtbayar.SetFocus;
end;
//txtjumlah wajib di isi angka kalau tidak diabaikan
procedure TfrmPembelian.txtJumlahKeyPress(Sender: TObject; var Key: char);
begin
if not ( Key in ['0'..'9', #8] ) then Key := #0;
end;
//ini jika terjadi perubahan text di combo kode
procedure TfrmPembelian.cmbKodeChange(Sender: TObject);
begin
if cmbkode.Text='A1' then
begin
txtnama.Text:='Sabun Mandi';
txtharga.Text:='2500';
end
else
if cmbkode.Text='A2' then
begin
txtnama.Text:='Durian';
txtharga.Text:='10000';
end
else
if cmbkode.Text='A3' then
begin
txtnama.Text:='Susu';
txtharga.Text:='5000';
end;
txtjumlah.SetFocus;
end;
//memindahkan kursor
procedure TfrmPembelian.cmbTahunChange(Sender: TObject);
begin
cmbkode.SetFocus;
end;
procedure TfrmPembelian.cmbBulanChange(Sender: TObject);
begin
cmbtahun.SetFocus;
end;
procedure TfrmPembelian.cmbTanggalChange(Sender: TObject);
begin
cmbbulan.SetFocus;
end;
initialization
{$I pembelian.lrs}
end.
Keterangan:
pada procedure TfrmPembelian.txtBayarExit terdapat script jika txtbayar.text='' maka txtbayar.text='0' dan di bawah ini untuk mengatasi error jika di compile di linux, kaau di compile di windows script diatas yang di perlukan dan tidak berpengaruh. Dan penjelasan sedikit udah saya masukkan di dalam script dengan memberikan tanda // semoga dapat membantu memahaminya.
Kemudian untuk txtnama, txtharga dan txtkembalian saya ubah enablenya menjadi flase karena hanya untuk dilihat bukan untuk di inputkan