Rtti Gevşek Unitler :)

Bir projedeki unit'lerin uses bloglarına baktığımızda bir sürü unit ismi görürüz.

Bunların bir çoğu da projeye bizim eklediğimiz unit dosyalarıdır.

Ve hepsi birbirine bağlıdır.Bu bağımlığı en aza indirmenin yollarından birisi de ,reflection kullanmaktır. :)

Aşağıda yazacağım rttiFormActivator methodu ile bir "unitismi.formsınıfadı" vererek formu oluşturmak için kullanabiliriz.

Bu method kullanıma göre özelleştirebilir.

function  rttiFormActivator(typeQualifiedName : string; isModal:Boolean=false) : TValue;
var
 context      : TRttiContext;
 rttTyp       : TRttiType;
 instanceType : TRttiInstanceType;
 instance     : TValue;
begin

 try
   context   := TRttiContext.Create();
   rttTyp    := context.FindType(typeQualifiedName);

   instanceType := rttTyp.AsInstance;
   instance     := instanceType.GetMethod('Create').Invoke(instanceType.MetaclassType,[nil]) ;

   Result := instance;

   case isModal of
      true  :   instanceType.GetMethod('ShowModal').Invoke(instance,[]);
      false :   instanceType.GetMethod('Show').Invoke(instance,[]);
   end;

 except on E: Exception do
   raise Exception.Create(typeQualifiedName+ ' Tipi register edilmemiş !');
 end;

end;

Unit1.pas dosyanın uses bloğuna kullanmak istediğimiz herhangi bir unit içersindeki formun unitini tanımlamadan direk aşağıdaki kullanılabilecektir.

procedure TForm1.btnShowForm2Click(Sender: TObject);
begin
  rttiFormActivator('Unit2.TForm2',true);
end;


procedure TForm1.btnShowForm3Click(Sender: TObject);
begin
  rttiFormActivator('Unit3.TForm3');
end;

unit1.pas'ın uses bloğuna unit2,unit3 eklemeyerek,bu unitlere bağlı olmasını engellemiş ve dinamik bir kullanım elde etmiş olduk. Yanlız şöyle önemli bir durum var. Kullanacağınız sınıflarını register etmediğiniz zaman rtti amca findType methodu ile ilgili verdiğiniz tipi bulamıyor. o yüzden sınıfları bulunduğu unit içinde register ederek,findType methodu ile bulmasını sağlayabiliriz.

initialization
 RegisterClass(TForm2);

finalization
 UnRegisterClass(TForm2);

Kaynak Kod : https://github.com/ismailkocacan/Rtti-Loose-Coupling-Units

iyi çalışmalar.

RTTI Object Mapping

Veritabanı içersinde aşağıdaki gibi tablo olduğunu varsayalım. Amacımız bu tablodaki bir satırlık kaydı,delphi tarafında ifade edecek olan TKisi sınıfından oluşturulan, instance,ın alanlarına basmak ! Bu iş içinde delphi reflection kütüphanesi RTTI kütüphanesini kullanıyoruz.

CREATE TABLE [dbo].[Kisi](
 [id] [int] IDENTITY(1,1) NOT NULL,
 [adi] [varchar](10) NULL,
 [soyadi] [varchar](10) NULL,
 [yasi] [smallint] NULL,
 [dogumTarihi] [smalldatetime] NULL,
 CONSTRAINT [PK_Kisi] PRIMARY KEY CLUSTERED 
(
 [id] ASC
)WITH (PAD_INDEX  = OFF, 
       STATISTICS_NORECOMPUTE  = OFF, 
    IGNORE_DUP_KEY = OFF, 
    ALLOW_ROW_LOCKS  = ON, 
    ALLOW_PAGE_LOCKS  = ON) 
    ON [PRIMARY]
) ON [PRIMARY]

insert into Kisi (adi,soyadi,yasi,dogumTarihi) values ('İSMAİL','KOCACAN',23,'1990.06.01')

Veri erişim methodlarımız.

DataAccess.pas

unit DataAccess;

interface

uses
  Forms,
  Data.DB,
  Data.Win.ADODB;

function createConnection: TADOConnection;
function createDataset(sql: string): TDataSet;

implementation

function createConnection: TADOConnection;
var
  connection: TADOConnection;
const
  CONNECTION_STRING='Provider=SQLOLEDB.1;Password=123;User ID=sa;Initial Catalog=DB;Data Source=.\SQLR2';
begin
  connection := TADOConnection.Create(Application);
  connection.ConnectionString :=CONNECTION_STRING;
  connection.Open();
  Result := connection;
end;

function createDataset(sql: string): TDataSet;
var
  query: TADOQuery;
begin
  query := TADOQuery.Create(Application);
  query.connection := createConnection;
  query.sql.Text := sql;
  query.Open;
  Result := query;
end;

end.

Dataset'teki alanlar ile nesnenin alanlarını eşitleyen,map methodu. Kullanım : TRttiObjectMapping.map(TDataSet sınıfından türemiş bir instance,TObject den türemiş bir nesne);

RttiObjectMapping.pas

unit RttiObjectMapping;

interface

uses
  Data.DB,
  System.Rtti;

type

  TRttiObjectMapping = class
  public
    class procedure map(dataset: TDataSet; instance: TObject);
  end;

implementation

{ TRttiObjectMapping }
class procedure TRttiObjectMapping.map(dataset: TDataSet; instance: TObject);
var
  cntx: TRttiContext;
  objField: TRttiField;
  dbFieldName: string;

  I: Integer;
  value: TValue;
begin
  cntx := TRttiContext.Create;
  for I := 0 to dataset.FieldCount - 1 do
  begin
    dbFieldName := dataset.Fields[I].DisplayName;
    for objField in cntx.GetType(instance.ClassType).GetFields do
    begin
      if dbFieldName = objField.Name then
      begin
        value := TValue.From(dataset.Fields[I].value);
        objField.SetValue(instance, value);
        Break;
      end;
    end;
  end;
  dataset.Close;
  dataset.Free;
  cntx.Free;
end;

end

Kisi tablosundaki bir satırı delphi ifade edecek olan TKisi sınıfımız. Nesne oluşturulurken,TRttiObjectMapping.map methodu ile map'leme işlemi,yani dataset alanları, nesnenin alanlarına atama işlemi yapılmıştır. Kisi tablosuna yeni bir alan eklediğinizde,eklediğiniz bu alanı TKisi sınıfıda eklediğinizde alanın değeri map'leme sayesinde otomatik olarak gelecektir.

Model.pas

unit Model;

interface

uses
 System.SysUtils,
 DataAccess,
 RttiObjectMapping;

type

  TKisi = class
  const
    QUERY='select * from Kisi where id=%s';
  private
    id: Integer;
    adi: string;
    soyadi: string;
    yasi: Byte;
    dogumTarihi: TDateTime;
  public
    function getId():Integer;
    function getAdi():string;
    function getSoyadi():string;
    function getYasi():Byte;
    function getDogumTarihi:TDateTime;
    constructor createFromId(id: Integer);
    destructor Destroy;
  end;

implementation


{ TKisi }
constructor TKisi.createFromId(id: Integer);
begin
  TRttiObjectMapping.map(createDataset(Format(QUERY, [IntToStr(id)])), Self);
end;

destructor TKisi.Destroy;
begin
  inherited;
end;

function TKisi.getAdi: string;
begin
  Result:=Self.adi;
end;

function TKisi.getDogumTarihi: TDateTime;
begin
  Result:=Self.dogumTarihi;
end;

function TKisi.getId: Integer;
begin
  Result:=Self.id;
end;

function TKisi.getSoyadi: string;
begin
  Result:=Self.soyadi;
end;

function TKisi.getYasi: Byte;
begin
  Result:=Self.yasi;
end;

end.

TKisi sınıfından bir intance(lKisi) oluşturup kullanıyoruz.

Main.pas

unit Main;

interface

uses
  Winapi.Windows,
  Winapi.Messages,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Vcl.StdCtrls;

type

  TFrmMain = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmMain: TFrmMain;

implementation

uses Model;

{$R *.dfm}


procedure TFrmMain.FormCreate(Sender: TObject);
var
 lKisi:TKisi;
begin
  lKisi := TKisi.createFromId(1);
  Memo1.Lines.Add(lKisi.getAdi);
  Memo1.Lines.Add(lKisi.getSoyadi);
  Memo1.Lines.Add(IntToStr(lKisi.getYasi));
  Memo1.Lines.Add(DateToStr(lKisi.getDogumTarihi));
  FreeAndNil(lKisi);
end;

end.

Kaynak kodları buradan indirip inceleyebilirsiniz.İyi Çalışmalar...

RTTI ile sadece o sınıfa ait methodları listelemek

RTTI ile bir sınıfa ait methodları listeliyebilmemin mümkünatı aşikardır.Lakin şöyle bir durum var.
Eğer methodlarını listelemek istediğiniz sınıf , birden çok sınıftan kalıtıla gelinerek yazılmış bir sınıfsa;

Alt sınıfın miras alınabilen tüm methodları,üst sınıfında methoduymuş gibi oluyor.
GetMethods ile o sınıfa ait methodları, listelemek istediğinizde taban sınıftaki methodlarda listeleniyor.
Haliyle bu methodlar ne ayak diyorsunuz.

Eğer kendi eklediğiniz methodları listelemek istiyorsanız....

var
  cntx: TRttiContext;
  typ: TRttiType;
  method: TRttiMethod;
begin
  cntx := TRttiContext.Create;
  typ := cntx.GetType(TServerMethods1);
  lBoxMethods.Items.Clear;
  for method in typ.GetMethods do
  begin
    if method.Parent.Name = typ.Name then
      lBoxMethods.Items.Add(method.Name);
  end;
end;

Nerden icab ettiğine gelince...

procedure TForm1.lBoxMethodsDblClick(Sender: TObject);
var
  methodName, url: string;
begin
  methodName := TListBox(Sender).Items[TListBox(Sender).ItemIndex];

  StartServer;
  url := Format('http://localhost:%s/datasnap/rest/TServerMethods1/' +
    methodName, [EditPort.Text]);
  ShellExecute(0, nil, PChar(url), nil, nil, SW_SHOWNOACTIVATE);
end;

İyi çalışmalar...