Ads

Ads

Translate

Tuesday, 29 October 2013

MVC Dalam Delphi Programming II – Meniru Konsep CI

By Fajar  |  October 29, 2013 No comments


CATATAN: Jangan menggunakan variabel bertipe interface untuk menyimpan data bertipe TObject. Bikin Error!
CI atau Code Igniter mempunyai konsep mvc yang menarik. Dibanding Tulisan saya sebelumnya, model mvc yang ditawarkan oleh CIebih elegan. Dibandingkan konsep MVC yang saya gambarkan dulu, yang hanya memanggil/memanfaatkan prosedur konsep MVC CI memanfaatkan kelas. Dalam tutorial awal CI kita lihat contoh contoh kodingnya:
Controller:

View
Beberapa konsep yang perlu diperhatikan disini:
1. Kemunculan View diatur oleh controller
2. Apa (data apa) yang ditampilkan View  di-supply oleh controller. Dalam definisi lengkap MVC, controller mendapatkan data dari Model (dapat berupa perintah sql dalam database).
3. Data yang dipertukarkan antara View dengan controller mempunyai tipe data generik, dalam bentuk list.
Konsep ini dapat diterapkan diterjemahkan di dalam delphi sebagai berikut:
- Controller seharusnya berupa Class
- Data harus bertipe generik. Karena  Delphi strong type, hal tersebut dapat diakali dengan menggunakan data yang bertipe data objek, dan mempunyai property yang memungkinkan diakses dalam tipe data apapun.
Saya menerjemahkan model MVC code igniter tersebut di atas menjadi sebagai berikut:
unit con_canvaser;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Forms,
Dialogs, Controls, TypInfo, SDKHelper;
type
TErrMsg = string;
IMvcData = interface(IInterface)
['{7293B5D3-FC1F-4DB5-B764-3F94AD2427C8}']
procedure SetValueStr(const Name: string; const Value: string);
procedure SetValueInt(const Name: string; const Value: Integer);
procedure SetValueDouble(const Name: string; const Value: Double);
procedure SetValueCurrency(const Name: string; const Value: Currency);
procedure SetValueVar(const Name: string; const Value: Variant);
procedure SetValueDate(const Name: string; const Value: TDateTime);
procedure SetValueObj(const Name: string; const Value: TObject);
function GetValueStr(const Name: string): string;
function GetValueInt(const Name: string): Integer;
function GetValueDouble(const Name: string): Double;
function GetValueCurrency(const Name: string): Currency;
function GetValueVar(const Name: string): Variant;
function GetValueDate(const Name: string): TDateTime;
function GetValueObj(const Name: string): TObject;
property ValueStr[const Name: string]: string read GetValueStr Write SetValueStr;
property ValueInt[const Name: string]: Integer read GetValueInt Write SetValueInt;
property ValueDouble[const Name: string]: Double read GetValueDouble Write SetValueDouble;
property ValueCurrency[const Name: string]: Currency read GetValueCurrency Write SetValueCurrency;
property ValueVar[const Name: string]: Variant read GetValueVar Write SetValueVar;
property ValueDate[const Name: string]: TDateTime read GetValueDate Write SetValueDate;
property ValueObj[const Name: string]: TObject read GetValueObj Write SetValueObj;
end;
TDateTimeVar = class(TInterfacedObject,IInterface)
private
FData: TDateTime;
public
constructor Create(InitValue: TDateTime);
property Data: TDateTime read FData write FData;
end;
TMvcData = class(TInterfacedObject, IMvcData)
private
FList: TStringList;
public
constructor Create;
destructor Destroy; override;
procedure SetValueStr(const Name: string; const Value: string);
procedure SetValueInt(const Name: string; const Value: Integer);
procedure SetValueDouble(const Name: string; const Value: Double);
procedure SetValueCurrency(const Name: string; const Value: Currency);
procedure SetValueVar(const Name: string; const Value: Variant);
procedure SetValueDate(const Name: string; const Value: TDateTime);
procedure SetValueObj(const Name: string; const Value: TObject);
function GetValueStr(const Name: string): string;
function GetValueInt(const Name: string): Integer;
function GetValueDouble(const Name: string): Double;
function GetValueCurrency(const Name: string): Currency;
function GetValueVar(const Name: string): Variant;
function GetValueDate(const Name: string): TDateTime;
function GetValueObj(const Name: string): TObject;
property ValueStr[const Name: string]: string read GetValueStr Write SetValueStr;
property ValueInt[const Name: string]: Integer read GetValueInt Write SetValueInt;
property ValueDouble[const Name: string]: Double read GetValueDouble Write SetValueDouble;
property ValueCurrency[const Name: string]: Currency read GetValueCurrency Write SetValueCurrency;
property ValueVar[const Name: string]: Variant read GetValueVar Write SetValueVar;
property ValueDate[const Name: string]: TDateTime read GetValueDate Write SetValueDate;
property ValueObj[const Name: string]: TObject read GetValueObj Write SetValueObj;
end;
IView = interface(IInterface)
['{8318E550-2DC0-4A2A-B45C-C8A636D24702}']
procedure GetInitData(MvcData: IMvcData);
function GetOutputData: IMvcData;
end;
IController = interface
['{4F6CCA74-90BD-46EF-8507-26A1C9F1FDAF}']
procedure DoResponse;
function GetData: IMvcData;
procedure SetData(Data: IMvcData);
property Data: IMvcData read GetData write SetData;
end;
TController = class(TInterfacedObject, IController)
private
FMvcData: IMvcData;
public
procedure DoResponse;
function GetData: IMvcData;
procedure SetData(Data: IMvcData);
property Data: IMvcData read GetData write SetData;
constructor Create; virtual;
end;
{ Canvaser Controller
Dengan ini selurut tabel-tabel rujukan combobox diloag
}
TCanvaserController = class(TController)
{daftar yang diload di sini adalah untuk mengisi combo box,
cuma  ada dua field sebagai key dan lookup value saja}
Procedure ReloadDummy;
procedure ReloadDaftarKota;
procedure ReloadDaftarPropinsi;
procedure ReloadDaftarSales;
procedure ReloadDaftarStatus;
procedure ReloadDaftarJenisTransaksi;
constructor Create; override;  {reload All combo reference}
end;
TPenjualanController = class(TCanvaserController)
constructor Create; override;
end;
TMasterOutletController = class(TCanvaserController)
function IsOutletExist: Boolean;
function IsBlokir: Boolean;
function SetBlokir: TErrMsg;  //return ” if success, otherwise false!
function SetUnBlokir: TErrMsg;
function Delete: TErrMsg;
function PostUpdated: TErrMsg;
function PostInserted(var NewCustId: string): TErrMsg;
constructor Create; override;
end;
{
TMasterSalesController = class(TCanvaserController)
function IsOutletExist: Boolean;
function IsBlokir: Boolean;
function SetBlokir: TErrMsg;  //return ” if success, otherwise false!
function SetUnBlokir: TErrMsg;
function Delete: TErrMsg;
function PostUpdated: TErrMsg;
function PostInserted: TErrMsg;
constructor Create; override;
end;
}
//IDataset harus punya 2 field, satu bernama Key satu bernama Value , sementara ini berlaku untuk Key Integer dan Value String
procedure InitList(Source: IDataset; DestList: TStringList);
//mendapat index dari keyval list
function GetMvcListIndex(Items: TStrings; KeyVal: string): Integer;
//mem-free object-object List
procedure FreeOwnObjets(List: TStringList);
{General Dialogs}
function MsgDlgConfirm(Msg: string): Boolean;
procedure MsgDlgInformation(Msg: string);
procedure MsgDlgWarning(Msg: string);
procedure MsgDlgError(Msg: string);
{General View Fungtions}
procedure DisableControls(Controls: array of TControl);
procedure EnableControls(Controls: array of TControl);
{mencek apakah input terdapat karakter yang dilarang}
function Validate(Controls: array of TControl; PropName: string): Boolean;
implementation
uses mod_canvaser;
{ TMvcData }
constructor TMvcData.Create;
begin
FList:= TStringList.Create;
end;
destructor TMvcData.Destroy;
begin
FreeOwnObjets(FList);
FreeAndNil(FList);
inherited;
end;
function TMvcData.GetValueInt(const Name: string): Integer;
begin
if FList.Values[Name]<>” then
Result:= StrToInt(FList.Values[Name])
else
Result:= -1;
end;
function TMvcData.GetValueStr(const Name: string): string;
begin
Result:= FList.Values[Name];
end;
function TMvcData.GetValueObj(const Name: string): TObject;
var Index: Integer;
begin
Index:= ValueInt[Name+'INDEX'];
if Index>0 then begin
ShowMessage(‘[GET] Found Obj Name = ‘ + Name);
Result:= FList.Objects[Index];
end else begin
ShowMessage(‘[GET] NOT Found Obj Name = ‘ + Name);
Result:= nil;
end;
end;
function TMvcData.GetValueVar(const Name: string): Variant;
var Index: Integer;
begin
Result:= Null;
if FList.Find(Name,Index) then
Result:= FList.Values[Name];
end;
function TMvcData.GetValueCurrency(const Name: string): Currency;
begin
Result:=0.0;
if Trim(FList.Values[Name])<>” then
Result:= StrToCurr(FList.Values[Name]);
end;
function TMvcData.GetValueDate(const Name: string): TDateTime;
var
Index: Integer;
begin
if FList.Find(Name,Index) then begin
Result:= TDateTimeVar(FList.Objects[Index]).Data;
end;
end;
function TMvcData.GetValueDouble(const Name: string): Double;
var
Index: Integer;
Value: string;
begin
Result:= 0.0;
if FList.Find(Name,Index) then begin
Value:= FList.Values[Name];
if Trim(Value)<>” then
Result:= StrToFloat(Value);
end;
end;
procedure TMvcData.SetValueInt(const Name: string; const Value: Integer);
begin
FList.Values[Name]:= IntToStr(Value);
end;
procedure TMvcData.SetValueStr(const Name, Value: string);
begin
FList.Values[Name]:= Value;
end;
procedure TMvcData.SetValueObj(const Name: string; const Value: TObject);
var
Index: Integer;
begin
Index:= ValueInt[Name+'INDEX'];
if Index>0 then begin
ShowMessage(‘[SET] Found Obj Name = ‘ + Name);
FList.Objects[Index].Free;
FList.Objects[Index]:= Value;
end else begin
ShowMessage(‘[SET] NOT Found Obj Name = ‘ + Name);
ValueInt[Name+'INDEX']:=  FList.AddObject(Name, Value);
end;
end;
procedure TMvcData.SetValueVar(const Name: string; const Value: Variant);
begin
FList.Values[Name]:= VarToStr(Value);
end;
procedure TMvcData.SetValueCurrency(const Name: string; const Value: Currency);
begin
FList.Values[Name]:= CurrToStr(Value);
end;
procedure TMvcData.SetValueDate(const Name: string; const Value: TDateTime);
var
Index: Integer;
begin
if FList.Find(Name,Index) then
TDateTimeVar(FList.Objects[Index]).Data:= Value
else
FList.AddObject(Name,TDateTimeVar.Create(Value));
end;
procedure TMvcData.SetValueDouble(const Name: string; const Value: Double);
begin
FList.Values[Name]:= FloatToStr(Value);
end;
{ TController }
constructor TController.Create;
begin
FMvcData:= TMvcData.Create;
//ShowMessage(‘Tcontroller create’);
end;
procedure TController.DoResponse;
begin
end;
function TController.GetData: IMvcData;
begin
Result:= FMvcData;
end;
procedure TController.SetData(Data: IMvcData);
begin
FMvcData:= Data;
end;
{ TCanvaserController }
constructor TCanvaserController.Create;
begin
inherited;
//ShowMessage(‘TCanvaserController Create’);
OpenDatabaseConnection;
ReloadDummy; {
Sepertinya terdapat BUG pada TStringList Object,
yakni, object yang di-assign (melalui AddObject) yang pertama, tidak bisa diakses.
maka butuh dummy sebagai objek awal, agar objek berikutnya dapat diakses.
}
ReloadDaftarKota;
ReloadDaftarPropinsi;
ReloadDaftarSales;
//ReloadDaftarStatus;
//ReloadDaftarJenisTransaksi;
//ShowMessage(‘TCanvaserController Create – END’);
end;
procedure TCanvaserController.ReloadDaftarJenisTransaksi;
var
StrList: TStringList;
begin
StrList:= TStringList.Create;
InitList(QueryM_TRANSAKSI,StrList);
Data.ValueObj['ObjDaftarJenisTransaksi']:= StrList;
StrList:= nil;
end;
procedure TCanvaserController.ReloadDummy;
var
StrList: TStringList;
begin
StrList:= TStringList.Create;
Data.ValueObj['ObjDummy']:= StrList;
StrList:= nil;
end;
procedure TCanvaserController.ReloadDaftarKota;
var
StrList: TStringList;
begin
ShowMessage(‘reload daftar kota, Kode Propinsi = ‘ + Data.ValueStr['KodePropinsi']);
StrList:= TStringList.Create;
InitList(QueryM_KOTA(Data.ValueStr['KodePropinsi']),StrList);
//InitList(QueryM_KOTA,StrList);
Data.ValueObj['ObjDaftarKota']:= StrList;
StrList:= nil;
end;
procedure TCanvaserController.ReloadDaftarPropinsi;
var
StrList: TStringList;
begin
StrList:= TStringList.Create;
InitList(QueryM_PROPINSI,StrList);
Data.ValueObj['ObjDaftarPropinsi']:= StrList;
StrList:= nil;
end;
procedure TCanvaserController.ReloadDaftarSales;
var
StrList: TStringList;
begin
StrList:= TStringList.Create;
InitList(QuerySALES,StrList);
Data.ValueObj['ObjDaftarSales']:= StrList;
StrList:= nil;
end;
procedure TCanvaserController.ReloadDaftarStatus;
var
StrList: TStringList;
begin
StrList:= TStringList.Create;
InitList(QueryM_STATUS,StrList);
Data.ValueObj['ObjDaftarStatus']:= StrList;
StrList:= nil;
end;
{ TPenjualanController }
constructor TPenjualanController.Create;
var
JnsTransList, NoPakList, ProdukList: TStringList;
begin
inherited;
JnsTransList:= TStringList.Create;
NoPakList:= TStringList.Create;
ProdukList:= TStringList.Create;
//list item for ‘ListJnsTrans’
InitList(QueryM_TRANSAKSI,JnsTransList);
Data.ValueObj['ObjListJnsTrans']:= JnsTransList;
InitList(QueryM_TRANSAKSI,NoPakList);
Data.ValueObj['ObjListNoPak']:= NoPakList;
InitList(QueryM_TRANSAKSI,ProdukList);
Data.ValueObj['ObjListProduk']:= ProdukList;
Data.ValueDate['TglPenjualan']:= Now;
ProdukList:= nil;
NoPakList:= nil;
JnsTransList:= nil;
FreeAndNil(JnsTransList);
FreeAndNil(NoPakList);
FreeAndNil(ProdukList);
end;
{ TDateTimeVar }
constructor TDateTimeVar.Create(InitValue: TDateTime);
begin
Data:= InitValue;
end;
procedure InitList(Source: IDataset; DestList: TStringList);
var
ObjList: TMvcData;
begin
DestList.Clear;
with Source do begin
while not eof do  begin
ObjList:= TMvcData.Create;
ObjList.ValueStr['KeyVal']:= FieldByName(‘KeyVal’).AsString;
DestList.AddObject(FieldByName(‘LookUpVal’).AsString, ObjList);
Next;
end;
end;
ObjList:= nil;
end;
function GetMvcListIndex(Items: TStrings; KeyVal: string): Integer;
var
List: TStringList;
i: Integer;
begin
Result:= -1;
List:= TStringList(Items);
for i:= 0 to List.Count – 1 do
if TMvcData(List.Objects[i]).ValueStr['KeyVal'] = KeyVal then begin
Result:= i;
Break;
end;
end;
procedure FreeOwnObjets(List: TStringList);
var i: Integer;
begin
if List.Count<1 then exit;
for i:= 0 to List.Count – 1 do
if Assigned(List.Objects[i]) then begin
if List.Objects[i] is TStringList then
FreeOwnObjets(TStringList(List.Objects[i])); {recursive}
List.Objects[i].Free;
end;
end;
{General Dialogs}
function MsgDlgConfirm(Msg: string): Boolean;
begin
Result:= MessageDlg(Msg, mtConfirmation, mbOKCancel,0) = mrOk;
end;
procedure MsgDlgInformation(Msg: string);
begin
MessageDlg(Msg, mtInformation, [mbOK],0);
end;
procedure MsgDlgWarning(Msg: string);
begin
MessageDlg(Msg, mtWarning, [mbOK],0);
end;
procedure MsgDlgError(Msg: string);
begin
MessageDlg(Msg, mtError, [mbOK],0);
end;
{General View Fungtions}
procedure DisableControls(Controls: array of TControl);
var i: Integer;
begin
for i:= Low(Controls) to High(Controls) do
Controls[i].Enabled:= False;
end;
procedure EnableControls(Controls: array of TControl);
var i: Integer;
begin
for i:= Low(Controls) to High(Controls) do
Controls[i].Enabled:= True;
end;
{ TMasterOutletController }
function TMasterOutletController.IsBlokir: Boolean;
begin
Result:= Data.ValueStr['IsBlokir'] = ’1′;
end;
function TMasterOutletController.IsOutletExist: Boolean;
var
sDataset: IDataset;
begin
Result:= False;
sDataset:= QueryCustomer(Data.ValueStr['CustId']);
if not Assigned(sDataset) then exit;
Result:= sDataset.RecordCount>0;
Data.ValueStr['CustNama']:=SDataset.FindField(‘NAMA’).AsString;
Data.ValueStr['CustKontak']:=SDataset.FindField(‘KONTAK’).AsString;
Data.ValueStr['CustAlamat']:=SDataset.FindField(‘ALAMAT’).AsString;
Data.ValueStr['CustTelepon']:=SDataset.FindField(‘NO_TELPON’).AsString;
Data.ValueStr['CustRekening']:=SDataset.FindField(‘NO_REKENING’).AsString;
Data.ValueStr['KodePropinsi']:=SDataset.FindField(‘K_PROPINSI’).AsString;
Data.ValueStr['KodeKota']:=SDataset.FindField(‘K_KOTA’).AsString;
Data.ValueStr['IsBlokir']:=SDataset.FindField(‘IS_BLOKIR’).AsString;
Data.ValueStr['SalesId']:=SDataset.FindField(‘SALES_ID’).AsString;
end;
function TMasterOutletController.PostInserted(var NewCustId: string): TErrMsg;
var
CUST_ID, Err_Code, Err_msg: String;
begin
try
with Data do begin
{ CUST_ID GENERATE OTOMATIS
procedure OutletInsert(CUST_ID, NAMA, KONTAK, ALAMAT, NO_TELPON, K_KOTA, K_PROPINSI,
NO_REKENING, SALES_ID, IS_BLOKIR, USER_ID: string);}
OutletInsert(
ValueStr['CustNama'], ValueStr['CustKontak'], ValueStr['CustAlamat'],
ValueStr['CustTelepon'], ValueStr['KodeKota'], ValueStr['KodePropinsi'],
ValueStr['CustRekening'], ValueStr['SalesId'], ValueStr['IsBlokir'],
ValueStr['UserId'], CUST_ID, Err_Code, Err_msg
);
if Err_Code<>” then
Result:= Format(‘\n[INSERT ERROR]\n%s’ ,[Err_msg])
else
NewCustId:= CUST_ID;
end;
except
on E:Exception do Result:= Format(‘\n[INSERT ERROR]\n%s’ ,[E.Message]);
end;
end;
function TMasterOutletController.PostUpdated: TErrMsg;
begin
try
with Data do begin
{procedure OutletUpdate(CUST_ID, NAMA, KONTAK, ALAMAT, NO_TELPON, K_KOTA, K_PROPINSI,
NO_REKENING, SALES_ID, IS_BLOKIR, USER_ID: string);}
OutletUpdate(
ValueStr['CustId'], ValueStr['CustNama'], ValueStr['CustKontak'], ValueStr['CustAlamat'],
ValueStr['CustTelepon'], ValueStr['KodeKota'], ValueStr['KodePropinsi'],
ValueStr['CustRekening'], ValueStr['SalesId'], ValueStr['IsBlokir'],
ValueStr['UserId']
);
end;
except
on E:Exception do
Result:= Format(‘\n[UPDATE ERROR]\n%s’ ,[E.Message]);
end;
end;
function TMasterOutletController.SetBlokir: TErrMsg;
begin
with Data do begin
ValueStr['IsBlokir']:=’1′; //representasi kondisi saat ini
try
OutletSetBlokir(’1′,ValueStr['CustId'], ValueStr['UserId']);
except
on E:Exception do Result:= E.Message;
end;
end;
end;
function TMasterOutletController.SetUnBlokir: TErrMsg;
begin
with Data do begin
ValueStr['IsBlokir']:=’0′; //representasi kondisi saat ini
try
OutletSetBlokir(’0′,ValueStr['CustId'], ValueStr['UserId']);
except
on E:Exception do Result:= E.Message;
end;
end;
end;
constructor TMasterOutletController.Create;
begin
inherited;
//ShowMessage(‘MasterOutletController create’);
end;
function TMasterOutletController.Delete: TErrMsg;
begin
with Data do begin
try
OutletDelete(ValueStr['CustId'], ValueStr['UserId']);
except
on E:Exception do Result:= Format(‘[DELETE ERROR]\n%s’,[E.Message]);
end;
end;
end;
function Validate(Controls: array of TControl; PropName: string): Boolean;
var
i: Integer;
PropValue: string;
begin
Result:= True;
for i:= Low(Controls) to High(Controls) do begin
PropValue:= GetPropValue(Controls[i],PropName);
if Pos(””,PropValue)>0 then begin
Result:= False;
if Controls[i] is TWinControl then TWinControl(Controls[i]).SetFocus;
Break;
end;
end;
end;
end.


Author: Fajar

Hello, I am Author, decode to know more: In commodo magna nisl, ac porta turpis blandit quis. Lorem ipsum dolor sit amet, consectetur adipiscing elit. In commodo magna nisl, ac porta turpis blandit quis. Lorem ipsum dolor sit amet.

0 comments:

Best Post This Year

Install Fortesreport community Delphi 7 dan RX Berlin

Download  Pertama2 kita harus punya file installernya terlebih dahulu, download  https://github.com/fortesinformatica/fortesrepo...

Total Pageviews

© 2014 Fajar Priyadi. WP themonic converted by Bloggertheme9. Published By Gooyaabi Templates | Powered By Blogger
TOP