Category Archives: Delphi
Apakah UNICODE itu?
UNICODE adalah suatu standar industri yang dirancang untuk mengijinkan teks dan simbol dari semua tulisan di dunia untuk ditampilkan dan dimanipulasi secara konsisten oleh komputer.
Dengan UNICODE kita dapat menampilkan teks atau simbol khusus (kode ASCII diatas 255) seperti tulisan Arab, China, Latin dan lain-lain.
Pada UNICODE setiap karakter disimpan dalam 2 byte (2x karakter biasa), sehingga memungkinkan ada $FFFF (65535 karakter).
Dukungan Delphi terhadap UNICODE dimulai sejak Delphi 2009, lalu bagaimana nasib pengguna Delphi dibawah 2009, apakah harus gigit jari ..?
Tenang ….. , dengan trik sederhana kita pengguna Delphi yang belum mendukung UNICODE (Delphi 2006 atau bahkan Delphi 7) dapat menikmati tampilan UNICODE tanpa hapus menginstall komponen tambahan.
Sudah gak sabar ya ..
Langsung aja deh ini penampakannya ..
Ini source kodenya
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TFMain = class(TForm)
procedure FormPaint(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FMain: TFMain;
const
arbBasmalah: array[0..30] of WideChar =
(#$0628,#$0640,#$0633,#$0640,#$0640,
#$0640,#$0640,#$0640,#$0640,#$0640,
#$0640,#$0645,#$0020,#$0627,#$0644,
#$0644,#$0647,#$0020,#$0627,#$0644,
#$0631,#$062D,#$0645,#$0646,#$0020,
#$0627,#$0644,#$0631,#$062D,#$064A,
#$0645);
arbImam: array[0..8] of WideChar = (#$0627,#$0645,#$0627,#$0645,
#$0020,#$062D,#$0627,#$0644,#$0645);
implementation
{$R *.dfm}
procedure TextSizeW(Canvas:TCanvas;ws:WideString;var sz:TSize);
begin
GetTextExtentPoint32W(Canvas.Handle,PWideChar(ws),Length(ws),sz);
end;
procedure TulisUnicode(Canvas:TCanvas;Left,Top:Integer;sText:WideString);
var
r: TRect;
sz: TSize;
begin
with Canvas do
begin
TextSizeW(Canvas,sText,sz);
r:=Rect(Left,Top,Left+sz.cx,Top+sz.cy);
DrawTextW(Handle,PWideChar(sText),Length(sText),r,DT_CENTER);
end;
end;
procedure TFMain.FormPaint(Sender: TObject);
begin
with Canvas do
begin
Brush.Style:=bsClear;
with Font do
begin
Name:='Times New Roman';
Size:=40;
Color:=clGreen;
end;
end;
TulisUnicode(Canvas,10,10,arbBasmalah);
Canvas.Font.Color:=clMaroon;
TulisUnicode(Canvas,10,100,arbImam);
end;
end.
Kalo males ngoding sendiri, boleh langsung download aja disini
https://www.box.com/s/kbax7j9xur8ienj8v3vw
Catatan:
Telah diuji menggunakan Turbo Delphi 2006 dan Delphi 7
Tools untuk mempermudah generate array akan di posting menyusul
== Semoga Bermanfaat ==
Sumber mengenai UNICODE dapat dibaca di
http://edn.embarcadero.com/article/38437
http://en.wikipedia.org/wiki/Unicode
http://id.wikipedia.org/wiki/Unicode
Pada setiap perkembangan versi delphi tentunya terdapat fitur-fitur baru yang ada kalanya tidak kompatibel dengan versi sebelumnya.
Pada saat tertentu kita perlu membuat aplikasi menggunakan Turbo Delphi 2006 namun disaat yang lain kita ingin aplikasi tersebut dapat juga di compile menggunakan Delphi 7.
Sebagai contoh, pada project Delphi 2007 keatas ada property Application.MainFormOnTaskbar, yang mana akan terjadi error bila dicompile menggunakan Delphi 2006 kebawah.
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(...., ....);
Application.Run;
end.
Perbedaan lain adalah type variable PChar, yang pada pada delphi yang unicode (Delphi 2009 keatas) adalah sama dengan WideChar sementara pada Delphi versi sebelumnya PChar sama dengan AnsiChar.
Untuk dapat membuat aplikasi yang dapat dikompilasi dengan berbagai macam versi delphi solusinya kita dapat menggunakan Conditional Define.
Condition Define yang banyak dipakai menggunakan {$IFDEF VERxxx} seperti contoh berikut ini
{$IFDEF VER210}
{$DEFINE D2010}
{$DEFINE D2009}
{$DEFINE D2007}
{$DEFINE D2006}
{$DEFINE D2005}
{$DEFINE DELPHI6UP}
{$DEFINE DELPHI7UP}
{$WARN UNIT_PLATFORM OFF}
{$WARN SYMBOL_PLATFORM OFF}
{$DEFINE SPLASH}
{$ENDIF}
{$IFDEF VER200}
{$DEFINE D2009}
{$DEFINE D2007}
{$DEFINE D2006}
{$DEFINE D2005}
{$DEFINE DELPHI6UP}
{$DEFINE DELPHI7UP}
{$WARN UNIT_PLATFORM OFF}
{$WARN SYMBOL_PLATFORM OFF}
{$DEFINE SPLASH}
{$ENDIF}
{$IFDEF VER185}
{$DEFINE D2007}
{$DEFINE D2006}
{$DEFINE D2005}
{$DEFINE DELPHI6UP}
{$DEFINE DELPHI7UP}
{$WARN UNIT_PLATFORM OFF}
{$WARN SYMBOL_PLATFORM OFF}
{$DEFINE SPLASH}
{$ENDIF}
{$IFDEF VER180}
{$DEFINE D2006}
{$DEFINE D2005}
{$DEFINE DELPHI6UP}
{$DEFINE DELPHI7UP}
{$WARN UNIT_PLATFORM OFF}
{$WARN SYMBOL_PLATFORM OFF}
{$DEFINE SPLASH}
{$ENDIF}
{$IFDEF VER170}
{$DEFINE D2005}
{$DEFINE DELPHI6UP}
{$DEFINE DELPHI7UP}
{$WARN UNIT_PLATFORM OFF}
{$WARN SYMBOL_PLATFORM OFF}
{$DEFINE SPLASH}
{$ENDIF}
{$IFDEF VER150}
{$DEFINE COMPILER7}
{$IFDEF BCB}
{$DEFINE BCB7}
{$DEFINE BCB}
{$DEFINE DELPHI6UP}
{$ELSE}
{$DEFINE DELPHI7}
{$DEFINE DELPHI}
{$DEFINE DELPHI6UP}
{$DEFINE DELPHI7UP}
{$ENDIF}
{$WARN UNIT_PLATFORM OFF}
{$WARN SYMBOL_PLATFORM OFF}
{$ENDIF}
Kelemahan dari cara diatas adalah bila kita menggunakan Delphi diatas Delphi 2010, compiler akan menganggap kita menggunakan Delphi 7 kebawah, tentunya hal ini akan berakibat yg tidak kita harapkan.
Solusi terbaik kita dapat menggunakan Konstanta RTLVersion.
Pada contoh berikut akan menghasilkan kode yang berbeda jika dicompile menggunakan Delphi dibawah Delphi 2006.
procedure TForm1.Button1Click(Sender: TObject);
begin
{$IF RTLVersion>=18}
ShowMessage('Anda menggunakan Delphi 2006 keatas');
{$ELSE}
ShowMessage('Upgrade Delphi anda untuk mendukung versi baru');
{$IFEND}
end;
Contoh lain
{$R *.res}
begin
Application.Initialize;
{$IF RTLVersion>=18.5}
Application.MainFormOnTaskbar := True;
{$IFEND}
Application.CreateForm(...., ....);
Application.Run;
end.
Berikut ini daftar kontanta masing-masing versi Delphi.
VERxxx |
RTLVersion |
Delphi Version |
VER140 |
14 |
Delphi 6 |
VER150 |
15 |
Delphi 7 |
VER160 |
16 |
Delphi 8, BDS 2.0 |
VER170 |
17 |
Delphi 2005, Delphi 9, BDS 3.0 |
VER180 |
18 |
Turbo Delphi, Delphi 2006, Delphi 10, BDS 4.0 |
VER185 |
18.5 |
Delphi 2007, Delphi 11, BDS 5.0 |
VER200 |
20 |
Delphi 2009, Delphi 12, BDS 6.0 |
VER210 |
21 |
Delphi 2010, delphi 13, RAD 7.0 |
VER220 |
22 |
Delphi XE, Delphi 14, RAD 8.0 |
VER230 |
23 |
Delphi XE2, Delphi 15, RAD 9.0 |
VER240 |
24 |
Delphi XE3, Delphi 16, RAD 10.0 |
Semoga bermanfaat.
Langsung aja ya ..
Berikut ini contoh aplikasi untuk merubah intensitas warna (RGB) pada sebuah gambar bitmap (bmp/jpg).
Klik Load Picture untuk memuat gambar dari file (jpg/bmp) yang akan di proses.
Setelah itu atur Trackbar (Red, Green, Blue) sesuai keinginan sehingga akan memperoleh hasil seperti gambar berikut.
Untuk mengembalikan gambar pada warna asli kita cukup menekan Reset.
Untuk menyimpan hasilnya Klik Save Picture.
Berikut ini kode selengkapnya ..
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, jpeg, ExtCtrls, StdCtrls, ExtDlgs;
type
TForm1 = class(TForm)
tbRed: TTrackBar;
imgFoto: TImage;
btLoad: TButton;
tbGreen: TTrackBar;
tbBlue: TTrackBar;
btReset: TButton;
opd: TOpenPictureDialog;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Panel1: TPanel;
btSave: TButton;
SavePictureDialog1: TSavePictureDialog;
procedure TrackBarAllChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btLoadClick(Sender: TObject);
procedure btResetClick(Sender: TObject);
procedure btSaveClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
bAsli: TBitmap;
bEffect: TBitmap;
implementation
{$R *.dfm}
procedure TForm1.btLoadClick(Sender: TObject);
begin
if opd.Execute then
begin
imgFoto.Picture.LoadFromFile(opd.FileName);
bAsli.Assign(imgFoto.Picture.Graphic);
bAsli.PixelFormat:=pf24bit;
bEffect.Assign(bAsli);
tbRed.Enabled:=True;
tbGreen.Enabled:=True;
tbBlue.Enabled:=True;
btSave.Enabled:=True;
end else
begin
imgFoto.Picture:=nil;
tbRed.Enabled:=False;
tbGreen.Enabled:=False;
tbBlue.Enabled:=False;
btSave.Enabled:=False;
end;
end;
procedure TForm1.btResetClick(Sender: TObject);
begin
tbRed.Position:=tbRed.Max;
tbGreen.Position:=tbGreen.Max;
tbBlue.Position:=tbBlue.Max;
end;
procedure TForm1.btSaveClick(Sender: TObject);
var
jpg: TJPEGImage;
begin
if SavePictureDialog1.Execute then
begin
jpg:=TJPEGImage.Create;
jpg.Assign(imgFoto.Picture.Graphic);
jpg.SaveToFile(SavePictureDialog1.FileName);
jpg.Free;
ShowMessage('Done');
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
bAsli:=TBitmap.Create;
bEffect:=TBitmap.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
bAsli.Free;
bEffect.Free;
end;
procedure TForm1.TrackBarAllChange(Sender: TObject);
var
x,y: Integer;
baAsli,baEffect: PByteArray;
begin
for y:=0 to bEffect.Height-1 do
begin
baAsli:=bAsli.ScanLine[y];
baEffect:=bEffect.ScanLine[y];
for x:=0 to bEffect.Width-1 do
begin
baEffect[x*3]:=Trunc(baAsli[x*3]*tbBlue.Position/tbBlue.Max);
baEffect[x*3+1]:=Trunc(baAsli[x*3+1]*tbGreen.Position/tbGreen.Max);
baEffect[x*3+2]:=Trunc(baAsli[x*3+2]*tbRed.Position/tbRed.Max);
end;
end;
imgFoto.Picture.Bitmap.Assign(bEffect);
end;
end.
Contoh aplikasi dapat didownload di https://www.box.com/s/u18279aflcnb4pc2lysk
Berikut ini contoh kode sederhana untuk merubah tampilan gambar bitmap menjadi menjadi negatif.
Klik Load Image untuk memuat gambar dari file (jpg/bmp) dan Klik Invert untuk membalik tampilannya.
Kodenya cukup singkat cuman beberapa baris
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenPictureDialog1.Execute then
begin
Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
Button2.Enabled:=True;
end else
begin
Image1.Picture:=nil;
Button2.Enabled:=False;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
b: TBitmap;
x,y: Integer;
ba: PByteArray;
begin
b:=TBitmap.Create;
b.Assign(Image1.Picture.Graphic);
b.PixelFormat:=pf24bit;
for y:=0 to b.Height-1 do
begin
ba:=b.ScanLine[y];
for x:=0 to b.Width*3-1 do
ba[x]:=255-ba[x];
end;
Image2.Picture.Bitmap.Assign(b);
b.Free;
end;
Contoh aplikasi selengkapnya bisa di download di …
https://www.box.com/s/rnvjn3jgfeqaj6qyogf2
Pada komponen ActionList telah disediakan banyak sekali action Standard yang akan sangat membantu dalam pemrograman delphi tanpa harus menulis code lagi secara manual.
Fungi-fungsi standar seperti File, Edit, Dataset dan lain-lain sudah tersedia kita tinggal pake, jika dikehendaki kita hanya perlu mengganti Caption dan iconnya saja.
Dalam prakteknya action standard yang telah disediakan ada kalanya tidak sesuai atau kurang mewakili kebutuhan kita.
Setelah pada bahasan sebelumnya kita Menambahkan dialog konfirmasi pada TDataSetDelete, kali kita akan memperbaiki “bug” yang ada pada TDataSetInsert.
Pada TDataSetInsert yang asli (contoh kasus menggunakan Delphi 2006), dia tetap aktif setelah kita melakukan Insert atau Edit. Hal ini cukup mengganggu kenyamanan manakala setelah user melakukan Insert/Edit belum selesai kemudian tanpa sengaja menekan button insert lagi, akibatnya data yang belum lengkap akan tersimpan, hal ini bisa jadi masalah jika ada persyaratan semua field harus lengkap sebelum tersimpan.
Berikut ini contoh kodenya …
uses Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialogs, StdCtrls, ExtCtrls, DBCtrls,
Grids, DBGrids, DB, DBActns, ActnList;
type
// Tambahkan ini ...
TDataSetInsert = class(DBActns.TDataSetInsert)
procedure UpdateTarget(Target: TObject); override;
end;
// Sampai sini .. Tekan Ctrl+Shift C untuk menulis codenya
TForm1 = class(TForm)
...
...
...
{ TDataSetInsert }
procedure TDataSetInsert.UpdateTarget(Target: TObject);
begin
with GetDataSet(Target) do
Enabled := Active and CanModify and (State=dsBrowse);
end;
Semoga bermanfaat
Kapan menggunakan Open dan kapan mengunakan ExecSQL, hal ini sebenarnya merupakan aturan dasar dalam pemakaian komponen query, namun masih banyak delphier (khususnya pemula) yang sepertinya masih kurang faham penggunaan Open/ExecSQL.
Sering kali Open dan ExecSQL di kerjakan bersama2 dalam satu query sehingga mengakibatkan error atau hasil yang tidak sesuai harapan.
Kunci dasarnya sebenarnya mudah kok ..
Kalo script SQLnya mengandung kata-kata SELECT maka perintah yang boleh digunakan selanjutnya adalah ..
Open;
Append;
Insert;
Edit;
Post;
Delete;
Next;
Prev;
First;
Last;
Close;
Kalo script SQLnya mengandung kata-kata selain SELECT, yaitu INSERT, UPDATE, DELETE, EXECUTE PROCEDURE dan lain-lain maka perintah selanjutnya adalah ..
ExecSQL, yang lain tidak boleh dipergunakan.
Contoh (1):
Query.SQL.Text:='SELECT ID,"Nama" FROM DATA';
Query.Open; => (Query.Open; = Query.Active:=True;)
Query.Append;
Query.FieldByName('ID').AsInteger:=1;
Query.FieldByName('Nama').AsString:='Imam';
Query.Post;
Contoh (2):
Query.SQL.Text:='INSERT INTO DATA(ID,"Nama") VALUES(:P1,:P2)';
Query.Prepare;
Query.ParamByName('ID').AsInteger:=1;
Query.ParamByName('Nama').AsString:='Imam';
Query.ExecSQL;
setelah ExecSQL tidak boleh ada perintah Open dan lain-lain yang seperti digunakan pada contoh 1
LEBIH PENTING LAGI JANGAN GUNAKAN SATU KOMPONEN QUERY DIPAKAI GANTIAN OPEN DAN EXECSQL
Semoga bermanfaat
Salah satu yang membuat kita “kerasan” menggunakan delphi karena didukung beragam paket VCL (komponen) bawaan maupun tambahan yang dibuat oleh pihak ketiga.
Saat ini ada ratusan bahkan ribuan komponen bagus yang dibuat untuk delphi baik yang gratis maupun berbayar.
Semakin hari semakin banyak saja komponen bagus yang membuat kita “ngiler” untuk memasang di delphi kita.
Dengan semakin banyak komponen yang kita pasang konsekuensinya lambat laun akan membuat loading delphi menjadi berat karena membutuhkan lebih banyak resource.
Untuk meringgankan beban delphi, salah satu jalan yang kita tempuh adalah dengan mengurangi sebagian paket komponen, diinstall sebagian aja yang saat ini dibutuhkan.
Namun cara ini agak merepotkan bila mana kita sedang mengerjakan banyak proyek yang menggunakan macam2 komponen berbeda.
Saat mengerjakan proyek A, install paket A,B,C.
Saat mengerjakan proyek B, install paket A,B,E,F.
Saat mengerjakan proyek C, install pake layout model lama.
Ada solusi untuk masalah diatas yaitu memanggil IDE delphi dengan menggunakan konfigurasi yang berbeda (kita bisa membuat 2 atau lebih shortcut untuk ini).
Caranya kita copy shortcut yang ada menjadi beberapa sesuai kebutuhan lalu kita edit parameternya.
misalnya ..
Shortcut asli pada Delphi XE
“C:\Program Files\Embarcadero\RAD Studio\8.0\bin\bds.exe” -pDelphi
kita buat beberapa shortcut misalnya ..
“C:\Program Files\Embarcadero\RAD Studio\8.0\bin\bds.exe” -pDelphi -rPaketA
“C:\Program Files\Embarcadero\RAD Studio\8.0\bin\bds.exe” -pDelphi -rPaketB
“C:\Program Files\Embarcadero\RAD Studio\8.0\bin\bds.exe” -pDelphi -rPaketC
selanjutnya kita panggil masing2 shortcut dan lakukan kustomisasi, misalnya paket apa aja yg diinstall, layoutnya gimana dan setting lainnya.
Dengan membuat berberapa konfigurasi seperti diatas maka loading IDE delphi akan lebih cepat dan ringan karena tidak semua paket dimuat ke memory dan kita tidak perlu bolak/balik bongkar pasang paket.
Semoga bermanfaat
Pada Aplikasi yang menggunakan database berbasis Client Server, banyak hal yang menyebabkan gagalnya koneksi, antara lain server mati dan gangguan jaringan.
Biasanya untuk mengantisipasi hal tersebut kita menggunakan jurus try .. except .. end seperti contoh dibawah ini :
try
IBDatabase1.Open;
except
ShowMessage('Koneksi gagal');
end;
tetapi salah satu kekurangan cara tersebut adalah menampilkan pesan kesalahan terlalu lama, bahkan hingga aplikasi client menjadi not responding.
hal ini tidak baik mengingat kecepatan merupakan salah satu hal terpenting dalam koneksi client server.
Menyikapi hal tersebut diatas, semoga library kecil yang kami buat ini dapat membantu menjadi sebuah solusi yang dapat melakukan pemeriksaan kesiapan server dengan lebih cepat sebelum kita benar-benar melakukan koneksi ke database.
Library ini lumayan kecil (cuman sekitar 19KB) dan mendukung untuk pemeriksaan server Interbase, Firebird, MySQL, PostgreSQL, SQLServer dan Oracle.
Library beserta unit deklarasinya dapat di download secara gratis di ..
https://app.box.com/s/hy0g5mhghpry6z6ljnbs
Isi unit cek_remote_unit ..
unit cek_remote_unit;
(*
Cek Remote Utilities
Unit untuk mengecek database Client Server
mendukung Interbase, Firebird, MySQL, PostgreSQL, SQLServer, Oracle
ditulis oleh : Imam Chalimi Muslim, Maret 2013
http://www.facebook.com/imam.chalimi
http://www.facebook.com/groups/delphi.interbase
catatan:
Unit ini membutuhkan file cek_remote.dll
copykan file cek_remote.dll satu folder dengan aplikasinya
atau copykan ke c:\windows\system32
Revisi terakhir 7 Maret 2013
 *)
interface
uses
Windows;
type
TServerPort = (spInterbase, spMySQL, spPostgreSQL, spSQLServer,
spIB3051, spIB3052, spIB3053, spOracle);
function CekRemoteServer(IPAdress:string='127.0.0.1';ServerPort:TServerPort=spInterbase):Boolean; stdcall;
external 'cek_remote.dll';
function CekRemoteInterbase(IPAdress:string='127.0.0.1'):Boolean; stdcall;
external 'cek_remote.dll';
function CekRemoteMySQL(IPAdress:string='127.0.0.1'):Boolean; stdcall;
external 'cek_remote.dll';
function CekRemotePostgreSQL(IPAdress:string='127.0.0.1'):Boolean; stdcall;
external 'cek_remote.dll';
function CekRemoteSQLServer(IPAdress:string='127.0.0.1'):Boolean; stdcall;
external 'cek_remote.dll';
function CekRemoteOracle(IPAdress:string='127.0.0.1'):Boolean; stdcall;
external 'cek_remote.dll';
implementation
end.
Contoh penggunaan …
procedure TForm1.Button1Click(Sender: TObject);
begin
if not CekRemoteInterbase('192.168.0.1') then
begin
ShowMessage('Koneksi gagal');
Exit;
end;
try
IBDatabase1.Open;
except
ShowMessage('Database tidak dapat dibuka');
end;
end;
fungsi-fungsi yang tersedia ..
CekRemoteServer … contoh CekRemoteServer(‘192.168.0.1’,spInterbase);
CekRemoteInterbase … contoh CekRemoteInterbase(‘192.168.0.1’);
CekRemoteMySQL … contoh CekRemoteSQLServer(‘192.168.0.1’);
CekRemotePostgreSQL … contoh CekRemoteSQLServer(‘192.168.0.1’);
CekRemoteSQLServer … contoh CekRemoteSQLServer(‘192.168.0.1’);
CekRemoteOracle … contoh CekRemoteOracle(‘192.168.0.1’);
selain itu juga dapat digunakan untuk memeriksa port interbase non standard 3051-3053.
Semoga bermanfaat
Pada saat mengompile contoh project Indy tiba-tiba kita mendapatkan pesan error seperti gambar diatas, bagaimana cara mengatasinya?
Hal tersebut terjadi karena unit yang dibutuhkan project tersebut ada namun dicompile dengan menggunakan versi yang berbeda.
Pada contoh diatas terjadi karena unit SockApp.dcu dicompile bergantung pada unit IdTCPServer.dcu punya Indy9, sedangkan path IdTCPServer.dcu yang terdaftar di library delphi adalah Indy10 (ada 2 versi Indy yang terinstall).
Solusi pertama adalah merubah alamat Indy yang digunakan pada path Library.
Namun bila kita tidak ingin merubahnya dan ingin tetap menjadikan Indy10 sebagai default (versi lebih baru, lebih banyak fitur), solusinya adalah dengan menambahkan search path khusus project tersebut.
Caranya masuk menu Project-Option dan masukkan alamat Indy9 seperti pada gambar berikut.
Solusi ini bukan hanya untuk indy namun juga untuk unit/komponen lain yang kebetulan mempunyai nama yang sama namun beda versi.
Semoga bermanfaat.
Seperti diketahui bersama banyak sekali vcl untuk koneksi data Interbase menggunakan Delphi, salah satunya dan yang kaya fitur adalah FIBPlus, sayangnya FIBplus ini berbayar.
Pada kesempatan kali ini kita akan mencoba mengoptimalkan VCL IBX (IBExpress) dengan pertimbangan IBX ini adalah VCL bawaan Delphi.
Kita akan mencoba memasukkan beberapa fitur yang ada di FIBPlus kedalam IBX.
Beberapa fitur yang akan kita tambahkan diantaranya :
- Auto Commit .. Commit otomatis setelah Post
- Simple Query .. Query sederhana tanpa komponen
- GetServerTime .. Membaca jam pada server
- Gen_ID Â .. Mengambil nilai generator (Auto Number)
- Default Value .. Nilai default akan terisi otomatis
- Numeric Format .. Field Numeric akan ditampilkan berformat
- Show Memo Text .. Text asli akan ditampilkan di Field Memo
- Konfirmasi penghapusan (pada Actionlist)
Langsung saja ini source kodenya ..
unit IBXPlus;
(*
Advanced IBExpress by Imam Chalimi
First Release November 11, 2012
Last Update November 24, 2012
Feature :
- Delete Confirmation (ActionList)
- Simple Query
- Gen_ID
- GetServerTime
- AutoCommit
- AutoFill Default Value
- AutoFormat Numeric Field
- Show Memo Text
*)
interface
uses Windows, IBCustomDataSet, IBDataBase, DB, SysUtils,
Classes, Variants, DBActns, Forms, VsrWindows;
type
TDataSetDelete = class(DBActns.TDataSetDelete)
public
procedure ExecuteTarget(Target: TObject); override;
end;
TIBDataBase = class(IBDataBase.TIBDataBase)
public
function QueryValue(sSQL:string;sParam:array of Variant):Variant;
function QueryValues(sSQL:string;sParam:array of Variant):Variant;
function Gen_ID(sGenID:string;iStep:Int64):Int64;
function Execute(sSQL:string;sParam:array of Variant):Boolean;
function GetServerTime:TDateTime;
end;
TIBDataSet = class(IBCustomDataSet.TIBDataSet)
private
procedure InternalCommit;
public
procedure AutoGenerateSQLs;
published
procedure DoAfterPost; override;
procedure DoOnNewRecord; override;
procedure DoAfterDelete; override;
procedure DoAfterOpen; override;
end;
TIBBCDField = class(IBCustomDataSet.TIBBCDField)
public
constructor Create(AOwner: TComponent); override;
end;
TMemoField = class(DB.TMemoField)
procedure GetText(var Text: string;
DisplayText: Boolean); override;
end;
{Global Variable}
var
IBX_AutoComit,
IBX_ShowID,
IBX_ShowBlob,
IBX_DefaultValue: Boolean;
implementation
{ TIBDataSet }
procedure TIBDataSet.AutoGenerateSQLs;
begin
(*
== Menyusul ... ==
*)
// InsertSQL.Text:='';
// DeleteSQL.Text:='';
// ModifySQL.Text:='';
// RefreshSQL.Text:='';
end;
procedure TIBDataSet.DoAfterDelete;
begin
inherited;
InternalCommit;
end;
procedure TIBDataSet.DoAfterOpen;
var
i: Integer;
begin
inherited;
for i:=0 to Fields.Count-1 do
with Fields[i] do
case DataType of
ftInteger: if ((FieldName='ID') or
(Copy(FieldName,Length(FieldName)-3,3)='_ID')) then
begin
DisplayWidth:=5;
if FieldName='ID' then
ReadOnly:=True;
Visible:=IBX_ShowID;
end;
ftBlob: Visible:=IBX_ShowBlob;
ftDate: EditMask:='99/99/9999';
end;
end;
procedure TIBDataSet.DoAfterPost;
begin
inherited;
InternalCommit;
end;
procedure TIBDataSet.DoOnNewRecord;
var
i: Integer;
s: string;
begin
if IBX_DefaultValue then
for i:=0 to FieldCount-1 do
begin
s:='SELECT F.RDB$DEFAULT_SOURCE ' +
'FROM RDB$RELATION_FIELDS F ' +
'WHERE F.RDB$RELATION_NAME=:X ' +
'AND F.RDB$FIELD_NAME=:Y ' +
'AND F.RDB$DEFAULT_SOURCE STARTING WITH ''DEFAULT''';
s:=TIBDataBase(Database).
QueryValue(s,[PSGetTableName,Fields[i].FieldName]);
System.Delete(s,1,8);
s:='SELECT '+Trim(s)+' FROM RDB$DATABASE';
try
Fields[i].Value:=TIBDataBase(Database).QueryValue(s,[]);
except
end;
end;
inherited;
end;
procedure TIBDataSet.InternalCommit;
begin
if IBX_AutoComit and
(Tag<>999) then
Transaction.CommitRetaining;
end;
{ TIBBCDField }
constructor TIBBCDField.Create(AOwner: TComponent);
begin
inherited;
DisplayFormat:='#,##0.00';
end;
{ TIBDataBase }
function TIBDataBase.Execute(sSQL: string; sParam: array of Variant): Boolean;
var
i: Integer;
begin
with TIBDataSet.Create(nil) do
begin
Database:=Self;
SelectSQL.Text:=sSQL;
Prepare;
if Length(sParam)>0 then
begin
for i:=0 to Length(sParam)-1 do
Params[i].Value:=sParam[i];
Prepare;
end;
ExecSQL;
InternalCommit;
Free;
end;
end;
function TIBDataBase.Gen_ID(sGenID: string; iStep: Int64): Int64;
begin
with TIBDataSet.Create(nil) do
begin
Database:=Self;
SelectSQL.Text:=Format('SELECT GEN_ID(%s,%d) ' +
'FROM RDB$DATABASE',[sGenID,iStep]);
Open;
Result:=Fields[0].AsInteger;
Close;
Free;
end;
end;
function TIBDataBase.QueryValue(sSQL: string;sParam:array of Variant): Variant;
var
i: Integer;
begin
with TIBDataSet.Create(nil) do
begin
Database:=Self;
SelectSQL.Text:=sSQL;
if Length(sParam)>0 then
begin
for i:=0 to Length(sParam)-1 do
Params[i].Value:=sParam[i];
Prepare;
end;
Open;
Result:=Fields[0].Value;
Close;
Free;
end;
end;
function TIBDataBase.QueryValues(sSQL: string;
sParam: array of Variant): Variant;
var
i: Integer;
begin
with TIBDataSet.Create(nil) do
begin
Database:=Self;
SelectSQL.Text:=sSQL;
if Length(sParam)>0 then
begin
for i:=0 to Length(sParam)-1 do
Params[i].Value:=sParam[i];
Prepare;
end;
Open;
Result:=VarArrayCreate([0,FieldCount-1],varVariant);
for i:=0 to Fields.Count-1 do
Result[i]:=Fields[i].Value;
Close;
Free;
end;
end;
function TIBDataBase.GetServerTime: TDateTime;
begin
with TIBDataSet.Create(nil) do
begin
Database:=Self;
SelectSQL.Text:='SELECT CURRENT_TIMESTAMP ' +
'FROM RDB$DATABASE';
Open;
Result:=Fields[0].AsDateTime;
Close;
Free;
end;
end;
{ TDataSetDelete }
procedure TDataSetDelete.ExecuteTarget(Target: TObject);
begin
if MessageBox(Application.Handle,'Yakin Dihapus ?','Konfirmasi',MB_YESNO)=IDYES then
inherited;
end;
{ TMemoField }
procedure TMemoField.GetText(var Text: string; DisplayText: Boolean);
begin
Text:=GetAsString;
end;
initialization
IBX_AutoComit:=True;
IBX_ShowID:=False;
IBX_ShowBlob:=False;
IBX_DefaultValue:=False;
end.
Untuk menggunakan unit ini cukup mudah, tambahkan IBXPlus pada klausa uses.
Yang perlu diperhatikan penulisan IBXPlus pada klausa uses harus diletakkan paling belakang atau setelah unit uses IBxxxx.
contoh:
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialogs, ExtCtrls, DBCtrls, Grids, DBGrids,
DB, IBCustomDataSet, IBDatabase, IBXPlus;
Unit yang sudah siap pakai (khusus delphi 7 dan Delphi 2006/Turbo Delphi) dapat di download di:
Semoga bermanfaat