Конференция "Компоненты" » Как-то старнно работет дизайнер свойства [WinXP]
 
  • Alexandr2007 (16.03.07 17:23) [0]
    Добрый день!
    Помогите пожалуйста, есть компонент, у него есть свойство типа TCollection, соотвтетственно описан класс TCollectionItems. Итого: кладу компонент на форму, по клику вызывается окно редактора, но в нем я не могу добавить новый Item.
    procedure TFilterEditor2006.Edit;
     Var
       Addr: Integer;
    begin
    //  inherited;
     Addr := GetOrdValueAt(0);
     F.Component := Pointer(Addr);
    //  if F.Component = nil
    //    then F.Component := TSmcFilters.Create;
     F.OnItemClick := DoItemClick;
     F.Show;
    end;
    Как только разкоментирую строки с TSmcFilters.Create - все работает, но как только появляется Item, я на него кликаю, свойства его появляются в инспекторе объектов, а вот окно редактора исчезает.
    В этом деле новичек, все сделал по аналогии найденного примера, но что-то не так все работает как хотелось...

    P.S. TSmcFilters: TCollection, TSmcFilter: TCollectionItem
  • Alexandr2007 (16.03.07 17:25) [1]
    Прочитал множество статей здесь на форуме, но что-то все равно не разобрался... :(
  • Alexandr2007 (16.03.07 17:39) [2]
    Народ, плиз... могу и исходники показать... только стоит ли все сюда вылаживать - много получится...
  • Юрий Зотов © (17.03.07 01:39) [3]
    1. Редактор уберите совсем, будет работать встроенный редактор свойства.
    2. В конструкторе компонента коллецию создаете, в деструкторе - убиваете.
    3. Для свойства-коллекции пишете метод Set, в нем вызываете Assign.
  • Alexandr2007 (19.03.07 10:48) [4]
    Юрий, а как мне тогда вызвать встроенный редактор свойств в процедуре Edit? Заранее спасибо
  • DimaBr (19.03.07 11:05) [5]
    > 2) Как реализовать двойной клик по компаненту в дизайнере,  что бы появилось окно свойства TCollection?
    http://pda.delphimaster.net/?n=12&id=1157851665&p=6
  • Alexandr2007 (20.03.07 10:48) [6]
    Ребята, больщое спасибо, но что-то у меня не получается, редактор не появляется, наверное, я какую-нибудь глупость упустил... :( Вы не могли бы посмотреть код ??? заранее спасибо:
    unit SmcFilterEditor2006;

    interface

    uses DesignEditors, DesignIntf, Classes, Dialogs, SysUtils, TypInfo;

    type
     TFilterEditor2006 = class(TComponentEditor)
     private
       FPropInfo : PPropInfo;
       FPropEdit : IProperty;
       procedure GetPropProc(const PropEdit: IProperty);
     protected
     public
       constructor Create(AComponent: TComponent; ADesigner: IDesigner); override;
       function GetVerb(Index: Integer): string; override;
       function GetVerbCount: Integer; override;
       procedure ExecuteVerb(Index: Integer); override;
       function GetPropertyName: String; virtual;
       procedure Edit; override;
     end;

     procedure Register;

    implementation

    uses SmcFilter2006;

    procedure Register;
    begin
     RegisterComponentEditor(TSmcFilter2006,TFilterEditor2006);
    end;

    { TFilterEditor2006 }

    constructor TFilterEditor2006.Create(AComponent: TComponent;
     ADesigner: IDesigner);
    begin
     inherited;
     FPropInfo := GetPropInfo(GetComponent.ClassInfo, GetPropertyName, [tkClass]);
    end;

    procedure TFilterEditor2006.Edit;
     Var
       Addr: Integer;
       Selection: TDesignerSelections;
    begin
     if (FPropEdit = nil) and (FPropInfo <> nil) then begin
       Selection := TDesignerSelections.Create;
       try
         Designer.GetSelections(Selection);
         GetComponentProperties(Selection, [tkClass], Designer, GetPropProc);
       finally
         Selection.Free;
       end;
     end;
     if FPropEdit <> nil
       then FPropEdit.Edit;
    end;

    procedure TFilterEditor2006.ExecuteVerb(Index: Integer);
    begin
     inherited;
     case Index of
       0: Edit;
     end;
    end;

    function TFilterEditor2006.GetPropertyName: String;
    begin
     Result := 'SmcFilter';
    end;

    procedure TFilterEditor2006.GetPropProc(const PropEdit: IProperty);
    begin
     if PropEdit.GetPropInfo = FPropInfo
       then FPropEdit := PropEdit;
    end;

    function TFilterEditor2006.GetVerb(Index: Integer): string;
    begin
     case Index of
       0: Result := 'Edit';
       else inherited GetVerb(Index);
     end;
    end;

    function TFilterEditor2006.GetVerbCount: Integer;
    begin
     Result := inherited GetVerbCount + 1;
    end;

    end.
  • Alexandr2007 (20.03.07 10:48) [7]
    unit SmcFilter2006;

    interface

    uses
     SysUtils, Classes, DB, DBClient, Dialogs, TypInfo, DesignIntf;

    type
     TSmcTypeFilterExpr =
         (tfeInt, tfeStr, tfeDat, tfeCheck, tfeMatExp, tfeCheckBox, tfeCombo);

     TSmcFilter = class;

     TSmcFilters = class(TCollection)
     private
       function GetItem(Index: Integer): TSmcFilter;
       procedure SetItem(Index: Integer; const Value: TSmcFilter);
     public
       constructor Create; overload;
       procedure AddFilter(Value: TSmcFilter);
       procedure DelFilter(Value: TSmcFilter);
       function CreateFilter(AFileld: TField; const ADetailDataSet: TClientDataSet;
         ATypeExpr: TSmcTypeFilterExpr): TSmcFilter;
       procedure GetFilterList(List: TList; const Name: String);
       function ParamByName(const Value: String): TSmcFilter;
       function FindFilter(const Value: String): TSmcFilter;
       procedure AssignValue(Value: TSmcFilters);
       property Items[Index: Integer]: TSmcFilter read GetItem write SetItem; default;
     end;

     TSmcFilter = class(TCollectionItem)
     private
       FField: TField;
       FDetailDataSet: TClientDataSet;
       FTypeFilterExpr: TSmcTypeFilterExpr;
       FFilterName: String;
     public
       constructor Create(Collection: TCollection); overload; override;
       constructor Create(AFilters: TSmcFilters; AField: TField;
         ADetailDataSet: TClientDataSet; ATypeFilterExpr: TSmcTypeFilterExpr);
         reintroduce; overload;
     published
       property Field: TField read FField write FField;
       property DetailDataSet: TClientDataSet read FDetailDataSet write FDetailDataSet;
       property TypeFilterExpr: TSmcTypeFilterExpr read FTypeFilterExpr write FTypeFilterExpr;
       property FilterName: String read FFilterName write FFilterName;  
     end;

     TSmcFilter2006 = class(TComponent)
     private
       FDataSet: TDataSet;
       FFilters: TSmcFilters;
       procedure SetFilters(const Value: TSmcFilters);
       procedure SetDataSet(const Value: TDataSet);
       { Private declarations }
     protected
       { Protected declarations }
     public
       constructor Create; reintroduce;
       destructor Destroy; reintroduce;
       { Public declarations }
     published
       property DataSet: TDataSet read FDataSet write SetDataSet;
       property Filters: TSmcFilters read FFilters write SetFilters;
       { Published declarations }
     end;

    procedure Register;

    implementation

    procedure Register;
    begin
     RegisterComponents('SmcLib2006', [TSmcFilter2006]);
    end;

    { TSmcFilter2006 }

    constructor TSmcFilter2006.Create;
    begin
     FFilters.Create;
    end;

    destructor TSmcFilter2006.Destroy;
    begin
     FFilters.Free;
     FFilters := nil;
    end;

    procedure TSmcFilter2006.SetDataSet(const Value: TDataSet);
    begin
     if FDataSet <> Value
       then FDataSet := Value;
    end;

    procedure TSmcFilter2006.SetFilters(const Value: TSmcFilters);
    begin
     FFilters.Assign(Value);
    end;

    { TSmcFilters }

    procedure TSmcFilters.AddFilter(Value: TSmcFilter);
    begin
     Value.Collection := Self;
    end;

    procedure TSmcFilters.AssignValue(Value: TSmcFilters);
     Var
       i: Integer;
       Fil: TSmcFilter;
    begin
     for I := 0 to Value.Count - 1 do
     begin
       Fil := FindFilter(Value[i].FilterName);
       if Fil <> nil
         then Fil.Assign(Value[i]);
     end;
    end;

    constructor TSmcFilters.Create;
    begin
     inherited Create(TSmcFilter);
    end;

    function TSmcFilters.CreateFilter(AFileld: TField;
     const ADetailDataSet: TClientDataSet;
     ATypeExpr: TSmcTypeFilterExpr): TSmcFilter;
    begin
     Result := Add as TSmcFilter;
     Result.Field := AFileld;
     Result.DetailDataSet := ADetailDataSet;
     Result.TypeFilterExpr := ATypeExpr;
    end;

    procedure TSmcFilters.DelFilter(Value: TSmcFilter);
    begin
     Value.Collection := nil;
    end;

    function TSmcFilters.FindFilter(const Value: String): TSmcFilter;
     Var
       I: Integer;
    begin
     for I := 0 to Count - 1 do
     begin
       Result := TSmcFilter(inherited Items[i]);
       if CompareText(Result.FilterName, Value) = 0
         then Exit;
     end;
     Result := nil;  
    end;

    procedure TSmcFilters.GetFilterList(List: TList; const Name: String);
     Var
       Pos: Integer;
    begin
     Pos := 1;
     while Pos <= Length(Name) do
       List.Add(ParamByName(ExtractFieldName(Name, Pos)));
    end;

    function TSmcFilters.GetItem(Index: Integer): TSmcFilter;
    begin
     Result := TSmcFilter(inherited Items[Index]);
    end;

    function TSmcFilters.ParamByName(const Value: String): TSmcFilter;
    begin
     Result := FindFilter(Value);
     if Result = nil
       then ShowMessage('Ошибка');
    end;

    procedure TSmcFilters.SetItem(Index: Integer; const Value: TSmcFilter);
    begin
     inherited SetItem(Index, TCollectionItem(Value));
    end;

    { TSmcFilter }

    constructor TSmcFilter.Create(Collection: TCollection);
    begin
     inherited Create(Collection);
     Field := nil;
     DetailDataSet := nil;
     TypeFilterExpr := tfeInt;
     FilterName := 'NewFilter';
    end;

    constructor TSmcFilter.Create(AFilters: TSmcFilters; AField: TField;
     ADetailDataSet: TClientDataSet; ATypeFilterExpr: TSmcTypeFilterExpr);
    begin
     Create(AFilters);
     Field := AField;
     DetailDataSet := ADetailDataSet;
     TypeFilterExpr := ATypeFilterExpr;
    end;

    end.
  • DimaBr (20.03.07 10:56) [8]
    В код вчитываться не стал, есть прще вариант.
    Подключить модуль ColnEdit и вызвать один из вариантов


    procedure ShowCollectionEditor(ADesigner: IDesigner; AComponent: TComponent;
     ACollection: TCollection; const PropertyName: string);
    function ShowCollectionEditorClass(ADesigner: IDesigner;
     CollectionEditorClass: TCollectionEditorClass; AComponent: TComponent;
     ACollection: TCollection; const PropertyName: string;
     ColOptions: TColOptions = [coAdd, coDelete, coMove]): TCollectionEditor;

  • Alexandr2007 (20.03.07 10:58) [9]
    т.е. в процедуре Edit вызвать ShowCollectionEditor ???
  • DimaBr (20.03.07 10:58) [10]
    Вот тут наверное ошибка

    function TFilterEditor2006.GetPropertyName: String;
    begin
    Result := 'SmcFilter'; // долно быть наверное - Filters
    end;

  • Alexandr2007 (20.03.07 10:59) [11]
    Спасибо большое, сейчас попробую
  • DimaBr (20.03.07 11:00) [12]

    > т.е. в процедуре Edit вызвать

    Угу !!!
    Можно например породить свой редактро от стандартного, добавив некую функциональность. Я таким образом добавлял DblClick в редакторе.
  • Alexandr2007 (20.03.07 11:54) [13]
    Продолжаю тупить... в процедуре все равено не отрабатывает if FPropEdit <> nil then FPropEdit.Edit; FPropEdit - не nill, но редактор не запускается (проблема действительно была в Result := 'SmcFilter'; // долно быть наверное - Filters)
    procedure TFilterEditor2006.Edit;
     Var
       Selection: TDesignerSelections;
    begin
     if (FPropEdit = nil) and (FPropInfo <> nil) then
     begin
       Selection := TDesignerSelections.Create;
       try
         Designer.GetSelections(Selection);
         GetComponentProperties(Selection, [tkClass], Designer, GetPropProc);
       finally
         Selection.Free;
       end;
     end;

     if FPropEdit <> nil
       then FPropEdit.Edit;
    end;
  • Alexandr2007 (20.03.07 11:55) [14]
    Я вот тут подумал, а правильно ли как я сделал -   TFilterEditor2006 = class(TComponentEditor)... ???
  • DimaBr (20.03.07 12:16) [15]
    Вы переопределили метод Edit и в нём же ЕГО же и вызываете


    procedure TFilterEditor2006.Edit;
    Var
      Addr: Integer;
      Selection: TDesignerSelections;
    begin
    if (FPropEdit = nil) and (FPropInfo <> nil) then begin
      Selection := TDesignerSelections.Create;
      try
        Designer.GetSelections(Selection);
        GetComponentProperties(Selection, [tkClass], Designer, GetPropProc);
      finally
        Selection.Free;
      end;
    end;
    // -----------------------------------------------
    if FPropEdit <> nil
      then FPropEdit.Edit;
    end;

  • Alexandr2007 (20.03.07 12:24) [16]
    А как тогда будет правильно сделать ? (я собственно говря это и подозревал, но брал с примера... мне главное понять суть...)
  • DimaBr (20.03.07 12:43) [17]
    А разве в примере так ???
    Скопируйте пример, унаследуйтесь  от него, переопределите GetPropertyName с усё !!!
  • DimaBr (20.03.07 12:51) [18]
    Подозреваю что не хватает регистрации !!!


    procedure Register;
    begin
    RegisterComponentEditor(TMyComponent,TMyEditor);
    end;



    Суть поста
    В момент создания редактора ищем свойство в классе.

    FPropInfo := GetPropInfo(GetComponent.ClassInfo, GetPropertyName, [tkClass])


    Если таково свойство есть -

    begin
          if (FPropEdit = nil) and (FPropInfo <> nil) then begin
    //  выбираем все выбранные компоненты (в данном слечучае это лишнее)
            Selections := TDesignerSelections.Create;
            try
              Designer.GetSelections(Selections);
              GetComponentProperties(Selections, [tkClass], Designer, GetPropProc)
            finally
              Selections.Free
            end;{try}
          end;{if}
    //  вызываем прописанный редактор
          if FPropEdit <> nil then FPropEdit.Edit
        end

  • Alexandr2007 (20.03.07 13:22) [19]
    1. Регистрация есть (в коде ее можно найти выше)
    2. В регистрации действительно стоит поиск свойства класса
    3. Код, написанный Вами ниже, у меня находится в процедуре Edit, но Вы выше написаои что я этот метод переопределяю и там же вызываю, где же тогда выполнять этот код???

    а так по тексту у меня все так же и написано
 
Конференция "Компоненты" » Как-то старнно работет дизайнер свойства [WinXP]
Есть новые Нет новых   [134427   +38][b:0][p:0.004]