Malam Pemirsa hehe lama nih gak posting lagi..
oke kali ini sy akan berbagi tentang mewarnai hasil pencarian pada DBGrid.. langsung aja yah...
Jadi asumsikan saya punya 2 tabel dan 1 buah DBGrid.
Pencarian berikut dapat berfungsi untuk di seluruh kolom yang tersedia.
procedure TfrmMain.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
case DataCol of
0..2 : Begin
if pos(txtCari.Text,Column.Field.AsString)=1 then
TDBGrid(Sender).Canvas.Brush.Color:=clYellow;
TDBGrid(Sender).DefaultDrawColumnCell(Rect,DataCol,Column,State);
End;
end;
end;
procedure TfrmMain.txtCariChange(Sender: TObject);
begin
case Table of
1 : Begin
ADOQuery1.SQL.Clear;
ADOQuery1.SQL.Add('SELECT * FROM '+
'MASTER_PEGAWAI '+
'WHERE '+
'KODE LIKE "%'+txtCari.Text+'%" OR '+
'NAMAPEGAWAI LIKE "%'+txtCari.Text+'%" OR '+
'TANGGALMASUK LIKE "%'+txtCari.Text+'%" OR '+
'STATUSPEGAWAI LIKE "%'+txtCari.Text+'%" OR '+
'INFORMASIPEKERJAAN LIKE "%'+txtCari.Text+'%" '+
'ORDER BY NAMAPEGAWAI ' +
'LIMIT '+Limit
);
ADOQuery1.Open;
End;
2 : Begin
ADOQuery1.SQL.Clear;
ADOQuery1.SQL.Add('SELECT * FROM '+
'MASTER_PELANGGAN '+
'WHERE '+
'KODE LIKE "%'+txtCari.Text+'%" OR '+
'NAMAPERUSAHAAN LIKE "%'+txtCari.Text+'%" OR '+
'FAX LIKE "%'+txtCari.Text+'%" OR '+
'KONTAK LIKE "%'+txtCari.Text+'%" OR '+
'JABATAN LIKE "%'+txtCari.Text+'%" '+
'ORDER BY NAMAPERUSAHAAN ' +
'LIMIT '+Limit
);
ADOQuery1.Open;
End;
End;
Bagian yang di warna HIJAU, itu tidak wajib dipakai. agan bisa hapus.
jauh lebih baik kalo agan mengerti LIMIT di MySQL hehe
Oke sekian dlu yah gan, ane lanjut lagi...
Terimakasih udah berkunjung di giavano.blogspot.com
My Journey, My Confusion, My Fault, My Correction. Never Stop Looking for the Perfection.. EON software developer :) Feel free to ask : 0899.707.1010 We provide the most suitable software for your business ..!! Thank You :)
Kamis, 01 Mei 2014
Senin, 17 Maret 2014
DELPHI - Memberikan halaman dan total halaman pada quickrep / Get Page Number and Page Count in Delphi easily
Selamat Malam Pemirsa ... ! :D
Buat para pengguna QuickReport, pasti pada kesulitan nih mendapatkan PageCount atau Total Halaman dari Laporan yang dicetak..
Buat yang udah tau, mohon berbagi cara yang lebih simplenya yah :D
oke langsung aja yah... Hasilnya nanti akan seperti ini :
Halaman 1/16 -> artinya kita sedang berada di halaman pertama dari total 16 halaman seluruhnya
Di tombol Preview, ketikkan coding :
QuickRep1.Prepare;
QRExpr1.Expression:= 'PAGENUMBER + '' / ' + INTTOSTR(QuickRep1.QRPrinter.PageCount) + '''';
QuickRep1.Preview;
Syaratnya :
Letakkan komponen QRExpr di dalam Quick Report.. Terserah agan mau taronya dimana :D
oke semoga bermanfaat yah..
Salam Coding dan Terimakasih telah berkunjung di giavano.blogspot.com ^_^
Buat para pengguna QuickReport, pasti pada kesulitan nih mendapatkan PageCount atau Total Halaman dari Laporan yang dicetak..
Buat yang udah tau, mohon berbagi cara yang lebih simplenya yah :D
oke langsung aja yah... Hasilnya nanti akan seperti ini :
Halaman 1/16 -> artinya kita sedang berada di halaman pertama dari total 16 halaman seluruhnya
Di tombol Preview, ketikkan coding :
QuickRep1.Prepare;
QRExpr1.Expression:= 'PAGENUMBER + '' / ' + INTTOSTR(QuickRep1.QRPrinter.PageCount) + '''';
QuickRep1.Preview;
Syaratnya :
Letakkan komponen QRExpr di dalam Quick Report.. Terserah agan mau taronya dimana :D
oke semoga bermanfaat yah..
Salam Coding dan Terimakasih telah berkunjung di giavano.blogspot.com ^_^
Kamis, 13 Maret 2014
DELPHI - Memformat Tanggal TDateTimePicker ke dalam berbagai model
Selamat malam pemirsa setia...!!! :D
Kali ini saya akan membagikan cara untuk memformat Datetimepicker-nya delphi kedalam format yang diinginkan
oke langsung aja...
1. Letakkan TDatetimepicker ke dalam form1
2. Tambahkan Combobox ke dalam form1
3. Tambahkan Label ke dalam form1
4. //Isi Comboboxnya (pilihan)
Dobel Click di form1 (boleh isi lewat properties Items milik combobox)
procedure TForm1.FormCreate(Sender: TObject);
begin
Combobox1.Items.Add('format dd/MM/yyyy Contoh : 31/07/1992');
Combobox1.Items.Add('format dd MMMM yyyy Contoh : 31 July 1992');
Combobox1.Items.Add('format dd MM yy Contoh : 31 07 92');
end;
5. Dobel click Comboboxnya
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
case Combobox1.ItemIndex of
0 : Label1.Caption:=FormatDateTime('dd/MM/yy',DateTimePicker1.Date);
1 : Label1.Caption:=FormatDateTime('dd MMMM yyyy',DateTimePicker1.Date);
2 : Label1.Caption:=FormatDateTime('dd MM yy',DateTimePicker1.Date);
end;
end;
6. Prakteknya : Jalankan program, dan pilih comboboxnya.. nanti tanggalnya akan tampil di Label1
Untuk format lainnya silahkan agan ganti sendiri dibagian yang warna kuning
Oke sekian dan terimakasih telah berkunjung di giavano.blogspot.com
Kali ini saya akan membagikan cara untuk memformat Datetimepicker-nya delphi kedalam format yang diinginkan
oke langsung aja...
1. Letakkan TDatetimepicker ke dalam form1
2. Tambahkan Combobox ke dalam form1
3. Tambahkan Label ke dalam form1
4. //Isi Comboboxnya (pilihan)
Dobel Click di form1 (boleh isi lewat properties Items milik combobox)
procedure TForm1.FormCreate(Sender: TObject);
begin
Combobox1.Items.Add('format dd/MM/yyyy Contoh : 31/07/1992');
Combobox1.Items.Add('format dd MMMM yyyy Contoh : 31 July 1992');
Combobox1.Items.Add('format dd MM yy Contoh : 31 07 92');
end;
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
case Combobox1.ItemIndex of
0 : Label1.Caption:=FormatDateTime('dd/MM/yy',DateTimePicker1.Date);
1 : Label1.Caption:=FormatDateTime('dd MMMM yyyy',DateTimePicker1.Date);
2 : Label1.Caption:=FormatDateTime('dd MM yy',DateTimePicker1.Date);
end;
end;
6. Prakteknya : Jalankan program, dan pilih comboboxnya.. nanti tanggalnya akan tampil di Label1
Untuk format lainnya silahkan agan ganti sendiri dibagian yang warna kuning
Oke sekian dan terimakasih telah berkunjung di giavano.blogspot.com
Selasa, 11 Maret 2014
DELPHI - Autonumber sederhana dengan ADOTable Delphi tanpa Stored Function
Selamat sore pemirsa... :D
kali ini saya akan bagikan coding untuk autonumbering tanpa stored function (murni pakai tabel). :p
kalo bisa sih pake stored function gan, ada di postingan sebelumnya.
contoh penomoran otomatis dengan ketentuan :
char [5],
format R0001..R9999,
nama tabel : supplier,
id supplier baru akan ditampilkan dalam komponen dbEdit1.text
procedure TfrmSupplier.btnNewClick(Sender: TObject);
var IdBaru, IdTerakhir: integer;
katakunci : string;
begin
IF tblSupplier.RecordCount=0 then
begin
tblSupplier.Insert;
dbEdit1.Text:='R0001';
end
else
begin
tblSupplier.Last;
IdTerakhir :=STRTOINT(copy((tblSupplier.FieldByName('IdSupplier').AsString),2,4));
katakunci :=copy((tblSupplier.FieldByName('IdSupplier').AsString),1,1);
IdBaru :=IdTerakhir+1;
tblSupplier.Insert;
if IdBaru<=9 then dbEdit1.Text:=CONCAT(katakunci,'000',INTTOSTR(IdBaru))
else if IdBaru<=99 then dbEdit1.Text:=CONCAT(katakunci,'00',INTTOSTR(IdBaru))
else if Idbaru<=999 then dbEdit1.Text:=CONCAT(katakunci,'0',INTTOSTR(IdBaru))
else dbEdit1.Text:=CONCAT(katakunci,INTTOSTR(IdBaru));
end
end;
Oke terimakasih telah berkunjung di blog ane :D
kali ini saya akan bagikan coding untuk autonumbering tanpa stored function (murni pakai tabel). :p
kalo bisa sih pake stored function gan, ada di postingan sebelumnya.
contoh penomoran otomatis dengan ketentuan :
char [5],
format R0001..R9999,
nama tabel : supplier,
id supplier baru akan ditampilkan dalam komponen dbEdit1.text
procedure TfrmSupplier.btnNewClick(Sender: TObject);
var IdBaru, IdTerakhir: integer;
katakunci : string;
begin
IF tblSupplier.RecordCount=0 then
begin
tblSupplier.Insert;
dbEdit1.Text:='R0001';
end
else
begin
tblSupplier.Last;
IdTerakhir :=STRTOINT(copy((tblSupplier.FieldByName('IdSupplier').AsString),2,4));
katakunci :=copy((tblSupplier.FieldByName('IdSupplier').AsString),1,1);
IdBaru :=IdTerakhir+1;
tblSupplier.Insert;
if IdBaru<=9 then dbEdit1.Text:=CONCAT(katakunci,'000',INTTOSTR(IdBaru))
else if IdBaru<=99 then dbEdit1.Text:=CONCAT(katakunci,'00',INTTOSTR(IdBaru))
else if Idbaru<=999 then dbEdit1.Text:=CONCAT(katakunci,'0',INTTOSTR(IdBaru))
else dbEdit1.Text:=CONCAT(katakunci,INTTOSTR(IdBaru));
end
end;
Oke terimakasih telah berkunjung di blog ane :D
DELPHI - Set Main Form : buka form 2 dan tutup form 1
Malem pemirsa !!! :D
kali ini saya akan bagikan cara untuk membuka form lain dan menutup form yang aktif sekarang...
intinya adalah : kita setting mainform pada saat aplikasi berjalan..
oke langsung aja yah.. ini cendolnya.. eh codingnya :D
1. Buat project baru
2. Buat 2 buah form (form1 dan form2)
3. buat procedure ini dibawah {$R *.dfm} di form1
procedure SetAsMainForm(aForm:TForm);
var
P:Pointer;
begin
P := @Application.Mainform;
Pointer(P^) := aForm;
end;
2. Alt + F11 (use unit) ke form 2
3. Tambahkan button di form1
4. dobel click, tambahkan coding ini :
form2.Show;
SetAsMainForm(Form2);
form1.Close;
oke beres kan pemirsa? hehe
mudah kan?
terimakasih telah berkunjung di giavano.blogspot.com ya :)
kali ini saya akan bagikan cara untuk membuka form lain dan menutup form yang aktif sekarang...
intinya adalah : kita setting mainform pada saat aplikasi berjalan..
oke langsung aja yah.. ini cendolnya.. eh codingnya :D
1. Buat project baru
2. Buat 2 buah form (form1 dan form2)
3. buat procedure ini dibawah {$R *.dfm} di form1
procedure SetAsMainForm(aForm:TForm);
var
P:Pointer;
begin
P := @Application.Mainform;
Pointer(P^) := aForm;
end;
2. Alt + F11 (use unit) ke form 2
3. Tambahkan button di form1
4. dobel click, tambahkan coding ini :
form2.Show;
SetAsMainForm(Form2);
form1.Close;
oke beres kan pemirsa? hehe
mudah kan?
terimakasih telah berkunjung di giavano.blogspot.com ya :)
Kamis, 06 Maret 2014
DELPHI - Memberi Warna Pada EditText Bila Cursor Aktif
Selamat Pagi Pemirsa ...! :D
Pernah kah kita mengisi sebuah formulir (pada komputer) dan ketika cursor berada pada sebuah komponen,
komponen tersebut berubah warna?
kemudian pada saat cursor pindah ke tempat / komponen lain, warnanya kembali seperti semula?
Gampang sih.. saya yakin agan2 dah pada banyak yang tau.. hehe
tp saya cuman numpang nyatet di blog sini.. barangkali kalo saya lupa hehehe
langsung aja gan...
1. Tambahkan 1 EditText ke dalam form
2. Klick Edittext kemudian pilih event onEnter
ketikkan coding ini :
Edittext1.Color:=clSkyBlue; // kalau cursor aktif disini, nanti warnanya berubah jadi biru langit
3. Pilih event onExit
Ketikkan coding ini :
Edittext1.Color:=clWindow;// kalo cursor pindah ke tempat lain, warnanya kembali jadi putih
kalo warnanya pengen yang lain tinggal ganti si clSkyBlue dengan warna yang agan suka haha
oke sekian catatan sangat kecil dari saya :3
semoga bermanfaat buat yang belum pernah nyoba :D
Terimakasih telah berkunjung ke giavano.blogspot.com :D
Pernah kah kita mengisi sebuah formulir (pada komputer) dan ketika cursor berada pada sebuah komponen,
komponen tersebut berubah warna?
kemudian pada saat cursor pindah ke tempat / komponen lain, warnanya kembali seperti semula?
Gampang sih.. saya yakin agan2 dah pada banyak yang tau.. hehe
tp saya cuman numpang nyatet di blog sini.. barangkali kalo saya lupa hehehe
langsung aja gan...
1. Tambahkan 1 EditText ke dalam form
2. Klick Edittext kemudian pilih event onEnter
ketikkan coding ini :
Edittext1.Color:=clSkyBlue; // kalau cursor aktif disini, nanti warnanya berubah jadi biru langit
3. Pilih event onExit
Ketikkan coding ini :
Edittext1.Color:=clWindow;// kalo cursor pindah ke tempat lain, warnanya kembali jadi putih
kalo warnanya pengen yang lain tinggal ganti si clSkyBlue dengan warna yang agan suka haha
oke sekian catatan sangat kecil dari saya :3
semoga bermanfaat buat yang belum pernah nyoba :D
Terimakasih telah berkunjung ke giavano.blogspot.com :D
Rabu, 05 Maret 2014
DELPHI - Autocomplete Text data dari database ke dalam EditText
hai pemirsa :D
pernah denger autocomplete text kan?
kyk gini nih :
Nama Saya giavano
jadi pas ngetik NAM, udah muncul tuh teks selanjutnya :D
gampang kok yuk kita mulaiii yuuu :D
1. Bikin projectnya... ( ga usah diajarin yah, udah pada bisa kan) file - new project - ......
2. Tambahin 1 Komponen EditText , 1 ADOQuery, 1 DataSource + ADOConnection
(ente urus sendiri yah koneksi ke database, pasti udah bisa kan) :D
3. File - New - Unit
hapus semua, copas coding dibawah : (Simpan dengan nama AutoEdit.pas)
unit AutoEdit;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, StdCtrls, Controls,
Dialogs, Forms;
type
TAutoEdit = class(TEdit)
private
fList: TListBox;
fItems: TStringList;
fLabel: TLabel;
fCaption: string;
fBackColor: TColor;
fCaptionColor: TColor;
fAutoComplete: Boolean;
fListCount: Integer;
fOldText: string;
procedure SetCaption(S: string);
procedure SetCaptionColor(const Color: TColor);
procedure SetBackColor(const Color: TColor);
procedure SetAutoComplete(AutoCompleteOn: Boolean);
procedure ShowList;
protected
procedure CreateParams( Var params: TCreateParams ); override;
procedure SetParent(AParent: TWinControl); override;
procedure SetName(const Value: TComponentName); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
procedure ListMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure HideList;
procedure DoExit; override;
property Items: TStringList
read fItems write fItems;
published
procedure KeyPress(var Key: Char); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
property Caption: string
read fCaption write SetCaption;
property CaptionColor: TColor
read fCaptionColor write SetCaptionColor;
property BackColor: TColor
read fBackColor write SetBackColor;
property AutoComplete: Boolean
read fAutoComplete write SetAutoComplete;
property ListCount: Integer
read fListCount write fListCount default 5;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Freeware', [TAutoEdit]);
end;
{ TAutoEdit }
constructor TAutoEdit.Create(AOwner: TComponent);
begin
inherited;
fItems := TStringList.Create;
fList := TListBox.Create(Self);
fLabel := TLabel.Create(Self);
fLabel.ParentColor := True;
fLabel.AutoSize := False;
fLabel.FocusControl := Self;
fCaptionColor := fLabel.Font.Color;
fBackColor := fLabel.Color;
fList.Parent := Self;
fList.IntegralHeight := True;
fList.ParentCtl3D := False;
fList.Ctl3D := False;
fList.TabStop := False;
fList.Visible := False;
fListCount := 5;
end;
destructor TAutoEdit.Destroy;
begin
fItems.Free;
fLabel.Free;
inherited;
end;
procedure TAutoEdit.SetParent(AParent: TWinControl);
var
FirstSetting: Boolean;
begin
if Parent = nil then
FirstSetting := True
else
FirstSetting := False;
inherited;
if Parent <> nil then
begin
fList.Parent := Self.Parent;
fLabel.Parent := Self.Parent;
if FirstSetting then
begin
fLabel.ParentColor := True;
SetBounds(Left, Top, Width, Height);
end;
end;
end;
procedure TAutoEdit.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
inherited SetBounds(ALeft, ATop, AWidth, AHeight);
if Parent <> nil then
begin
if (fCaption > '') and (fLabel.Parent <> nil) then
begin
fLabel.Top := ATop - (1 + fLabel.Canvas.TextHeight('lj'));
fLabel.Height := AHeight + 4 + fLabel.Canvas.TextHeight('lj');
end
else
begin
fLabel.Top := ATop - 2;
fLabel.Height := AHeight + 4;
end;
fLabel.Left := ALeft - 2;
fLabel.Width := AWidth + 4;
if csDesigning in ComponentState then
begin
fList.Parent := Self;
HideList;
end
else
if fList.Visible then
ShowList;
end;
end;
procedure TAutoEdit.SetName(const Value: TComponentName);
begin
if Name > '' then
if fCaption = Name then
Caption := Value;
inherited SetName(Value);
if Text = Name then
begin
Text := '';
Caption := Value;
end;
end;
procedure TAutoEdit.CreateParams(var params: TCreateParams);
begin
inherited;
fList.Color := Self.Color;
fList.Font := Self.Font;
fList.OnMouseUp := ListMouseUp;
HideList;
end;
procedure TAutoEdit.SetCaption(S: string);
begin
fCaption := S;
fLabel.Caption := ' ' + S;
SetBounds(Left, Top, Width, Height)
end;
procedure TAutoEdit.SetCaptionColor(const Color: TColor);
begin
if fCaptionColor <> Color then
begin
fCaptionColor := Color;
fLabel.Font.Color := Color;
SetBounds(Left, Top, Width, Height)
end;
end;
procedure TAutoEdit.SetBackColor(const Color: TColor);
begin
if fBackColor <> Color then
begin
fBackColor := Color;
fLabel.Color := Color;
SetBounds(Left, Top, Width, Height)
end;
end;
procedure TAutoEdit.SetAutoComplete(AutoCompleteOn: Boolean);
begin
fAutoComplete := AutoCompleteOn;
end;
procedure TAutoEdit.ListMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Text := fList.Items[fList.ItemIndex];
SelStart := Length(Text);
HideList;
fList.Clear;
PostMessage(Handle, WM_KEYDOWN, VK_TAB, 0);
PostMessage(Handle, WM_KEYUP, VK_TAB, 0);
end;
procedure TAutoEdit.DoExit;
begin
if not fList.Focused then
HideList;
inherited;
end;
procedure TAutoEdit.KeyPress(var Key: Char);
var
K, T: string;
I, S: Integer;
begin
if ReadOnly then
begin
inherited;
Exit;
end;
K := Key;
if (Key = #27) and (fList.Visible) then
begin
Key := #0;
Text := Copy(Text, 1, SelStart);
SelStart := Length(Text);
fList.Clear;
HideList;
end
else
if fAutoComplete then
if ((K > #27) and (K < #129)) or (K = #8) then
begin
if (K = #8) then
T := Copy(Text, 1, SelStart - 1)
else
T := Copy(Text, 1, SelStart) + K;
K := Uppercase(T);
fList.Clear;
if fItems.Count > 0 then
for I := 0 to fItems.Count - 1 do
begin
if (Pos(K, Uppercase(fItems[I])) = 1) then
fList.Items.Add(fItems[I]);
if fList.Items.Count > fListCount - 1 then
Break;
end;
S := Length(T);
if (fList.Items.Count > 0) and (Key <> #8) then
Text := Copy(T, 1, S)
+ Copy(fList.Items[0], S + 1, Length(fList.Items[0]))
else
Text := T;
Key := #0;
SelStart := S;
SelLength := Length(Text) - S;
fOldText := Copy(Text, 1, SelStart);
end;
if fList.Items.Count > 0 then
ShowList
else
HideList;
inherited;
end;
procedure TAutoEdit.KeyDown(var Key: Word; Shift: TShiftState);
var
I, S: Integer;
begin
if Key = VK_DELETE then
begin
fList.Clear;
HideList;
end
else
if fList.Visible then
if (Key = VK_DOWN) or (Key = VK_UP) then
begin
S := SelStart;
if Key = VK_DOWN then
I := fList.ItemIndex + 1
else
I := fList.ItemIndex - 1;
if I < -1 then
I := fList.Items.Count -1;
if I > fList.Items.Count - 1 then
I := - 1;
fList.ItemIndex := I;
if I = -1 then
begin
Text := fOldText;
SelStart := Length(Text);
SelLength := 0;
end
else
begin
Text := fList.Items[fList.ItemIndex];
SelStart := S;
SelLength := Length(Text) - S;
end;
Key := 0;
end;
if (not fList.Visible) and ((Key = VK_LEFT) or (Key = VK_RIGHT)) then
if SelLength = Length(Text) then
if (Shift = []) and (Length(Text) > 0) then
begin
SelLength := 0;
Key := 0;
end;
inherited;
end;
procedure TAutoEdit.ShowList;
begin
if Parent <> nil then
begin
fList.Top := Top + ClientHeight;
fList.Left := Left;
fList.Width := Width;
fList.Height := fList.ItemHeight * (fList.Items.Count + 1);
fList.BringToFront;
fList.Show;
end;
end;
procedure TAutoEdit.HideList;
var
I: Integer;
begin
if (Text > '') then
for I := 0 to fList.Items.Count - 1 do
if Uppercase(fList.Items[I]) = Uppercase(Text) then
begin
Text := fList.Items[I];
Break;
end;
fList.Hide;
fList.Top := Top;
fList.Height := 0;
fList.Left := Left;
fList.Width := 0;
end;
initialization
RegisterClass(TLabel);
end.
4. File New Unit lagi (Simpan dengan nama : AutoCompleteText.pas)
Hapus semua, copas coding dibawah :
unit AutoCompleteText;
interface
uses
stdctrls, sysutils, classes, ADODB;
Var ListValues : TStringList;
function EditComplete(myKey:integer;mEdit: TEdit; mItems: TStrings; mCase: Boolean = True): Boolean;
procedure GetDataAutoComplete(ADOQuery : TADOQuery);
implementation
function EditComplete(myKey:integer;mEdit: TEdit; mItems: TStrings; mCase: Boolean = True): Boolean;
var
I, T: Integer;
vSubStr, S: string;
begin
Result := False;
case myKey of
8, 13, 46, 37..40: ;// jangan cari jika myKey adalah backspace, enter, delete atau panah kanan-kiri
else
if (not Assigned(mEdit)) or (not Assigned(mItems)) then
Exit;
vSubStr := mEdit.Text;
if not mCase then vSubStr := UpperCase(vSubStr);
for I := 0 to Pred(mItems.Count) do
begin
S := mItems[I];
if not mCase then
S := UpperCase(S);
if (Pos(vSubStr, S) = 1) and (vSubStr <> S) then
begin
T := Length(vSubStr);
mEdit.Text := mItems[I];
mEdit.SelStart := T;
mEdit.SelLength := Length(mItems[I]) - T;
Result := True;
Break;
end;
end;
end;
end;
procedure GetDataAutoComplete(ADOQuery : TADOQuery);
Begin
ListValues.Free;
ListValues := TStringList.Create;
while not ADOQuery.Eof do
begin
ListValues.Add(ADOQuery.Fields[0].Value);
ADOQuery.Next;
end;
End;
end.
5. Di form 1, pilih komponen EditText kemudian di event OnKeyUp :
ADOQuery1.SQL.Clear;
ADOQuery1.SQL.ADD('SELECT nama FROM pelanggan WHERE nama LIKE "%'+Edit1.Text+'%" LIMIT 1'); // Limit 1 boleh dihapus boleh engga.. supaya cepet aja itu
ADOQuery1.Open;
GetDataAutoComplete(ADOQuery1);
EditComplete(key,Edit1,listValues);
6. Running, pasti eror kan? nah karena ente belum USE UNIT (Alt+F11) ke AutocompleteText.pas dan AutoEdit,pas.
7. Berhasil deh Selamat Mencoba (y)
dengan asumsi :
- Koneksi database sudah benar
- Ambil nama dari tabel Pelanggan
ini contoh SS nya :D
Terimakasih telah berkunjung di giavano.blogspot.com (y)
pernah denger autocomplete text kan?
kyk gini nih :
Nama Saya giavano
jadi pas ngetik NAM, udah muncul tuh teks selanjutnya :D
gampang kok yuk kita mulaiii yuuu :D
1. Bikin projectnya... ( ga usah diajarin yah, udah pada bisa kan) file - new project - ......
2. Tambahin 1 Komponen EditText , 1 ADOQuery, 1 DataSource + ADOConnection
(ente urus sendiri yah koneksi ke database, pasti udah bisa kan) :D
3. File - New - Unit
hapus semua, copas coding dibawah : (Simpan dengan nama AutoEdit.pas)
unit AutoEdit;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, StdCtrls, Controls,
Dialogs, Forms;
type
TAutoEdit = class(TEdit)
private
fList: TListBox;
fItems: TStringList;
fLabel: TLabel;
fCaption: string;
fBackColor: TColor;
fCaptionColor: TColor;
fAutoComplete: Boolean;
fListCount: Integer;
fOldText: string;
procedure SetCaption(S: string);
procedure SetCaptionColor(const Color: TColor);
procedure SetBackColor(const Color: TColor);
procedure SetAutoComplete(AutoCompleteOn: Boolean);
procedure ShowList;
protected
procedure CreateParams( Var params: TCreateParams ); override;
procedure SetParent(AParent: TWinControl); override;
procedure SetName(const Value: TComponentName); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
procedure ListMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure HideList;
procedure DoExit; override;
property Items: TStringList
read fItems write fItems;
published
procedure KeyPress(var Key: Char); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
property Caption: string
read fCaption write SetCaption;
property CaptionColor: TColor
read fCaptionColor write SetCaptionColor;
property BackColor: TColor
read fBackColor write SetBackColor;
property AutoComplete: Boolean
read fAutoComplete write SetAutoComplete;
property ListCount: Integer
read fListCount write fListCount default 5;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Freeware', [TAutoEdit]);
end;
{ TAutoEdit }
constructor TAutoEdit.Create(AOwner: TComponent);
begin
inherited;
fItems := TStringList.Create;
fList := TListBox.Create(Self);
fLabel := TLabel.Create(Self);
fLabel.ParentColor := True;
fLabel.AutoSize := False;
fLabel.FocusControl := Self;
fCaptionColor := fLabel.Font.Color;
fBackColor := fLabel.Color;
fList.Parent := Self;
fList.IntegralHeight := True;
fList.ParentCtl3D := False;
fList.Ctl3D := False;
fList.TabStop := False;
fList.Visible := False;
fListCount := 5;
end;
destructor TAutoEdit.Destroy;
begin
fItems.Free;
fLabel.Free;
inherited;
end;
procedure TAutoEdit.SetParent(AParent: TWinControl);
var
FirstSetting: Boolean;
begin
if Parent = nil then
FirstSetting := True
else
FirstSetting := False;
inherited;
if Parent <> nil then
begin
fList.Parent := Self.Parent;
fLabel.Parent := Self.Parent;
if FirstSetting then
begin
fLabel.ParentColor := True;
SetBounds(Left, Top, Width, Height);
end;
end;
end;
procedure TAutoEdit.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
inherited SetBounds(ALeft, ATop, AWidth, AHeight);
if Parent <> nil then
begin
if (fCaption > '') and (fLabel.Parent <> nil) then
begin
fLabel.Top := ATop - (1 + fLabel.Canvas.TextHeight('lj'));
fLabel.Height := AHeight + 4 + fLabel.Canvas.TextHeight('lj');
end
else
begin
fLabel.Top := ATop - 2;
fLabel.Height := AHeight + 4;
end;
fLabel.Left := ALeft - 2;
fLabel.Width := AWidth + 4;
if csDesigning in ComponentState then
begin
fList.Parent := Self;
HideList;
end
else
if fList.Visible then
ShowList;
end;
end;
procedure TAutoEdit.SetName(const Value: TComponentName);
begin
if Name > '' then
if fCaption = Name then
Caption := Value;
inherited SetName(Value);
if Text = Name then
begin
Text := '';
Caption := Value;
end;
end;
procedure TAutoEdit.CreateParams(var params: TCreateParams);
begin
inherited;
fList.Color := Self.Color;
fList.Font := Self.Font;
fList.OnMouseUp := ListMouseUp;
HideList;
end;
procedure TAutoEdit.SetCaption(S: string);
begin
fCaption := S;
fLabel.Caption := ' ' + S;
SetBounds(Left, Top, Width, Height)
end;
procedure TAutoEdit.SetCaptionColor(const Color: TColor);
begin
if fCaptionColor <> Color then
begin
fCaptionColor := Color;
fLabel.Font.Color := Color;
SetBounds(Left, Top, Width, Height)
end;
end;
procedure TAutoEdit.SetBackColor(const Color: TColor);
begin
if fBackColor <> Color then
begin
fBackColor := Color;
fLabel.Color := Color;
SetBounds(Left, Top, Width, Height)
end;
end;
procedure TAutoEdit.SetAutoComplete(AutoCompleteOn: Boolean);
begin
fAutoComplete := AutoCompleteOn;
end;
procedure TAutoEdit.ListMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Text := fList.Items[fList.ItemIndex];
SelStart := Length(Text);
HideList;
fList.Clear;
PostMessage(Handle, WM_KEYDOWN, VK_TAB, 0);
PostMessage(Handle, WM_KEYUP, VK_TAB, 0);
end;
procedure TAutoEdit.DoExit;
begin
if not fList.Focused then
HideList;
inherited;
end;
procedure TAutoEdit.KeyPress(var Key: Char);
var
K, T: string;
I, S: Integer;
begin
if ReadOnly then
begin
inherited;
Exit;
end;
K := Key;
if (Key = #27) and (fList.Visible) then
begin
Key := #0;
Text := Copy(Text, 1, SelStart);
SelStart := Length(Text);
fList.Clear;
HideList;
end
else
if fAutoComplete then
if ((K > #27) and (K < #129)) or (K = #8) then
begin
if (K = #8) then
T := Copy(Text, 1, SelStart - 1)
else
T := Copy(Text, 1, SelStart) + K;
K := Uppercase(T);
fList.Clear;
if fItems.Count > 0 then
for I := 0 to fItems.Count - 1 do
begin
if (Pos(K, Uppercase(fItems[I])) = 1) then
fList.Items.Add(fItems[I]);
if fList.Items.Count > fListCount - 1 then
Break;
end;
S := Length(T);
if (fList.Items.Count > 0) and (Key <> #8) then
Text := Copy(T, 1, S)
+ Copy(fList.Items[0], S + 1, Length(fList.Items[0]))
else
Text := T;
Key := #0;
SelStart := S;
SelLength := Length(Text) - S;
fOldText := Copy(Text, 1, SelStart);
end;
if fList.Items.Count > 0 then
ShowList
else
HideList;
inherited;
end;
procedure TAutoEdit.KeyDown(var Key: Word; Shift: TShiftState);
var
I, S: Integer;
begin
if Key = VK_DELETE then
begin
fList.Clear;
HideList;
end
else
if fList.Visible then
if (Key = VK_DOWN) or (Key = VK_UP) then
begin
S := SelStart;
if Key = VK_DOWN then
I := fList.ItemIndex + 1
else
I := fList.ItemIndex - 1;
if I < -1 then
I := fList.Items.Count -1;
if I > fList.Items.Count - 1 then
I := - 1;
fList.ItemIndex := I;
if I = -1 then
begin
Text := fOldText;
SelStart := Length(Text);
SelLength := 0;
end
else
begin
Text := fList.Items[fList.ItemIndex];
SelStart := S;
SelLength := Length(Text) - S;
end;
Key := 0;
end;
if (not fList.Visible) and ((Key = VK_LEFT) or (Key = VK_RIGHT)) then
if SelLength = Length(Text) then
if (Shift = []) and (Length(Text) > 0) then
begin
SelLength := 0;
Key := 0;
end;
inherited;
end;
procedure TAutoEdit.ShowList;
begin
if Parent <> nil then
begin
fList.Top := Top + ClientHeight;
fList.Left := Left;
fList.Width := Width;
fList.Height := fList.ItemHeight * (fList.Items.Count + 1);
fList.BringToFront;
fList.Show;
end;
end;
procedure TAutoEdit.HideList;
var
I: Integer;
begin
if (Text > '') then
for I := 0 to fList.Items.Count - 1 do
if Uppercase(fList.Items[I]) = Uppercase(Text) then
begin
Text := fList.Items[I];
Break;
end;
fList.Hide;
fList.Top := Top;
fList.Height := 0;
fList.Left := Left;
fList.Width := 0;
end;
initialization
RegisterClass(TLabel);
end.
4. File New Unit lagi (Simpan dengan nama : AutoCompleteText.pas)
Hapus semua, copas coding dibawah :
unit AutoCompleteText;
interface
uses
stdctrls, sysutils, classes, ADODB;
Var ListValues : TStringList;
function EditComplete(myKey:integer;mEdit: TEdit; mItems: TStrings; mCase: Boolean = True): Boolean;
procedure GetDataAutoComplete(ADOQuery : TADOQuery);
implementation
function EditComplete(myKey:integer;mEdit: TEdit; mItems: TStrings; mCase: Boolean = True): Boolean;
var
I, T: Integer;
vSubStr, S: string;
begin
Result := False;
case myKey of
8, 13, 46, 37..40: ;// jangan cari jika myKey adalah backspace, enter, delete atau panah kanan-kiri
else
if (not Assigned(mEdit)) or (not Assigned(mItems)) then
Exit;
vSubStr := mEdit.Text;
if not mCase then vSubStr := UpperCase(vSubStr);
for I := 0 to Pred(mItems.Count) do
begin
S := mItems[I];
if not mCase then
S := UpperCase(S);
if (Pos(vSubStr, S) = 1) and (vSubStr <> S) then
begin
T := Length(vSubStr);
mEdit.Text := mItems[I];
mEdit.SelStart := T;
mEdit.SelLength := Length(mItems[I]) - T;
Result := True;
Break;
end;
end;
end;
end;
procedure GetDataAutoComplete(ADOQuery : TADOQuery);
Begin
ListValues.Free;
ListValues := TStringList.Create;
while not ADOQuery.Eof do
begin
ListValues.Add(ADOQuery.Fields[0].Value);
ADOQuery.Next;
end;
End;
end.
5. Di form 1, pilih komponen EditText kemudian di event OnKeyUp :
ADOQuery1.SQL.Clear;
ADOQuery1.SQL.ADD('SELECT nama FROM pelanggan WHERE nama LIKE "%'+Edit1.Text+'%" LIMIT 1'); // Limit 1 boleh dihapus boleh engga.. supaya cepet aja itu
ADOQuery1.Open;
GetDataAutoComplete(ADOQuery1);
EditComplete(key,Edit1,listValues);
6. Running, pasti eror kan? nah karena ente belum USE UNIT (Alt+F11) ke AutocompleteText.pas dan AutoEdit,pas.
7. Berhasil deh Selamat Mencoba (y)
dengan asumsi :
- Koneksi database sudah benar
- Ambil nama dari tabel Pelanggan
ini contoh SS nya :D
Terimakasih telah berkunjung di giavano.blogspot.com (y)
DELPHI - Membuat Laporan / Surat / Bon / Faktur berformat PDF dengan QuickReport dengan mudah
Hai pemirsa :D
kali ini saya akan berbagi cara untuk membuat laporan dengan Quickreport berformat PDF !!!
gampang kok :D
langsung ajaa yah
1. Tambahakan dibagian USES = QRPDFFilt
2. Buat laporannya / suratnya / faktur / bon
3. Tambahkan komponen TSaveDialog
4. tambahkan 1 button,. isinya :
procedure TfrmSuratKwitansi.btnSimpanPDFClick(Sender: TObject); // Button
var
PDFFilt : TQRPDFDocumentFilter;
begin
//buat pdf
SaveDialog1.Execute();
if Length(SaveDialog1.FileName)>0 then
begin
PDFFilt := TQRPDFDocumentFilter.Create(SaveDialog1.FileName);
QuickRep1.ExportToFilter( PDFFilt );
PDFFilt.free;
end
else
ShowMessage('Penyimpanan Dibatalkan');
End
jadi kita bisa plih tempat dimana kita mau simpan PDFnya
Oke mudah kan? hehe
silahkan dicoba
Terimakasih telah berkunjung di giavano.blogspot.com
kali ini saya akan berbagi cara untuk membuat laporan dengan Quickreport berformat PDF !!!
gampang kok :D
langsung ajaa yah
1. Tambahakan dibagian USES = QRPDFFilt
2. Buat laporannya / suratnya / faktur / bon
3. Tambahkan komponen TSaveDialog
4. tambahkan 1 button,. isinya :
procedure TfrmSuratKwitansi.btnSimpanPDFClick(Sender: TObject); // Button
var
PDFFilt : TQRPDFDocumentFilter;
begin
//buat pdf
SaveDialog1.Execute();
if Length(SaveDialog1.FileName)>0 then
begin
PDFFilt := TQRPDFDocumentFilter.Create(SaveDialog1.FileName);
QuickRep1.ExportToFilter( PDFFilt );
PDFFilt.free;
end
else
ShowMessage('Penyimpanan Dibatalkan');
End
jadi kita bisa plih tempat dimana kita mau simpan PDFnya
Oke mudah kan? hehe
silahkan dicoba
Terimakasih telah berkunjung di giavano.blogspot.com
Jumat, 21 Februari 2014
DELPHI - Multi Line / Banyak Baris dalam (in) TStringGrid Delphi
Hai pemirsa maaf sudah lama nih saya gak posting, hehe sibuk sih banyak kerjaan :D
Udah pada tau kan tentang TStringGrid ini?
Simplenya, StringGrid ini sama seperti DBGrid, tapi sayangnya DBGrid tidak bisa di edit kalo belum di koneksikan ke database.
StringGrid ini sama seperti DataGridView pada VB.Net
oke jadi ceritanya saya mau buat supaya dalam 1 cell di Grid, bisa 2 baris atau lebih
kyk gini nih
Penasaran? langsung aja step by stepnya yah :D
1. Letakkan TStringGrid ke dalam Form
2. Ubah properties
StringGrid1.Cols[0].Text:='QTY';
StringGrid1.Cols[1].Text:='ITEM';
StringGrid1.Cols[2].Text:='DESCRIPTION';
StringGrid1.Cols[3].Text:='UNIT PRICE';
StringGrid1.Cols[4].Text:='LINE TOTAL';
StringGrid1.ColWidths[0]:=50;
StringGrid1.ColWidths[1]:=100;
StringGrid1.ColWidths[2]:=300;
StringGrid1.ColWidths[3]:=100;
StringGrid1.ColWidths[4]:=100;
4.Pilih StringGridnya, EVENT - ONDRAWCELL ketikkan kode berikut
with TStringGrid(Sender) do
if Pos(#13#10, Cells[ACol, ARow]) > 0 then
begin
Canvas.FillRect(Rect);
Inc(Rect.Left, 2);
Inc(Rect.Top, 2);
DrawText(Canvas.Handle, PChar(Cells[ACol, ARow]), -1, Rect,
DT_NOPREFIX or DT_WORDBREAK);
end;
5. Tambahkan procedure ini dibawah {$R *.dfm}
procedure TForm1.UpdateRowHeights(AGrid: TStringGrid);
var
Y: Integer;
MaxHeight: Integer;
X: Integer;
R: TRect;
TxtHeight: Integer;
begin
for Y := AGrid.FixedRows to AGrid.RowCount - 1 do
begin
MaxHeight := AGrid.DefaultRowHeight - 4;
for X := AGrid.FixedCols to AGrid.ColCount - 1 do
begin
R := Rect(0, 0, AGrid.ColWidths[X] - 4, 0);
TxtHeight := DrawText(AGrid.Canvas.Handle, PChar(AGrid.Cells[X, Y]), -1,
R, DT_WORDBREAK or DT_CALCRECT);
if TxtHeight > MaxHeight then
MaxHeight := TxtHeight;
end;
AGrid.RowHeights[Y] := MaxHeight + 4;
end;
end;
TForm1 dapat diganti ya sesuai nama form kalian :)
6. Tambahin ini di bagian atas dibawah TYPE
private
{ Private declarations }
procedure UpdateRowHeights(AGrid: TStringGrid); // mendaftarkan procedure yg kita buat
public
{ Public declarations }
end;
7. Pilih StringGridnya, EVENT ONKEYPRESS tambahkan coding :
if key=#13 then
UpdateRowHeights(StringGrid1);
selesaii deh :D
saatnya uji coba..!
Pilih salah satu cells / Fields
kemudian ketikan
ABC trus buat pindah baris barunya, teken CTRL + ENTER
ketikkan CDE
kalo sudah selesai, tekan ENTER
taraaa :D
oke sekian pemirsa
terimakasih sudah berkunjung di blog saya :)
Udah pada tau kan tentang TStringGrid ini?
Simplenya, StringGrid ini sama seperti DBGrid, tapi sayangnya DBGrid tidak bisa di edit kalo belum di koneksikan ke database.
StringGrid ini sama seperti DataGridView pada VB.Net
oke jadi ceritanya saya mau buat supaya dalam 1 cell di Grid, bisa 2 baris atau lebih
kyk gini nih
Penasaran? langsung aja step by stepnya yah :D
1. Letakkan TStringGrid ke dalam Form
2. Ubah properties
- OPTIONS - GOEDITING - TRUE
- COLCOUNT = 5
- FIXEDCOLS = 0
- FIXEDROW = 1
StringGrid1.Cols[0].Text:='QTY';
StringGrid1.Cols[1].Text:='ITEM';
StringGrid1.Cols[2].Text:='DESCRIPTION';
StringGrid1.Cols[3].Text:='UNIT PRICE';
StringGrid1.Cols[4].Text:='LINE TOTAL';
StringGrid1.ColWidths[0]:=50;
StringGrid1.ColWidths[1]:=100;
StringGrid1.ColWidths[2]:=300;
StringGrid1.ColWidths[3]:=100;
StringGrid1.ColWidths[4]:=100;
4.Pilih StringGridnya, EVENT - ONDRAWCELL ketikkan kode berikut
with TStringGrid(Sender) do
if Pos(#13#10, Cells[ACol, ARow]) > 0 then
begin
Canvas.FillRect(Rect);
Inc(Rect.Left, 2);
Inc(Rect.Top, 2);
DrawText(Canvas.Handle, PChar(Cells[ACol, ARow]), -1, Rect,
DT_NOPREFIX or DT_WORDBREAK);
end;
5. Tambahkan procedure ini dibawah {$R *.dfm}
procedure TForm1.UpdateRowHeights(AGrid: TStringGrid);
var
Y: Integer;
MaxHeight: Integer;
X: Integer;
R: TRect;
TxtHeight: Integer;
begin
for Y := AGrid.FixedRows to AGrid.RowCount - 1 do
begin
MaxHeight := AGrid.DefaultRowHeight - 4;
for X := AGrid.FixedCols to AGrid.ColCount - 1 do
begin
R := Rect(0, 0, AGrid.ColWidths[X] - 4, 0);
TxtHeight := DrawText(AGrid.Canvas.Handle, PChar(AGrid.Cells[X, Y]), -1,
R, DT_WORDBREAK or DT_CALCRECT);
if TxtHeight > MaxHeight then
MaxHeight := TxtHeight;
end;
AGrid.RowHeights[Y] := MaxHeight + 4;
end;
end;
TForm1 dapat diganti ya sesuai nama form kalian :)
6. Tambahin ini di bagian atas dibawah TYPE
private
{ Private declarations }
procedure UpdateRowHeights(AGrid: TStringGrid); // mendaftarkan procedure yg kita buat
public
{ Public declarations }
end;
7. Pilih StringGridnya, EVENT ONKEYPRESS tambahkan coding :
if key=#13 then
UpdateRowHeights(StringGrid1);
selesaii deh :D
saatnya uji coba..!
Pilih salah satu cells / Fields
kemudian ketikan
ABC trus buat pindah baris barunya, teken CTRL + ENTER
ketikkan CDE
kalo sudah selesai, tekan ENTER
taraaa :D
oke sekian pemirsa
terimakasih sudah berkunjung di blog saya :)
Rabu, 20 November 2013
DELPHI - Membuat Gradient Warna Pada Form (TForm)
Hai sobat delphiers, udah lama nih ane gak posting,,
just share aja nih coding buat MAKEOVER-nya DELPHI,,
procedure TForm1.FormPaint(Sender: TObject);
var Row, Ht: Word ;
begin
Ht := (ClientHeight + 255) div 256 ;
for Row := 0 to 255 do
with Canvas do begin
Brush.Color := RGB(255, 255, Row);
FillRect(Rect(0, Row * Ht,
ClientWidth, (Row + 1) * Ht)) ;
end;
end;
Kalo mau ganti warnanya, tinggal rubah aja angkanya dengan yang anda mau. pake sistem RGB Colour.
Oke sekian aja terimakasih telah berkunjung di giavano.blogspot.com
Salam Sobat delphiers ^_^
just share aja nih coding buat MAKEOVER-nya DELPHI,,
procedure TForm1.FormPaint(Sender: TObject);
var Row, Ht: Word ;
begin
Ht := (ClientHeight + 255) div 256 ;
for Row := 0 to 255 do
with Canvas do begin
Brush.Color := RGB(255, 255, Row);
FillRect(Rect(0, Row * Ht,
ClientWidth, (Row + 1) * Ht)) ;
end;
end;
Kalo mau ganti warnanya, tinggal rubah aja angkanya dengan yang anda mau. pake sistem RGB Colour.
Oke sekian aja terimakasih telah berkunjung di giavano.blogspot.com
Salam Sobat delphiers ^_^
Rabu, 18 September 2013
DELPHI - Membedakan warna baris di DBGrid
Selamat malam pemirsa... :D
maaf sudah lama gak spawn , sibuk nih hehe
oke gan langsung aja,
pernah liat DBGrid yang warna barisnya beda2? ganjil genap gitu :D
nih codingnya
procedure TfrmMenuUtama.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect;
Field: TField; State: TGridDrawState);
begin
if (ADOQuery1.RecNo mod 2)=0 then
DBGrid1.Canvas.Brush.Color := clSkyBlue
else
DBGrid1.Canvas.Brush.Color := $000080FF;
DBGrid1.DefaultDrawDataCell (Rect, Field, State);
end;
nah itu untuk yang bedakan ganjil genap, sedangkan untuk kriteria tertentu, bisa aja kasih keterangan di if nya.
contohnya untuk memberi warna MERAH pada nilai ujian yang kurang dari 70
procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect;
Field: TField; State: TGridDrawState);
begin
if (ADOQuery1.FieldByName('NILAI').Value < 70 ) then
DBGrid1.Canvas.Brush.Color := clred
else
DBGrid1.Canvas.Brush.Color := clWhite;
DBGrid1.DefaultDrawDataCell (Rect, Field, State);
end;
Mudah kan? oke terimakasih telah berkunjung di giavano.blogspot.com ^^
maaf sudah lama gak spawn , sibuk nih hehe
oke gan langsung aja,
pernah liat DBGrid yang warna barisnya beda2? ganjil genap gitu :D
nih codingnya
procedure TfrmMenuUtama.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect;
Field: TField; State: TGridDrawState);
begin
if (ADOQuery1.RecNo mod 2)=0 then
DBGrid1.Canvas.Brush.Color := clSkyBlue
else
DBGrid1.Canvas.Brush.Color := $000080FF;
DBGrid1.DefaultDrawDataCell (Rect, Field, State);
end;
nah itu untuk yang bedakan ganjil genap, sedangkan untuk kriteria tertentu, bisa aja kasih keterangan di if nya.
contohnya untuk memberi warna MERAH pada nilai ujian yang kurang dari 70
procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect;
Field: TField; State: TGridDrawState);
begin
if (ADOQuery1.FieldByName('NILAI').Value < 70 ) then
DBGrid1.Canvas.Brush.Color := clred
else
DBGrid1.Canvas.Brush.Color := clWhite;
DBGrid1.DefaultDrawDataCell (Rect, Field, State);
end;
Mudah kan? oke terimakasih telah berkunjung di giavano.blogspot.com ^^
Selasa, 20 Agustus 2013
DELPHI - Menulis text kedalam sebuah File text .txt
Selamat malam pemirsa :D
kali ini saya bagikan cara untuk menulis ke dalam sebuah file melalui DELPHI..
oke langsung aja lah yah, ini codingnya
kali ini saya bagikan cara untuk menulis ke dalam sebuah file melalui DELPHI..
oke langsung aja lah yah, ini codingnya
procedure TForm1.tbSimpanClick(Sender: TObject);var TFile : TextFile;begin assignFile(TFile, 'C:\catatan.txt'); if FileExists('catatan.txt') then Append(TFile) else ReWrite(TFile); writeln(TFile,'INI TULISAN PERTAMA SAYA'); closeFile(TFile);end;
Coding itu bebas anda letakkan di tempat yang dibutuhkan. silahkan mencoba.
Terimakasih telah berkunjung di giavano.blogspot.com ^_^
Minggu, 11 Agustus 2013
DELPHI - Mengurangi stok secara otomatis menggunakan Trigger MySQL
Selamat siang pemirsa, :D
berhubung kemaren ada yang request jadi saya tempel di blog ini
oke langsung aja,
jadi trigger itu fungsinya untuk jadi pemicu, misalnya :
pas kita jual barang, stok harus berkurang....
pas kita beli barang, stok harus bertambah...
pas kita update penjualan, stok harus dikurangi yang lama dan ditambah yang baru...
nah itu lah yang gunanya trigger, kalo ga pake trigger juga bisa, tapi lambat dan codingnya ribet.
misalnya saya punya tabel penjualan (master & detail) seperti ini
//Master
CREATE TABLE `mjual` (
`NOMOR_JUAL` char(10) NOT NULL,
`TANGGAL` date NOT NULL,
`NOPLAT` varchar(10) default NULL,
`MOTOR` varchar(20) default NULL,
`BIAYA_PASANG` double default '0',
`JENIS_BAYAR` varchar(20) default 'TUNAI',
`STATUS` varchar(50) default 'LUNAS',
PRIMARY KEY (`NOMOR_JUAL`),
UNIQUE KEY `IDJual` (`NOMOR_JUAL`)
)
//detail
CREATE TABLE `djual` (
`NOMOR_JUAL` char(10) NOT NULL,
`ID_BARANG` varchar(20) NOT NULL,
`JUMLAH` int(11) default '0',
`HARGA_JUAL` double default '0',
`DISKON` double default '0',
KEY `IDJual` (`NOMOR_JUAL`),
KEY `IDBarang` (`ID_BARANG`),
CONSTRAINT `djual_fk` FOREIGN KEY (`NOMOR_JUAL`) REFERENCES `mjual` (`NOMOR_JUAL`) ON UPDATE CASCADE,
CONSTRAINT `djual_fk1` FOREIGN KEY (`ID_BARANG`) REFERENCES `barang` (`ID_BARANG`) ON UPDATE CASCADE
)
//tabel barang
CREATE TABLE `barang` (
`ID_BARANG` varchar(20) NOT NULL,
`NAMA_BARANG` varchar(75) default NULL,
`SATUAN` varchar(10) default NULL,
`HARGA_BELI` double default '0',
`HARGA_BARANG` double default '0',
`STOK` int(11) default '0',
`NAMA_SUPPLIER` varchar(30) default NULL,
PRIMARY KEY (`ID_BARANG`),
UNIQUE KEY `IDGuru` (`ID_BARANG`),
KEY `IDSupplier` (`NAMA_SUPPLIER`),
CONSTRAINT `barang_fk` FOREIGN KEY (`NAMA_SUPPLIER`) REFERENCES `supplier` (`NAMA_SUPPLIER`) ON UPDATE CASCADE
)
//tabel supplier
CREATE TABLE `supplier` (
`NAMA_SUPPLIER` varchar(30) NOT NULL,
`ALAMAT` varchar(100) default NULL,
`TELEPON` varchar(30) default NULL,
`EMAIL` varchar(50) default NULL,
`NAMA_SALESMAN` varchar(30) default NULL,
`TELEPON_SALESMAN` varchar(30) default NULL,
`SISA_HUTANG` double default '0',
)
misalnya saya punya data tabel barang seperti ini
ID_BARANG | NAMA_BARANG | STOK | HARGA_BARANG
00000000001 | sabun colek | 100 | 3000
00000000002 | sabun mandi | 100 | 1500
nah nanti di tabel penjualan (detail) ketika kita masukin
kode 00000000001
jumlah penjualan 15,
maka stok 00000000001 harus menjadi 85. (inilah yang dimaksud trigger AFTER INSERT)
stok hanya akan berkurang, JIKA barang terjual (sesuai kodebarang yang diinput)
CREATE TRIGGER `djual_after_ins_tr` AFTER INSERT ON `djual`
FOR EACH ROW
BEGIN
UPDATE barang SET stok = stok - NEW.jumlah
WHERE ID_Barang = NEW.ID_Barang;
END;
nah gimana kalo ternyata salah input? trus jumlahnya bukan 15, tapi 20, kita tinggal update aja detail penjualannya, ganti si 15 jadi 20
kode 00000000001
jumlah penjualan 20,
maka stok 00000000001 harus menjadi 80. (inilah yang dimaksud trigger AFTER UPDATE)
CREATE TRIGGER `djual_after_upd_tr` AFTER UPDATE ON `djual`
FOR EACH ROW
BEGIN
UPDATE barang SET stok = stok - NEW.jumlah + OLD.jumlah
WHERE ID_Barang = OLD.ID_Barang;
END;
berhubung kemaren ada yang request jadi saya tempel di blog ini
oke langsung aja,
jadi trigger itu fungsinya untuk jadi pemicu, misalnya :
pas kita jual barang, stok harus berkurang....
pas kita beli barang, stok harus bertambah...
pas kita update penjualan, stok harus dikurangi yang lama dan ditambah yang baru...
nah itu lah yang gunanya trigger, kalo ga pake trigger juga bisa, tapi lambat dan codingnya ribet.
misalnya saya punya tabel penjualan (master & detail) seperti ini
//Master
CREATE TABLE `mjual` (
`NOMOR_JUAL` char(10) NOT NULL,
`TANGGAL` date NOT NULL,
`NOPLAT` varchar(10) default NULL,
`MOTOR` varchar(20) default NULL,
`BIAYA_PASANG` double default '0',
`JENIS_BAYAR` varchar(20) default 'TUNAI',
`STATUS` varchar(50) default 'LUNAS',
PRIMARY KEY (`NOMOR_JUAL`),
UNIQUE KEY `IDJual` (`NOMOR_JUAL`)
)
//detail
CREATE TABLE `djual` (
`NOMOR_JUAL` char(10) NOT NULL,
`ID_BARANG` varchar(20) NOT NULL,
`JUMLAH` int(11) default '0',
`HARGA_JUAL` double default '0',
`DISKON` double default '0',
KEY `IDJual` (`NOMOR_JUAL`),
KEY `IDBarang` (`ID_BARANG`),
CONSTRAINT `djual_fk` FOREIGN KEY (`NOMOR_JUAL`) REFERENCES `mjual` (`NOMOR_JUAL`) ON UPDATE CASCADE,
CONSTRAINT `djual_fk1` FOREIGN KEY (`ID_BARANG`) REFERENCES `barang` (`ID_BARANG`) ON UPDATE CASCADE
)
//tabel barang
CREATE TABLE `barang` (
`ID_BARANG` varchar(20) NOT NULL,
`NAMA_BARANG` varchar(75) default NULL,
`SATUAN` varchar(10) default NULL,
`HARGA_BELI` double default '0',
`HARGA_BARANG` double default '0',
`STOK` int(11) default '0',
`NAMA_SUPPLIER` varchar(30) default NULL,
PRIMARY KEY (`ID_BARANG`),
UNIQUE KEY `IDGuru` (`ID_BARANG`),
KEY `IDSupplier` (`NAMA_SUPPLIER`),
CONSTRAINT `barang_fk` FOREIGN KEY (`NAMA_SUPPLIER`) REFERENCES `supplier` (`NAMA_SUPPLIER`) ON UPDATE CASCADE
)
//tabel supplier
CREATE TABLE `supplier` (
`NAMA_SUPPLIER` varchar(30) NOT NULL,
`ALAMAT` varchar(100) default NULL,
`TELEPON` varchar(30) default NULL,
`EMAIL` varchar(50) default NULL,
`NAMA_SALESMAN` varchar(30) default NULL,
`TELEPON_SALESMAN` varchar(30) default NULL,
`SISA_HUTANG` double default '0',
)
misalnya saya punya data tabel barang seperti ini
ID_BARANG | NAMA_BARANG | STOK | HARGA_BARANG
00000000001 | sabun colek | 100 | 3000
00000000002 | sabun mandi | 100 | 1500
nah nanti di tabel penjualan (detail) ketika kita masukin
kode 00000000001
jumlah penjualan 15,
maka stok 00000000001 harus menjadi 85. (inilah yang dimaksud trigger AFTER INSERT)
stok hanya akan berkurang, JIKA barang terjual (sesuai kodebarang yang diinput)
CREATE TRIGGER `djual_after_ins_tr` AFTER INSERT ON `djual`
FOR EACH ROW
BEGIN
UPDATE barang SET stok = stok - NEW.jumlah
WHERE ID_Barang = NEW.ID_Barang;
END;
nah gimana kalo ternyata salah input? trus jumlahnya bukan 15, tapi 20, kita tinggal update aja detail penjualannya, ganti si 15 jadi 20
kode 00000000001
jumlah penjualan 20,
maka stok 00000000001 harus menjadi 80. (inilah yang dimaksud trigger AFTER UPDATE)
CREATE TRIGGER `djual_after_upd_tr` AFTER UPDATE ON `djual`
FOR EACH ROW
BEGIN
UPDATE barang SET stok = stok - NEW.jumlah + OLD.jumlah
WHERE ID_Barang = OLD.ID_Barang;
END;
nah gimana kalo salah? dan datanya harus dihapus?
contoh kode 00000000001 uda dimasukkin jumlah jualnya 15, trus mau dihapus karena salah, tentu stoknya harus kembali lagi kan jadi 100,
(inilah yang dimaksud trigger BEFORE DELETE)
jadi sebelum datanya dihapus, sistem otomatis kembalikan stok yang lama.
CREATE TRIGGER `djual_before_del_tr` BEFORE DELETE ON `djual`
FOR EACH ROW
BEGIN
UPDATE barang SET stok = stok + OLD.jumlah
WHERE ID_Barang = OLD.ID_Barang;
END;
yah silahkan anda coba di db engine masing2, sesuaikan sintaksnya dengan versi SQL yang dipakai :D
Semoga membantu,
thanks.
Kamis, 08 Agustus 2013
C# - Membuat Koneksi Dan Melakukan Operasi Database (SQLite embedded database)
Selamat Sore pemirsa setia :D
kali ini saya akan bagikan source code c# untuk membuat koneksi dengan embedded database SQLite
Oke langsung saja
using System;
using System.Collections.Generic;
using System.ComponentModel;
using System.Data;
using System.Drawing;
using System.Linq;
using System.Text;
using System.Windows.Forms;
using System.Data.SQLite;
//.....//
public frm_department()
{
InitializeComponent();
}
//Tambahkan coding ini setelah constructor (constructor itu kira2 seperti diatas)
private SQLiteConnection conn;
private DataSet ds;
private SQLiteCommand cmd;
private SQLiteDataAdapter sda;
private SQLiteCommandBuilder cmdBuilder;
//Bagian Merah dibawah boleh diganti dengan nama database yang anda inginkan.. directorynya pun bebas terserah anda
private void exec(String query)
{
conn = new SQLiteConnection(@"Data Source=D:\School.sdb;
PRAGMA journal_mode = OFF;
PRAGMA synchronous = OFF;
PRAGMA locking_mode = EXCLUSIVE;
PRAGMA temp_store = MEMORY;
PRAGMA page_size = 4096;
PRAGMA cache_size = 10000;");
conn.Open();
ds = new DataSet();
cmd = conn.CreateCommand();
string sql = query;
sda = new SQLiteDataAdapter(sql, conn);
cmdBuilder = new SQLiteCommandBuilder(sda);
sda.Fill(ds);
}
Nah coding diatas untuk Procedure, sedangkan untuk mengisi Query seperti ini :
//Pembuatan Embedded database
exec("CREATE TABLE [Departments] ( " +
"[Department_ID] INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT, " +
"[Faculty_ID] INTEGER NOT NULL," +
"[Employee_ID] INTEGER NOT NULL," +
"[Title] TEXT NOT NULL," +
"[Description] TEXT NOT NULL," +
"[Address] TEXT NOT NULL," +
"[Phone] TEXT NOT NULL," +
"[Date_Register] datetime NOT NULL" +
");");
//Operasi Input Data
exec("insert into departments(faculty_id,employee_id, title, description, address, phone, date_register)"+
"values ("+
"'" + g_faculty_ID.SelectedItem + "',"+
"'" + g_Personnel_Id.SelectedItem + "'," +
"'" + txt_Title.Text + "'," +
"'" + txt_Description.Text + "'," +
"'" + txt_Address.Text + "'," +
"'" + txt_Phone.Text + "'," +
"datetime('now','localtime') );");
MessageBox.Show("Done!");
Jangan lupa di bagian Reference tambahkan SQLite.dll (seperti menambahkan reference Mysqlconnector pada Database server)
Oke sekian dan terimakasih
Bila ada yang ingin ditanyakan silahkan Comment disini :
kali ini saya akan bagikan source code c# untuk membuat koneksi dengan embedded database SQLite
Oke langsung saja
using System;
using System.Collections.Generic;
using System.ComponentModel;
using System.Data;
using System.Drawing;
using System.Linq;
using System.Text;
using System.Windows.Forms;
using System.Data.SQLite;
//.....//
public frm_department()
{
InitializeComponent();
}
//Tambahkan coding ini setelah constructor (constructor itu kira2 seperti diatas)
private SQLiteConnection conn;
private DataSet ds;
private SQLiteCommand cmd;
private SQLiteDataAdapter sda;
private SQLiteCommandBuilder cmdBuilder;
//Bagian Merah dibawah boleh diganti dengan nama database yang anda inginkan.. directorynya pun bebas terserah anda
private void exec(String query)
{
conn = new SQLiteConnection(@"Data Source=D:\School.sdb;
PRAGMA journal_mode = OFF;
PRAGMA synchronous = OFF;
PRAGMA locking_mode = EXCLUSIVE;
PRAGMA temp_store = MEMORY;
PRAGMA page_size = 4096;
PRAGMA cache_size = 10000;");
conn.Open();
ds = new DataSet();
cmd = conn.CreateCommand();
string sql = query;
sda = new SQLiteDataAdapter(sql, conn);
cmdBuilder = new SQLiteCommandBuilder(sda);
sda.Fill(ds);
}
Nah coding diatas untuk Procedure, sedangkan untuk mengisi Query seperti ini :
//Pembuatan Embedded database
exec("CREATE TABLE [Departments] ( " +
"[Department_ID] INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT, " +
"[Faculty_ID] INTEGER NOT NULL," +
"[Employee_ID] INTEGER NOT NULL," +
"[Title] TEXT NOT NULL," +
"[Description] TEXT NOT NULL," +
"[Address] TEXT NOT NULL," +
"[Phone] TEXT NOT NULL," +
"[Date_Register] datetime NOT NULL" +
");");
//Operasi Input Data
exec("insert into departments(faculty_id,employee_id, title, description, address, phone, date_register)"+
"values ("+
"'" + g_faculty_ID.SelectedItem + "',"+
"'" + g_Personnel_Id.SelectedItem + "'," +
"'" + txt_Title.Text + "'," +
"'" + txt_Description.Text + "'," +
"'" + txt_Address.Text + "'," +
"'" + txt_Phone.Text + "'," +
"datetime('now','localtime') );");
MessageBox.Show("Done!");
Jangan lupa di bagian Reference tambahkan SQLite.dll (seperti menambahkan reference Mysqlconnector pada Database server)
Oke sekian dan terimakasih
Bila ada yang ingin ditanyakan silahkan Comment disini :
Sabtu, 03 Agustus 2013
DELPHI - Backup Restore MySQL di delphi dengan komponen Open dan Save Dialog
Malam Pemirsa setia :D
Good night...!
Here Coding to BackUp and Restore your Database with Delphi
for example :
Database : Bengkel ( colored Red, according to your own database - tergantung anda )
Password : 1234 ( colored Red, same, it totally based on your own password - tergantung anda )
Folder MySQL : C:\Program Files (x86)\MySQL\MySQL Server 5.0\bin\
(folder MySQL it depends on your directory - tergantung tempat anda install mysql)
add component SaveDialog and OpenDialog on your form
BackUp
SaveDialog1.Execute;
if SaveDIalog1.FileName<>'' then
begin
ShellExecute(self.Handle, PCHAR('open'),
PCHAR('C:\Program Files (x86)\MySQL\MySQL Server 5.0\bin\mysqldump.exe'),
PCHAR('-uroot -p1234 -hlocalhost -R -r "'+ SaveDialog1.FileName+'.sql" bengkel'),
PCHAR('C:\Program Files (x86)\MySQL\MySQL Server 5.0\bin'),SW_SHOW);
MessageDlg('Data Berhasil di Backup !!', mtInformation, [mbOK], 0);
end
else
MessageDlg('GAGAL. Harap Pilih Lokasi!!', mtInformation, [mbOK], 0);
Restore
OpenDialog1.Execute;
if OpenDialog1.FileName<>'' then
begin
ShellExecute(self.Handle,pchar('open'),
PCHAR('C:\Program Files (x86)\MySQL\MySQL Server 5.0\bin\mysql.exe'),
PCHAR('-uroot -p1234 -hlocalhost -e "drop database if exists bengkel; '+
'create database bengkel; use bengkel;\. '+OpenDialog1.FileName+'"'),nil,SW_HIDE);
MessageDlg('Data Berhasil di Restore !!', mtInformation, [mbOK], 0);
end
else
MessageDlg('GAGAL. Harap Pilih Lokasi !!!', mtInformation, [mbOK], 0);
end;
OK easy right?
thanks 4 ur attention and see the next Update at giavano.blogspot.com
Thank you
Good night...!
Here Coding to BackUp and Restore your Database with Delphi
for example :
Database : Bengkel ( colored Red, according to your own database - tergantung anda )
Password : 1234 ( colored Red, same, it totally based on your own password - tergantung anda )
Folder MySQL : C:\Program Files (x86)\MySQL\MySQL Server 5.0\bin\
(folder MySQL it depends on your directory - tergantung tempat anda install mysql)
add component SaveDialog and OpenDialog on your form
BackUp
SaveDialog1.Execute;
if SaveDIalog1.FileName<>'' then
begin
ShellExecute(self.Handle, PCHAR('open'),
PCHAR('C:\Program Files (x86)\MySQL\MySQL Server 5.0\bin\mysqldump.exe'),
PCHAR('-uroot -p1234 -hlocalhost -R -r "'+ SaveDialog1.FileName+'.sql" bengkel'),
PCHAR('C:\Program Files (x86)\MySQL\MySQL Server 5.0\bin'),SW_SHOW);
MessageDlg('Data Berhasil di Backup !!', mtInformation, [mbOK], 0);
end
else
MessageDlg('GAGAL. Harap Pilih Lokasi!!', mtInformation, [mbOK], 0);
Restore
OpenDialog1.Execute;
if OpenDialog1.FileName<>'' then
begin
ShellExecute(self.Handle,pchar('open'),
PCHAR('C:\Program Files (x86)\MySQL\MySQL Server 5.0\bin\mysql.exe'),
PCHAR('-uroot -p1234 -hlocalhost -e "drop database if exists bengkel; '+
'create database bengkel; use bengkel;\. '+OpenDialog1.FileName+'"'),nil,SW_HIDE);
MessageDlg('Data Berhasil di Restore !!', mtInformation, [mbOK], 0);
end
else
MessageDlg('GAGAL. Harap Pilih Lokasi !!!', mtInformation, [mbOK], 0);
end;
OK easy right?
thanks 4 ur attention and see the next Update at giavano.blogspot.com
Thank you
Langganan:
Postingan (Atom)
.png)
.png)
.png)
.png)