Category Archives: Delphi

Cara sederhana membuat tampilan UNICODE pada Delphi 2006 kebawah

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 ..
unicode.jpg

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

RTLVersion Constant, solusi conditional defines yang lebih baik

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.

Membuat effect RGB pada gambar menggunakan delphi

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

Kode sederhana membuat tampilan Bitmap menjadi negatif

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

Memperbaiki “bug” TDataSetInsert (ActionList)

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

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

Tips Optimasi agar loading IDE delphi lebih cepat, ringan dan nyaman dipakai

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

Unit khusus (Library) untuk cek koneksi database Client Server

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

Terjadi error “Unit XXX was compiled with a different version of YYY”, bagaimana solusinya?

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.

Mengoptimalkan kemampuan VCL IBX (Interbase Express)

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