Конференция "Компоненты" » подсистема object tree падае наметртво при удалении подкомпонента [D7, WinXP]
 
  • AlexRayne (06.09.09 00:49) [0]
    Драсте. продолжаю свою предыдущую тему.
    создал компонент-контейнер других компонентов
    вот модуль
    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]
    Удалено модератором
 
Конференция "Компоненты" » подсистема object tree падае наметртво при удалении подкомпонента [D7, WinXP]
Есть новые Нет новых   [134427   +35][b:0][p:0.001]