Мастера DELPHI, Delphi programming community Рейтинг@Mail.ru Титульная страница Поиск, карта сайта Написать письмо 
| Новости |
Новости сайта
Поиск |
Поиск по лучшим сайтам о Delphi
FAQ |
Огромная база часто задаваемых вопросов и, конечно же, ответы к ним ;)
Статьи |
Подборка статей на самые разные темы. Все о DELPHI
Книги |
Новинки книжного рынка
Новости VCL
Обзор свежих компонент со всего мира, по-русски!
|
| Форумы
Здесь вы можете задать свой вопрос и наверняка получите ответ
| ЧАТ |
Место для общения :)
Орешник |
Коллекция курьезных вопросов из форумов
KOL и MCK |
KOL и MCK - Компактные программы на Delphi
Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / rsdn.org

 
Чтобы не потерять эту дискуссию, сделайте закладку « предыдущая ветвь | форум | следующая ветвь »

подсистема object tree падае наметртво при удалении подкомпонента [D7, WinXP]


AlexRayne   (06.09.09 00:49

Драсте. продолжаю свою предыдущую тему.
создал компонент-контейнер других компонентов
вот модуль
type

   FiltersSet = class(TComponent)
     protected
       //FItems : LogTracks;
       procedure GetChildren(Proc: TGetChildProc; Root: TComponent);override;
       function GetChildOwner: TComponent; override;
       function GetItem(index : integer) : baseEventFilter;
     public
       function  Add(const aName : string; template : BaseEventFilter) : integer;overload;
       function  Add(const aName : string; aFilterClass : EventFilterClass) : integer;overload;
       procedure GatterItemsNames(target : TStrings);

       constructor Create(aOwner : TComponent);override;
       destructor Destroy;override;
       property Items[Index : integer] : BaseEventFilter read GetItem;
   end;

var
   LogFiltersEnum : FiltersSet;

procedure Register;

implementation
uses AdressPaleteFrame
   , sysutils
     ;

{****************************************************************************
                             FiltersSet
******************************************************************************}
constructor FiltersSet.Create(aOwner : TComponent);
begin
 inherited;
end;

destructor FiltersSet.Destroy;
begin
 inherited;
end;

procedure FiltersSet.GetChildren(Proc: TGetChildProc; Root: TComponent);
var
 I: Integer;
 OwnedComponent: TComponent;
begin
   for I := 0 to ComponentCount - 1 do
   begin
     OwnedComponent := Components[I];
     if not OwnedComponent.HasParent then Proc(OwnedComponent);
   end;
end;

function FiltersSet.GetChildOwner: TComponent;
begin
 result := self;
end;

function FiltersSet.GetItem(index : integer) : BaseEventFilter;
begin
 result := components[index] as BaseEventFilter;
end;

function  FiltersSet.Add(const aName : string; aFilterClass : EventFilterClass) : integer;
var
 aFilter : baseEventFilter;
begin
   afilter := aFilterClass.Create(Self);
   aFilter.Name := aName;
   //afilter.SetSubComponent(true);
   result := afilter.ComponentIndex;
end;

function  FiltersSet.Add(const aName : string; template : BaseEventFilter) : integer;
var
 aFilter : baseEventFilter;
 idx : integer;
 newname : string;
 namecomp : tcomponent;
begin
   newname := aName;
   namecomp := FindComponent(aName);
   if assigned(namecomp) then
       idx := namecomp.ComponentIndex
   else
       idx := -1;
   while idx >= 0 do begin
     newname := aName + IntTostr(idx+1);
     namecomp := FindComponent(newName);
     if assigned(namecomp) then
       idx := namecomp.ComponentIndex
     else
       idx := -1;
   end;
   afilter := template.CreateInstance(Self);
   aFilter.Name := newName;
   //afilter.SetSubComponent(true);
   result := afilter.ComponentIndex;
end;

procedure FiltersSet.GatterItemsNames(target : TStrings);
var
 idx : integer;
begin
 for idx := 0 to ComponentCount -1 do
   target.add(components[idx].name);
end;

procedure Register;
begin
 RegisterClasses([FiltersSet]);
end;

initialization begin
   RegisterClasses([FiltersSet, AdressFilter]);
   LogFiltersEnum := FiltersSet.Create(nil);
   LogFiltersEnum.Add('AdressFilter', AdressFilter);
end;

finalization begin
   FreeAndNil(LogFiltersEnum);
end;

end.


alexrayne   (06.09.09 00:58[1]

продолжаю.
для работы с контейнером создал редактор, он нормально работает. и азхотелось мне чтобы object tree view отображал содержимое контейнера, для чего зарегистрировал ветки\sprigи\ контейнера и фильтра.
тут и начались беды - если позволить ветке контейнера описывать свои подкомпоненты, то они нормально отображаются  при загрузке проекта, но если содержимое контейнера начать изменять - удалить чегото, то дельфя начинает ругаться исключениями типа Access violation. а если попробовать удалить подкомпонент контейнера прямо  в object tree voew - то дельфа вываливается моментально, без предупреждений

вот модуль дизайнеров

unit FiltersSetDesigner;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, ExtCtrls, StdCtrls
 , DesignEditors, DesignIntf, TypInfo, TreeIntf
 ;

TYPE
 FiltersSetEditor = class(TDefaultEditor)
   procedure ExecuteVerb(Index: Integer); override;
   function GetVerb(Index: Integer): string; override;
   function GetVerbCount: Integer; override;
 end;

 {object tree sprigs}
 BaseEventFilterSprig = class(TComponentSprig);

 FiltersSetSprig = class(TComponentSprig)
 public
   constructor Create(AItem: TPersistent); override;
   function DragOver(AItem: TSprig): Boolean; override;
   function DragDrop(AItem: TSprig): Boolean; override;
   function PaletteOver(ASprigClass: TSprigClass; AClass: TClass): Boolean; override;
   //procedure FigureChildren; override;
 end;

procedure Register;

implementation
uses LogTracksEditForm
   , LogFiltersGUI
   , LogFilters
   ;

procedure Register;
begin
 RegisterComponentEditor(FiltersSet, FiltersSetEditor);
 RegisterSprigType(BaseEventFilter,BaseEventFilterSprig);
 RegisterSprigType(FiltersSet,FiltersSetSprig);
end;

procedure EditFilters(value : FiltersSet; Designer: IDesigner);
begin
 with TLogTracksDesigner.Create(Application) do
   try
     target := value;
     ShowModal;
   finally
     Free;
   end;
end;

{***************************************************************************
                             FiltersSetEditor
******************************************************************************}
function FiltersSetEditor.GetVerbCount: Integer;
begin
   result := 1;
end;

procedure FiltersSetEditor.ExecuteVerb(Index: Integer);
begin
 if index = 0 then
     editfilters(component as FiltersSet, designer);
end;

function FiltersSetEditor.GetVerb(Index: Integer): string;
begin
 if index = 0 then
   result := 'filters....'
 else
   result := '';
end;

{***************************************************************************
                             BaseEventFilterSprig
******************************************************************************}
{***************************************************************************
                             FiltersSetSprig
******************************************************************************}
constructor FiltersSetSprig.Create(AItem: TPersistent);
begin
 inherited;
 ImageIndex := CDataModuleSprigImage;
end;

function FiltersSetSprig.DragOver(AItem: TSprig): Boolean;
begin
 Result := (AItem.Owner = Self)
            and (AItem is BaseEventFilterSprig{TComponentSprig})
            and AItem.DragOverTo(Self)
            //and ((AItem as TComponentSprig).Item is BaseEventFilter)
            ;
end;

function FiltersSetSprig.DragDrop(AItem: TSprig): Boolean;
begin
 Result := (AItem.Owner = Self)
            and (AItem is BaseEventFilterSprig{TComponentSprig})
            and AItem.DragDropTo(Self)
            ;
end;

function FiltersSetSprig.PaletteOver(ASprigClass: TSprigClass;
 AClass: TClass): Boolean;
begin
 Result := ASprigClass.InheritsFrom(BaseEventFilterSprig);
end;

{
procedure FiltersSetSprig.FigureChildren;
var
 I: Integer;
 LChildItem: TComponent;
 LChild: TSprig;
 LChildClass: TComponentSprigClass;
begin
 // let it go first
 inherited;

 // now lets loop through the component items
 for I := 0 to FiltersSet(Item).ComponentCount - 1 do
 begin

   // find the best class
   LChildItem := FiltersSet(Item).Components[I];
   LChild := Root.Find(LChildItem);

   // if not then create it
   if LChild = nil then
   begin
     LChildClass := TComponentSprigClass(FindBestSprigClass(LChildItem.ClassType, TComponentSprig));
     if LChildClass <> nil then
     begin
       LChild := LChildClass.Create(LChildItem, Self);

       Add(LChild);
     end;
   end;
 end;
end;
}

end.


AlexRayne   (06.09.09 01:00[2]

ктото пробовал тварить чегото подобное, подскажите чего недотумкал?


DimaBr ©   (07.09.09 10:59[3]

Вообще этим мало кто занимается, источников практически нет.
Проще (на мой взгляд) всё же вернуться с колекции


AlexRayne   (07.09.09 15:44[4]

имхо, ето нифига непроще, как сериализовать все ето?
ктото должен быть хозяином фильтра, а так как он  TComponent, то владельцем остается только компонет-контейнер.
тогда если переходить к коллекциям - то получается тожесамое, только в контейнер еще и коллекцию добавить надо, а какой от нее прок, если она фактически будет дублировать только собственный список компонентов контейнера?

имхо, падение objecttree както связано с тем что в контейнере нет ассоцииваных с фильтрами полей, ведь и DataModule и Form каждый компонент который нв них лежит объявлен в виде явного поля.


Игорь Шевченко ©   (07.09.09 23:59[5]


> то дельфя начинает ругаться исключениями типа Access violation


Какой кошмар. А отладчиком компонентописатели не пользуются ?


AlexRayne   (09.09.09 01:15[6]

пользуется, но ведь он покрывает только код который можно скомпилить, и он таки покрывает мною написаный код, а вот код objecttree нет, вобчем исключение возникает в какомто модуле update.pas - ето все что удалось вырвать из отладчика. где его искать етот модуль? да и даже если найти , чем поможет?


DimaBr ©   (09.09.09 08:35[7]

Реализуйте по типу TDataset-TField или TActionList-TAction, то есть компоненты в компоненте с добавлением их на форму. И не нужно будет мучаться с деревом.


alexrayne   (09.09.09 10:29[8]

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


имя   (20.10.15 19:55[9]

Удалено модератором


версия для печати

Написать ответ

Ваше имя (регистрация  E-mail 







Разрешается использование тегов форматирования текста:
<b>жирный</b> <i>наклонный</i> <u>подчеркнутый</u>,
а для выделения текста программ, используйте <code> ... </code>
и не забывайте закрывать теги! </b></i></u></code> :)


Наверх

  Рейтинг@Mail.ru     Титульная страница Поиск, карта сайта Написать письмо