Текущий архив: 2006.02.12;
Скачать: CL | DM;

Вниз

TFontProperty.Edit;   Найти похожие ветки 

← →
DimaBr   (2005-08-25 10:42) [0]

Здравствуйте !
Помогите получить значение свойства  - объекта.
Имеется компонент Test и свойстово Cell

type TAligment = (alLeft,alRight,alTop,alBottom,alValue);
type
 TCell = class(TPersistent)
   private
     fAligment: TAligment;
     fPosition: integer;
   protected
     procedure SetPosition(Value: integer);
   public
     constructor Create;
     destructor Destroy;override;
   published
     property Aligment: TAligment read fAligment write fAligment;
     property Position: integer read fPosition write SetPosition;
end;

type
 TTest = class(TComponent)
   private
     fCell : TCell;
   protected
   public
     constructor Create(AOwner:TComponent);override;
     destructor Destroy;override;
   published
     property Cell: TCell read fCell write fCell;
end;

А также его редактор

type TCellProperty = class(TClassProperty)
 public
   procedure Edit; override;
   function GetAttributes: TPropertyAttributes; override;
 end;

procedure TCellProperty.Edit;
begin
 with TCellEditorFrm.Create(Application) do
 try
   ACell := TCell(GetOrdValue);   <- ошибка
   if Execute then SetOrdValue(Longint(ACell));
 finally
   Free;
 end;
end;


Посмотрел на реализацию TFont и написал тоже самое. Только вот никак не могу понять, почему в TFont используется GetOrdValue, ведь свойтсво Font - НЕ перечислимого типа


procedure TFontProperty.Edit;
var
 FontDialog: TFontDialog;
begin
 FontDialog := TFontDialog.Create(Application);
 try
   FontDialog.Font := TFont(GetOrdValue);
   FontDialog.HelpContext := hcDFontEditor;
   FontDialog.HelpType := htContext;
   // TODO 4 -oCPJ: Figure out what these TFont dialog options mean for CLX
   // FontDialog.Options := FontDialog.Options + [fdShowHelp, fdForceFontExist];
   if FontDialog.Execute then SetOrdValue(Longint(FontDialog.Font));
 finally
   FontDialog.Free;
 end;
end;


---

← →
Яся   (2005-08-25 11:23) [1]

Font - указатель, значит целое, а значит GetOrdValue самое то

---

← →
DimaBr   (2005-08-25 11:43) [2]

У меня в строке

ACell := TCell(GetOrdValue);

вылетает AV, причём ACell к тому времени уже создан и проинициализирован.

---

← →
Яся   (2005-08-25 12:55) [3]

Copies the contents of another, similar object.
procedure Assign(Source: TPersistent); virtual;

Note: The types of some properties are also objects. If these properties have write methods that use Assign to set the value of the property, then in these cases the statement "Destination := Source" is the same as "Destination.Assign(Source)".
Это как раз относиться к свойству Font

---

← →
Юрий Зотов ©   (2005-08-25 13:15) [4]

1. > ACell к тому времени уже создан и проинициализирован.

Зачем? Вам же нужно редактировать именно тот экземпляр объекта, который создан компонентом, лежащим на форме (cсылку на него и дает GetOrdValue). Так зачем же создавать другой? Да еще потом и затирать ссылку на него, организуя тем самым утечку памяти.

Второй экземпляр объекта бывает нужен, если мы хотим в диалоге редактирования реализовать кнопку "Отмена". Тогда - да, тогда мы создаем копию и редактируем ее, а при нажатии "ОК" переносим свойства копии в свойства искомого объекта. Но если Вы хотели сделать именно это, то код неверен, а правильно было бы так:

procedure TCellProperty.Edit;
var
 Source: TCell;
begin
 Source := TCell(GetOrdValue); // Ссылка на искомый объект
 with TCellEditorFrm.Create(Application) do
 try
   ACell.Assign(Source); // Инициализация копии
   if Execute then
     Source.Assign(ACell) // Изменения вступают в силу
 finally
   Free
 end
end;

Здесь предполагатся, что форма редактора сама создает (а потом уничтожает) ACell и что в классе TCell перекрыт метод AssignTo.

2. TAlignment - очень советую назвать как-то иначе. Такой тип в VCL уже есть и поэтому программа, использующая Ваш компонент, окажется зависимой от порядка перечисления модулей в uses. Это может привести к багам, причем локализовать такие баги обычно бывает очень трудно.

3. Судя по приведенному коду, конструктор и деструктор в TCell не нужны, а вот перекрыть AssignTo было бы совсем не лишним (для копирования значений полей). Если же редактироваться будет копия объекта, а не он сам напрямую, то перекрытие AssignTo становится даже обязательным.

4. Еще было бы совсем не лишним указать для свойств Alignment и Position дефолтные значения. Если они отличаются от alLeft и нуля соответственно, то конструктор в TCell все же будет нужен (для инициализации полей).

5. > property Cell: TCell read fCell write fCell

Прямой доступ по записи даст утечку памяти и запросто может послужить источником Access Violation. Нужно write SetCell, а в SetCell вызвать Assign (вот еще для чего в TCell надо перекрыть AssignTo).

6. Есть ощущение, что после исправления п.п. 1-5 искомая проблема исчезнет сама собой.
:о)

---

← →
DimaBr   (2005-08-25 14:31) [5]

Спасибо, буду побывать.

---

← →
DimaBr   (2005-08-25 16:54) [6]

To Юрий Зотов.
Выполнил в точности все пять рекомендаций. Характер ошибки не изменился. Может быть неправильно переопределил AssignTo, но до него дело всё равно не доходит.

procedure TeeCell.AssignTo(Value: TPersistent);
begin
 TeeCell(Value).Aligment := Aligment;
 TeeCell(Value).fPosition:= Position;
end;

procedure TCellProperty.Edit;
var Source: TeeCell;
begin
 ShowMessage("Edit");
 Source := TeeCell(GetOrdValue);
 ShowMessage(inttostr(Source.Position));
 with TCellEditorFrm.Create(Application) do
 try
   ACell.Assign(Source);
   if Execute
     then Source.Assign(ACell);
 finally
   Free;
 end;
end;

При нажатии на "..." выскакивает окошечко "Edit", потои AV. То есть до второго Message дело не доходит.

---

← →
Юрий Зотов ©   (2005-08-25 17:10) [7]

> DimaBr   (25.08.05 16:54) [6]

> Может быть неправильно переопределил AssignTo

procedure TeeCell.AssignTo(Dest: TPersistent); // override !!!
begin
 if Dest is TeeCell then
   with TeeCell(Dest) do
   begin
     Aligment := Self.Aligment;
     Position := Self.Position
   end
 else
   inherited
end;

> до второго Message дело не доходит.

Ошибка в коде компонента. То ли его внутренний объект Cell еще не создан, то ли уже уничтожен, то ли испорчена ссылка на него - в общем, надо видеть код.

---

← →
DimaBr   (2005-08-25 17:35) [8]

unit CellEditor;

type
 TCellEditorFrm = class(TForm)
   ComboBox1: TComboBox;
   Edit1: TEdit;
   Button1: TButton;
   Button2: TButton;
   procedure FormCreate(Sender: TObject);
   procedure FormShow(Sender: TObject);
   procedure ComboBox1Change(Sender: TObject);
   procedure Edit1Change(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
   ACell : TeeCell;
 end;

type TCellProperty = class(TClassProperty)
 public
   procedure Edit; override;
   function GetAttributes: TPropertyAttributes; override;
 end;

implementation
{$R *.dfm}
const StrAlig: array[0..4] of string = ("ëåâûé","ïðàâûé","âåðõ","íèç" ,"çíà÷åíèå");
const ValAlig: array[0..4] of TeeAligment = (alLeft,alRight,alTop,alBottom,alValue);

procedure TCellEditorFrm.FormCreate(Sender: TObject);
var i: integer;
begin
 ACell := TeeCell.Create;  // создали ACell при создании формы
 for i := 0 to 4 do
   ComboBox1.Items.Add(StrAlig[i]);
end;
procedure TCellEditorFrm.FormDestroy(Sender: TObject);
begin
 ACell.Free;
end;

procedure TCellEditorFrm.FormShow(Sender: TObject);
var i: integer;
begin
 for i := 0 to 4 do
   if ACell.Aligment = ValAlig[i] then ComboBox1.ItemIndex := i;
 Edit1.Text := Inttostr(ACell.Position);
end;

procedure TCellProperty.Edit;
var Source: TeeCell;
begin
 showmessage("Edit");
 Source := TeeCell(GetOrdValue);
 showmessage(inttostr(Source.Position));
 with TCellEditorFrm.Create(Application) do
 try
   ACell.Assign(Source);
   if ShowModal = 1
     then Source.Assign(ACell);
 finally
   Free;
 end;
end;

function TCellProperty.GetAttributes: TPropertyAttributes;
begin
 Result := [paDialog,paSubProperties];
end;

procedure TCellEditorFrm.ComboBox1Change(Sender: TObject);
begin
 ACell.Aligment := ValAlig[ComboBox1.ItemIndex];
end;

procedure TCellEditorFrm.Edit1Change(Sender: TObject);
begin
 ACell.Position := StrToInt(Edit1.Text);
end;
end.


unit Test;

type TeeAligment = (alLeft,alRight,alTop,alBottom,alValue);
type
 TeeCell = class(TPersistent)
   private
     fAligment: TeeAligment;
     fPosition: integer;
   protected
     procedure SetPosition(Value: integer);
   public
     constructor Create;
     destructor Destroy;override;
     procedure AssignTo(Value: TPersistent);override;
   published
     property Aligment: TeeAligment read fAligment write fAligment default alLeft;
     property Position: integer read fPosition write SetPosition default 0;
end;

type
 TTest = class(TComponent)
   private
     fCell : TeeCell;
   protected
     procedure SetCell(Value:TeeCell);
     function GetCell: TeeCell;
   public
     constructor Create(AOwner:TComponent);override;
     destructor Destroy;override;
   published
     property Cell: TeeCell read GetCell write SetCell;
end;

procedure Register;

implementation
uses CellEditor;

constructor TeeCell.Create;
begin
 inherited Create;
 fAligment := alValue;
 fPosition := 30;
end;

destructor TeeCell.Destroy;
begin
 inherited Destroy;
end;

constructor TTest.Create;
begin
 inherited Create(AOwner);
 fCell := TeeCell.Create;
end;

destructor TTest.Destroy;
begin
 fCell.Free;
 inherited Destroy;
end;

procedure TTest.SetCell(Value:TeeCell);
begin
 fCell.Assign(Value);
end;

function TTest.GetCell: TeeCell;
begin
 Result := fCell;
end;

procedure TeeCell.SetPosition(Value: integer);
begin
 if (Value = fPosition) or (Abs(Value) > 90) then Exit;
 fPosition := Value;
end;

procedure TeeCell.AssignTo(Value: TPersistent);
begin
if Value is TeeCell then
  with TeeCell(Value) do
  begin
    Aligment := Self.Aligment;
    Position := Self.Position
  end
else
  inherited
end;

procedure Register;
begin
 RegisterComponents("Standard", [TTest]);
 RegisterPropertyEditor(TypeInfo(TeeAligment), TeeCell, "Aligment",TCellProperty);
end;

end.


---

← →
Юрий Зотов ©   (2005-08-25 19:14) [9]

Ну елы-палы!

Вы же сделали редактор для объектного свойства Cell - почему же тогда Вы регистрируете его для порядкового свойства Alignment, да еще совсем другого класса?

Ясное дело, что GetOrdValue будет давать число от 0 до 4, а это запрещенная область адресов - и здравствуй, Access Voilation! Еще хорошо, что хоть AV выскочило, при другом раскладе можно было бы просто втихую портить память и полжизни этот баг вылавливать.

RegisterPropertyEditor(TeeCell.ClassInfo, TTest, "Cell", TCellProperty);

P.S.
Погрешностей в коде очень много, в том числе и грубых. Шлифуйте.

---

← →
Юрий Зотов ©   (2005-08-26 05:29) [10]

Чтобы было понятнее, где погрешности, причесал я код. Сравните построчно - увидите, в чем отличия. Если причины правки будет неясны - спрашивайте.

unit Test;

type
 TeeAlignment = (alLeft, alRight, alTop, alBottom, alValue);

 TeeCell = class(TPersistent)
 private
   FAligment: TeeAlignment;
   FPosition: integer;
   procedure SetPosition(const Value: integer);
 protected
   procedure AssignTo(Dest: TPersistent); override;
 public
   constructor Create;
 published
   property Aligment: TeeAlignment read FAligment write FAligment default alValue;
   property Position: integer read FPosition write SetPosition default 30;
 end;

 TTest = class(TComponent)
 private
   FCell: TeeCell;
   procedure SetCell(const Value:TeeCell);
 public
   constructor Create(AOwner:TComponent);override;
   destructor Destroy;override;
 published
   property Cell: TeeCell read FCell write SetCell;
 end;

procedure TeeCell.AssignTo(Dest: TPersistent);
begin
 if Dest is TeeCell then
   with TeeCell(Dest) do
   begin
     FAligment := Self.FAligment;
     FPosition := Self.FPosition
   end
 else
   inherited
end;

constructor TeeCell.Create;
begin
 inherited;
 FAligment := alValue;
 FPosition := 30
end;

procedure TeeCell.SetPosition(const Value: integer);
const
  MaxValue = 90;
begin
 if Abs(Value) > MaxValue then
   raise ERangeError.CreateFmt("Value must be between -%d and +%d", [MaxValue, MaxValue]);
 FPosition := Value
end;

{ TTest }

constructor TTest.Create(AOwner: TComponent);
begin
 inherited;
 FCell := TeeCell.Create
end;

destructor TTest.Destroy;
begin
 FCell.Free;
 inherited
end;

procedure TTest.SetCell(const Value: TeeCell);
begin
 FCell.Assign(Value);
end;

==============================================================

unit CellEditor;

type
 TCellEditorFrm = class(TForm)
   ComboBox1: TComboBox;
   Edit1: TEdit;
   Button1: TButton;
   Button2: TButton;
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
   procedure FormShow(Sender: TObject);
   procedure ComboBox1Change(Sender: TObject);
   procedure Edit1Change(Sender: TObject);
 private
   FCell: TeeCell;
 end;

 TCellProperty = class(TClassProperty)
 public
   procedure Edit; override;
   function GetAttributes: TPropertyAttributes; override;
 end;

procedure TCellEditorFrm.FormCreate(Sender: TObject);
var
 i: integer;
begin
 FCell := TeeCell.Create;
 for i := Ord(Low(TeeAlignment)) to Ord(High(TeeAlignment)) do
   ComboBox1.Items.Add(GetEnumName(TypeInfo(TeeAlignment), i))
end;

procedure TCellEditorFrm.FormDestroy(Sender: TObject);
begin
 FCell.Free
end;

procedure TCellEditorFrm.FormShow(Sender: TObject);
begin
 ComboBox1.ItemIndex := Ord(FCell.Aligment);
 Edit1.Text := IntToStr(FCell.Position)
end;

procedure TCellEditorFrm.ComboBox1Change(Sender: TObject);
begin
 FCell.Aligment := TeeAlignment(ComboBox1.ItemIndex)
end;

procedure TCellEditorFrm.Edit1Change(Sender: TObject);
begin
 try
   FCell.Position := StrToInt(Edit1.Text)
 except
   Edit1.Undo;
   raise
 end
end;

{ TCellProperty }

procedure TCellProperty.Edit;
var
 Source: TeeCell;
begin
 Source := TeeCell(GetOrdValue);
 with TCellEditorFrm.Create(nil) do
 try
   FCell.Assign(Source);
   if ShowModal = mrOK then
     Source.Assign(FCell)
 finally
   Free
 end
end;

function TCellProperty.GetAttributes: TPropertyAttributes;
begin
 Result := inherited GetAttributes + [paDialog]
end;


---

← →
DimaBr   (2005-08-26 09:10) [11]

Огромное спасибо !!!   Всё замечательно работает.
Возникло несколько вопросов:

1) В чём различие между..., ведь в любом случае параметр изменить нельзя.

procedure SetPosition(const Value: integer);
procedure SetPosition(Value: integer);

2) В чём различие

constructor TeeCell.Create;
begin
inherited;
inherited Create;
end;

3) Не лучше ли написать вместо

Result := inherited GetAttributes + [paDialog];
Result := [paMultiSelect, paSubProperties, paReadOnly,paDialog];
4) Код

procedure TCellEditorFrm.Edit1Change(Sender: TObject);
begin
try
  FCell.Position := StrToInt(Edit1.Text)
except
  Edit1.Undo;
  raise
end
end;
я перенёс в Edit1Exit, поскольку при вводе числа 100, код отрабатываеся для 1, потом для 10 (10 - нормально), потом для 100 (100 - выход за предел и UNDO - 10)
5) Имеет ли смысл приравнивать в методе SetPosition() FPosition := Value, если они равны.

---

← →
Юрий Зотов ©   (2005-08-26 12:58) [12]

1. В случае const параметр передается по ссылке. Поэтому, если его длина не более 4-х байт, то разницы нет (кроме очевидной, о которой вряд ли стоит здесь говорить). Но если длина параметра более 4-х байт, то смысл есть, и даже очень большой - мы даем возможность компилятору передать его через регистр, да еще и экономим место в стеке.

В данном случае длина Value - 4 байта и разницы нет, но лучше придерживаться грамотного стиля всегда, чтобы он стал просто привычкой и шел как бы сам по себе, на автопилоте.

2. Разницы нет. Просто меньше писанины, а стиль кода подчеркивает, что унаследованный метод вызывается с теми же самыми параметрами и позволяет увидеть это даже при беглом просмотре. При корпоративной разработке довольно полезно.

3. Можно, но для этого надо лезть в VCL и копировать кусок оттуда - тратится время. А зачем его тратить, если нам нужно только добавить диалог? Кроме того, не исключено, что в следующих версиях Delphi что-то изменится (такое, кстати уже бывало) - а ведь вызов inherited автоматически это учтет и ничего не придется переделывать, код получится универсальным.

4. Правильно сделали. Лучше даже вообще убрать все обработчики OnChange или OnExit (чтобы не срабатывали при каждом чихе), а присвоение свойств объекта повесить на кнопку ОК (при ошибке не присваивать ModalResult, чтобы не закрывать форму).

5. С точки зрения логики алгоритма - без разницы. А с точки зрения оптимальности кода - смысл есть (присваивание - это одна команда move, код проверки - это еще несколько команд, без которых в данном случае вполне можно и обойтись).

---

← →
DimaBr   (2005-08-26 15:02) [13]

Ещё раз ОГРОМНОЕ СПАСИБО !!!!!!

---

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

Текущий архив: 2006.02.12;
Скачать: CL | DM;

Наверх

Память: 0.51 MB
Время: 0.045 c