работа в рантайме с классами (не обьектами)

← →
sirin © (2006-03-26 15:53) [0]

Здраствуйте. Подсткажите, есть ли в делфи возможность динамического формирования класса ?
Я хочу создать класс в рантайме, добавить ему поля, и свойства, и создать с него обьект
Это нужно для создания обьектных оберток вокруг датасета.

← →
Наиль © (2006-03-26 20:33) [1]

Нет

← →
Джо © (2006-03-26 20:36) [2]

> sirin © (26.03.06 15:53)

А как ты его потом собираешься использовать, если на момент компиляции имена этих методов и полей неизвестны?

← →
sirin © (2006-03-26 20:52) [3]

в делфи возможна работа у учетом того, что свойства класса неизвестны, к примеру можно получить список свойств обьекта, их имена и значения (указатели на них). Неужели непредусмотрена возможность динамического добавления свойств ?

← →
Джо © (2006-03-26 21:12) [4]

> [3] sirin © (26.03.06 20:52)
> Неужели непредусмотрена
> возможность динамического добавления свойств ?

Нет. Вся эта run-time type information формируется при компиляции.

← →
Джо © (2006-03-26 21:57) [5]

Могу предложить такую схему.

[CODE]
unit CustStorage;

interface
uses SysUtils, Classes, Contnrs;

type

EWrongDataType = class (Exception);

TDataType = (dtString,dtInteger,dtFloat);

TCustomData = class
private
FStringValue: string;
FIntegerValue: Integer;
FFloatValue: Double;
FDataType: TDataType;
FName: string;
function GetAsFloat: Double;
procedure SetAsFloat(const Value: Double);
function GetAsInteger: Integer;
procedure SetAsInteger(const Value: Integer);
function GetAsString: string;
procedure SetAsString(const Value: string);
procedure RaiseIfNotType (AType: TDataType);
public
property Name: string read FName;
property AsString: string read GetAsString write SetAsString;
property AsInteger: Integer read GetAsInteger write SetAsInteger;
property AsFloat: Double read GetAsFloat write SetAsFloat;
property DataType: TDataType read FDataType;
constructor Create (ADataType: TDataType; AName: string);
end;

TCustomStorage = class
private
FList: TObjectList;
function GetItems(AName: string): TCustomData;
function FindItem (AName: string): Integer;
procedure Add (AName: string; DataType: TDataType; Value: Variant);
public
constructor Create;
destructor Destroy; override;
property Items[AName: string]: TCustomData read GetItems; default;
procedure AddInteger (AName: string; AValue: Integer);
procedure AddString (AName: string; AValue: string);
procedure AddFloat (AName: string; AValue: Double);
end;

implementation
uses TypInfo;

constructor TCustomData.Create(ADataType: TDataType; AName: string);
begin
FDataType := ADataType;
FName := AnsiUpperCase(AName);
end;

function TCustomData.GetAsFloat: Double;
begin
RaiseIfNotType(dtFloat);
Result := FFloatValue;
end;

function TCustomData.GetAsInteger: Integer;
begin
RaiseIfNotType(dtInteger);
Result := FIntegerValue;
end;

function TCustomData.GetAsString: string;
begin
RaiseIfNotType(dtString);
Result := FStringValue;
end;

procedure TCustomData.RaiseIfNotType(AType: TDataType);
begin
if AType <> FDataType then
raise EWrongDataType.CreateFmt("Wrong data type: %s",[GetEnumName(TypeInfo(TDataType),Integer(AType))]);
end;

procedure TCustomData.SetAsFloat(const Value: Double);
begin
RaiseIfNotType(dtFloat);
FFloatValue := Value
end;

procedure TCustomData.SetAsInteger(const Value: Integer);
begin
RaiseIfNotType(dtInteger);
FFloatValue := Value
end;

procedure TCustomData.SetAsString(const Value: string);
begin
RaiseIfNotType(dtString);
FStringValue := Value
end;

{ TCustomStorage }

procedure TCustomStorage.Add(AName: string; DataType: TDataType;
Value: Variant);
var
Idx: Integer;
Data: TCustomData;
begin
Idx := FindItem(AName);
if Idx = -1 then
begin
Data := TCustomData.Create(DataType,AName);
case DataType of
dtString: Data.AsString := Value;
dtInteger: Data.AsInteger := Value;
dtFloat: Data.AsFloat := Value;
end;
FList.Add(Data)
end
else
raise Exception.CreateFmt("Item "%s" already exists",[AName]);
end;

procedure TCustomStorage.AddFloat(AName: string; AValue: Double);
begin
Add (AName,dtFloat,AValue);
end;

procedure TCustomStorage.AddInteger(AName: string; AValue: Integer);
begin
Add (AName,dtInteger,AValue);
end;

procedure TCustomStorage.AddString(AName, AValue: string);
begin
Add (AName,dtString,AValue);
end;

constructor TCustomStorage.Create;
begin
FList := TObjectList.Create (True);
end;

destructor TCustomStorage.Destroy;
begin
FList.Free;
inherited;
end;

function TCustomStorage.FindItem(AName: string): Integer;
var
I: Integer;
begin
Result := -1;
AName := AnsiUpperCase(AName);

for I := 0 to FList.Count - 1 do
if TCustomData(FList[I]).Name = AName then
begin
Result := I;
Break
end
end;

function TCustomStorage.GetItems(AName: string): TCustomData;
var
Idx: Integer;
begin
Idx := FindItem(AName);
if Idx = -1 then
raise Exception.CreateFmt("Item "%s" not found",[AName])
else
Result := TCustomData(FList[Idx])
end;

end.[/CODE]

Пример использования.
[CODE]
uses CustStorage;

procedure TForm18.Button1Click(Sender: TObject);
var
AStorage: TCustomStorage;

IntegerField: Integer;
StringField: string;
FloatField: Double;
begin
AStorage := TCustomStorage.Create;
try
AStorage.AddInteger("MyIntegerField"); // не указываем значение сразу
AStorage.AddString("MyStringField","строка");
AStorage.AddFloat("MyFloatField",999.666);

AStorage["MyIntegerField"].AsInteger := 123; // задаем значение

IntegerField := AStorage["MyIntegerField"].AsInteger;
StringField := AStorage["MyStringField"].AsString;
FloatField := AStorage["MyFloatField"].AsFloat;

finally
AStorage.Free;
end;
end;[/CODE]

--
Просто пример, его можно улучшить и даже упростить. В нем, возможно, есть ошибки: написал наспех и особо не тестировал.

← →
Джо © (2006-03-26 21:58) [6]

Сорри, напутал с тэгами, чертов BB CODE :(

Явно не мой день. :( Исправить метод:
procedure TCustomData.SetAsInteger(const Value: Integer); begin RaiseIfNotType(dtInteger); FIntegerValue := Value end;
В общем, я думаю, суть того, что я предложил, ясна.

Суть ясна, спасибо
в принципе, я представлял это себе немного по другому.
но этот вариант тоже вполне подходит.
И еще вопрос, может я просто не до конца разобрался в этом...
Существует ли какой-то стандартный механизм формирования обьектных оберток вокруг датасетов ? Пока вышеуказанный пример кажется мне наиболее оптимальным, при условии, если не создавать для каждого датасета отдельный класс.

> [8] sirin © (27.03.06 00:30)

Честно говоря, я не вполне понимаю, что вы имеете ввиду под "объектные обертки вокруг датасетов".

работа в рантайме с классами (не обьектами) Найти похожие ветки