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:
- Delphi 7 … Â https://www.box.com/s/xast4eqnp16q8v80ebzy
- Turbo Delphi … Â https://www.box.com/s/ph75xaq2x9l8mue6xtg5
Semoga bermanfaat