Form Transaksi Penjualan Dengan Delphi 7

Selasa, 10 Maret 20155komentar

Disini saya ingin memberikan sedikit pengetahuan tentang Bagaimana  membuat program aplikasi penjualan. Program kali ini saya menggunakan sebuah database M Access 2007. Saya berharap kalau sobat semua sebelumnya sudah pernah belajar tentang dasar-dasar pemrograman delphi. Supaya sobat nanti bisa mengerti dengan tips kali ini.

- Ada 3 Form : From transaksi, Barang dan Pembayaran.
- No Nota dibikin Auto
- db Access 2007
- dan disini saya coba pake dbgrid 

Contoh Tampilan :




Sourcenya :


function AutoNumber(Q:TAdoQuery;table,key,kode:String;edit:TEdit):String;
var
nomer:Integer;
Kd:String;
begin
with Q do
begin
Close;
SQL.Text:='select * from '+table+'';
Open;
end;
if Q.RecordCount = 0 then nomer:=1 else
if Q.RecordCount > 0 then
begin
with Q do
begin
Close;
SQL.Text:=('select max(right('+key+',10)) as kd from '+table+'');
Open;
end;
nomer:=Q.FieldByName('kd').AsInteger + 1 ;
end;
kd:=inttostr(nomer);
kd:=Copy('0000000000'+kd,length('0000000000'+kd)-9,10);
edit.text :=kode+kd;
end;

procedure TFpenjualan.reset;
var
i:integer;
begin
for i := 0 to ComponentCount -1 do
begin
if (Components[i] is TEdit) and (TEdit(Components[i]).Tag = 0) then
Tedit(Components[i]).Text :=''
end;
tambah.Caption:='Tambah';
Lrp.Caption:='Rp';
total.Caption:='0';

end;

function ambilkanan(Tx:string;Jkar:Integer):String;
var Panjang,q,R,Sisa:Integer;
terbalik,TextBener:string;
begin
panjang:=Length(trim(Tx));
Terbalik:='';
sisa:=Panjang-Jkar;
for q:=panjang downto (sisa+1) do begin
terbalik:=terbalik+tx[q];
end;
textBener:='';
for R:=length(trim(Terbalik)) downto 1 do
begin
textBener:=textbener+terbalik[r];
end;
Result:=TextBener;
end;

procedure TFpenjualan.NoAuto;
var N,Urutan:integer;
Jkarakter:Integer;
kbaru:string[10];
begin
if Q2.RecordCount=0 then N:=1
else begin
Q2.Last;
Urutan:=StrToInt(Ambilkanan(Q2['ID'],8));
N:=Urutan+1;
end;
Jkarakter:=length(Trim(IntToStr(N)));
Case JKarakter of
1: kbaru:='TJ0000000'+trim(IntToStr(N));
2: kbaru:='TJ000000'+trim(IntToStr(N));
3: kbaru:='TJ00000'+trim(IntToStr(N));
4: kbaru:='TJ0000'+trim(IntToStr(N));
5: kbaru:='TJ000'+trim(IntToStr(N));
6: Kbaru:='TJ00'+trim(IntToStr(N));
7: Kbaru:='TJ0'+trim(IntToStr(N));
8: kbaru:='TJ'+trim(IntToStr(N));
end;
//ADOT_MASTER_PENJ.Append;
Enotapenjualan.Text:=kbaru;
//Edit1.SelStart:=Length(KBaru);
//Edit1.SetFocus;


{var TJG, hasil, panjang, coba : string;
I : Integer;

begin if Q2.IsEmpty then
Enotapenjualan.Text := AutoNumber else
begin
Q2.Last;
TJG := Copy(Q2.fieldbyname('ID').AsString,5,1);
I := StrToInt(TJG);
I := I+1;
panjang := IntToStr(I);
hasil := 'TJG0'+ panjang;
Enotapenjualan.text := hasil ;

end; }

{var id, idjadi, nol:string;
begin

nol:='00';

with Q2 do
begin
Q2.SQL.Clear;
Q2.SQL.Add('select * from tb__transaksi order by ID');
Q2.Open;

if Recordcount > 0 then
begin
last;
id:=FieldByname('ID').AsString;
idjadi:=RightStr(id,2);
id:=Inttostr(Strtoint(idjadi)+1);
idjadi:='GAS'+LeftStr(nol,2-length(id))+id;
Enotapenjualan.Text:=idjadi;
end else
begin
Enotapenjualan.Text:='GAS01';
end;
end;}

{var
Yr, Mn, Dy : Word;
NextID : String;
begin
DecodeDate(Now, Yr, Mn, Dy);
Q2.Close;
Q2.SQL.Clear;
Q2.SQL.Add('Select tb__transaksi.ID');
Q2.SQL.Add('From tb__transaksi');
Q2.SQL.Add('Where Month(tb__transaksi.tgl) = ' + inttostr(Mn));
Q2.SQL.Add('Order by tb__transaksi.ID Desc');
Q2.Open;
NextID := copy(Q2.Fields[0].AsString, 6, 3);
If NextID <> '' then NextID := FormatFloat('000', strtoint(NextID) + 1)
else NextID := '001';
Enotapenjualan.text := 'R' + FormatFloat('00', strtoint(copy(inttostr(Yr), 3, 2))) +
FormatFloat('00', Mn) + NextID;

}

end;



procedure TFpenjualan.CreateGrid;

begin
while Q1.RecordCount>0 do
begin
Q1.First;
Q1.Delete;
Q1.Next;
end;
end;

procedure TFPenjualan.keluarClick(Sender: TObject);
begin
Application.Terminate;
end;

procedure TFPenjualan.tambahClick(Sender: TObject);
begin
reset;
CreateGrid;
NoAuto;
{AutoNumber(Q2,'tb__transaksi','ID','GAS.',Enotapenjualan);
procedure TfAuto.genClick(Sender: TObject); }
{var
Yr, Mn, Dy : Word;
kd : String;
begin
DecodeDate(Now, Yr, Mn, Dy);
Q2.Close;
Q2.SQL.Clear;
Q2.SQL.Add('Select Top 1 ID From tb__transaksi');
Q2.SQL.Add('Where Year(tgl)='+ inttostr(Yr));
Q2.SQL.Add('And Month(tgl)='+ inttostr(Mn));
Q2.SQL.Add('Order by ID Desc');
Q2.Open;

kd := copy(Q2.Fields[0].AsString, 8, 5);

If kd <> '' then kd := FormatFloat('00000', strtoint(kd) + 1)
else kd := '00001';

Enotapenjualan.Text := 'JAL'+ FormatFloat('00', Mn) +
FormatFloat('00', strtoint(copy(inttostr(Yr), 3, 2))) + kd;
}end;





procedure TFPenjualan.bayarClick(Sender: TObject);
begin
if bayar.Caption = 'Bayar' then
begin
if Q1.IsEmpty then
begin
Showmessage('belum lakukan transaksi')
end else
Fbayar.Visible:=true;

end else if bayar.Caption = 'Simpan' then
begin
Q2.Append;
Q2.FieldByName('ID').AsString:=enotapenjualan.Text;
Q2.FieldByName('tgl').AsString:=date.Caption;
Q2.FieldByName('namasupplier').AsString:=cbpelanggan.Text;
Q2.FieldByName('jumlahseluruh').AsString:=etotalbayar.Text;
Q2.Post;
Q2.last;


CreateGrid;
NoAuto;
Enotapenjualan.Enabled:=false;
bayar.Caption:='Bayar';
end;
end;



procedure TFPenjualan.deleteClick(Sender: TObject);
begin
if Q1.IsEmpty then
begin
Showmessage('tidak ada transaksi')
end else
if messageDLg('Yakin item akan dihapus?',mtConfirmation,[Mbyes,MBno],0)=Mryes then
begin
Q1.Delete;
end;
end;

procedure TFPenjualan.EhargabeliKeyPress(Sender: TObject; var Key: Char);
begin
if not (key in['0'..'9',#8,#10,#13]) then
Key:=#0;
end;

procedure TFPenjualan.FormShow(Sender: TObject);
begin

//show pelanggan

cbpelanggan.Clear;
Q3.First;
while Q3.Eof = False do
begin
cbpelanggan.Items.Add(Q3.FieldByName('namapelanggan').AsString );
Q3.Next;
end;
cbpelanggan.Text:='';

// bersih tabel transaksi
reset;
CreateGrid;
{NoAuto;}
end;

procedure TFPenjualan.EjumlahKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
var a,b,c,d :real;
begin
if Key = 13 then
begin
if (Ejumlah.Text <> '') and (Ejumlah.Text <>'0') then
begin

Q4.Edit;
Q4['stok']:= Q4['stok']-strtofloat(Ejumlah.Text);
Q4.Post;


a:=strtofloat(Ehargabeli.Text);
b:=strtofloat(Ejumlah.Text);
c:=a*b;

Q1.Append;
Q1.FieldByName('kodetransaksi').AsString:=Ekodebarang.Text;
Q1.FieldByName('namabarang').AsString:=Enamabarang.Text;
Q1.FieldByName('satuan').AsString:=Esatuan.Text;
Q1.FieldByName('harga').AsString:=Ehargabeli.Text;
Q1.FieldByName('jumlah').AsString:=Ejumlah.Text;
Q1.FieldByName('subtotal').AsString:=floattostr(c);
Q1.Post;
Q1.First;

//MENGHITUNG TOTAL
while not Q1.Eof do
begin
d:=d+Q1['subtotal'];
Etotalbayar.Text:=floattostr(d);
total.Caption:=FloatToStr(d);
Q1.Next;
end;
Enamabarang.Clear;
Esatuan.Clear;
Ehargabeli.Clear;
Ejumlah.Clear;

if MessageDlg('Apakah ingin menambah barang?',mtConfirmation,[mbyes,mbno],0)=mrYes then
FcariBarangJual.ShowModal;
end else
Showmessage('Jumlah Belum dimasukan');
end;
end;

procedure TFPenjualan.cariClick(Sender: TObject);
begin
Fcaribarangjual.Showmodal;
end;

procedure TFPenjualan.FormActivate(Sender: TObject);
begin
date.caption:=formatdatetime('dd/mm/yyyy',datetimepicker1.date);
Q2.Active;
end;



procedure TFPenjualan.EkodebarangChange(Sender: TObject);
begin
with Q4 do
begin
Close;
SQL.Clear;
SQL.Text:='select * from tb_databarang where kodebarang like"%'+ekodebarang.Text+'%"';
Open;
end;
end;


procedure TFPenjualan.EtotalbayarChange(Sender: TObject);
begin
Fbayar.Edit1.text:=Etotalbayar.Text;
end;

procedure TFPenjualan.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin

case Key of
VK_ESCAPE:Close;
VK_F4 : cariClick(Sender);
VK_F6 : tambahClick(Sender);
VK_F3 : bayarClick(Sender);
VK_F5 : deleteClick(Sender);
end;
end;

Bagi yang mau aplikasinya Monggo sedot aja di sini,,,

Pass : www.diajarwe.blogspot.com

http://www.4shared.com/rar/FwHuPXajba/transaksi.html




Semoga membantu dan bermanfaat bagi anda semua. Saya ucapkan terima kasih karena sudah berkunjung ke blog yang sederhana ini.
Share this article :

+ komentar + 5 komentar

28 Mei 2016 pukul 13.50

gan link downloadnya error

Anonim
20 Juli 2016 pukul 07.51

link error mas bos

5 Mei 2018 pukul 12.06

Link error mas, klo boleh kirim aplikasi nya via email dong mas, adamsopo@gmail.com

2 Juli 2018 pukul 22.18

kirim code delphi lewat email dong kak buat belajara
email : davidprayogo99@gmail.com

14 Desember 2020 pukul 01.36

min boleh minta aplikasinya soalnya link nya eror juliansyah1271@gmail.com

Posting Komentar

 
Copyright © 2011. DiAjarWe - All Rights Reserved