Latest: Download Free Desktop Wallpapers of Chef Loony! | Series: AuthorRank? | Download MBT eBooks!

Kumpulan beberapa Procedure Tentang Database

1 komentar

unit UPerintah;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, DB, ZAbstractRODataset, ZAbstractDataset, ZDataset,
SUISkinEngine, Buttons, ExtCtrls, Grids, DBGrids, ComCtrls, SUIButton;

type
TfrmPerintah = class(TForm)
Edit1: TEdit;
ComboBox1: TComboBox;
ZQuery1: TZQuery;
Memo1: TMemo;
suiSkinEngine1: TsuiSkinEngine;
BitBtn1: TBitBtn;
Panel1: TPanel;
DBGrid1: TDBGrid;
Button1: TButton;
ScrollBox1: TScrollBox;
StatusBar1: TStatusBar;
suiButton1: TsuiButton;
procedure batal(x:TForm;y:TEdit);
procedure hapusTableQuery(x:TZQuery;y:TEdit;z:string);
procedure SimpanTableQuery(form:TForm;query:TZQuery;edit:TEdit;sekuel:String;sama:String;queryinsert:TZQuery;sekuelinsert:String);
procedure editkosong(edit:TEdit;kata:string);
procedure memokosong(memo:TMemo;kata:String);
procedure combokosong(combo:TComboBox;kata:string);
procedure showall(query:TZQuery;table:String;urut:String);
procedure LoadCombo(combo:TComboBox;namaquery:TZQuery;isitable:TStringField);
procedure querybebas(query:TZQuery;sekuel:String);
procedure warna(x:TForm);
procedure enter(edit:TEdit; Sender: TObject;var Key: Char);
procedure cmbMati(combo:TComboBox; Sender: TObject;var Key: Char);
procedure cmbMati2(edit:TEdit; Sender: TObject;var Key: Char);
procedure cmbMati3(memo:TMemo; Sender: TObject;var Key: Char);
procedure cmbMati4(button:TBitBtn; Sender: TObject;var Key: Char);
procedure cmbMati5(dtp:TDateTimePicker; Sender: TObject;var Key: Char);
procedure cmbMati6(button:TButton; Sender: TObject;var Key: Char);
procedure edTeks(edit:TEdit; Sender: TObject;var Key: Char);
procedure edTeks2(dtp:TDateTimePicker; Sender: TObject;var Key: Char);
procedure edTeks3(combo:TComboBox; Sender: TObject;var Key: Char);
procedure edTeks4(btn:TSuiButton; Sender: TObject;var Key: Char);
procedure edTeks5(btn:TBitBtn; Sender: TObject;var Key: Char);
procedure cmbTeks(combo:TComboBox; Sender: TObject;var Key: Char);
procedure dtpTgl(dtp:TDateTimePicker; Sender: TObject;var Key: Char);
procedure MemoTeks(memo:TMemo; Sender: TObject;var Key: Char);
procedure edAngka(edit:TEdit; Sender: TObject;var Key: Char);
procedure edAngka2(combo:TComboBox; Sender: TObject;var Key: Char);
procedure edAngka3(buton:TBitBtn; Sender: TObject;var Key: Char);
procedure edAngka4(dtp:TDateTimePicker; Sender: TObject;var Key: Char);
procedure edAngka5(memo:TMemo; Sender: TObject;var Key: Char);
procedure edAngka6(buton:TButton; Sender: TObject;var Key: Char);
procedure warnaGrid(DBGrid:TDBGrid;ZQuery:TZQuery;Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn;State: TGridDrawState);
procedure hapusdata(table:string;nm_table:string;ZQTampil:TZQuery;ZQPenghapus:TZQuery;nm_field:string;datadihapus:string);
procedure FormActivate(Sender: TObject);
procedure deleteTotal(ZQ:TZQuery;nmTable:String);
procedure LoadThn(combo:TComboBox);
private
{ Private declarations }
public
{ Public declarations }
end;

var
frmPerintah: TfrmPerintah;

implementation

uses UUtama, DateUtils;

{$R *.dfm}

procedure TfrmPerintah.hapusdata(table:string;nm_table:string;ZQTampil:TZQuery;ZQPenghapus:TZQuery;nm_field:string;datadihapus:string);
begin
if(ZQTampil.RecordCount=0)then
begin
MessageDlg('Maaf, table '+nm_table+' kosong. Tidak ada data yang bisa anda hapus...!!!!',mtInformation,[mbOK],0);
end
else
if(ZQTampil.RecordCount<>0)then
begin
if(MessageDlg('Yakin data '+nm_table+' dengan '+nm_field+' '+datadihapus+' mau dihapus..??? ',mtConfirmation,[mbYes,mbNo],0)=mrYes)then
begin
ZQPenghapus.Close;
ZQPenghapus.SQL.Clear;
ZQPenghapus.SQL.Add('delete from '+table+' where "'+datadihapus+'"');
ZQPenghapus.ExecSQL;
ZQTampil.Refresh;
end;
end;
end;

procedure TfrmPerintah.enter(edit:TEdit; Sender: TObject;var Key: Char);
begin
if (Key=chr(13)) then edit.SetFocus
end;

procedure TfrmPerintah.cmbMati(combo:TComboBox; Sender: TObject;var Key: Char);
begin
if (Key=chr(13)) then combo.SetFocus
else
if not(key in[Chr(13)]) then key:=#0;
end;

procedure TfrmPerintah.cmbMati2(edit:TEdit; Sender: TObject;var Key: Char);
begin
if (Key=chr(13)) then edit.SetFocus
else
if not(key in[Chr(13)]) then key:=#0;
end;

procedure TfrmPerintah.cmbMati3(memo:TMemo; Sender: TObject;var Key: Char);
begin
if (Key=chr(13)) then memo.SetFocus
else
if not(key in[Chr(13)]) then key:=#0;
end;

procedure TfrmPerintah.cmbMati4(button:TBitBtn; Sender: TObject;var Key: Char);
begin
if (Key=chr(13)) then button.SetFocus
else
if not(key in[Chr(13)]) then key:=#0;
end;

procedure TfrmPerintah.cmbMati5(dtp:TDateTimePicker; Sender: TObject;var Key: Char);
begin
if (Key=chr(13)) then dtp.SetFocus
else
if not(key in[Chr(13)]) then key:=#0;
end;

procedure TfrmPerintah.cmbMati6(button:TButton; Sender: TObject;var Key: Char);
begin
if (Key=chr(13)) then button.SetFocus
else
if not(key in[Chr(13)]) then key:=#0;
end;

procedure TfrmPerintah.edTeks(edit:TEdit; Sender: TObject;var Key: Char);
begin
if not(key in[chr(13),chr(8),'0'..'9','a'..'z','A'..'Z','.',',',' ',':',';','(',')','[',']','&','@','/','-']) then key:=#0
else
if not(key=chr(13)) then exit
else edit.SetFocus;
end;

procedure TfrmPerintah.edTeks2(dtp:TDateTimePicker; Sender: TObject;var Key: Char);
begin
if not(key in[chr(13),chr(8),'0'..'9','a'..'z','A'..'Z','.',',',' ',':',';','(',')','[',']','&','@','/','-']) then key:=#0
else
if not(key=chr(13)) then exit
else dtp.SetFocus;
end;

procedure TfrmPerintah.edTeks3(combo:TComboBox; Sender: TObject;var Key: Char);
begin
if not(key in[chr(13),chr(8),'0'..'9','a'..'z','A'..'Z','.',',',' ',':',';','(',')','[',']','&','@','/','-']) then key:=#0
else
if not(key=chr(13)) then exit
else combo.SetFocus;
end;

procedure TfrmPerintah.edTeks4(btn:TSuiButton; Sender: TObject;var Key: Char);
begin
if not(key in[chr(13),chr(8),'0'..'9','a'..'z','A'..'Z','.',',',' ',':',';','(',')','[',']','&','@','/','-']) then key:=#0
else
if not(key=chr(13)) then exit
else btn.SetFocus;
end;

procedure TfrmPerintah.edTeks5(btn:TBitBtn; Sender: TObject;var Key: Char);
begin
if not(key in[chr(13),chr(8),'0'..'9','a'..'z','A'..'Z','.',',',' ',':',';','(',')','[',']','&','@','/','-']) then key:=#0
else
if not(key=chr(13)) then exit
else btn.SetFocus;
end;

procedure TfrmPerintah.cmbTeks(combo:TComboBox; Sender: TObject;var Key: Char);
begin
if not(key in[chr(13),chr(8),'0'..'9','a'..'z','A'..'Z','.',',',' ',':',';','(',')','[',']','&','@','/','-']) then key:=#0
else
if not(key=chr(13)) then exit
else combo.SetFocus;
end;

procedure TfrmPerintah.dtpTgl(dtp:TDateTimePicker; Sender: TObject;var Key: Char);
begin
if not(key in[chr(13),chr(8),'0'..'9','a'..'z','A'..'Z','.',',',' ',':',';','(',')','[',']','&','@','/','-']) then key:=#0
else
if not(key=chr(13)) then exit
else dtp.SetFocus;
end;

procedure TfrmPerintah.MemoTeks(memo:TMemo; Sender: TObject;var Key: Char);
begin
if not(key in[chr(13),chr(8),'0'..'9','a'..'z','A'..'Z','.',',',' ',':',';','(',')','[',']','&','@','/','-']) then key:=#0
else
if not(key=chr(13)) then exit
else memo.SetFocus;
end;

procedure TfrmPerintah.edAngka(edit:TEdit; Sender: TObject;var Key: Char);
begin
if (Key=chr(13)) then edit.SetFocus
else
if not(key in['0'..'9',Chr(8)]) then key:=#0
end;

procedure TfrmPerintah.edAngka2(combo:TComboBox; Sender: TObject;var Key: Char);
begin
if (Key=chr(13)) then combo.SetFocus
else
if not(key in['0'..'9',Chr(8)]) then key:=#0
end;

procedure TfrmPerintah.edAngka3(buton:TBitBtn; Sender: TObject;var Key: Char);
begin
if (Key=chr(13)) then buton.SetFocus
else
if not(key in['0'..'9',Chr(8)]) then key:=#0
end;

procedure TfrmPerintah.edAngka4(dtp:TDateTimePicker; Sender: TObject;var Key: Char);
begin
if (Key=chr(13)) then dtp.SetFocus
else
if not(key in['0'..'9',Chr(8)]) then key:=#0
end;

procedure TfrmPerintah.edAngka5(memo:TMemo; Sender: TObject;var Key: Char);
begin
if (Key=chr(13)) then memo.SetFocus
else
if not(key in['0'..'9',Chr(8)]) then key:=#0
end;

procedure TfrmPerintah.edAngka6(buton:TButton; Sender: TObject;var Key: Char);
begin
if (Key=chr(13)) then buton.SetFocus
else
if not(key in['0'..'9',Chr(8)]) then key:=#0
end;

procedure TfrmPerintah.LoadCombo(combo:TComboBox;namaquery:TZQuery;isitable:TStringField);
var
i:integer;
begin
combo.Clear;
namaquery.Active:=true;
namaquery.First;
for i:=1 to namaquery.RecordCount do
begin
combo.Items.Add(isitable.Value);
namaquery.Next;
end;
end;

procedure TfrmPerintah.combokosong(combo:TComboBox;kata:string);
begin
MessageDlg('Maaf, '+kata+' masih kosong. Silahkan anda isi terlebih dulu !!!',mtInformation,[mbOK],0);
combo.SetFocus;
Exit;
end;

procedure TfrmPerintah.memokosong(memo:TMemo;kata:String);
begin
MessageDlg('Maaf, '+kata+' masih kosong. Silahkan anda isi terlebih dulu !!!',mtInformation,[mbOK],0);
memo.SetFocus;
Exit;
end;

procedure TfrmPerintah.showall(query:TZQuery;table:String;urut:String);
begin
query.Active:=true;
query.Close;
query.SQL.Clear;
query.SQL.Add('select * from '+table+' order by '+urut);
query.Open;
end;

procedure TfrmPerintah.querybebas(query:TZQuery;sekuel:String);
begin
query.Close;
query.SQL.Clear;
query.SQL.Add(sekuel);
query.Open;
query.Active:=true;
end;

procedure TfrmPerintah.editkosong(edit:TEdit;kata:string);
begin
MessageDlg('Maaf, '+kata+' masih kosong. Silahkan anda isi terlebih dulu !!!',mtInformation,[mbOK],0);
edit.SetFocus;
Exit;
end;

procedure TfrmPerintah.SimpanTableQuery(form:TForm;query:TZQuery;edit:TEdit;sekuel:String;sama:String;queryinsert:TZQuery;sekuelinsert:String);
begin
with query do
begin
Close;
Sql.Clear;
SQL.Add(sekuel);
Open;
end;
// cek didalam tabel
if not query.IsEmpty then
begin
MessageDlg('Maaf, '+sama+' sudah dipakai sebelumnya. Silahkan Anda pakai yang lain...!!!',mtError,[mbOK],0);
edit.Clear;
edit.SetFocus;
Exit;
end
else
if query.IsEmpty then
begin
query.Close;
query.SQL.Clear;
query.SQL.Add(sekuelinsert);
query.ExecSQL;
queryinsert.Active:=true;
queryinsert.Refresh;
batal(form,edit);
end
end;

procedure TfrmPerintah.hapusTableQuery(x:TZQuery;y:TEdit;z:string);
begin
if x.RecordCount=0 then
begin
MessageDlg('Maaf '+z+' sudah habis. Silahkan anda isi lagi',mtInformation,[mbOK],0);
y.SetFocus;
end
else
if MessageDlg('Yakin '+z+' mau dihapus, data di table ini berelasi dengan data di table lain. Jika anda hapus data ini, kemungkinan data di table lain yang menggunakan data ini juga ikut terhapus. Silahkan anda periksa dulu di table yang lain...??? ',mtConfirmation,[mbYes,mbNo],0)=mrYes then
begin
try
begin
x.Delete;
x.Refresh;
end
except
on EZDatabaseError do
begin
MessageDlg('Gagal menghapus, kemugkinan data masih dipakai di table lain...!!!',mtInformation,[mbOK],0);
Exit;
end;
end
end;
end;

procedure TfrmPerintah.batal(x:TForm;y:TEdit);
var
i:Integer;
begin
for i :=0 to x.ComponentCount-1 do
begin
if x.Components[i] is TEdit then TEdit(x.Components[i]).Text:='';
if x.Components[i] is TComboBox then TComboBox(x.Components[i]).Text:='';
if x.Components[i] is TMemo then TMemo(x.Components[i]).Text:='';
end;
y.SetFocus;
end;

procedure TfrmPerintah.warna(x:TForm);
var
i:shortInt;
begin
x.Color:=$00E8E8E8;
for i :=0 to x.ComponentCount-1 do
begin
if x.Components[i] is TLabel then TLabel(x.Components[i]).Font.Color:=clGreen;
if x.Components[i] is TBitBtn then TBitBtn(x.Components[i]).Font.Color:=clGreen;
if x.Components[i] is TButton then TButton(x.Components[i]).Font.Color:=clGreen;
if x.Components[i] is TPanel then
begin
TPanel(x.Components[i]).Color:=$00E8E8E8;
TPanel(x.Components[i]).Font.Color:=clGreen;
end;
if x.Components[i] is TDBGrid then
begin
TDBGrid(x.Components[i]).FixedColor:=$00E8E8E8;
TDBGrid(x.Components[i]).TitleFont.Color:=clGreen;
end;
if x.Components[i] is TScrollBox then TScrollBox(x.Components[i]).Color:=$00E8E8E8;
end;
end;

procedure TfrmPerintah.warnaGrid(DBGrid:TDBGrid;ZQuery:TZQuery;Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn;State: TGridDrawState);
begin
if(ZQuery.RecNo mod 2)=0then DBGrid.Canvas.Brush.Color:=$00E8E8E8;
DBGrid.DefaultDrawColumnCell(Rect,DataCol,Column,State);
end;

procedure TfrmPerintah.deleteTotal(ZQ:TZQuery;nmTable:String);
begin
ZQ.Close;
ZQ.SQL.Clear;
ZQ.SQL.Add('delete from '+nmTable);
ZQ.ExecSQL;
end;

procedure TfrmPerintah.LoadThn(combo:TComboBox);
var
i:integer;
begin
for i:=2000 to YearOf(now)do
begin
combo.Items.Add(IntToStr(i));
end;
end;

procedure TfrmPerintah.FormActivate(Sender: TObject);
begin
ZQuery1.Connection:=frmUtama.ZConnectionInventory;
end;

end.



=======================================
contoh penggunaannya pada simpan data
=======================================
procedure TfrmBarang.BtnSimpanClick(Sender: TObject);
begin
if(Trim(edKode.Text)='')then frmPerintah.editkosong(edKode,'Kode Barang')
else
if(Trim(edNama.Text)='')then frmPerintah.editkosong(edNama,'Nama Barang')
else
if(Trim(cmbSatuan.Text)='')or(Trim(edSatuan.Text)='')then frmPerintah.combokosong(cmbSatuan,'Satuan')
else
if(Trim(cmbJns.Text)='')or(Trim(edJenis.Text)='')then frmPerintah.combokosong(cmbJns,'Jenis Ketersediaan')
else
if(Trim(edLetak.Text)='')then frmPerintah.editkosong(edLetak,'Letak Barang')
else
if(Trim(edHbeli.Text)='')then frmPerintah.editkosong(edHbeli,'Harga beli')
else
if(Trim(edHjual.Text)='')then frmPerintah.editkosong(edHjual,'Harga jual bebas')
else
if(Trim(edHJualResep.Text)='')then frmPerintah.editkosong(edHJualResep,'Harga jual resep')
else
if(Trim(edStok.Text)='')then frmPerintah.editkosong(edStok,'Stok')
else
begin
frmPerintah.querybebas(frmUtama.ZQueryBarang,'select * from databarang where kode_brng="'+edKode.Text+'"');
if not(frmUtama.ZQueryBarang.IsEmpty)then
begin
MessageDlg('Maaf, kode barang "'+frmUtama.ZQueryBarangkode_brng.Value+'" sudah digunakan sebelumnya untuk barang '+frmUtama.ZQueryBarangnama_brng.Value+'..!!!!',mtInformation,[mbOK],0);
edKode.SetFocus;
end
else
if(frmUtama.ZQueryBarang.IsEmpty)then
begin
frmUtama.ZQueryBarang.Insert;
frmUtama.ZQueryBarangkode_brng.Value:=edKode.Text;
frmUtama.ZQueryBarangnama_brng.Value:=edNama.Text;
frmUtama.ZQueryBarangkode_sat.Value:=cmbSatuan.Text;
frmUtama.ZQueryBarangkdjns.Value:=cmbJns.Text;
frmUtama.ZQueryBarangletak_barang.Value:=edLetak.Text;
frmUtama.ZQueryBarangstok.Value:=StrToFloat(edStok.Text);
frmUtama.ZQueryBarangh_beli.Value:=StrToFloat(edHbeli.Text);
frmUtama.ZQueryBarangh_jual.Value:=StrToFloat(edHjual.Text);
frmUtama.ZQueryBarangh_resep.Value:=StrToFloat(edHJualResep.Text);
frmUtama.ZQueryBarang.Post;
frmUtama.ZQuery1.Refresh;
frmPerintah.batal(frmBarang,edKode);
edStok.Text:='0';
Label15.Caption:=IntToStr(frmUtama.ZQuery1.RecordCount);
jumlahCari;

frmPerintah.querybebas(frmUtama.ZQueryBarang,'select * from databarang order by kode_brng');
frmPerintah.LoadCombo(frmPembelian.cmbBarang,frmUtama.ZQueryBarang,frmUtama.ZQueryBarangkode_brng);
frmPerintah.LoadCombo(frmPembelian.cmbBarangCari,frmUtama.ZQueryBarang,frmUtama.ZQueryBarangkode_brng);
frmPerintah.LoadCombo(frmPenjualan.cmbBarang,frmUtama.ZQueryBarang,frmUtama.ZQueryBarangkode_brng);
frmPerintah.LoadCombo(frmPenjualan.cmbBarangCari,frmUtama.ZQueryBarang,frmUtama.ZQueryBarangkode_brng);
end;
end;
end;

=========================================
contoh penggunaan untuk mengosongkan semua field yang ada
=========================================
procedure TfrmBarang.BtnBatalClick(Sender: TObject);
begin
frmPerintah.batal(frmBarang,edKode);
edStok.Text:='0';
end;

1 komentar:

  • MBT Icons and buttons

    Icons and Buttons

    Our resources have been successfully downloaded over 10K times and found almost every where. Get yours!

  • choosing webhost for a blog

    Why HostGator?

    Learn Why we chose HostGator as our Web Host and find discount coupons to kick start your blog today!

  • SEO Settings for blogger

    ALL IN ONE SEO PACK 2012

    Learn every single SEO tip that will boost your blog's ranking and organic traffic. We got them all!

  • Blogger widgets and plugins

    Visit MBT's Blogger LAB

    Why not take a tour of all great Blogger widgets published so far? You Name it we have it!

  • become a six figure blogger!

    Become a SIX FIGURE BLOGGER

    Learn what it takes to become a successful entrepreneur and build a living online!