| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

работа в рантайме с классами (не обьектами) [D7, WinXP]

sirin ©   (2006-03-26 15:53:00) 

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

---

Джо   (2006-03-27 00:59:00) [1]

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

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

---

sirin   (2006-03-27 00:30:00) [2]

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

---

Джо   (2006-03-26 22:00:00) [3]

Явно не мой день. :( Исправить метод:

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

В общем, я думаю, суть того, что я предложил, ясна.

---

Джо   (2006-03-26 21:58:00) [4]

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

---

Джо   (2006-03-26 21:57:00) [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:12:00) [6]

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

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

---

sirin   (2006-03-26 20:52:00) [7]

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

---

Джо   (2006-03-26 20:36:00) [8]

> sirin ©   (26.03.06 15:53)

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

---

Наиль   (2006-03-26 20:33:00) [9]

Нет

---

Наверх