Форум: "Компоненты";
Текущий архив: 2006.10.08;
Скачать: [xml.tar.bz2];

Вниз

Закрытие узла.   Найти похожие ветки 

← →
DimaBr   (2006-02-20 10:04) [0]

Здравствуйте !
Помогите пожалуйста закрыть узел в инспекторе.

Имеется перечислимое свойство. В зависимости от его состояния в свойстве типа TPersistent изменяется перечень публикуемых свойств. Когда в дизайнере меняем перечислимое свойство нужно закрыть и открыть узел свойства TPersistent дабы обновить список его подсвойств. Как это реализовать ?

---

← →
Юрий Зотов ©   (2006-02-20 10:22) [1]

Если у объектного свойства меняется перечень подсвойств, значит, меняется его класс, а он отображается, как значение свойства. Таким образом, меняется значение свойства - а тогда для обновления списка его подсвойств достаточно в GetAttributes включить paVolatileSubProperties.

---

← →
DimaBr   (2006-02-20 11:24) [2]

К сожалению, при такой регистрации в инспекторе вместо раскрывающегося списка вижу - (Unknown), может неправильно регистрирую ?

type
TMyProperty = class(TPropertyEditor)
 function GetAttributes: TPropertyAttributes; override;
end;

procedure Register;

implementation
function TMyProperty.GetAttributes: TPropertyAttributes;
begin
 Result := inherited GetAttributes + [paVolatileSubProperties];
end;

procedure Register;
begin
 RegisterComponents("Standard", [TTest1]);
 RegisterPropertyEditor(TypeInfo(TPersistent), TTest1, "TestMain", TMyProperty);
end;

---

← →
Юрий Зотов ©   (2006-02-20 11:49) [3]

В GetAttributes нет paSubProperties - откуда же тогда возьмется плюсик?

TMyProperty = class(TClassProperty)

---

← →
DimaBr   (2006-02-20 12:35) [4]

А воз и ныне там. К сожалению перечитывание свойств не происходит, может руки кривые...

type
TCCC = (t1,t2);
TTest1 = class(TComponent)
 private
   fTest: TPersistent;
   fT: TCCC;
   procedure SetT(const Value: TCCC);
 public
   constructor Create(AOwner: TComponent);override;
 published
   property T: TCCC read fT write SetT;
   property TestMain: TPersistent read fTest write fTest;
end;

TTest3 = class(TPersistent)
private
  fA: integer;
published
  property A: integer read fA write fA;
end;

TTest4 = class(TPersistent)
 private
   fB: integer;
published
  property B: integer read fB write fB;
end;

implementation
constructor TTest1.Create(AOwner: TComponent);
begin
 inherited;
 t := t1;
end;

procedure TTest1.SetT(const Value: TCCC);
begin
 fT := Value;
 fTest.Free;
 case Value of
   t1: fTest := TTest3.Create;
   t2: fTest := TTest4.Create;
 end;{case}
end;

---

← →
Юрий Зотов ©   (2006-02-21 03:21) [5]

> DimaBr   (20.02.06 12:35) [4]

Предлагается улучшенный  вариант. Он не содержит ненужное свойство T, а вместо него изменение класса происходит прямо в той строчке Object Inspector, в которой этот класс и отображается.

Разберите код по косточкам - сразу все станет ясно. А если свойство T так уж необходимо, оставьте его и к нему прилепите аналогичный редактор.

Run-time модуль:

unit YzComponent;

interface

uses
 SysUtils, Classes;

type
 TYzBaseClass = class(TPersistent)
 private
   FOwner: TComponent;
 protected
   function GetOwner: TPersistent; override;
 public
   constructor Create(AOwner: TComponent); virtual;
 end;

 TYzClass = class of TYzBaseClass;

 TYzClass1 = class(TYzBaseClass)
 private
   FProp1: integer;
 protected
   procedure AssignTo(Dest: TPersistent); override;
 published
   property Prop1: integer read FProp1 write FProp1 default 0;
 end;

 TYzClass2 = class(TYzBaseClass)
 private
   FProp2: integer;
 protected
   procedure AssignTo(Dest: TPersistent); override;
 published
   property Prop2: integer read FProp2 write FProp2 default 0;
 end;

 TYzComponent = class(TComponent)
 private
   FYzClassProp: TYzBaseClass;
   procedure SetYzClassProp(const Value: string);
   function GetYzClassProp: string;
 protected
   property YzClass: TYzBaseClass read FYzClassProp;
 published
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
   property YzClassProp: string read GetYzClassProp write SetYzClassProp;
 end;

implementation

{ TYzBaseClass }

constructor TYzBaseClass.Create(AOwner: TComponent);
begin
 inherited Create;
 FOwner := AOwner
end;

function TYzBaseClass.GetOwner: TPersistent;
begin
 Result := FOwner
end;

{ TYzClass1 }

procedure TYzClass1.AssignTo(Dest: TPersistent);
begin
 if Dest is TYzClass1 then
   TYzClass1(Dest).FProp1 := FProp1
 else
   inherited
end;

{ TYzClass2 }

procedure TYzClass2.AssignTo(Dest: TPersistent);
begin
 if Dest is TYzClass2 then
   TYzClass2(Dest).FProp2 := FProp2
 else
   inherited
end;

{ TYzComponent }

constructor TYzComponent.Create(AOwner: TComponent);
begin
 inherited;
 FYzClassProp := TYzClass1.Create(Self)
end;

destructor TYzComponent.Destroy;
begin
 FYzClassProp.Free;
 inherited
end;

function TYzComponent.GetYzClassProp: string;
begin
 Result := FYzClassProp.ClassName
end;

procedure TYzComponent.SetYzClassProp(const Value: string);
var
 C: TClass;
 OldProp: TYzBaseClass;
begin
 if not SameText(YzClassProp, Value) then
 begin
   C := FindClass(Value);
   if not C.InheritsFrom(TYzBaseClass) then
     raise Exception.CreateFmt("Class "%s" is not TYzBaseClass", [Value]);
   OldProp := FYzClassProp;
   try
     FYzClassProp := TYzClass(C).Create(Self)
   except
     FYzClassProp := OldProp;
     raise
   end;
   OldProp.Free
 end
end;

initialization
 RegisterClasses([TYzClass1, TYzClass2])
finalization
 UnregisterClasses([TYzClass1, TYzClass2])
end.


И редактор свойства:

type
 TYzClassProperty = class(TStringProperty)
 public
   function AllEqual: boolean; override;
   function GetAttributes: TPropertyAttributes; override;
   procedure GetProperties(Proc: TGetPropProc); override;
   procedure GetValues(Proc: TGetStrProc); override;
 end;

{ TYzClassProperty }

function TYzClassProperty.AllEqual: boolean;
var
 S: string;
 i: integer;
begin
 if PropCount > 1 then
 begin
   Result := False;
   S := GetStrValue;
   for i := 1 to PropCount - 1 do
     if not SameText(GetStrValueAt(i), S) then
       Exit
 end;
 Result := True
end;

function TYzClassProperty.GetAttributes: TPropertyAttributes;
begin
 Result := inherited GetAttributes + [paSubProperties, paValueList, paSortList, paVolatileSubProperties]
end;

type
 TFriendYzComponent = class(TYzComponent);

procedure TYzClassProperty.GetProperties(Proc: TGetPropProc);
var
 Components, Props: IDesignerSelections;
 i: integer;
begin
 Components := TDesignerSelections.Create;
 Designer.GetSelections(Components);
 Props := TDesignerSelections.Create;
   for i := 0 to Components.Count - 1 do
     Props.Add(TFriendYzComponent(Components[i]).YzClass);
 if Props.Count > 0 then
   GetComponentProperties(Props, tkProperties, Designer, Proc);
end;

procedure TYzClassProperty.GetValues(Proc: TGetStrProc);
begin
 Proc("TYzClass1");
 Proc("TYzClass2")
end;

Метод GetValues содержит прямое перечисление классов. Это сделано ради простоты примера, но в рабочем варианте так делать не нужно. Заведите список классов и делайте перечисление по нему.

---

← →
DimaBr   (2006-02-21 09:02) [6]

Спасибо большое Юрий, я написал нечто подобное, но у Вас всё равно красивее. Насколько я понял paVolatileSubProperties срабатывает только для активного в данный момент пункта в инспекторе, поэтому я и не смог добиться обновления поскольку активен был другой пункт.

---

Страницы: 1 вся ветка

Форум: "Компоненты";
Текущий архив: 2006.10.08;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.48 MB
Время: 0.048 c