生成するサンプルのポストがありましたが、ちょっと改良してTClientDataSetを
動的生成する例を書いてみた。（って使い道があるかちょっと疑問です。）
一応ソースは、こんな感じ
DBのデータ型の列挙とRTTIのデータ型の列挙が微妙に違っているので
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.
そのマッピングを少々強引に行ってます。
で、上のユニットを利用する例が
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.
