2009年10月7日水曜日

Rttiを使ってClientDataSetを作ってみる

以前、Team JapanのブログにEmployeeクラスのインスタンスからInsert文を
生成するサンプル
のポストがありましたが、ちょっと改良してTClientDataSetを
動的生成する例を書いてみた。(って使い道があるかちょっと疑問です。)

一応ソースは、こんな感じ

unit Unit3;

interface

uses
  DBClient;

type DataSetOperator = Record
function CreateDataSet(obj : TObject) : TClientDataSet;
function AddRecord(cds : TClientDataSet; obj : TObject) : Boolean;
End;


implementation

uses
Rtti,TypInfo, DB, SysUtils;
{ DataSetFactory }

function DataSetOperator.AddRecord(cds: TClientDataSet; obj: TObject): Boolean;
var
ctx : TRttiContext;
rtp : TRttiProperty;
rtps : TArray;
begin

ctx := TRttiContext.Create;

rtps := ctx.FindType(obj.UnitName + '.' + obj.ClassName).GetProperties;
cds.Append;
for rtp in rtps do
begin
cds.FieldByName(rtp.Name).Value := rtp.GetValue(obj).AsVariant;
end;
cds.UpdateRecord;
end;

function DataSetOperator.CreateDataSet(obj: TObject): TClientDataSet;
var
ctx : TRttiContext;
rtp : TRttiProperty;
rtps : TArray;
cds : TClientDataSet;
ft : TFieldType;
fn : String;
ftSize : Integer;
//ftdf : TFieldDef;
begin

cds := TClientDataSet.Create(nil);

ctx := TRttiContext.Create;

rtps := ctx.FindType(obj.UnitName + '.' + obj.ClassName).GetProperties;

for rtp in rtps do
begin
//ここがちょっとダサイかも
//DelphiのRTTIの型とDBの型のマッチング
ftSize := 0;
if CompareText(rtp.PropertyType.Name,'Integer') = 0 then ft := ftInteger;
if CompareText(rtp.PropertyType.Name,'String') = 0 then
begin
ft := ftString;
ftSize := 50;
end;
if CompareText(rtp.PropertyType.Name,'TDateTime') = 0 then ft := ftDateTime;
if CompareText(rtp.PropertyType.Name,'Currency') = 0 then ft := ftCurrency;
//if CompareText(rtp.PropertyType.Name,'Currency') = 0 then ft := ftCurrency;

cds.FieldDefs.Add(rtp.Name,ft,ftSize);

end;
cds.CreateDataSet;
Result := cds;
//cds.FieldDefs.Add();

end;

end.

DBのデータ型の列挙とRTTIのデータ型の列挙が微妙に違っているので
そのマッピングを少々強引に行ってます。

で、上のユニットを利用する例が


unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, DB, Grids, DBGrids;

type
TForm1 = class(TForm)
DBGrid1: TDBGrid;
DataSource1: TDataSource;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;

var
Form1: TForm1;

implementation

uses Unit2, Unit3,DBClient;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
Emp : TEmployee;
DF : DataSetOperator;
cds : TClientDataSet;
begin

Emp := TEmployee.Create;

cds := DF.CreateDataSet(Emp);
cds.Active := true;
DataSource1.DataSet := cds;
//DataSource1.DataSet.Active := true;

Emp.EmpNo := 2;
Emp.FirstName := 'OldTPFun';
Emp.LastName := 'Delphi';
Emp.HireDate := StrToDate('2009/10/07');
Emp.Salary := 100000.00;
DF.AddRecord(cds,Emp);

Emp.Free;
end;

end.


このプログラム上で使っているEmployee型の定義は以下のとおりです。



unit Unit2;

interface

type TEmployee = class
private
FEmpNo: Integer;
FFirstName: String;
FLastName: String;
FHireDate: TDateTime;
FSalary: Currency;
procedure SetEmpNo(const Value: Integer);
procedure SetFirstName(const Value: String);
procedure SetLastName(const Value: String);
procedure SetHireDate(const Value: TDateTime);
procedure SetSalary(const Value: Currency);
public
property EmpNo : Integer read FEmpNo write SetEmpNo;
property FirstName : String read FFirstName write SetFirstName;
property LastName : String read FLastName write SetLastName;
property HireDate : TDateTime read FHireDate write SetHireDate;
property Salary : Currency read FSalary write SetSalary;
end;
implementation

{ TEmployee }

procedure TEmployee.SetEmpNo(const Value: Integer);
begin
FEmpNo := Value;
end;

procedure TEmployee.SetFirstName(const Value: String);
begin
FFirstName := Value;
end;

procedure TEmployee.SetHireDate(const Value: TDateTime);
begin
FHireDate := Value;
end;

procedure TEmployee.SetLastName(const Value: String);
begin
FLastName := Value;
end;

procedure TEmployee.SetSalary(const Value: Currency);
begin
FSalary := Value;
end;

end.

0 件のコメント: