-
Драсте. продолжаю свою предыдущую тему. создал компонент-контейнер других компонентов вот модуль 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.
-
продолжаю. для работы с контейнером создал редактор, он нормально работает. и азхотелось мне чтобы 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.
-
ктото пробовал тварить чегото подобное, подскажите чего недотумкал?
-
Вообще этим мало кто занимается, источников практически нет. Проще (на мой взгляд) всё же вернуться с колекции
-
имхо, ето нифига непроще, как сериализовать все ето? ктото должен быть хозяином фильтра, а так как он TComponent, то владельцем остается только компонет-контейнер. тогда если переходить к коллекциям - то получается тожесамое, только в контейнер еще и коллекцию добавить надо, а какой от нее прок, если она фактически будет дублировать только собственный список компонентов контейнера?
имхо, падение objecttree както связано с тем что в контейнере нет ассоцииваных с фильтрами полей, ведь и DataModule и Form каждый компонент который нв них лежит объявлен в виде явного поля.
-
> то дельфя начинает ругаться исключениями типа Access violation
Какой кошмар. А отладчиком компонентописатели не пользуются ?
-
пользуется, но ведь он покрывает только код который можно скомпилить, и он таки покрывает мною написаный код, а вот код objecttree нет, вобчем исключение возникает в какомто модуле update.pas - ето все что удалось вырвать из отладчика. где его искать етот модуль? да и даже если найти , чем поможет?
-
Реализуйте по типу TDataset-TField или TActionList-TAction, то есть компоненты в компоненте с добавлением их на форму. И не нужно будет мучаться с деревом.
-
пока неплохо и так - с отключеным просмотром подкомпонентов, редактор нормальный есть. если на форме у меня несколько контейнеров (а у меня 2), то фильтры их свалятся в одну кучу, тут нужно соответственно следить за тем чтобы их имена непересекались - ето серьезное ограниченичение. вдобавок сейчас я легко знаю в каком контейнере находится фильтр, а если они в общей куче, то надо придумывать поиск.
-
Удалено модератором
|